Commit 57d0ce34 authored by Martijn Vervoort's avatar Martijn Vervoort
Browse files

- improved handling of equivalent types within one application to share a

  single implementation.
parent d54d61fc
......@@ -98,7 +98,7 @@ write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_modul
= (True,tcl_file,type_heaps,predefined_symbols)
where
collect_type_constructors_in_dynamic_patterns :: !Int !Int [(!TypeSymbIdent,!String)] -> [(!TypeSymbIdent,!String)]
collect_type_constructors_in_dynamic_patterns :: !Int !Int [TypeSymbIdent] -> [TypeSymbIdent]
collect_type_constructors_in_dynamic_patterns i limit type_constructors_in_dynamic_patterns
| i == limit
= type_constructors_in_dynamic_patterns
......@@ -107,7 +107,7 @@ where
# (GTT_Constructor type_name=:{type_name={id_name}} module_name used_in_application_of_type_dependent_function)
= global_type_instances.[i]
| used_in_application_of_type_dependent_function || ci_type_constructor_used_in_dynamic_patterns.[i]
= collect_type_constructors_in_dynamic_patterns (inc i) limit [(type_name,module_name):type_constructors_in_dynamic_patterns]
= collect_type_constructors_in_dynamic_patterns (inc i) limit [type_name:type_constructors_in_dynamic_patterns]
= collect_type_constructors_in_dynamic_patterns (inc i) limit type_constructors_in_dynamic_patterns
= collect_type_constructors_in_dynamic_patterns (inc i) limit type_constructors_in_dynamic_patterns
where
......
......@@ -74,10 +74,14 @@ isPredefinedModuleName name :== name == PredefinedModuleName
UnderscoreSystemModule :== "_system" // implements the predefined module
LowLevelInterfaceModule :== "StdDynamicLowLevelInterface"
FunctionTypeConstructorAsString :== " -> "
instance toString GlobalTCType
create_type_string type_name module_name
:== type_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ module_name ) "")
:== if (type_name == FunctionTypeConstructorAsString)
type_name
(type_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ module_name ) ""))
get_type_name_and_module_name_from_type_string :: !String -> (!String,!String)
......@@ -75,15 +75,19 @@ UnderscoreSystemModule :== "_system" // implements the predefined module
LowLevelInterfaceModule :== "StdDynamicLowLevelInterface"
FunctionTypeConstructorAsString :== " -> "
instance toString GlobalTCType
where
toString (GTT_Basic basic_type) = create_type_string (toString basic_type) PredefinedModuleName
toString GTT_Function = " -> "
toString GTT_Function = FunctionTypeConstructorAsString
toString (GTT_Constructor type_symb_indent mod_name _) = create_type_string type_symb_indent.type_name.id_name mod_name
// +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ mod_name) "")
create_type_string type_name module_name
:== type_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ module_name ) "")
:== if (type_name == FunctionTypeConstructorAsString)
type_name
(type_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ module_name ) ""))
get_type_name_and_module_name_from_type_string :: !String -> (!String,!String)
get_type_name_and_module_name_from_type_string type_string
......@@ -95,6 +99,8 @@ get_type_name_and_module_name_from_type_string type_string
#! module_name
= type_string % (inc sep_pos,dec (size type_string))
= (type_name,module_name)
| type_string == FunctionTypeConstructorAsString
= (type_string,PredefinedModuleName)
where
CharIndex :: !String !Int !Char -> (!Bool,!Int)
CharIndex s i char
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment