diff options
| -rw-r--r-- | frontend/check.dcl | 2 | ||||
| -rw-r--r-- | frontend/check.icl | 225 | ||||
| -rw-r--r-- | frontend/checksupport.dcl | 2 | ||||
| -rw-r--r-- | frontend/checktypes.icl | 1 | ||||
| -rw-r--r-- | frontend/convertDynamics.icl | 10 | ||||
| -rw-r--r-- | frontend/frontend.icl | 31 | ||||
| -rw-r--r-- | frontend/overloading.icl | 12 | ||||
| -rw-r--r-- | frontend/postparse.icl | 25 | ||||
| -rw-r--r-- | frontend/predef.dcl | 15 | ||||
| -rw-r--r-- | frontend/predef.icl | 26 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 11 |
11 files changed, 292 insertions, 68 deletions
diff --git a/frontend/check.dcl b/frontend/check.dcl index 6977364..c46be57 100644 --- a/frontend/check.dcl +++ b/frontend/check.dcl @@ -2,7 +2,7 @@ definition module check import syntax, transform, checksupport, typesupport, predef -checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !*{#*{#FunDef}} !*PredefinedSymbols !*SymbolTable !*File !*Heaps +checkModule :: !Bool !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !*{#*{#FunDef}} !*PredefinedSymbols !*SymbolTable !*File !*Heaps -> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !*{#*{#FunDef}},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File, [String]) checkFunctions :: !Index !Level !Index !Index !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState diff --git a/frontend/check.icl b/frontend/check.icl index ab60419..9e0f4a4 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -5,6 +5,7 @@ import StdEnv import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef import explicitimports, comparedefimp, checkFunctionBodies, containers, portToNewSyntax, compilerSwitches import genericsupport +import typereify // import RWSDebug cUndef :== (-1) @@ -1322,11 +1323,11 @@ gimme_a_lazy_array_type a = a gimme_a_strict_array_type :: !u:{!.a} -> v:{!.a}, [u<=v] gimme_a_strict_array_type a = a -create_icl_to_dcl_index_table :: !ModuleKind !{#Int} IndexRange !Int !(Optional {#{#Int}}) !*{#DclModule} !*{#FunDef} +create_icl_to_dcl_index_table :: !ModuleKind !{#Int} !Int !(Optional {#{#Int}}) !*{#DclModule} !*{#FunDef} -> (!Optional {#{#Int}},!Optional {#{#Int}}, !.{#DclModule},!*{#FunDef}) -create_icl_to_dcl_index_table MK_Main icl_sizes icl_global_function_range main_dcl_module_n dcl_conversions modules fun_defs +create_icl_to_dcl_index_table MK_Main icl_sizes main_dcl_module_n dcl_conversions modules fun_defs = (No,No,modules,fun_defs) -create_icl_to_dcl_index_table _ icl_sizes icl_global_function_range main_dcl_module_n old_conversions modules fun_defs +create_icl_to_dcl_index_table _ icl_sizes main_dcl_module_n old_conversions modules fun_defs #! (size_icl_functions,fun_defs) = usize fun_defs #! icl_sizes = make_icl_sizes with @@ -1396,6 +1397,29 @@ where = renumber (inc gencase_index) gencases = gencases + +renumber_type_fun_indices :: (Optional {{#Int}}) *{#CheckedTypeDef} -> *{#CheckedTypeDef} +renumber_type_fun_indices No type_defs + = type_defs +renumber_type_fun_indices (Yes conversion_table) type_defs + # (n, type_defs) = usize type_defs + = renumber 0 n conversion_table.[cFunctionDefs] type_defs +where + renumber :: Int Int {# Int} *{#CheckedTypeDef} -> *{#CheckedTypeDef} + renumber i n conversion type_defs + | i < n + # (type_def, type_defs) = type_defs![i] + # icl_index = type_def.td_fun_index + | icl_index <> NoIndex && icl_index < size conversion + # dcl_index = conversion.[icl_index] + # type_def = { type_def & td_fun_index = dcl_index } + # type_defs = { type_defs & [i] = type_def } + = renumber (inc i) n conversion type_defs + // otherwise + = renumber (inc i) n conversion type_defs + // otherwise + = type_defs + renumber_icl_definitions_as_dcl_definitions :: !(Optional {{#Int}}) !{#Int} IndexRange !Int ![Declaration] !*{#DclModule} !*CommonDefs !*{#FunDef} -> (![Declaration],!.{#DclModule},!.CommonDefs,!*{#FunDef}) renumber_icl_definitions_as_dcl_definitions No icl_sizes icl_global_function_range main_dcl_module_n icl_decl_symbols modules cdefs fun_defs @@ -1459,7 +1483,8 @@ renumber_icl_definitions_as_dcl_definitions (Yes icl_to_dcl_index_table) icl_siz reorder_common_definitions {com_type_defs,com_cons_defs,com_selector_defs,com_class_defs,com_member_defs,com_instance_defs,com_generic_defs,com_gencase_defs} # dummy_ident = {id_name="",id_info=nilPtr} # com_type_defs=reorder_and_enlarge_array com_type_defs n_dictionary_types icl_to_dcl_index_table.[cTypeDefs] - {td_ident=dummy_ident,td_index= -1,td_arity=0,td_args=[],td_attrs=[],td_context=[],td_rhs=UnknownType,td_attribute=TA_None,td_pos=NoPos,td_used_types=[]} + {td_ident=dummy_ident,td_index= -1,td_arity=0,td_args=[],td_attrs=[],td_context=[],td_rhs=UnknownType,td_attribute=TA_None,td_pos=NoPos,td_used_types=[], + td_fun_index = NoIndex} # dummy_symbol_type={st_vars=[],st_args=[],st_args_strictness=NotStrict,st_arity=0,st_result={at_attribute=TA_None,at_type=TE},st_context=[],st_attr_vars=[],st_attr_env=[]} # com_selector_defs=reorder_and_enlarge_array com_selector_defs n_dictionary_selectors icl_to_dcl_index_table.[cSelectorDefs] {sd_ident=dummy_ident,sd_field=dummy_ident,sd_type=dummy_symbol_type,sd_exi_vars=[],sd_field_nr=0,sd_type_index=0,sd_type_ptr=nilPtr,sd_pos=NoPos} @@ -2087,32 +2112,35 @@ checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cyc = checkDclModule2 dcl_imported_module_numbers super_components.[mod_index] imports_ikh component_nr is_on_cycle modules_in_component_set mod_ident dcl_common def_macro_indices def_funtypes ste_index expl_imp_infos dcl_modules icl_functions macro_defs heaps cs -renumber_icl_module :: ModuleKind IndexRange IndexRange IndexRange Index Int {#Int} (Optional {#{#Int}}) IndexRange *{#FunDef} *CommonDefs [Declaration] *{#DclModule} *ErrorAdmin - -> (![IndexRange],![IndexRange], ![IndexRange], !Int,!Index,!IndexRange,!*{#FunDef},!*CommonDefs,![Declaration],!*{#DclModule}, *ErrorAdmin); -renumber_icl_module mod_type icl_global_function_range icl_instance_range icl_generic_range nr_of_functions main_dcl_module_n icl_sizes dcl_conversions def_macro_indices icl_functions icl_common local_defs dcl_modules error +renumber_icl_module :: ModuleKind IndexRange IndexRange IndexRange IndexRange Index Int {#Int} (Optional {#{#Int}}) IndexRange *{#FunDef} *CommonDefs [Declaration] *{#DclModule} *ErrorAdmin + -> (![IndexRange],![IndexRange],![IndexRange], ![IndexRange], !Int,!Index,!IndexRange,!*{#FunDef},!*CommonDefs,![Declaration],!*{#DclModule}, *ErrorAdmin); +renumber_icl_module mod_type icl_global_function_range icl_instance_range icl_generic_range icl_type_fun_range nr_of_functions main_dcl_module_n icl_sizes dcl_conversions def_macro_indices icl_functions icl_common local_defs dcl_modules error # (optional_icl_to_dcl_index_table,optional_old_conversion_table,dcl_modules,icl_functions) - = create_icl_to_dcl_index_table mod_type icl_sizes icl_global_function_range main_dcl_module_n dcl_conversions dcl_modules icl_functions - + = create_icl_to_dcl_index_table mod_type icl_sizes main_dcl_module_n dcl_conversions dcl_modules icl_functions # (dcl_mod, dcl_modules) = dcl_modules![main_dcl_module_n] # icl_functions = add_dummy_specialized_functions mod_type dcl_mod icl_functions # class_instances = icl_common.com_instance_defs # gencase_defs = icl_common.com_gencase_defs - # (dcl_icl_conversions, class_instances, gencase_defs, error) + # type_defs = icl_common.com_type_defs + # (dcl_icl_conversions, class_instances, gencase_defs, type_defs, error) = add_dcl_instances_to_conversion_table - optional_old_conversion_table nr_of_functions dcl_mod class_instances gencase_defs error + optional_old_conversion_table nr_of_functions dcl_mod class_instances gencase_defs type_defs error | not error.ea_ok - = ([],[],[], 0,0,def_macro_indices,icl_functions, - {icl_common & com_instance_defs=class_instances, com_gencase_defs=gencase_defs}, + = ([],[],[],[], 0,0,def_macro_indices,icl_functions, + {icl_common & com_instance_defs=class_instances, com_gencase_defs=gencase_defs, + com_type_defs=type_defs}, local_defs,dcl_modules,error) # (n_functions,icl_functions) = usize icl_functions # optional_icl_to_dcl_index_table = recompute_icl_to_dcl_index_table_for_functions optional_icl_to_dcl_index_table dcl_icl_conversions n_functions # class_instances = renumber_member_indexes_of_class_instances optional_icl_to_dcl_index_table class_instances # gencase_defs = renumber_members_of_gencases optional_icl_to_dcl_index_table gencase_defs - + # type_defs = renumber_type_fun_indices optional_icl_to_dcl_index_table type_defs + # icl_common = { icl_common & com_instance_defs = class_instances , com_gencase_defs = gencase_defs + , com_type_defs = type_defs } # (local_defs,dcl_modules,icl_common,icl_functions) @@ -2132,8 +2160,11 @@ renumber_icl_module mod_type icl_global_function_range icl_instance_range icl_ge # n_dcl_gencases = dcl_gencases.ir_to-dcl_gencases.ir_from //..AA - # local_functions_index_offset = n_dcl_instances + n_dcl_specials + n_dcl_gencases - + # dcl_type_funs = dcl_mod.dcl_type_funs + # n_dcl_type_funs = dcl_type_funs.ir_to-dcl_type_funs.ir_from + + # local_functions_index_offset = n_dcl_instances + n_dcl_gencases + n_dcl_specials + n_dcl_type_funs + # dcl_mod = case dcl_mod of dcl_mod=:{dcl_macro_conversions=Yes conversion_table} # new_macro_conversions = {if (old_icl_macro_index==(-1)) old_icl_macro_index (old_icl_macro_index+local_functions_index_offset) \\ old_icl_macro_index<-:conversion_table} @@ -2146,26 +2177,42 @@ renumber_icl_module mod_type icl_global_function_range icl_instance_range icl_ge # n_not_exported_global_functions=n_global_functions-n_exported_global_functions # end_not_exported_global_functions_range=first_not_exported_global_function_index+n_not_exported_global_functions # icl_global_functions_ranges = [{ir_from=icl_global_function_range.ir_from,ir_to=n_exported_global_functions}, - {ir_from=first_not_exported_global_function_index,ir_to=end_not_exported_global_functions_range}] - + {ir_from=first_not_exported_global_function_index,ir_to=end_not_exported_global_functions_range} + ] # first_macro_index = def_macro_indices.ir_from+local_functions_index_offset # end_macro_indexes = def_macro_indices.ir_to+local_functions_index_offset # def_macro_indices={ir_from=first_macro_index,ir_to=end_macro_indexes} # n_dcl_specials_and_gencases = n_dcl_specials + n_dcl_gencases # not_exported_instance_range = - { ir_from=icl_instance_range.ir_from + n_dcl_instances + n_dcl_specials_and_gencases - , ir_to = icl_instance_range.ir_to + n_dcl_specials_and_gencases + { ir_from=icl_instance_range.ir_from + n_dcl_instances + n_dcl_specials_and_gencases + n_dcl_type_funs + , ir_to = icl_instance_range.ir_to + n_dcl_specials_and_gencases + n_dcl_type_funs } # icl_instances_ranges = [dcl_instances, not_exported_instance_range] # not_exported_generic_range = - { ir_from =icl_generic_range.ir_from + n_dcl_specials_and_gencases - , ir_to = icl_generic_range.ir_to + n_dcl_specials + { ir_from =icl_generic_range.ir_from + n_dcl_specials_and_gencases + n_dcl_type_funs + , ir_to = icl_generic_range.ir_to + n_dcl_specials + n_dcl_type_funs } # icl_generic_ranges = [dcl_gencases, not_exported_generic_range] - = (icl_global_functions_ranges, icl_instances_ranges, icl_generic_ranges, n_exported_global_functions,local_functions_index_offset,def_macro_indices,icl_functions,icl_common,local_defs,dcl_modules, error) + # n_not_exported_type_funs + = (icl_type_fun_range.ir_to - icl_type_fun_range.ir_from) - n_dcl_type_funs + # not_exported_type_fun_range = + { ir_from = not_exported_generic_range.ir_to + , ir_to = not_exported_generic_range.ir_to + n_not_exported_type_funs + } + + # icl_type_fun_ranges = [dcl_type_funs, not_exported_type_fun_range] + + # dcl_global = {ir_from=icl_global_function_range.ir_from,ir_to=n_exported_global_functions} + # dcl_ranges = + [dcl_global, dcl_instances, dcl_gencases, dcl_type_funs, dcl_specials] + # icl_global = {ir_from=first_not_exported_global_function_index,ir_to=end_not_exported_global_functions_range} + # icl_ranges = + [icl_global, not_exported_instance_range, not_exported_generic_range] + + = (icl_global_functions_ranges, icl_instances_ranges, icl_generic_ranges, icl_type_fun_ranges, n_exported_global_functions,local_functions_index_offset,def_macro_indices,icl_functions,icl_common,local_defs,dcl_modules, error) where add_dummy_specialized_functions MK_Main dcl_mod icl_functions = icl_functions @@ -2176,24 +2223,29 @@ renumber_icl_module mod_type icl_global_function_range icl_instance_range icl_ge # dummy_function = {fun_ident={id_name="",id_info=nilPtr},fun_arity= -1,fun_priority=NoPrio,fun_body=NoBody,fun_type=No,fun_pos=NoPos,fun_kind=FK_Unknown,fun_lifted=0,fun_info=EmptyFunInfo} = arrayPlusList icl_functions [dummy_function \\ i<-[0..n_specials-1]] - add_dcl_instances_to_conversion_table :: (Optional {#{#Int}}) !Index !DclModule !*{# ClassInstance} !*{# GenericCaseDef} *ErrorAdmin - -> (!*Optional *{#Index},!*{# ClassInstance}, !*{# GenericCaseDef},*ErrorAdmin) - add_dcl_instances_to_conversion_table optional_old_conversion_table first_free_index dcl_mod=:{dcl_specials,dcl_functions,dcl_common,dcl_macro_conversions} icl_instances icl_gencases error + add_dcl_instances_to_conversion_table :: (Optional {#{#Int}}) !Index !DclModule !*{# ClassInstance} !*{# GenericCaseDef} !*{# CheckedTypeDef} *ErrorAdmin + -> (!*Optional *{#Index},!*{# ClassInstance}, !*{# GenericCaseDef}, !*{# CheckedTypeDef},*ErrorAdmin) + add_dcl_instances_to_conversion_table optional_old_conversion_table first_free_index + dcl_mod=:{dcl_specials,dcl_functions,dcl_common,dcl_macro_conversions,dcl_type_funs} + icl_instances icl_gencases icl_type_defs error = case dcl_macro_conversions of Yes _ - # (new_conversion_table, icl_instances, icl_gencases, error) + # (new_conversion_table, icl_instances, icl_gencases, icl_type_defs, error) = build_conversion_table_for_instances_of_dcl_mod dcl_specials first_free_index optional_old_conversion_table - dcl_functions dcl_common.com_instance_defs icl_instances dcl_common.com_gencase_defs icl_gencases error - -> (Yes new_conversion_table,icl_instances, icl_gencases, error) + dcl_functions dcl_common.com_instance_defs icl_instances dcl_common.com_gencase_defs icl_gencases + dcl_common.com_type_defs icl_type_defs error + -> (Yes new_conversion_table,icl_instances, icl_gencases, icl_type_defs, error) No - -> (No, icl_instances, icl_gencases, error) + -> (No, icl_instances, icl_gencases, icl_type_defs, error) where - build_conversion_table_for_instances_of_dcl_mod dcl_specials=:{ir_from,ir_to} first_free_index optional_old_conversion_table dcl_functions dcl_instances icl_instances dcl_gencases icl_gencases error + build_conversion_table_for_instances_of_dcl_mod dcl_specials=:{ir_from,ir_to} first_free_index optional_old_conversion_table dcl_functions + dcl_instances icl_instances dcl_gencases icl_gencases dcl_types icl_type_defs error #! nr_of_dcl_functions = size dcl_functions # (Yes old_conversion_table) = optional_old_conversion_table #! dcl_instances_table = old_conversion_table.[cInstanceDefs] #! dcl_gencase_table = old_conversion_table.[cGenericCaseDefs] #! dcl_function_table = old_conversion_table.[cFunctionDefs] + #! dcl_type_table = old_conversion_table.[cTypeDefs] #! new_table = { createArray nr_of_dcl_functions NoIndex & [i] = icl_index \\ icl_index <-: dcl_function_table & i <- [0..] } #! index_diff = first_free_index - ir_from #! new_table = { new_table & [i] = i + index_diff \\ i <- [ir_from .. ir_to - 1] } @@ -2201,7 +2253,9 @@ renumber_icl_module mod_type icl_global_function_range icl_instance_range icl_ge = build_conversion_table_for_instances 0 dcl_instances dcl_instances_table icl_instances new_table error #! (new_table, icl_gencases, error) = build_conversion_table_for_generic_cases 0 dcl_gencases dcl_gencase_table icl_gencases new_table error - = (new_table, icl_instances, icl_gencases, error) + #! (new_table, icl_type_defs) + = fill_conversion_table_for_type_funs 0 dcl_types icl_type_defs dcl_type_table new_table + = (new_table, icl_instances, icl_gencases, icl_type_defs, error) build_conversion_table_for_generic_cases dcl_index dcl_gencases gencase_table icl_gencases new_table error | dcl_index < size gencase_table @@ -2239,10 +2293,52 @@ renumber_icl_module mod_type icl_global_function_range icl_instance_range icl_ge = build_conversion_table_for_instances_of_members (inc mem_index) dcl_members icl_members new_table = new_table -checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !*{#*{#FunDef}} !*PredefinedSymbols !*SymbolTable !*File !*Heaps + fill_conversion_table_for_type_funs dcl_type_index dcl_types icl_type_defs type_conversions new_table + | dcl_type_index >= size dcl_types + = (new_table, icl_type_defs) + # dcl_type_fun_index = dcl_types.[dcl_type_index].td_fun_index + | dcl_type_fun_index == NoIndex || dcl_types.[dcl_type_index].td_fun_index == NoIndex + = fill_conversion_table_for_type_funs (inc dcl_type_index) dcl_types icl_type_defs type_conversions new_table + // sanity check ... + | dcl_type_index < 0 // == NoIndex + = abort ("check, fill_conversion_table_for_type_funs: too small dcl conversion " + +++ dcl_types.[dcl_type_index].td_ident.id_name) + | dcl_type_index >= size type_conversions + = abort ("check, fill_conversion_table_for_type_funs: too large dcl conversion " + +++ dcl_types.[dcl_type_index].td_ident.id_name) + # icl_type_index = type_conversions.[dcl_type_index] + // sanity check ... + | icl_type_index < 0 // == NoIndex + = abort ("check, fill_conversion_table_for_type_funs: no icl type index " + +++ dcl_types.[dcl_type_index].td_ident.id_name) + | icl_type_index >= size icl_type_defs + = abort ("check, fill_conversion_table_for_type_funs: too large icl type index " + +++ dcl_types.[dcl_type_index].td_ident.id_name) + // ... sanity check + # (icl_type_fun_index,icl_type_defs) = icl_type_defs![icl_type_index].td_fun_index + | dcl_type_fun_index == NoIndex + // sanity check ... + | icl_type_fun_index <> NoIndex + = abort ("check, fill_conversion_table_for_type_funs: indices mismatch icl ") + // +++ icl_types.[icl_type_index].td_ident.id_name) + // ... sanity check + = fill_conversion_table_for_type_funs (inc dcl_type_index) dcl_types icl_type_defs type_conversions new_table + // otherwise + // sanity check ... + | icl_type_fun_index == NoIndex + = abort ("check, fill_conversion_table_for_type_funs: indices mismatch dcl ") + // +++ dcl_types.[dcl_type_index].td_ident.id_name) + | new_table.[dcl_type_fun_index] <> NoIndex + = abort ("check, fill_conversion_table_for_type_funs: entry already occupied ") + // +++ dcl_types.[dcl_type_index].td_ident.id_name) + /// ... sanity check + # new_table = {new_table & [dcl_type_fun_index] = icl_type_fun_index} + = fill_conversion_table_for_type_funs (inc dcl_type_index) dcl_types icl_type_defs type_conversions new_table + +checkModule :: !Bool !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !*{#*{#FunDef}} !*PredefinedSymbols !*SymbolTable !*File !*Heaps -> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !*{#*{#FunDef}},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File, [String]) -checkModule {mod_defs,mod_ident,mod_type,mod_imports,mod_imported_objects,mod_foreign_exports,mod_modification_time} icl_global_function_range fun_defs n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache +checkModule support_dynamics {mod_defs,mod_ident,mod_type,mod_imports,mod_imported_objects,mod_foreign_exports,mod_modification_time} icl_global_function_range fun_defs n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache optional_dcl_mod scanned_modules dcl_modules cached_dcl_macros predef_symbols symbol_table err_file heaps # nr_of_cached_modules = size dcl_modules # (optional_pre_def_mod,predef_symbols) @@ -2254,7 +2350,7 @@ checkModule {mod_defs,mod_ident,mod_type,mod_imports,mod_imported_objects,mod_fo = check_module1 mod_defs icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules cached_dcl_macros dcl_module_n_in_cache predef_symbols symbol_table err_file # icl_instance_range = {ir_from = first_inst_index, ir_to = first_gen_inst_index/*AA nr_of_functions*/} # icl_generic_range = {ir_from = first_gen_inst_index, ir_to = nr_of_functions} //AA - = check_module2 mod_ident mod_modification_time mod_imported_objects mod_imports mod_foreign_exports mod_type icl_global_function_range icl_instance_range icl_generic_range nr_of_functions nr_of_cached_modules optional_pre_def_mod local_defs icl_functions macro_defs init_dcl_modules cdefs sizes heaps cs + = check_module2 support_dynamics mod_ident mod_modification_time mod_imported_objects mod_imports mod_foreign_exports mod_type icl_global_function_range icl_instance_range icl_generic_range nr_of_functions nr_of_cached_modules optional_pre_def_mod local_defs icl_functions macro_defs init_dcl_modules cdefs sizes heaps cs check_module1 cdefs icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules cached_dcl_macros dcl_module_n_in_cache predef_symbols symbol_table err_file # error = {ea_file = err_file, ea_loc = [], ea_ok = True } @@ -2321,6 +2417,7 @@ check_module1 cdefs icl_global_function_range fun_defs optional_dcl_mod optional <=< adjust_predefined_module_symbol PD_StdStrictLists <=< adjust_predefined_module_symbol PD_StdDynamic <=< adjust_predefined_module_symbol PD_StdGeneric + <=< adjust_predefined_module_symbol PD_CleanTypes <=< adjust_predefined_module_symbol PD_StdMisc <=< adjust_predefined_module_symbol PD_PredefinedModule = ([], [], { cs & cs_predef_symbols = cs_predef_symbols, cs_symbol_table = cs_symbol_table}) @@ -2425,11 +2522,11 @@ check_module1 cdefs icl_global_function_range fun_defs optional_dcl_mod optional fill_macro_def_array i [dcl_macro_defs:macro_defs] a = fill_macro_def_array (i+1) macro_defs {a & [i]=dcl_macro_defs} -check_module2 :: Ident {#Char} [.ImportedObject] .[Import ImportDeclaration] [IdentPos] .ModuleKind !.IndexRange !.IndexRange !.IndexRange !Int !Int +check_module2 :: Bool Ident {#Char} [.ImportedObject] .[Import ImportDeclaration] [IdentPos] .ModuleKind !.IndexRange !.IndexRange !.IndexRange !Int !Int (Optional (Module a)) [Declaration] *{#FunDef} *{#*{#FunDef}} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange) *{#.Int} *Heaps *CheckState -> (!Bool,.IclModule,!.{#DclModule},.{!Group},!*{#*{#FunDef}},!Int,!.Heaps,!.{#PredefinedSymbol},!.Heap SymbolTableEntry,!.File,[String]); -check_module2 mod_ident mod_modification_time mod_imported_objects mod_imports mod_foreign_exports mod_type icl_global_function_range icl_instance_range icl_generic_range nr_of_functions nr_of_cached_modules optional_pre_def_mod local_defs icl_functions macro_defs init_dcl_modules cdefs sizes heaps cs +check_module2 support_dynamics mod_ident mod_modification_time mod_imported_objects mod_imports mod_foreign_exports mod_type icl_global_function_range icl_instance_range icl_generic_range nr_of_functions nr_of_cached_modules optional_pre_def_mod local_defs icl_functions macro_defs init_dcl_modules cdefs sizes heaps cs # (main_dcl_module_n,cs)=cs!cs_x.x_main_dcl_module_n (copied_dcl_defs, dcl_conversions, dcl_modules, local_defs, cdefs, icl_sizes, cs) @@ -2448,9 +2545,32 @@ check_module2 mod_ident mod_modification_time mod_imported_objects mod_imports m | not cs.cs_error.ea_ok = (False, abort "evaluated error 2 (check.icl)", {}, {}, {}, cs.cs_x.x_main_dcl_module_n,heaps, cs.cs_predef_symbols, cs.cs_symbol_table, cs.cs_error.ea_file, []) + + # cs_symbol_table + = cs.cs_symbol_table + # cs_predef_symbols + = cs.cs_predef_symbols + # hp_var_heap + = heaps.hp_var_heap + # (icl_type_fun_range, dcl_modules, icl_functions, icl_common, + cs_predef_symbols, hp_var_heap, cs_symbol_table) + = if support_dynamics + (addTypeFunctions mod_ident nr_of_cached_modules dcl_modules + icl_functions icl_common + cs_predef_symbols hp_var_heap cs_symbol_table) + ({ir_from=0,ir_to=0}, dcl_modules, icl_functions, icl_common, + cs_predef_symbols, hp_var_heap, cs_symbol_table) + # (nr_of_functions, icl_functions) + = usize icl_functions + # cs + = {cs & cs_symbol_table=cs_symbol_table, cs_predef_symbols=cs_predef_symbols} + # heaps + = {heaps & hp_var_heap=hp_var_heap} + + # def_macro_indices=cdefs.def_macro_indices - # (icl_global_functions_ranges,icl_instances_ranges, icl_generic_ranges, n_exported_global_functions,local_functions_index_offset,def_macro_indices,icl_functions,icl_common,local_defs,dcl_modules, error) - = renumber_icl_module mod_type icl_global_function_range icl_instance_range icl_generic_range nr_of_functions main_dcl_module_n icl_sizes dcl_conversions def_macro_indices icl_functions icl_common local_defs dcl_modules cs.cs_error + # (icl_global_functions_ranges,icl_instances_ranges, icl_generic_ranges,icl_type_fun_ranges, n_exported_global_functions,local_functions_index_offset,def_macro_indices,icl_functions,icl_common,local_defs,dcl_modules, error) + = renumber_icl_module mod_type icl_global_function_range icl_instance_range icl_generic_range icl_type_fun_range nr_of_functions main_dcl_module_n icl_sizes dcl_conversions def_macro_indices icl_functions icl_common local_defs dcl_modules cs.cs_error | not error.ea_ok = (False, abort "evaluated error 3 (check.icl)", {}, {}, {}, cs.cs_x.x_main_dcl_module_n,heaps, cs.cs_predef_symbols, cs.cs_symbol_table, error.ea_file, []) @@ -2518,6 +2638,9 @@ check_module2 mod_ident mod_modification_time mod_imported_objects mod_imports m (icl_functions, e_info, heaps, cs) = checkInstanceBodies icl_instances_ranges local_functions_index_offset icl_functions e_info heaps cs + (icl_functions, e_info, heaps, cs) + = checkGlobalFunctionsInRanges icl_type_fun_ranges main_dcl_module_n local_functions_index_offset icl_functions e_info heaps cs + (foreign_exports,icl_functions,cs) = checkForeignExports mod_foreign_exports icl_global_functions_ranges icl_functions cs cs = check_needed_modules_are_imported mod_ident ".icl" cs @@ -2555,7 +2678,8 @@ check_module2 mod_ident mod_modification_time mod_imported_objects mod_imports m icl_instances = icl_instances_ranges, icl_specials = icl_specials, icl_gencases = icl_generic_ranges, icl_import = icl_imported, icl_imported_objects = mod_imported_objects, icl_foreign_exports = foreign_exports, icl_used_module_numbers = imported_module_numbers, icl_copied_from_dcl = copied_dcl_defs, - icl_modification_time = mod_modification_time} + icl_modification_time = mod_modification_time, + icl_type_funs = icl_type_fun_ranges} heaps = { heaps & hp_var_heap = var_heap, hp_expression_heap = expr_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}} (main_dcl_module, dcl_modules) = dcl_modules![main_dcl_module_n] @@ -2565,7 +2689,8 @@ check_module2 mod_ident mod_modification_time mod_imported_objects mod_imports m # (predef_symbols_for_transform, cs_predef_symbols) = get_predef_symbols_for_transform cs_predef_symbols (groups, icl_functions, macro_defs, var_heap, expr_heap, cs_symbol_table, cs_error) - = partitionateAndLiftFunctions (icl_global_functions_ranges++icl_instances_ranges++icl_generic_ranges) main_dcl_module_n predef_symbols_for_transform icl_mod.icl_functions macro_defs + = partitionateAndLiftFunctions (icl_global_functions_ranges++icl_instances_ranges++icl_generic_ranges++icl_type_fun_ranges) + main_dcl_module_n predef_symbols_for_transform icl_mod.icl_functions macro_defs heaps.hp_var_heap heaps.hp_expression_heap cs_symbol_table cs_error # heaps = {heaps & hp_var_heap=var_heap,hp_expression_heap=expr_heap} @@ -2579,7 +2704,7 @@ check_module2 mod_ident mod_modification_time mod_imported_objects mod_imports m icl_specials = {ir_from = nr_of_functions, ir_to = nr_of_functions}, icl_gencases = icl_generic_ranges, icl_import = icl_imported, icl_imported_objects = mod_imported_objects, icl_foreign_exports = foreign_exports, icl_used_module_numbers = imported_module_numbers, icl_copied_from_dcl = copied_dcl_defs, - icl_modification_time = mod_modification_time} + icl_modification_time = mod_modification_time, icl_type_funs = icl_type_fun_ranges} = (False, icl_mod, dcl_modules, {}, {}, cs_x.x_main_dcl_module_n,heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file, directly_imported_dcl_modules) where check_start_rule mod_kind mod_ident icl_global_functions_ranges cs=:{cs_symbol_table,cs_x} @@ -2880,6 +3005,7 @@ initialDclModule ({mod_ident, mod_modification_time, mod_defs=mod_defs=:{def_fun , dcl_instances = { ir_from = 0, ir_to = 0} , dcl_specials = { ir_from = 0, ir_to = 0 } , dcl_gencases = { ir_from = 0, ir_to = 0 } + , dcl_type_funs = { ir_from = 0, ir_to = 0 } , dcl_common = dcl_common , dcl_sizes = sizes , dcl_dictionary_info = { n_dictionary_types=0,n_dictionary_constructors=0,n_dictionary_selectors=0 } @@ -3520,7 +3646,8 @@ where <=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_Tuple mod_index STE_DclFunction <=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_LazyArray mod_index STE_DclFunction <=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_StrictArray mod_index STE_DclFunction - <=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_UnboxedArray mod_index STE_DclFunction) + <=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_UnboxedArray mod_index STE_DclFunction + <=< adjustPredefSymbol PD_Dyn__to_TypeCodeConstructor mod_index STE_DclFunction) # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdGeneric] # type_bimap = predefined_idents.[PD_TypeBimap] @@ -3576,6 +3703,18 @@ where = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} <=< adjustPredefSymbol PD_abort mod_index STE_DclFunction <=< adjustPredefSymbol PD_undef mod_index STE_DclFunction) + # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_CleanTypes] + | pre_mod.pds_def == mod_index + = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} + <=< adjustPredefSymbol PD_CTTypeDef mod_index STE_Type + <=< adjustPredefSymbol PD_CTAlgType mod_index STE_Constructor + <=< adjustPredefSymbol PD_CTRecordType mod_index STE_Constructor + <=< adjustPredefSymbol PD_CTSynType mod_index STE_Constructor + <=< adjustPredefSymbol PD_CTPredefined mod_index STE_Constructor + <=< adjustPredefSymbol PD_CTConsDef mod_index STE_Type + <=< adjustPredefSymbol PD__CTToCons mod_index STE_DclFunction + <=< adjustPredefSymbol PD_CTFieldDef mod_index STE_Type ) + = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols}) where unused diff --git a/frontend/checksupport.dcl b/frontend/checksupport.dcl index 924df80..260ec66 100644 --- a/frontend/checksupport.dcl +++ b/frontend/checksupport.dcl @@ -96,6 +96,7 @@ cConversionTableSize :== 10 , icl_instances :: ![IndexRange] , icl_specials :: !IndexRange , icl_gencases :: ![IndexRange] + , icl_type_funs :: ![IndexRange] , icl_common :: !.CommonDefs , icl_import :: !{!Declaration} , icl_imported_objects :: ![ImportedObject] @@ -112,6 +113,7 @@ cConversionTableSize :== 10 , dcl_macros :: !IndexRange , dcl_specials :: !IndexRange , dcl_gencases :: !IndexRange + , dcl_type_funs :: !IndexRange , dcl_common :: !CommonDefs , dcl_sizes :: !{# Int} , dcl_dictionary_info :: !DictionaryInfo diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl index ac33f28..b2effaf 100644 --- a/frontend/checktypes.icl +++ b/frontend/checktypes.icl @@ -1446,6 +1446,7 @@ where , td_attribute = TA_None , td_pos = NoPos , td_used_types = [] + , td_fun_index = NoIndex } cons_def = diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl index 161b6dc..d5c8a59 100644 --- a/frontend/convertDynamics.icl +++ b/frontend/convertDynamics.icl @@ -646,8 +646,14 @@ where # predef_type_index = type_index + FirstTypePredefinedSymbolIndex = constructorExp (predefinedTypeConstructor predef_type_index) SK_Function 0 ci - typeConstructor (GTT_Constructor cons_ident) ci - = (App {app_symb = cons_ident, app_args = [], app_info_ptr = nilPtr}, ci) + typeConstructor (GTT_Constructor cons_ident fun_ident) ci + # type_cons + = App {app_symb = cons_ident, app_args = [], app_info_ptr = nilPtr} + # type_fun + = App {app_symb = fun_ident, app_args = [], app_info_ptr = nilPtr} + # (to_tc_symb, ci) + = getSymbol PD_Dyn__to_TypeCodeConstructor SK_Function 2 ci + = (App {app_symb = to_tc_symb, app_args = [type_cons, type_fun], app_info_ptr = nilPtr}, ci) typeConstructor (GTT_Basic basic_type) ci = constructorExp (basicTypeConstructor basic_type) SK_Function 0 ci typeConstructor GTT_Function ci diff --git a/frontend/frontend.icl b/frontend/frontend.icl index 12bd1f7..743bde0 100644 --- a/frontend/frontend.icl +++ b/frontend/frontend.icl @@ -4,8 +4,8 @@ implementation module frontend import scanner, parse, postparse, check, type, trans, convertcases, overloading, utilities, convertDynamics, - convertimportedtypes, compilerSwitches, analtypes, generics1 - + convertimportedtypes, compilerSwitches, analtypes, generics1, + typereify //import coredump //import print @@ -51,7 +51,8 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an # symbol_table = hash_table.hte_symbol_heap #! n_cached_dcl_modules=size cached_dcl_modules # (ok, icl_mod, dcl_mods, components, cached_dcl_macros,main_dcl_module_n,heaps, predef_symbols, symbol_table, error, directly_imported_dcl_modules) - = checkModule mod global_fun_range mod_functions n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache optional_dcl_mod modules cached_dcl_modules functions_and_macros predef_symbols (symbol_table -*-> "Checking") error heaps + = checkModule support_dynamics mod global_fun_range mod_functions n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache optional_dcl_mod modules cached_dcl_modules functions_and_macros predef_symbols (symbol_table -*-> "Checking") error heaps + hash_table = { hash_table & hte_symbol_heap = symbol_table} | not ok @@ -62,7 +63,8 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an select_and_remove_icl_functions_from_record :: !*IclModule -> (!.{#FunDef},!.IclModule) select_and_remove_icl_functions_from_record icl_mod=:{icl_functions} = (icl_functions,{icl_mod & icl_functions={}}) - # {icl_global_functions,icl_instances,icl_gencases, icl_specials, icl_common,icl_name,icl_import,icl_imported_objects,icl_foreign_exports,icl_used_module_numbers,icl_copied_from_dcl} = icl_mod + # {icl_global_functions,icl_instances,icl_gencases, icl_specials, icl_common,icl_name,icl_import,icl_imported_objects, + icl_type_funs, icl_foreign_exports,icl_used_module_numbers,icl_copied_from_dcl} = icl_mod /* (_,f,files) = fopen "components" FWriteText files (components, icl_functions, f) = showComponents components 0 True icl_functions f @@ -101,6 +103,16 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an // ti_common_defs = { ti_common_defs & [main_dcl_module_n] = icl_common } // # (td_infos, th_vars, error_admin) = analyseTypeDefs ti_common_defs type_groups td_infos type_heaps.th_vars error_admin ({com_type_defs}, ti_common_defs) = replace ti_common_defs main_dcl_module_n icl_common + + | support_dynamics && not (sanityCheckTypeFunctions main_dcl_module_n icl_common dcl_mods fun_defs) + = abort "frontend: sanityCheckTypeFunctions failed" + + # hp_var_heap = heaps.hp_var_heap + # (fun_defs, predef_symbols, hp_var_heap, type_heaps) + = if support_dynamics + (buildTypeFunctions main_dcl_module_n fun_defs ti_common_defs + predef_symbols hp_var_heap type_heaps) + (fun_defs, predef_symbols, hp_var_heap, type_heaps) # (td_infos, th_vars, error_admin) = analyseTypeDefs ti_common_defs type_groups com_type_defs main_dcl_module_n td_infos type_heaps.th_vars error_admin # (class_infos, td_infos, th_vars, error_admin) = determineKindsOfClasses icl_used_module_numbers ti_common_defs td_infos th_vars error_admin @@ -110,7 +122,7 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an type_heaps = { type_heaps & th_vars = th_vars } - # heaps = { heaps & hp_type_heaps = type_heaps, hp_expression_heap = hp_expression_heap, hp_generic_heap = gen_heap } + # heaps = { heaps & hp_type_heaps = type_heaps, hp_expression_heap = hp_expression_heap, hp_generic_heap = gen_heap, hp_var_heap=hp_var_heap } # (saved_main_dcl_common, ti_common_defs) = replace (dcl_common_defs dcl_mods) main_dcl_module_n icl_common with dcl_common_defs :: .{#DclModule} -> .{#CommonDefs} // needed for Clean 2.0 to disambiguate overloading @@ -159,7 +171,7 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an # (fun_def_size, fun_defs) = usize fun_defs # (components, fun_defs) = partitionateFunctions (fun_defs -*-> "partitionateFunctions") - (icl_global_functions++icl_instances ++ [icl_specials] ++ icl_gencases ++ generic_ranges) + (icl_global_functions++icl_instances ++ [icl_specials] ++ icl_gencases ++ generic_ranges ++ icl_type_funs) | options.feo_up_to_phase == FrontEndPhaseTypeCheck = frontSyntaxTree cached_dcl_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n @@ -191,7 +203,7 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an = transformGroups cleanup_info main_dcl_module_n stdStrictLists_module_n def_min def_max (components -*-> "Transform") fun_defs acc_args common_defs imported_funs dcl_types used_conses_in_dynamics type_def_infos var_heap type_heaps expression_heap options.feo_fusion error predef_symbols # error_admin = {ea_file = error, ea_loc = [], ea_ok = True } - # {dcl_instances,dcl_specials,dcl_gencases} = dcl_mods.[main_dcl_module_n] + # {dcl_instances,dcl_specials,dcl_gencases,dcl_type_funs} = dcl_mods.[main_dcl_module_n] # (start_rule_index,predef_symbols) = get_index_of_start_rule predef_symbols with get_index_of_start_rule predef_symbols @@ -206,7 +218,7 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an # exported_global_functions = case start_rule_index of NoIndex -> [icl_exported_global_functions] sri -> [{ir_from=sri,ir_to=inc sri},icl_exported_global_functions] - # exported_functions = exported_global_functions ++ [dcl_instances,dcl_specials,dcl_gencases] + # exported_functions = exported_global_functions ++ [dcl_instances,dcl_specials,dcl_gencases,dcl_type_funs] # (components, fun_defs, predef_symbols, var_heap, expression_heap, error_admin) = case options.feo_strip_unused of True -> partitionateFunctions` (fun_defs -*-> "partitionateFunctions`") @@ -272,7 +284,8 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an icl_common=icl_common, icl_gencases = icl_gencases ++ generic_ranges, icl_import=icl_import, icl_imported_objects=icl_imported_objects, icl_foreign_exports=icl_foreign_exports, icl_name=icl_name,icl_used_module_numbers=icl_used_module_numbers, - icl_copied_from_dcl=icl_copied_from_dcl,icl_modification_time=icl_mod.icl_modification_time} + icl_copied_from_dcl=icl_copied_from_dcl,icl_modification_time=icl_mod.icl_modification_time, + icl_type_funs = icl_type_funs} , fe_dcls = dcl_mods , fe_components = components diff --git a/frontend/overloading.icl b/frontend/overloading.icl index 54533ce..a8d6729 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -1300,6 +1300,8 @@ toTypeCodeConstructor type=:{glob_object=type_index, glob_module=module_index} c // sanity check ... # type_ident = types.[type_index].td_ident.id_name + # td_fun_index + = types.[type_index].td_fun_index # tc_type_name = types.[tc_type_index].td_ident.id_name | "TC;" +++ type_ident <> tc_type_name @@ -1311,7 +1313,15 @@ toTypeCodeConstructor type=:{glob_object=type_index, glob_module=module_index} c = { symb_ident = ds_ident , symb_kind = SK_Constructor {glob_module = module_index, glob_object = ds_index} } - = GTT_Constructor type_constructor + // sanity check ... + | td_fun_index == NoIndex + = fatal "toTypeCodeConstructor" ("no function (" +++ type_ident +++ ")") + // ... sanity check + # type_fun + = { symb_ident = {ds_ident & id_info = nilPtr} // this is wrong but let's give it a try + , symb_kind = SK_Function {glob_module = module_index, glob_object = td_fun_index} + } + = GTT_Constructor type_constructor type_fun fatal :: {#Char} {#Char} -> .a fatal function_name message diff --git a/frontend/postparse.icl b/frontend/postparse.icl index adcdfd5..ef762ff 100644 --- a/frontend/postparse.icl +++ b/frontend/postparse.icl @@ -1062,13 +1062,13 @@ parseAndScanDclModule dcl_module import_file_position parsed_modules cached_modu # (parse_ok, mod, ca_hash_table, err_file, files) = wantModule cWantDclFile dcl_module import_file_position support_generics ca_hash_table ca_error.pea_file searchPaths modtimefunction files # ca = {ca & ca_hash_table=ca_hash_table, ca_error={pea_file=err_file,pea_ok=True} } | parse_ok - = scan_dcl_module mod parsed_modules searchPaths modtimefunction files ca + = scan_dcl_module dcl_module mod parsed_modules searchPaths modtimefunction files ca = (False, [MakeEmptyModule mod.mod_ident MK_None: parsed_modules],files, ca) where - scan_dcl_module :: ParsedModule [ScannedModule] !SearchPaths (ModTimeFunction *Files) *Files *CollectAdmin -> (Bool, [ScannedModule],*Files, *CollectAdmin) - scan_dcl_module mod=:{mod_defs = pdefs} parsed_modules searchPaths modtimefunction files ca + scan_dcl_module :: Ident ParsedModule [ScannedModule] !SearchPaths (ModTimeFunction *Files) *Files *CollectAdmin -> (Bool, [ScannedModule],*Files, *CollectAdmin) + scan_dcl_module dcl_module mod=:{mod_defs = pdefs} parsed_modules searchPaths modtimefunction files ca # (_, defs, imports, imported_objects,foreign_exports,ca) - = reorganiseDefinitionsAndAddTypes support_dynamics False pdefs ca + = reorganiseDefinitionsAndAddTypes dcl_module support_dynamics False pdefs ca (def_macros, ca) = collectFunctions defs.def_macros False {ca & ca_fun_count=0,ca_rev_fun_defs=[]} (range, ca) = addFunctionsRange def_macros ca (rev_fun_defs,ca) = ca!ca_rev_fun_defs @@ -1089,7 +1089,7 @@ scanModule mod=:{mod_ident,mod_type,mod_defs = pdefs} cached_modules support_gen , ca_rev_fun_defs = [] , ca_hash_table = hash_table } - (fun_defs, defs, imports, imported_objects,foreign_exports,ca) = reorganiseDefinitionsAndAddTypes support_dynamics True pdefs ca + (fun_defs, defs, imports, imported_objects,foreign_exports,ca) = reorganiseDefinitionsAndAddTypes mod_ident support_dynamics True pdefs ca (reorganise_icl_ok, ca) = ca!ca_error.pea_ok @@ -1156,7 +1156,7 @@ where | not parse_ok = (False, No,NoIndex, [],cached_modules, files, ca) # pdefs = mod.mod_defs - # (_, defs, imports, imported_objects,foreign_exports,ca) = reorganiseDefinitionsAndAddTypes support_dynamics False pdefs ca + # (_, defs, imports, imported_objects,foreign_exports,ca) = reorganiseDefinitionsAndAddTypes mod_ident support_dynamics False pdefs ca # mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = defs} # cached_modules = [mod.mod_ident:cached_modules] # (import_ok, parsed_modules,files, ca) = scanModules imports [] cached_modules searchPaths support_generics support_dynamics modtimefunction files ca @@ -1467,10 +1467,18 @@ reorganiseDefinitions icl_module [] _ _ _ _ ca def_instances = [], def_funtypes = [], def_generics = [], def_generic_cases = []}, [], [], [], ca) -reorganiseDefinitionsAndAddTypes support_dynamics icl_module defs ca +reorganiseDefinitionsAndAddTypes mod_ident support_dynamics icl_module defs ca | support_dynamics + # clean_types_module_ident + = predefined_idents.[PD_CleanTypes] + # clean_types_module = + { import_module = clean_types_module_ident + , import_symbols = [] + , import_file_position = NoPos + } + # imports = if (mod_ident == clean_types_module_ident) [] [clean_types_module] # (rev_defs, ca) - = addTypeConstructors defs [] ca + = addTypeConstructors defs [PD_Import imports] ca = reorganiseDefinitions icl_module (reverse rev_defs) 0 0 0 0 ca = reorganiseDefinitions icl_module defs 0 0 0 0 ca where @@ -1501,6 +1509,7 @@ addTypeConstructor def=:{td_ident, td_attribute, td_attrs, td_args, td_arity, td , td_attribute = attr , td_pos = position , td_used_types = [] + , td_fun_index = NoIndex } type_tc_cons cons_ident type_ident args arity position = { pc_cons_ident = cons_ident diff --git a/frontend/predef.dcl b/frontend/predef.dcl index 4101092..7097ac8 100644 --- a/frontend/predef.dcl +++ b/frontend/predef.dcl @@ -248,7 +248,20 @@ PD_FromThenToU :== 259 PD_FromThenToUTS :== 260 PD_FromThenToO :== 261 -PD_NrOfPredefSymbols :== 262 +/* Clean Type introspection */ +PD_CleanTypes :== 262 +PD_CTTypeDef :== 263 +PD_CTAlgType :== 264 +PD_CTRecordType :== 265 +PD_CTSynType :== 266 +PD_CTPredefined :== 267 +PD_CTConsDef :== 268 +PD__CTToCons :== 269 +PD_CTFieldDef :== 270 + +PD_Dyn__to_TypeCodeConstructor :== 271 + +PD_NrOfPredefSymbols :== 272 GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2 GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2 diff --git a/frontend/predef.icl b/frontend/predef.icl index 9090a07..739990a 100644 --- a/frontend/predef.icl +++ b/frontend/predef.icl @@ -132,6 +132,8 @@ predefined_idents [PD_Dyn_TypeCodeConstructor_StrictArray] = i "TypeCodeConstructor_StrictArray", [PD_Dyn_TypeCodeConstructor_UnboxedArray] = i "TypeCodeConstructor_UnboxedArray", + [PD_Dyn__to_TypeCodeConstructor] = i "_to_TypeCodeConstructor", + [PD_StdGeneric] = i "StdGeneric", [PD_TypeBimap] = i "Bimap", [PD_ConsBimap] = i "_Bimap", @@ -213,7 +215,17 @@ predefined_idents [PD_FromThenToSTS]= i "_from_then_to_sts", [PD_FromThenToU]= i "_from_then_to_u", [PD_FromThenToUTS]= i "_from_then_to_uts", - [PD_FromThenToO]= i "_from_then_to_o" + [PD_FromThenToO]= i "_from_then_to_o", + + [PD_CleanTypes] = i "StdCleanTypes", + [PD_CTTypeDef] = i "CTTypeDef", + [PD_CTAlgType] = i "CTAlgType", + [PD_CTRecordType] = i "CTRecordType", + [PD_CTSynType] = i "CTSynType", + [PD_CTPredefined] = i "CTPredefined", + [PD_CTConsDef] = i "CTConsDef", + [PD__CTToCons] = i "CTToCons", + [PD_CTFieldDef] = i "CTFieldDef" } =: idents @@ -364,6 +376,8 @@ where <<- (local_predefined_idents, IC_Expression, PD_Dyn_TypeCodeConstructor_StrictArray) <<- (local_predefined_idents, IC_Expression, PD_Dyn_TypeCodeConstructor_UnboxedArray) + <<- (local_predefined_idents, IC_Expression, PD_Dyn__to_TypeCodeConstructor) + <<- (local_predefined_idents, IC_Module, PD_StdGeneric) <<- (local_predefined_idents, IC_Type, PD_TypeBimap) <<- (local_predefined_idents, IC_Expression, PD_ConsBimap) @@ -412,6 +426,16 @@ where <<- (local_predefined_idents, IC_Expression, PD_abort) <<- (local_predefined_idents, IC_Expression, PD_undef) + <<- (local_predefined_idents, IC_Module, PD_CleanTypes) + <<- (local_predefined_idents, IC_Type, PD_CTTypeDef) + <<- (local_predefined_idents, IC_Expression, PD_CTAlgType) + <<- (local_predefined_idents, IC_Expression, PD_CTRecordType) + <<- (local_predefined_idents, IC_Expression, PD_CTSynType) + <<- (local_predefined_idents, IC_Expression, PD_CTPredefined) + <<- (local_predefined_idents, IC_Type, PD_CTConsDef) + <<- (local_predefined_idents, IC_Expression, PD__CTToCons) + <<- (local_predefined_idents, IC_Type, PD_CTFieldDef) + <<- (local_predefined_idents, IC_Expression, PD_Start) <<- (local_predefined_idents, IC_Expression, PD_FromS) diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 0c4f25d..41eb1dd 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -444,6 +444,7 @@ NoGlobalIndex :== {gi_module=NoIndex,gi_index=NoIndex} , td_attribute :: !TypeAttribute , td_pos :: !Position , td_used_types :: ![GlobalIndex] + , td_fun_index :: !Index } :: TypeDefInfo = @@ -936,6 +937,7 @@ cNonRecursiveAppl :== False | TVI_AttrAndRefCount !TypeAttribute !Int | TVI_CorrespondenceNumber !Int /* auxiliary used in module comparedefimp */ | TVI_AType !AType /* auxiliary used in module comparedefimp */ + | TVI_Reify !Int | TVI_Used /* to administer that this variable is encountered (in checkOpenTypes) */ | TVI_TypeCode !TypeCodeExpression | TVI_CPSLocalTypeVar !Int /* MdM - the index of the variable as generated by the theorem prover */ @@ -1278,7 +1280,11 @@ instance == OverloadedListType | TCE_UniType ![VarInfoPtr] !TypeCodeExpression | TCE_UnqType !TypeCodeExpression -:: GlobalTCType = GTT_Basic !BasicType | GTT_Constructor !SymbIdent | GTT_PredefTypeConstructor !(Global Index) | GTT_Function +:: GlobalTCType + = GTT_Basic !BasicType + | GTT_Constructor !SymbIdent !SymbIdent // type_cons type_fun + | GTT_PredefTypeConstructor !(Global Index) + | GTT_Function :: AlgebraicPattern = { ap_symbol :: !(Global DefinedSymbol) @@ -1417,7 +1423,8 @@ ParsedInstanceToClassInstance pi members :== MakeTypeDef name lhs rhs attr contexts pos :== { td_ident = name, td_index = -1, td_arity = length lhs, td_args = lhs, td_attrs = [], td_attribute = attr, td_context = contexts, - td_pos = pos, td_rhs = rhs, td_used_types = [] } + td_pos = pos, td_rhs = rhs, td_used_types = [], td_fun_index = NoIndex + } MakeDefinedSymbol ident index arity :== { ds_ident = ident, ds_arity = arity, ds_index = index } |