diff options
| -rw-r--r-- | frontend/check.dcl | 2 | ||||
| -rw-r--r-- | frontend/check.icl | 296 | ||||
| -rw-r--r-- | frontend/checkFunctionBodies.icl | 7 | ||||
| -rw-r--r-- | frontend/checksupport.dcl | 4 | ||||
| -rw-r--r-- | frontend/checksupport.icl | 15 | ||||
| -rw-r--r-- | frontend/checktypes.icl | 8 | ||||
| -rw-r--r-- | frontend/comparedefimp.dcl | 4 | ||||
| -rw-r--r-- | frontend/comparedefimp.icl | 214 | ||||
| -rw-r--r-- | frontend/explicitimports.dcl | 4 | ||||
| -rw-r--r-- | frontend/explicitimports.icl | 39 | ||||
| -rw-r--r-- | frontend/main.icl | 9 | ||||
| -rw-r--r-- | frontend/parse.icl | 5 | ||||
| -rw-r--r-- | frontend/postparse.icl | 68 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 6 | ||||
| -rw-r--r-- | frontend/syntax.icl | 6 | ||||
| -rw-r--r-- | frontend/trans.icl | 39 |
16 files changed, 310 insertions, 416 deletions
diff --git a/frontend/check.dcl b/frontend/check.dcl index 125d4a4..583ebe6 100644 --- a/frontend/check.dcl +++ b/frontend/check.dcl @@ -5,7 +5,7 @@ import syntax, transform, checksupport, typesupport, predef cPredefinedModuleIndex :== 1 checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !{#FunDef} !*PredefinedSymbols !*SymbolTable !*File !*Heaps - -> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File) + -> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File) checkFunctions :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState) diff --git a/frontend/check.icl b/frontend/check.icl index e98d400..5be0684 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -374,19 +374,19 @@ where = ({st & st_vars = st_vars, st_args = st_args, st_result = st_result, st_attr_vars = st_attr_vars, st_context = st_context, st_attr_env = st_attr_env }, specials, type_heaps) -determineTypesOfInstances :: !Index !Index !*CommonDefs !*{#DclModule} !*TypeHeaps !*VarHeap !*CheckState - -> (![FunType], !Index, ![ClassInstance], !*CommonDefs, !*{#DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState) -determineTypesOfInstances first_memb_inst_index mod_index dcl_common=:{com_instance_defs,com_class_defs,com_member_defs} +determineTypesOfInstances :: !Index !Index !*{#ClassInstance} !*{# ClassDef} !*{# MemberDef} + !*{#DclModule} !*TypeHeaps !*VarHeap !*CheckState + -> (![FunType], !Index, ![ClassInstance], !*{#ClassInstance}, !*{# ClassDef}, !*{# MemberDef}, !*{#DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState) +determineTypesOfInstances first_memb_inst_index mod_index com_instance_defs com_class_defs com_member_defs modules type_heaps var_heap cs=:{cs_error} | cs_error.ea_ok #! nr_of_class_instances = size com_instance_defs # (memb_inst_defs, next_mem_inst_index, all_class_specials, com_class_defs, com_member_defs, modules, com_instance_defs, type_heaps, var_heap, cs_error) = determine_types_of_instances 0 nr_of_class_instances first_memb_inst_index mod_index [] com_class_defs com_member_defs modules com_instance_defs type_heaps var_heap cs_error - = (memb_inst_defs, next_mem_inst_index, all_class_specials, - { dcl_common & com_instance_defs = com_instance_defs,com_class_defs = com_class_defs, com_member_defs = com_member_defs }, - modules, type_heaps, var_heap, { cs & cs_error = cs_error }) - = ([], first_memb_inst_index, [], dcl_common, modules, type_heaps, var_heap, cs) + = (memb_inst_defs, next_mem_inst_index, all_class_specials, com_instance_defs, com_class_defs, + com_member_defs, modules, type_heaps, var_heap, { cs & cs_error = cs_error }) + = ([], first_memb_inst_index, [], com_instance_defs, com_class_defs, com_member_defs, modules, type_heaps, var_heap, cs) where determine_types_of_instances :: !Index !Index !Index !Index ![ClassInstance] !v:{#ClassDef} !w:{#MemberDef} @@ -910,7 +910,9 @@ checkDclModules imports_of_icl_mod dcl_modules icl_functions heaps cs=:{cs_symbo = { dag_nr_of_nodes = nr_of_dcl_modules+1, dag_get_children = select dependencies } components = partitionateDAG module_dag [cs.cs_x.x_main_dcl_module_n,index_of_icl_module] - (nr_of_components, component_numbers) +// | False--->("biggest component:", maxList (map length components)) +// = undef + # (nr_of_components, component_numbers) = getComponentNumbers components module_dag.dag_nr_of_nodes reversed_dag1 = reverseDAG module_dag @@ -1015,18 +1017,18 @@ checkDclModules imports_of_icl_mod dcl_modules icl_functions heaps cs=:{cs_symbo = (expl_imp_symbols_accu, nr_of_expl_imp_symbols, [(ste_index, import_file_position, expl_imp_indices):expl_imp_indices_accu], cs_symbol_table) - get_expl_imp_symbol (ID_OldSyntax idents) state - = foldSt (get_symbol No) idents state - get_expl_imp_symbol import_declaration state - = get_symbol (getBelongingSymbolsFromID import_declaration) (get_ident import_declaration) state + get_expl_imp_symbol imp_decl=:(ID_OldSyntax idents) state + = foldSt (get_symbol imp_decl) idents state + get_expl_imp_symbol imp_decl state + = get_symbol imp_decl (get_ident imp_decl) state - get_symbol belonging_symbols ident=:{id_info} (expl_imp_symbols_accu, nr_of_expl_imp_symbols, expl_imp_indices_accu, cs_symbol_table) + get_symbol imp_decl ident=:{id_info} (expl_imp_symbols_accu, nr_of_expl_imp_symbols, expl_imp_indices_accu, cs_symbol_table) # (ste, cs_symbol_table) = readPtr id_info cs_symbol_table = case ste.ste_kind of STE_ExplImpSymbol expl_imp_symbols_nr # ini - = { ini_symbol_nr = expl_imp_symbols_nr, ini_belonging = belonging_symbols } + = { ini_symbol_nr = expl_imp_symbols_nr, ini_imp_decl = imp_decl } -> (expl_imp_symbols_accu, nr_of_expl_imp_symbols, [ini:expl_imp_indices_accu], cs_symbol_table) STE_Empty @@ -1034,7 +1036,7 @@ checkDclModules imports_of_icl_mod dcl_modules icl_functions heaps cs=:{cs_symbo = writePtr id_info { ste & ste_kind = STE_ExplImpSymbol nr_of_expl_imp_symbols, ste_previous = ste } cs_symbol_table ini - = { ini_symbol_nr = nr_of_expl_imp_symbols, ini_belonging = belonging_symbols } + = { ini_symbol_nr = nr_of_expl_imp_symbols, ini_imp_decl = imp_decl } -> ([ident:expl_imp_symbols_accu], nr_of_expl_imp_symbols+1, [ini:expl_imp_indices_accu], cs_symbol_table) @@ -1062,13 +1064,13 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices { cs & cs_symbol_table = cs_symbol_table }) STE_Module _ # is_on_cycle - = case expl_imp_indices of + = case mod_indices of [_] -> False _ -> True cs_error = fold2St check_whether_module_imports_itself expl_imp_indices mod_indices cs.cs_error cs_error - = case expand_syn_types_late_XXX False is_on_cycle of + = case switch_import_syntax is_on_cycle False of True # ident_pos = { ip_ident = dcl_name_of_first_mod_in_component, ip_line = 1, @@ -1077,9 +1079,7 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices = pushErrorAdmin ident_pos cs_error cs_error = checkError "" - (switch_import_syntax "cyclic module dependencies not allowed in conjunction with Clean 1.3 import syntax" - "cyclic module dependencies currently not implemented") // XXX cs_error -> popErrorAdmin cs_error _ @@ -1109,7 +1109,9 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices (imports, (dcl_modules, _, expl_imp_info, cs)) = mapSt (solveExplicitImports expl_imp_indices_ikh modules_in_component_set) mod_indices (dcl_modules, bitvectCreate nr_of_modules, expl_imp_info, cs) - imports_ikh + | not cs.cs_error.ea_ok + -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + # imports_ikh = fold2St (ikhInsert` False) mod_indices imports ikhEmpty // maps the module indices of all modules in the actual component to all explicit // imports of that module @@ -1119,24 +1121,15 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices (possibly_write_expl_imports_of_main_dcl_mod_to_file imports_ikh dcl_modules cs) (dcl_modules, cs) - (expl_imp_infos, dcl_modules, icl_functions, heaps, cs) - = foldSt (checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cycle modules_in_component_set + (afterwards_info, (expl_imp_infos, dcl_modules, icl_functions, heaps, cs)) + = mapSt (checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cycle modules_in_component_set super_components imports_ikh) mod_indices (expl_imp_infos, dcl_modules, icl_functions, heaps, cs) - #! main_dcl_module_n - = cs_x.x_main_dcl_module_n - # (dcl_modules, hp_type_heaps, cs_error) - = foldSt expand_syn_types_of_dcl_mod - (expand_syn_types_late_XXX - [mod_index \\ mod_index<-mod_indices | mod_index<>main_dcl_module_n] []) - (dcl_modules, heaps.hp_type_heaps, cs.cs_error) - cs - = { cs & cs_error = cs_error } - heaps - = { heaps & hp_type_heaps = hp_type_heaps} - - (dcl_modules, icl_functions, heaps, cs) + | not cs.cs_error.ea_ok + -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + + # (dcl_modules, icl_functions, heaps, cs) = case is_on_cycle of False -> (dcl_modules, icl_functions, heaps, cs) @@ -1146,21 +1139,12 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices mod_indices imports (dcl_modules, icl_functions, heaps.hp_expression_heap, cs) -> (dcl_modules, icl_functions, { heaps & hp_expression_heap = hp_expression_heap }, cs) + (dcl_modules, heaps, cs) + = fold2St doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked + mod_indices afterwards_info + (dcl_modules, heaps, cs) -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) where - expand_syn_types_of_dcl_mod mod_index (dcl_modules, hp_type_heaps, cs_error) - | expand_syn_types_late_XXX False True - = abort "expand_syn_types_of_dcl_mod" - # (type_defs, dcl_modules) - = dcl_modules![mod_index].dcl_common.com_type_defs - unique_type_defs - = { el \\ el <-:type_defs } - (expanded_type_defs, dcl_modules, hp_type_heaps, cs_error) - = expandSynonymTypes mod_index unique_type_defs dcl_modules hp_type_heaps cs_error - dcl_modules - = { dcl_modules & [mod_index].dcl_common.com_type_defs = expanded_type_defs } - = (dcl_modules, hp_type_heaps, cs_error) - check_whether_module_imports_itself expl_imp_indices_for_module mod_index cs_error = foldSt (check_that mod_index) expl_imp_indices_for_module cs_error where @@ -1191,13 +1175,21 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices (dcl_modules, expl_imp_infos, cs_symbol_table) = (expl_imp_infos, dcl_modules, cs_symbol_table) + just_update_expl_imp_info components_array super_components mod_index + (expl_imp_infos, dcl_modules, cs_symbol_table) + # ({dcls_local_for_import, dcls_import}, dcl_modules) + = dcl_modules![mod_index].dcl_declared + (dcl_modules, expl_imp_infos, cs_symbol_table) + = updateExplImpInfo super_components.[mod_index] mod_index dcls_import dcls_local_for_import + dcl_modules expl_imp_infos cs_symbol_table + = (expl_imp_infos, dcl_modules, cs_symbol_table) + check_expl_imp_completeness_of_dcl_mod_within_non_trivial_component mod_index {si_explicit} (dcl_modules, icl_functions, hp_expression_heap, cs) # ({dcl_declared}, dcl_modules) = dcl_modules![mod_index] ({dcls_local_for_import, dcls_import}) = dcl_declared - // XXX possibly adding dcls_local_for_import is not necessary! cs = addDeclarationsOfDclModToSymbolTable mod_index dcls_local_for_import dcls_import cs (dcl_modules, icl_functions, hp_expression_heap, cs=:{cs_symbol_table}) @@ -1207,14 +1199,6 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices = removeImportsAndLocalsOfModuleFromSymbolTable dcl_declared cs.cs_symbol_table = (dcl_modules, icl_functions, hp_expression_heap, { cs & cs_symbol_table = cs_symbol_table }) - just_update_expl_imp_info components_array super_components mod_index - (expl_imp_infos, dcl_modules, cs_symbol_table) - # ({dcls_local_for_import, dcls_import}, dcl_modules) - = dcl_modules![mod_index].dcl_declared - (dcl_modules, expl_imp_infos, cs_symbol_table) - = updateExplImpInfo super_components.[mod_index] mod_index dcls_import dcls_local_for_import - dcl_modules expl_imp_infos cs_symbol_table - = (expl_imp_infos, dcl_modules, cs_symbol_table) compute_used_module_nrs (mod_index, _, _) (mod_nr_accu, dcl_modules) | inNumberSet mod_index mod_nr_accu @@ -1238,16 +1222,14 @@ checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cyc = mod_entry cs_symbol_table = writePtr dcl_name.id_info { mod_entry & ste_kind = STE_ClosedModule } cs.cs_symbol_table - (expl_imp_infos, dcl_modules, icl_functions, heaps, cs) - = checkDclModule dcl_imported_module_numbers super_components.[mod_index] imports_ikh component_nr + = checkDclModule dcl_imported_module_numbers super_components.[mod_index] imports_ikh component_nr is_on_cycle modules_in_component_set mod ste_index expl_imp_infos dcl_modules icl_functions heaps { cs & cs_symbol_table = cs_symbol_table } - = (expl_imp_infos, dcl_modules, icl_functions, heaps, cs) checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !{#FunDef} !*PredefinedSymbols !*SymbolTable !*File !*Heaps - -> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef}, !Int,!*Heaps, !*PredefinedSymbols, !*SymbolTable, *File) + -> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef}, !Int,!*Heaps, !*PredefinedSymbols, !*SymbolTable, *File) checkModule m 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 functions_and_macros predef_symbols symbol_table err_file heaps // | False--->("checkModule", m.mod_name) // = undef @@ -1412,7 +1394,7 @@ add_function_conversion_table dcl_to_icl_function_conversions main_dcl_module_n check_module2 :: Ident [.ImportedObject] .[Import ImportDeclaration] .ModuleKind !.IndexRange !.IndexRange !Int !Int (Optional (Module a)) [Declaration] *{#FunDef} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange) *{#.Int} *Heaps *CheckState - -> (!Bool,!.IclModule,!.{#DclModule},.{!Group},!Optional {#Int},!.{#FunDef},!Int,!.Heaps,!.{#PredefinedSymbol}, + -> (!Bool,.IclModule,!.{#DclModule},.{!Group},!Optional {#Int},!.{#FunDef},!Int,!.Heaps,!.{#PredefinedSymbol}, !.Heap SymbolTableEntry,!.File); check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range nr_of_functions n_functions_and_macros_in_dcl_modules optional_pre_def_mod local_defs icl_functions init_dcl_modules cdefs sizes heaps cs # (main_dcl_module_n,cs)=cs!cs_x.x_main_dcl_module_n @@ -1433,7 +1415,9 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func (nr_of_icl_component, expl_imp_indices, expl_imp_info, dcl_modules, icl_functions, heaps, cs) = checkDclModules mod_imports dcl_modules icl_functions heaps cs - (imported_module_numbers, dcl_modules) + | not cs.cs_error.ea_ok + = (False, abort "evaluated error 1 (check.icl)", {}, {}, No, {}, cs.cs_x.x_main_dcl_module_n,heaps, cs.cs_predef_symbols, cs.cs_symbol_table, cs.cs_error.ea_file) + # (imported_module_numbers, dcl_modules) = foldSt compute_used_module_nrs expl_imp_indices (addNr main_dcl_module_n (addNr cPredefinedModuleIndex EndNumbers), @@ -1488,12 +1472,10 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func = checkCommonDefinitions cIsNotADclModule main_dcl_module_n icl_common dcl_modules heaps.hp_type_heaps heaps.hp_var_heap cs (unexpanded_icl_type_defs, icl_common) - = expand_syn_types_late_XXX (copy_com_type_defs icl_common) (undef, icl_common) + = copy_com_type_defs icl_common (com_type_defs, dcl_modules, hp_type_heaps, cs_error) - = expand_syn_types_late_XXX - (expandSynonymTypes main_dcl_module_n icl_common.com_type_defs dcl_modules hp_type_heaps cs.cs_error) - (icl_common.com_type_defs, dcl_modules, hp_type_heaps, cs.cs_error) + = expandSynonymTypes main_dcl_module_n icl_common.com_type_defs dcl_modules hp_type_heaps cs.cs_error icl_common = { icl_common & com_type_defs = com_type_defs } cs @@ -1520,7 +1502,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func cs_symbol_table = removeDeclarationsFromSymbolTable local_defs cGlobalScope cs_symbol_table cs_symbol_table - = foldlArraySt mw_removeImportedSymbolsFromSymbolTable icl_imported cs_symbol_table + = foldlArraySt removeImportedSymbolsFromSymbolTable icl_imported cs_symbol_table dcl_modules = e_info.ef_modules @@ -1553,9 +1535,11 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func heaps = { heaps & hp_var_heap = var_heap, hp_expression_heap = expr_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}} - (dcl_modules, icl_mod, heaps, cs_error) + (main_dcl_module, dcl_modules) + = dcl_modules![main_dcl_module_n] + (icl_mod, heaps, cs_error) = compareDefImp icl_sizes_without_added_dcl_defs untransformed_fun_bodies main_dcl_module_n - unexpanded_icl_type_defs dcl_modules icl_mod heaps cs_error + unexpanded_icl_type_defs main_dcl_module icl_mod heaps cs_error = (cs_error.ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, cached_functions_and_macros, cs_x.x_main_dcl_module_n, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file) # icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, @@ -1591,10 +1575,14 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func {ste_kind = STE_Module mod, ste_index} = entry solved_imports = { si_explicit = [], si_implicit = [] } - (_, modules, macro_and_fun_defs, heaps, cs) + (deferred_stuff, (_, modules, macro_and_fun_defs, heaps, cs)) = checkDclModule EndNumbers [] (ikhInsert` False cPredefinedModuleIndex solved_imports ikhEmpty) cUndef False cDummyArray mod ste_index cDummyArray modules macro_and_fun_defs heaps cs + (modules, heaps, cs) + = doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked cPredefinedModuleIndex + deferred_stuff (modules, heaps, cs) ({dcl_declared={dcls_import,dcls_local,dcls_local_for_import}}, modules) = modules![ste_index] - = (modules, macro_and_fun_defs, heaps, addDeclarationsOfDclModToSymbolTable ste_index dcls_local_for_import dcls_import cs) + = (modules, macro_and_fun_defs, heaps, + addDeclarationsOfDclModToSymbolTable ste_index dcls_local_for_import dcls_import cs) check_predefined_module No modules macro_and_fun_defs heaps cs = (modules, macro_and_fun_defs, heaps, cs) @@ -1602,7 +1590,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func -> (![FunDef], !w:{# DclModule}, !v:{# ClassInstance}, !u:{# FunDef}, !Index, !(Optional {# Index}), !*VarHeap, !*TypeVarHeap, !*ExpressionHeap) collect_specialized_functions_in_dcl_module modules icl_instances icl_functions first_free_index main_dcl_module_n var_heap type_var_heap expr_heap # (dcl_mod, modules) = modules![main_dcl_module_n] - # {dcl_specials,dcl_functions,dcl_common,dcl_class_specials,dcl_conversions} = dcl_mod + # {dcl_specials,dcl_functions,dcl_common,dcl_conversions} = dcl_mod = case dcl_conversions of Yes conversion_table # (new_conversion_table, icl_instances) @@ -1718,25 +1706,10 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func # new = createArray size NoBody = iFoldSt (\i (dst, src=:{[i]=src_i})->({ dst & [i] = src_i.fun_body }, src)) 0 size (new, fun_defs) - memcpy :: !a:{#Int} -> (!.{#Int}, !a:{#Int}) - memcpy src - #! size = size src - # new = createArray size 0 - = iFoldSt (\i (dst, src=:{[i]=src_i})->({ dst & [i] = src_i }, src)) 0 size (new, src) - copy_com_type_defs icl_common=:{com_type_defs} - #! size - = size com_type_defs - | size==0 - = ({}, { icl_common & com_type_defs = com_type_defs }) - # (el0, com_type_defs) - = com_type_defs![0] - new - = createArray size el0 - (new, com_type_defs) - = iFoldSt (\i (dst, src=:{[i]=src_i})->({ dst & [i] = src_i }, src)) 0 size - (new, com_type_defs) - = (new, { icl_common & com_type_defs = com_type_defs }) + # (com_type_defs`, com_type_defs) + = memcpy com_type_defs + = (com_type_defs`, { icl_common & com_type_defs = com_type_defs }) check_needed_modules_are_imported mod_name extension cs=:{cs_x={x_needed_modules}} # cs = case x_needed_modules bitand cNeedStdDynamics of @@ -1804,7 +1777,6 @@ initialDclModule ({mod_name, mod_defs=mod_defs=:{def_funtypes,def_macros}, mod_t , dcl_functions = { function \\ function <- mod_defs.def_funtypes } , dcl_macros = def_macros , dcl_instances = { ir_from = 0, ir_to = 0 } - , dcl_class_specials = { ir_from = 0, ir_to = 0 } , dcl_specials = { ir_from = 0, ir_to = 0 } , dcl_common = dcl_common , dcl_sizes = sizes @@ -1952,18 +1924,6 @@ add_declaration_to_symbol_table opt_dcl_macro_range {dcl_kind=STE_FunctionOrMacr add_declaration_to_symbol_table yes_for_icl_module {dcl_kind=dcl_kind=:STE_Imported def_kind def_mod, dcl_ident, dcl_index, dcl_pos} importing_mod cs = addSymbol yes_for_icl_module dcl_ident dcl_pos dcl_kind def_kind dcl_index def_mod importing_mod cs -mw_removeImportedSymbolsFromSymbolTable :: Declaration !*SymbolTable -> .SymbolTable -mw_removeImportedSymbolsFromSymbolTable {dcl_ident=dcl_ident=:{id_info}, dcl_index} symbol_table - # ({ste_kind,ste_def_level,ste_previous}, symbol_table) - = readPtr id_info symbol_table - symbol_table - = symbol_table <:= (id_info, ste_previous) - = case ste_kind of - STE_Imported (STE_Field selector_id) def_mod - -> removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table - _ - -> symbol_table - updateExplImpInfo super_components mod_index dcls_import dcls_local_for_import dcl_modules expl_imp_infos cs_symbol_table # (changed_symbols, (expl_imp_infos, cs_symbol_table)) @@ -2013,10 +1973,87 @@ updateExplImpForMarkedLocalSymbol mod_index decl {ste_kind=STE_ExplImpComponentN updateExplImpForMarkedLocalSymbol _ _ entry dcl_modules expl_imp_infos cs_symbol_table = (dcl_modules, expl_imp_infos, cs_symbol_table) + +memcpy :: u:(a b) -> (!.(c b),!v:(a b)) | Array .a & createArray_u , createArrayc_u , size_u , update_u , uselect_u b & Array .c, [u <= v]; +memcpy src + #! size + = size src + | size==0 + = ({}, src) + # (el0, src) + = src![0] + new + = createArray size el0 + = iFoldSt (\i (dst, src=:{[i]=src_i})->({ dst & [i] = src_i }, src)) 0 size (new, src) + +doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked + :: !.Int !(!.Int,.Int,.[FunType]) + !(!*{#.DclModule},!*Heaps,!*CheckState) + -> (!.{#DclModule},!.Heaps,!.CheckState); +doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked mod_index + (nr_of_dcl_functions_and_instances, nr_of_dcl_funs_insts_and_specs, rev_special_defs) + (dcl_modules, heaps=:{hp_type_heaps, hp_var_heap}, cs=:{cs_error}) + #! main_dcl_module_n + = cs.cs_x.x_main_dcl_module_n + # (dcl_modules, hp_type_heaps, cs_error) + = case mod_index==main_dcl_module_n of + True + -> (dcl_modules, hp_type_heaps, cs_error) + False + -> expand_syn_types_of_dcl_mod mod_index (dcl_modules, hp_type_heaps, cs_error) + (dcl_mod=:{dcl_functions, dcl_common}, dcl_modules) + = dcl_modules![mod_index] + nr_of_dcl_functions + = size dcl_functions + (memb_inst_defs, nr_of_dcl_functions_and_instances2, rev_spec_class_inst, + com_instance_defs, com_class_defs, com_member_defs, dcl_modules, hp_type_heaps, hp_var_heap, cs) + = determineTypesOfInstances nr_of_dcl_functions mod_index + (fst (memcpy dcl_common.com_instance_defs)) + (fst (memcpy dcl_common.com_class_defs)) + (fst (memcpy dcl_common.com_member_defs)) + dcl_modules hp_type_heaps hp_var_heap { cs & cs_error = cs_error } + heaps + = { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap } + (nr_of_dcl_funs_insts_and_specs, new_class_instances, rev_special_defs, all_spec_types, heaps, cs_error) + = checkSpecialsOfInstances mod_index nr_of_dcl_functions rev_spec_class_inst nr_of_dcl_funs_insts_and_specs [] + rev_special_defs { mem \\ mem <- memb_inst_defs } { [] \\ mem <- memb_inst_defs } heaps cs.cs_error + dcl_functions + = array_plus_list dcl_functions + ( [ { mem_inst & ft_specials = if (isEmpty spec_types) SP_None (SP_ContextTypes spec_types) } + \\ mem_inst <- memb_inst_defs & spec_types <-: all_spec_types + ] + ++ reverse rev_special_defs + ) + dcl_mod + = { dcl_mod & + dcl_functions = dcl_functions, + dcl_specials = { ir_from = nr_of_dcl_functions_and_instances, + ir_to = nr_of_dcl_funs_insts_and_specs }, + dcl_common = { dcl_common & com_instance_defs = com_instance_defs, + com_class_defs = com_class_defs, com_member_defs = com_member_defs }} + dcl_modules + = { dcl_modules & [mod_index] = dcl_mod } + cs + = { cs & cs_error = cs_error } + = (dcl_modules, heaps, cs) + where + expand_syn_types_of_dcl_mod mod_index (dcl_modules, hp_type_heaps, cs_error) + # (type_defs, dcl_modules) + = dcl_modules![mod_index].dcl_common.com_type_defs + unique_type_defs + = { el \\ el <-:type_defs } + (expanded_type_defs, dcl_modules, hp_type_heaps, cs_error) + = expandSynonymTypes mod_index unique_type_defs dcl_modules hp_type_heaps cs_error + dcl_modules + = { dcl_modules & [mod_index].dcl_common.com_type_defs = expanded_type_defs } + = (dcl_modules, hp_type_heaps, cs_error) + + + checkDclModule :: !NumberSet ![Int] !(IntKeyHashtable SolvedImports) !Int !Bool !LargeBitvect !(Module (CollectedDefinitions ClassInstance IndexRange)) !Index !*ExplImpInfos !*{#DclModule} !*{#FunDef} !*Heaps !*CheckState - -> (!*ExplImpInfos, !*{#DclModule}, !*{#FunDef}, !*Heaps, !*CheckState) + -> (!(!Int,!Index,![FunType]), !(!*ExplImpInfos, !*{#DclModule}, !*{#FunDef}, !*Heaps, !*CheckState)) checkDclModule dcl_imported_module_numbers super_components imports_ikh component_nr is_on_cycle modules_in_component_set {mod_name,mod_imports,mod_defs} mod_index expl_imp_info modules icl_functions heaps=:{hp_var_heap, hp_type_heaps,hp_expression_heap} cs @@ -2039,27 +2076,19 @@ checkDclModule dcl_imported_module_numbers super_components imports_ikh componen # (dcl_common, modules, hp_type_heaps, hp_var_heap, cs) = checkCommonDefinitions cIsADclModule mod_index dcl_common modules hp_type_heaps hp_var_heap cs - (memb_inst_defs, nr_of_dcl_functions_and_instances, rev_spec_class_inst, dcl_common, modules, hp_type_heaps, hp_var_heap, cs) - = determineTypesOfInstances nr_of_dcl_functions mod_index dcl_common modules hp_type_heaps hp_var_heap cs + #!nr_of_members + = count_members mod_index dcl_common.com_instance_defs dcl_common.com_class_defs modules + # nr_of_dcl_functions_and_instances + = nr_of_dcl_functions+nr_of_members + heaps + = { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap, hp_expression_heap=hp_expression_heap} (nr_of_dcl_funs_insts_and_specs, rev_function_list, rev_special_defs, com_type_defs, com_class_defs, modules, heaps, cs) = checkDclFunctions mod_index nr_of_dcl_functions_and_instances mod_defs.def_funtypes - dcl_common.com_type_defs dcl_common.com_class_defs modules { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap, hp_expression_heap=hp_expression_heap} cs + dcl_common.com_type_defs dcl_common.com_class_defs modules heaps cs - (nr_of_dcl_funs_insts_and_specs, new_class_instances, rev_special_defs, all_spec_types, heaps, cs_error) - = checkSpecialsOfInstances mod_index nr_of_dcl_functions rev_spec_class_inst nr_of_dcl_funs_insts_and_specs [] - rev_special_defs { mem \\ mem <- memb_inst_defs } { [] \\ mem <- memb_inst_defs } heaps cs.cs_error - - dcl_functions = { function \\ function <- revAppend rev_function_list - ( [ { mem_inst & ft_specials = if (isEmpty spec_types) SP_None (SP_ContextTypes spec_types) } \\ - mem_inst <- memb_inst_defs & spec_types <-: all_spec_types ] ++ - reverse rev_special_defs) } - - com_instance_defs = dcl_common.com_instance_defs - com_instance_defs = { inst_def \\ inst_def <- [ inst_def \\ inst_def <-: com_instance_defs ] ++ new_class_instances } - - (com_member_defs, com_instance_defs, dcl_functions, cs) - = adjust_predefined_symbols mod_index dcl_common.com_member_defs com_instance_defs dcl_functions { cs & cs_error = cs_error } + dcl_functions = { function \\ function <- reverse rev_function_list } + com_member_defs = dcl_common.com_member_defs e_info = { ef_type_defs = com_type_defs, ef_selector_defs = dcl_common.com_selector_defs, ef_class_defs = com_class_defs, ef_cons_defs = dcl_common.com_cons_defs, ef_member_defs = com_member_defs, ef_modules = modules, ef_is_macro_fun = False } @@ -2070,7 +2099,6 @@ checkDclModule dcl_imported_module_numbers super_components imports_ikh componen cs = check_needed_modules_are_imported mod_name ".dcl" cs com_instance_defs = dcl_common.com_instance_defs - com_instance_defs = array_plus_list com_instance_defs new_class_instances (ef_member_defs, com_instance_defs, dcl_functions, cs) = adjust_predefined_symbols mod_index e_info.ef_member_defs com_instance_defs dcl_functions cs @@ -2082,9 +2110,6 @@ checkDclModule dcl_imported_module_numbers super_components imports_ikh componen True -> (modules, icl_functions, hp_expression_heap, cs) heaps = { heaps & hp_expression_heap = hp_expression_heap } - first_special_class_index = size com_instance_defs - last_special_class_index = first_special_class_index + length new_class_instances - dcl_common = { dcl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, com_instance_defs = com_instance_defs, com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs } @@ -2096,14 +2121,14 @@ checkDclModule dcl_imported_module_numbers super_components imports_ikh componen = removeDeclarationsFromSymbolTable dcl_defined cModuleScope cs_symbol_table cs_symbol_table - = foldlArraySt mw_removeImportedSymbolsFromSymbolTable dcls_import cs_symbol_table + = foldlArraySt removeImportedSymbolsFromSymbolTable dcls_import cs_symbol_table dcl_mod = { dcl_mod & dcl_declared = { dcl_mod.dcl_declared & dcls_import = dcls_import }, dcl_common = dcl_common, dcl_functions = dcl_functions, dcl_instances = { ir_from = nr_of_dcl_functions, ir_to = nr_of_dcl_functions_and_instances }, - dcl_specials = { ir_from = nr_of_dcl_functions_and_instances, ir_to = nr_of_dcl_funs_insts_and_specs }, - dcl_class_specials = { ir_from = first_special_class_index, ir_to = last_special_class_index }, + dcl_specials = { ir_from = cUndef, ir_to = cUndef }, dcl_imported_module_numbers = dcl_imported_module_numbers} - = (expl_imp_info, { modules & [ mod_index ] = dcl_mod }, icl_functions, heaps, { cs & cs_symbol_table = cs_symbol_table }) + = ((nr_of_dcl_functions_and_instances, nr_of_dcl_funs_insts_and_specs, rev_special_defs), + (expl_imp_info, { modules & [ mod_index ] = dcl_mod }, icl_functions, heaps, { cs & cs_symbol_table = cs_symbol_table })) where adjust_predefined_symbols mod_index class_members class_instances fun_types cs=:{cs_predef_symbols} # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdArray] @@ -2184,6 +2209,17 @@ where (Yes symbol_type) = inst_def.ft_type = { instance_defs & [ds_index] = { inst_def & ft_type = makeElemTypeOfArrayFunctionStrict inst_def.ft_type ins_offset offset_table } } + count_members :: !Index !{# ClassInstance} !{# ClassDef} !{# DclModule} -> Int + count_members mod_index com_instance_defs com_class_defs modules + # (sum, _, _) + = foldlArraySt (count_members_of_instance mod_index) com_instance_defs (0, com_class_defs, modules) + = sum + + count_members_of_instance mod_index {ins_class} (sum, com_class_defs, modules) + # ({class_members}, com_class_defs, modules) + = getClassDef ins_class mod_index com_class_defs modules + = (size class_members + sum, com_class_defs, modules) + NewEntry symbol_table symb_ptr def_kind def_index level previous :== symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous }) diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl index 29f4b0a..640ed68 100644 --- a/frontend/checkFunctionBodies.icl +++ b/frontend/checkFunctionBodies.icl @@ -1630,7 +1630,6 @@ checkFields mod_index field_ass opt_type e_info=:{ef_selector_defs,ef_type_defs, -> (No, e_info, cs) = (No, e_info, cs) where - check_fields [ bind=:{bind_dst} : field_ass ] cs=:{cs_symbol_table,cs_error} # (entry, cs_symbol_table) = readPtr bind_dst.id_info cs_symbol_table # fields = retrieveSelectorIndexes mod_index entry @@ -1667,13 +1666,13 @@ where (type_def, type_defs) = type_defs![selector_def.sd_type_index] -> (Yes (type_def, glob_module), selector_defs, type_defs, modules, cs) # ({dcl_common={com_selector_defs,com_type_defs}}, modules) = modules![glob_module] - # selector_def = com_selector_defs.[glob_object] - type_def = com_type_defs.[selector_def.sd_type_index] + {sd_type_index} = com_selector_defs.[glob_object] + type_def = com_type_defs.[sd_type_index] -> (Yes (type_def,glob_module), selector_defs, type_defs, modules, cs) No -> (No, selector_defs, type_defs, modules, { cs & cs_error = checkError "" " could not determine the type of this record" cs.cs_error }) - check_and_rearrange_fields :: Int Int {#FieldSymbol} ![Bind ParsedExpr (Ident,[Global .Int])] *ErrorAdmin -> ([Bind ParsedExpr .(Global FieldSymbol)],!.ErrorAdmin); + check_and_rearrange_fields :: !Int !Int !{#FieldSymbol} ![Bind ParsedExpr (Ident,[Global .Int])] !*ErrorAdmin -> (![Bind ParsedExpr .(Global FieldSymbol)],!.ErrorAdmin); check_and_rearrange_fields mod_index field_index fields field_ass cs_error | field_index < size fields # (field_expr, field_ass) = look_up_field mod_index fields.[field_index] field_ass diff --git a/frontend/checksupport.dcl b/frontend/checksupport.dcl index 0aa9847..d0442fc 100644 --- a/frontend/checksupport.dcl +++ b/frontend/checksupport.dcl @@ -94,7 +94,6 @@ cConversionTableSize :== 8 , dcl_functions :: !{# FunType } , dcl_instances :: !IndexRange , dcl_macros :: !IndexRange - , dcl_class_specials :: !IndexRange , dcl_specials :: !IndexRange , dcl_common :: !CommonDefs , dcl_sizes :: !{# Int} @@ -154,6 +153,7 @@ addDeclarationsOfDclModToSymbolTable :: .Int !{!Declaration} !{!Declaration} !*C addGlobalDefinitionsToSymbolTable :: ![Declaration] !*CheckState -> .CheckState; addSymbol :: !(Optional a) !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !Int !*CheckState -> (!Bool, !.CheckState) addImportedFunctionOrMacro :: !(Optional IndexRange) !Ident !Int !*CheckState -> (!Bool, !.CheckState) +removeImportedSymbolsFromSymbolTable :: Declaration !*SymbolTable -> .SymbolTable removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *SymbolTable removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; @@ -180,5 +180,3 @@ nrOfBelongingSymbols :: !BelongingSymbols -> Int import_ident :: Ident restoreHeap :: !Ident !*SymbolTable -> .SymbolTable - -expand_syn_types_late_XXX yes no :== no diff --git a/frontend/checksupport.icl b/frontend/checksupport.icl index dabd555..7eb91eb 100644 --- a/frontend/checksupport.icl +++ b/frontend/checksupport.icl @@ -106,7 +106,6 @@ where , dcl_functions :: !{# FunType } , dcl_instances :: !IndexRange , dcl_macros :: !IndexRange - , dcl_class_specials :: !IndexRange , dcl_specials :: !IndexRange , dcl_common :: !CommonDefs , dcl_sizes :: !{# Int} @@ -428,6 +427,18 @@ where -> cs = { cs & cs_error = checkErrorWithIdentPos (newPosition ident dcl_pos) " multiply defined" cs.cs_error} +removeImportedSymbolsFromSymbolTable :: Declaration !*SymbolTable -> .SymbolTable +removeImportedSymbolsFromSymbolTable {dcl_ident=dcl_ident=:{id_info}, dcl_index} symbol_table + # ({ste_kind,ste_def_level,ste_previous}, symbol_table) + = readPtr id_info symbol_table + symbol_table + = symbol_table <:= (id_info, ste_previous) + = case ste_kind of + STE_Imported (STE_Field selector_id) def_mod + -> removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table + _ + -> symbol_table + removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; removeFieldFromSelectorDefinition {id_info} field_mod field_index symbol_table # (entry, symbol_table) = readPtr id_info symbol_table @@ -620,5 +631,3 @@ restoreHeap {id_info} cs_symbol_table # ({ste_previous}, cs_symbol_table) = readPtr id_info cs_symbol_table = writePtr id_info ste_previous cs_symbol_table - -expand_syn_types_late_XXX yes no :== no diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl index 2b8f743..09f4dcc 100644 --- a/frontend/checktypes.icl +++ b/frontend/checktypes.icl @@ -416,12 +416,6 @@ checkTypeDefs is_main_dcl type_defs module_index cons_defs selector_defs module where check_type_defs is_main_dcl type_index nr_of_types module_index ts ti=:{ti_type_heaps,ti_var_heap} cs | type_index == nr_of_types - | cs.cs_error.ea_ok && not is_main_dcl - # marks = createArray nr_of_types CS_NotChecked - {exp_type_defs,exp_modules,exp_type_heaps,exp_error} = (expand_syn_types_late_XXX id (expand_syn_types module_index 0 nr_of_types)) - { exp_type_defs = ts.ts_type_defs, exp_modules = ts.ts_modules, exp_marks = marks, - exp_type_heaps = ti_type_heaps, exp_error = cs.cs_error } - = (exp_type_defs, ts.ts_cons_defs, ts.ts_selector_defs, exp_modules, ti_var_heap, exp_type_heaps, { cs & cs_error = exp_error }) = (ts.ts_type_defs, ts.ts_cons_defs, ts.ts_selector_defs, ts.ts_modules, ti_var_heap, ti_type_heaps, cs) # (ts, ti, cs) = checkTypeDef type_index module_index ts ti cs = check_type_defs is_main_dcl (inc type_index) nr_of_types module_index ts ti cs @@ -437,8 +431,6 @@ expand_syn_types module_index type_index nr_of_types expst expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin -> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin) expandSynonymTypes module_index exp_type_defs exp_modules exp_type_heaps exp_error - | expand_syn_types_late_XXX False True - = abort "expandSynonymTypes" #! nr_of_types = size exp_type_defs # marks diff --git a/frontend/comparedefimp.dcl b/frontend/comparedefimp.dcl index c13df7d..1652f37 100644 --- a/frontend/comparedefimp.dcl +++ b/frontend/comparedefimp.dcl @@ -4,6 +4,6 @@ import syntax, checksupport // compare definition and implementation module -compareDefImp :: !{#Int} !{!FunctionBody} !Int {#CheckedTypeDef} !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin - -> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin) +compareDefImp :: !{#Int} !{!FunctionBody} !Int !{#CheckedTypeDef} !DclModule !*IclModule !*Heaps !*ErrorAdmin + -> (!.IclModule,!.Heaps,!.ErrorAdmin) diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl index 3c713e9..7243ee6 100644 --- a/frontend/comparedefimp.icl +++ b/frontend/comparedefimp.icl @@ -26,17 +26,6 @@ import syntax, checksupport, compare_constructor, utilities, StdCompare :: !.HeapWithNumber TypeVarInfo , tc_attr_vars :: !.HeapWithNumber AttrVarInfo - , tc_dcl_modules - :: !.{#DclModule} - , tc_icl_type_defs - :: !{#CheckedTypeDef} - , tc_type_conversions - :: !Conversions - , tc_visited_syn_types // to detect cycles in type synonyms - // only for no in expand_syn_types_late_XXX - :: !.{#Bool} - , tc_main_dcl_module_n - :: !Int } :: TypesCorrespondMonad @@ -59,6 +48,8 @@ import syntax, checksupport, compare_constructor, utilities, StdCompare :: !{! FunctionBody } , ec_function_conversions :: !Conversions + , ec_main_dcl_module_n + :: !Int } :: ExpressionsCorrespondMonad @@ -73,8 +64,7 @@ import syntax, checksupport, compare_constructor, utilities, StdCompare :: !Int } -:: OptionalCorrespondenceNumber = CorrespondenceNumber !Int | Bound | Unbound - // Bound is only used for no case in expand_syn_types_late_XXX +:: OptionalCorrespondenceNumber = CorrespondenceNumber !Int | Unbound class t_corresponds a :: !a !a -> *TypesCorrespondMonad // whether two types correspond @@ -89,40 +79,29 @@ class CorrespondenceNumber a where initial_hwn hwn_heap = { hwn_heap = hwn_heap, hwn_number = 0 } -compareDefImp :: !{#Int} !{!FunctionBody} !Int {#CheckedTypeDef} !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin - -> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin) -compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n type_defs_of_icl_mod dcl_modules +compareDefImp :: !{#Int} !{!FunctionBody} !Int !{#CheckedTypeDef} !DclModule !*IclModule !*Heaps !*ErrorAdmin + -> (!.IclModule,!.Heaps,!.ErrorAdmin) +compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n icl_com_type_defs main_dcl_module icl_module heaps error_admin // icl definitions with indices >= size_uncopied_icl_defs.[def_type] don't have to be compared, // because they are copies of definitions that appear exclusively in the dcl module - # (main_dcl_module, dcl_modules) = dcl_modules![main_dcl_module_n] = case main_dcl_module.dcl_conversions of - No -> (dcl_modules, icl_module, heaps, error_admin) + No -> (icl_module, heaps, error_admin) Yes conversion_table # {dcl_functions, dcl_macros, dcl_common} = main_dcl_module {icl_common, icl_functions} = icl_module {hp_var_heap, hp_expression_heap, hp_type_heaps={th_vars, th_attrs}} = heaps - { com_type_defs, com_cons_defs=icl_com_cons_defs, + { com_cons_defs=icl_com_cons_defs, com_selector_defs=icl_com_selector_defs, com_class_defs=icl_com_class_defs, com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs } = icl_common - icl_com_type_defs - = expand_syn_types_late_XXX type_defs_of_icl_mod com_type_defs - (icl_type_defs, icl_com_type_defs) - = expand_syn_types_late_XXX (icl_com_type_defs, icl_com_type_defs) - (memcpy icl_com_type_defs) tc_state = { tc_type_vars = initial_hwn th_vars , tc_attr_vars = initial_hwn th_attrs - , tc_dcl_modules = dcl_modules - , tc_icl_type_defs = icl_type_defs - , tc_type_conversions = conversion_table.[cTypeDefs] - , tc_visited_syn_types = createArray (size dcl_common.com_type_defs) False - , tc_main_dcl_module_n = main_dcl_module_n } - (icl_com_type_defs, tc_state, error_admin) + (_, tc_state, error_admin) = compareWithConversions size_uncopied_icl_defs.[cTypeDefs] conversion_table.[cTypeDefs] dcl_common.com_type_defs icl_com_type_defs tc_state error_admin @@ -147,23 +126,23 @@ compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n type_defs_o size_uncopied_icl_defs.[cInstanceDefs] conversion_table.[cInstanceDefs] dcl_common.com_instance_defs icl_com_instance_defs tc_state error_admin (icl_functions, hp_var_heap, hp_expression_heap, tc_state, error_admin) - = compareMacrosWithConversion conversion_table.[cMacroDefs] conversion_table.[cFunctionDefs] - dcl_macros untransformed - icl_functions hp_var_heap hp_expression_heap tc_state error_admin + = compareMacrosWithConversion main_dcl_module_n + conversion_table.[cMacroDefs] conversion_table.[cFunctionDefs] + dcl_macros untransformed + icl_functions hp_var_heap hp_expression_heap tc_state error_admin (icl_functions, tc_state, error_admin) = compareFunctionTypesWithConversions conversion_table.[cFunctionDefs] dcl_functions icl_functions tc_state error_admin - { tc_type_vars, tc_attr_vars, tc_dcl_modules } - = tc_state + { tc_type_vars, tc_attr_vars } + = tc_state icl_common - = { icl_common & com_type_defs=expand_syn_types_late_XXX com_type_defs icl_com_type_defs, - com_cons_defs=icl_com_cons_defs, + = { icl_common & com_cons_defs=icl_com_cons_defs, com_selector_defs=icl_com_selector_defs, com_class_defs=icl_com_class_defs, com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs } heaps = { hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap, hp_type_heaps = { th_vars = tc_type_vars.hwn_heap, th_attrs = tc_attr_vars.hwn_heap}} - -> ( tc_dcl_modules, { icl_module & icl_common = icl_common, icl_functions = icl_functions }, + -> ({ icl_module & icl_common = icl_common, icl_functions = icl_functions }, heaps, error_admin ) where memcpy :: !u:{#CheckedTypeDef} -> (!.{#CheckedTypeDef}, !u:{#CheckedTypeDef}) @@ -237,14 +216,16 @@ generate_error message iclDef iclDefs tc_state error_admin error_admin = checkError ident_pos.ip_ident message error_admin = (iclDefs, tc_state, popErrorAdmin error_admin) -compareMacrosWithConversion conversions function_conversions macro_range untransformed icl_functions var_heap expr_heap tc_state error_admin +compareMacrosWithConversion main_dcl_module_n conversions function_conversions macro_range untransformed + icl_functions var_heap expr_heap tc_state error_admin #! nr_of_functions = size icl_functions # correspondences = createArray nr_of_functions cNoCorrespondence ec_state = { ec_correspondences = correspondences, ec_var_heap = initial_hwn var_heap, ec_expr_heap = expr_heap, ec_icl_functions = icl_functions, ec_error_admin = error_admin, ec_tc_state = tc_state, ec_untransformed = untransformed, - ec_function_conversions = function_conversions } + ec_function_conversions = function_conversions, + ec_main_dcl_module_n = main_dcl_module_n } ec_state = iFoldSt (compareMacroWithConversion conversions macro_range.ir_from) macro_range.ir_from macro_range.ir_to ec_state {ec_icl_functions, ec_var_heap, ec_expr_heap, ec_error_admin, ec_tc_state} = ec_state @@ -326,8 +307,6 @@ instance CorrespondenceNumber TypeVarInfo where = CorrespondenceNumber number toCorrespondenceNumber TVI_Empty = Unbound - toCorrespondenceNumber (TVI_AType _) - = expand_syn_types_late_XXX (abort "not used!!!") Bound fromCorrespondenceNumber number = TVI_CorrespondenceNumber number @@ -415,51 +394,11 @@ instance t_corresponds (Global DefinedSymbol) where instance t_corresponds (TypeDef TypeRhs) where t_corresponds dclDef iclDef - = (expand_syn_types_late_XXX t_corresponds_TypeDef` t_corresponds_TypeDef) dclDef iclDef + = t_corresponds_TypeDef dclDef iclDef where t_corresponds_TypeDef dclDef iclDef tc_state // | False--->("comparing:", dclDef, iclDef) // = undef - # tc_state = { tc_state & tc_visited_syn_types.[dclDef.td_index] = True } - tc_state = init_attr_vars dclDef.td_attrs tc_state - tc_state = init_attr_vars iclDef.td_attrs tc_state - tc_state = init_atype_vars dclDef.td_args tc_state - tc_state = init_atype_vars iclDef.td_args tc_state - (corresponds, tc_state) = t_corresponds dclDef.td_args iclDef.td_args tc_state - | not corresponds - = (corresponds, tc_state) - # icl_root_has_anonymous_attr = root_has_anonymous_attr iclDef.td_attribute iclDef.td_rhs - | icl_root_has_anonymous_attr<>root_has_anonymous_attr dclDef.td_attribute dclDef.td_rhs - && isnt_abstract dclDef.td_rhs - = (False, tc_state) - # coerced_icl_rhs = if icl_root_has_anonymous_attr (coerce iclDef.td_rhs) iclDef.td_rhs - (corresponds, tc_state) = t_corresponds dclDef.td_rhs coerced_icl_rhs tc_state - tc_state = { tc_state & tc_visited_syn_types.[dclDef.td_index] = False } - | not corresponds - = (corresponds, tc_state) - # (corresponds, tc_state) = t_corresponds dclDef.td_context iclDef.td_context tc_state - | not corresponds - = (corresponds, tc_state) - # attributes_correspond = (is_TA_Unique dclDef.td_attribute)==(is_TA_Unique iclDef.td_attribute) - = (attributes_correspond, tc_state) - where - root_has_anonymous_attr (TA_Var lhs_attr_var) syn_type=:(SynType a_type=:{at_attribute=TA_Var rhs_attr_var}) - = rhs_attr_var.av_info_ptr==lhs_attr_var.av_info_ptr - root_has_anonymous_attr _ _ - = False - - coerce (SynType atype) - = SynType { atype & at_attribute = TA_Anonymous } - - isnt_abstract (AbstractType _) = False - isnt_abstract _ = True - - is_TA_Unique TA_Unique = True - is_TA_Unique _ = False - - t_corresponds_TypeDef` dclDef iclDef tc_state -// | False--->("comparing:", dclDef, iclDef) -// = undef # tc_state = init_attr_vars dclDef.td_attrs tc_state tc_state = init_attr_vars iclDef.td_attrs tc_state tc_state = init_atype_vars dclDef.td_args tc_state @@ -484,106 +423,10 @@ instance t_corresponds ATypeVar where instance t_corresponds AType where t_corresponds dclDef iclDef - = (expand_syn_types_late_XXX t_corresponds_at_type` t_corresponds_at_type) dclDef iclDef - where - t_corresponds_at_type` dclDef iclDef - | dclDef.at_annotation<>iclDef.at_annotation - = return False - = t_corresponds dclDef.at_attribute iclDef.at_attribute - &&& t_corresponds dclDef.at_type iclDef.at_type - - t_corresponds_at_type dclDef iclDef tc_state - | dclDef.at_annotation<>iclDef.at_annotation - = (False, tc_state) - # (corresponds, tc_state) = simple_corresponds dclDef iclDef tc_state - | corresponds - = (corresponds, tc_state) - = case dclDef.at_type of - TA dcl_type_symb dcl_args - -> corresponds_with_expanded_syn_type dcl_type_symb.type_index dcl_args iclDef tc_state - TV {tv_info_ptr} - #! x = sreadPtr tv_info_ptr tc_state.tc_type_vars.hwn_heap - -> case x of - TVI_AType dcl_atype - -> t_corresponds { dcl_atype & at_annotation = dclDef.at_annotation } iclDef tc_state - _ -> (False, tc_state) - _ -> (False, tc_state) - where - simple_corresponds dclDef iclDef - = t_corresponds dclDef.at_attribute iclDef.at_attribute - &&& t_corresponds dclDef.at_type iclDef.at_type - - corresponds_with_expanded_syn_type {glob_module, glob_object} dclArgs icl_atype - tc_state -// # is_defined_in_main_dcl = glob_module==cIclModIndex - # is_defined_in_main_dcl = glob_module==tc_state.tc_main_dcl_module_n - | is_defined_in_main_dcl && tc_state.tc_visited_syn_types.[glob_object] - = (False, tc_state) // cycle in synonym types in main dcl - # ({dcl_common}, tc_state) = tc_state!tc_dcl_modules.[glob_module] - type_def = dcl_common.com_type_defs.[glob_object] - = case type_def.td_rhs of - SynType {at_type=TV type_var, at_attribute} - // a "projection" type. attributes are treated in a special way - # arg_pos = get_arg_pos type_var type_def.td_args 0 - dcl_arg = dclArgs!!arg_pos - coerced_dcl_arg = { dcl_arg & at_attribute = determine_type_attribute type_def.td_attribute } - -> t_corresponds coerced_dcl_arg icl_atype tc_state - SynType atype - # tc_state = { tc_state & tc_type_vars - = bind_type_vars type_def.td_args dclArgs tc_state.tc_type_vars } - tc_state = init_attr_vars type_def.td_attrs tc_state - tc_state = opt_set_visited_bit is_defined_in_main_dcl glob_object True tc_state - atype = { atype & at_attribute = determine_type_attribute type_def.td_attribute } - (corresponds, tc_state) = t_corresponds atype icl_atype tc_state - tc_state = opt_set_visited_bit is_defined_in_main_dcl glob_object False tc_state - -> (corresponds, tc_state) - AbstractType _ - | not is_defined_in_main_dcl - -> (False, tc_state) - #! icl_type_def = tc_state.tc_icl_type_defs.[tc_state.tc_type_conversions.[glob_object]] - # tc_state = { tc_state & tc_type_vars - = bind_type_vars icl_type_def.td_args dclArgs tc_state.tc_type_vars } - tc_state = init_attr_vars icl_type_def.td_attrs tc_state - -> case icl_type_def.td_rhs of - SynType atype - # atype = { atype & at_attribute = determine_type_attribute type_def.td_attribute } - -> t_corresponds atype icl_atype tc_state - _ -> (False, tc_state) - _ -> (False, tc_state) - where - - bind_type_vars formal_args actual_args tc_type_vars - # hwn_heap = bind_type_vars` formal_args actual_args tc_type_vars.hwn_heap - = { tc_type_vars & hwn_heap = hwn_heap } - - bind_type_vars` [{atv_variable}:formal_args] [actual_arg:actual_args] type_var_heap - # (actual_arg, type_var_heap) = possibly_dereference actual_arg type_var_heap - = bind_type_vars` formal_args actual_args - (writePtr atv_variable.tv_info_ptr (TVI_AType actual_arg) type_var_heap) - // --->("binding", atv_variable.tv_name,"to",actual_arg) - bind_type_vars` _ _ type_var_heap - = type_var_heap - - possibly_dereference atype=:{at_type=TV {tv_info_ptr}} type_var_heap - #! dereferenced = sreadPtr tv_info_ptr type_var_heap - = case dereferenced of - TVI_AType atype2 - -> (atype2, type_var_heap) - _ -> (atype, type_var_heap) - possibly_dereference atype type_var_heap - = (atype, type_var_heap) - - opt_set_visited_bit True glob_object bit tc_state - = { tc_state & tc_visited_syn_types.[glob_object] = bit } - opt_set_visited_bit False _ _ tc_state - = tc_state - - determine_type_attribute TA_Unique = TA_Unique - determine_type_attribute _ = TA_Multi - - get_arg_pos x [h:t] count - | x==h.atv_variable = count - = get_arg_pos x t (inc count) + | dclDef.at_annotation<>iclDef.at_annotation + = return False + = t_corresponds dclDef.at_attribute iclDef.at_attribute + &&& t_corresponds dclDef.at_type iclDef.at_type instance t_corresponds TypeAttribute where t_corresponds TA_Unique TA_Unique @@ -594,9 +437,6 @@ instance t_corresponds TypeAttribute where = t_corresponds dclDef iclDef t_corresponds (TA_RootVar dclDef) (TA_RootVar iclDef) = PA_BUG (return True) (t_corresponds dclDef iclDef) - t_corresponds _ TA_Anonymous - | expand_syn_types_late_XXX False True - = return True t_corresponds TA_None icl = case icl of TA_Multi-> return True @@ -975,7 +815,7 @@ e_corresponds_VarInfoPtr ident dclPtr iclPtr ec_state=:{ec_var_heap} e_corresponds_app_symb dcl_app_symb=:{symb_name, symb_kind=SK_Function dcl_glob_index} icl_app_symb=:{symb_kind=SK_Function icl_glob_index} ec_state - #! main_dcl_module_n = ec_state.ec_tc_state.tc_main_dcl_module_n + #! main_dcl_module_n = ec_state.ec_main_dcl_module_n | dcl_glob_index.glob_module==main_dcl_module_n && icl_glob_index.glob_module==main_dcl_module_n | ec_state.ec_function_conversions.[dcl_glob_index.glob_object]<>icl_glob_index.glob_object = give_error symb_name ec_state diff --git a/frontend/explicitimports.dcl b/frontend/explicitimports.dcl index e1c5c64..86da888 100644 --- a/frontend/explicitimports.dcl +++ b/frontend/explicitimports.dcl @@ -4,7 +4,7 @@ import syntax, checksupport :: ImportNrAndIdents = { ini_symbol_nr :: !Index - , ini_belonging :: !Optional [ImportedIdent] + , ini_imp_decl :: !ImportDeclaration } :: SolvedImports = @@ -16,7 +16,7 @@ import syntax, checksupport markExplImpSymbols :: !Int !*(!*{!*{!u:ExplImpInfo}}, !*SymbolTable) -> (!.[Ident],!(!{!{!u:ExplImpInfo}},!.SymbolTable)) -updateExplImpForMarkedSymbol :: !Index Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable +updateExplImpForMarkedSymbol :: !Index !Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable -> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !.SymbolTable) solveExplicitImports :: !(IntKeyHashtable [(Int,Position,[ImportNrAndIdents])]) !{#Int} !Index diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl index 91bc360..2763f05 100644 --- a/frontend/explicitimports.icl +++ b/frontend/explicitimports.icl @@ -17,7 +17,7 @@ implies a b :== not a || b :: ImportNrAndIdents = { ini_symbol_nr :: !Index - , ini_belonging :: !Optional [ImportedIdent] + , ini_imp_decl :: !ImportDeclaration } :: SolvedImports = @@ -64,7 +64,7 @@ markExplImpSymbols component_nr (expl_imp_info, cs_symbol_table) -updateExplImpForMarkedSymbol :: !Index Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable +updateExplImpForMarkedSymbol :: !Index !Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable -> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !.SymbolTable) updateExplImpForMarkedSymbol mod_index decl {ste_kind=STE_ExplImpComponentNrs component_numbers inst_indices} dcl_modules expl_imp_infos cs_symbol_table @@ -177,9 +177,11 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod = ((decl_accu, position), (dcl_modules, visited_modules, expl_imp_info, cs)) solve_belonging position expl_imp_indices_ikh modules_in_component_set importing_mod - (decl, {ini_symbol_nr, ini_belonging=Yes belongs}, imported_mod) + (decl, {ini_symbol_nr, ini_imp_decl}, imported_mod) (decls_accu, dcl_modules, visited_modules, expl_imp_info, cs=:{cs_error, cs_symbol_table}) - # (all_belongs, dcl_modules) + # (Yes belongs) + = getBelongingSymbolsFromID ini_imp_decl + (all_belongs, dcl_modules) = get_all_belongs decl dcl_modules (ExplImpInfo eii_ident eii_declaring_modules, expl_imp_info) = replace expl_imp_info ini_symbol_nr TemporarilyFetchedAway @@ -319,7 +321,7 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod {di_decl = di_decl, di_instances = [], di_belonging=EndNumbers} eei_dm) path eii_declaring_modules new_belonging_accu - = case ini.ini_belonging of + = case getBelongingSymbolsFromID ini.ini_imp_decl of No -> belonging_accu Yes _ @@ -365,9 +367,9 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod belong_nr belong_ident path eii_declaring_modules visited_modules | not (isEmpty imp_imp_symbols) // follow the path trough an explicit import only if the symbol is listed there - # (found, ini_belonging) + # (found, opt_belongs) = search_imported_symbol imported_symbol imp_imp_symbols - | not (found && implies (belong_nr<>cUndef) (belong_ident_found belong_ident ini_belonging)) + | not (found && implies (belong_nr<>cUndef) (belong_ident_found belong_ident opt_belongs)) = try_children imports expl_imp_indices_ikh modules_in_component_set imported_symbol belong_nr belong_ident path eii_declaring_modules visited_modules = continue imp_imp_mod imports expl_imp_indices_ikh modules_in_component_set imported_symbol @@ -394,9 +396,9 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod search_imported_symbol :: !Int ![ImportNrAndIdents] -> (!Bool, !Optional [ImportedIdent]) search_imported_symbol imported_symbol [] = (False, No) - search_imported_symbol imported_symbol [{ini_symbol_nr, ini_belonging}:t] + search_imported_symbol imported_symbol [{ini_symbol_nr, ini_imp_decl}:t] | imported_symbol==ini_symbol_nr - = (True, ini_belonging) + = (True, getBelongingSymbolsFromID ini_imp_decl) = search_imported_symbol imported_symbol t @@ -437,14 +439,18 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod check_singles position [] [] (expl_imp_info, cs_error) = (expl_imp_info, cs_error) - give_error position {ini_symbol_nr} (expl_imp_info, cs_error) + give_error position {ini_symbol_nr, ini_imp_decl} (expl_imp_info, cs_error) # (eii_ident, expl_imp_info) = do_a_lot_just_to_read_an_array_2 ini_symbol_nr expl_imp_info cs_error = pushErrorAdmin (newPosition import_ident position) cs_error cs_error - // XXX it should be also printed to which namespace eii_ident belongs - = checkError eii_ident "not exported by the specified module" cs_error + = checkError eii_ident + (switch_import_syntax + "not exported by the specified module" + ("not exported as a "+++impDeclToNameSpaceString ini_imp_decl + +++" by the specified module")) + cs_error = (expl_imp_info, popErrorAdmin cs_error) do_a_lot_just_to_read_an_array_2 i expl_imp_info @@ -454,6 +460,13 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod = get_eei_ident eii = (eii_ident, { expl_imp_info & [i] = eii }) + impDeclToNameSpaceString (ID_Function _) = "function/macro" + impDeclToNameSpaceString (ID_Class _ _) = "class" + impDeclToNameSpaceString (ID_Type _ _) = "type" + impDeclToNameSpaceString (ID_Record _ _) = "type" + impDeclToNameSpaceString (ID_Instance _ _ _)= "instance" + + get_eei_ident (eii=:ExplImpInfo eii_ident _) = (eii_ident, eii) :: CheckCompletenessState = @@ -811,7 +824,7 @@ instance check_completeness TypeContext where (check_whether_ident_is_imported tc_class.glob_object.ds_ident STE_Class cci ccs) instance check_completeness (TypeDef TypeRhs) where - check_completeness {td_rhs, td_context} cci ccs + check_completeness td=:{td_rhs, td_context} cci ccs = check_completeness td_rhs cci (check_completeness td_context cci ccs) diff --git a/frontend/main.icl b/frontend/main.icl index 06a4e99..7fc2459 100644 --- a/frontend/main.icl +++ b/frontend/main.icl @@ -21,6 +21,14 @@ Start world CommandLoop proj ms=:{ms_io} + # answer = "c t5\n" + (command, argument) = SplitAtLayoutChar (dropWhile isSpace (fromString answer)) + | command == [] + = CommandLoop proj { ms & ms_io = ms_io} + # (ready, proj, ms) = DoCommand command argument proj { ms & ms_io = ms_io} + = ms +/* +CommandLoop proj ms=:{ms_io} # (answer, ms_io) = freadline (ms_io <<< "> ") (command, argument) = SplitAtLayoutChar (dropWhile isSpace (fromString answer)) | command == [] @@ -29,6 +37,7 @@ CommandLoop proj ms=:{ms_io} | ready = ms = CommandLoop proj ms +*/ :: MainStateDefs funs funtypes types conses classes instances members selectors = { msd_funs :: !funs diff --git a/frontend/parse.icl b/frontend/parse.icl index 11960d8..5e6f6a6 100644 --- a/frontend/parse.icl +++ b/frontend/parse.icl @@ -268,7 +268,7 @@ wantModule iclmodule file_id=:{id_name} import_file_position hash_table error se ->(ok,mod,hash_table,file,pre_def_symbols,files) (No, files) -> let mod = { mod_name = file_id, mod_type = MK_None, mod_imports = [], mod_imported_objects = [], mod_defs = [] } in - (False, mod, hash_table, error <<< import_file_position <<< ":could not open " <<< file_name <<< "\n", pre_def_symbols, files) + (False, mod, hash_table, error <<< import_file_position <<< ": could not open " <<< file_name <<< "\n", pre_def_symbols, files) where initModule :: String ScanState !*HashTable !*File !*PredefinedSymbols *Files -> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files) @@ -896,7 +896,8 @@ want_2_0_import_declaration token pState -> (ID_Class { ii_ident = class_id, ii_extended = ii_extended } No, pState) InstanceToken # (class_name, pState) = want pState - (ii_extended, pState) = optional_extension pState +// (ii_extended, pState) = optional_extension pState // XXX fix this, Pieter + ii_extended = False (types, pState) = wantList "instance types" tryBrackType pState (class_id, pState) = stringToIdent class_name IC_Class pState (inst_id, pState) = stringToIdent class_name (IC_Instance types) pState diff --git a/frontend/postparse.icl b/frontend/postparse.icl index 2315d0d..91e845c 100644 --- a/frontend/postparse.icl +++ b/frontend/postparse.icl @@ -745,7 +745,7 @@ where scan_dcl_module :: ParsedModule [ScannedModule] !SearchPaths *Files *CollectAdmin -> (Bool, [ScannedModule], *Files, *CollectAdmin) scan_dcl_module mod=:{mod_defs = pdefs} parsed_modules searchPaths files ca # (_, defs, imports, imported_objects, ca) - = reorganiseDefinitions False pdefs 0 0 0 ca + = reorganiseDefinitions False pdefs 0 0 0 0 ca (macro_defs, ca) = collectFunctions defs.def_macros False ca (range, ca) @@ -769,7 +769,7 @@ scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules first_new_fu , ca_u_predefs = predefs , ca_hash_table = hash_table } - (fun_defs, defs, imports, imported_objects, ca) = reorganiseDefinitions True pdefs 0 0 0 ca + (fun_defs, defs, imports, imported_objects, ca) = reorganiseDefinitions True pdefs 0 0 0 0 ca (reorganise_icl_ok, ca) = ca!ca_error.pea_ok (import_dcl_ok, optional_parsed_dcl_mod,dcl_module_n,parsed_modules, cached_modules,files, ca) @@ -828,7 +828,7 @@ where | not parse_ok = (False, No,NoIndex, [],cached_modules, files, ca) # pdefs = mod.mod_defs - # (_, defs, imports, imported_objects, ca) = reorganiseDefinitions False pdefs 0 0 0 ca + # (_, defs, imports, imported_objects, ca) = reorganiseDefinitions False pdefs 0 0 0 0 ca # mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = defs} # cached_modules = [mod.mod_name:cached_modules] # (import_ok, parsed_modules, files, ca) = scanModules imports [] cached_modules searchPaths files ca @@ -897,37 +897,37 @@ collectFunctionBodies fun_name fun_arity fun_prio fun_kind all_defs=:[PD_Functio collectFunctionBodies fun_name fun_arity fun_prio fun_kind defs ca = ([], fun_kind, defs, ca) -reorganiseDefinitions :: Bool [ParsedDefinition] Index Index Index *CollectAdmin -> (![FunDef],!CollectedDefinitions (ParsedInstance FunDef) [FunDef], ![ParsedImport], ![ImportedObject], !*CollectAdmin) -reorganiseDefinitions icl_module [PD_Function pos name is_infix args rhs fun_kind : defs] cons_count sel_count mem_count ca +reorganiseDefinitions :: Bool [ParsedDefinition] Index Index Index Index *CollectAdmin -> (![FunDef],!CollectedDefinitions (ParsedInstance FunDef) [FunDef], ![ParsedImport], ![ImportedObject], !*CollectAdmin) +reorganiseDefinitions icl_module [PD_Function pos name is_infix args rhs fun_kind : defs] cons_count sel_count mem_count type_count ca # prio = if is_infix (Prio NoAssoc 9) NoPrio fun_arity = length args (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca - (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count ca fun = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies] fun_kind prio No pos | fun_kind == FK_Macro = (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros ]}, imports, imported_objects, ca) = ([ fun : fun_defs ], c_defs, imports, imported_objects, ca) -reorganiseDefinitions icl_module [PD_TypeSpec fun_pos fun_name prio No specials : defs] cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_TypeSpec fun_pos fun_name prio No specials : defs] cons_count sel_count mem_count type_count ca = case defs of [PD_Function pos name is_infix args rhs fun_kind : defs] | fun_name <> name - -> reorganiseDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos ("function alternative for "+++fun_name.id_name+++" expected") ca) + -> reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count (postParseError fun_pos ("function alternative for "+++fun_name.id_name+++" expected") ca) | not (sameFixity prio is_infix) - -> reorganiseDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "infix of type specification and alternative should match" ca) + -> reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count (postParseError fun_pos "infix of type specification and alternative should match" ca) // | belongsToTypeSpec fun_name prio name is_infix # fun_arity = length args (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca - (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count ca fun = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos | fun_kind == FK_Macro -> (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros]}, imports, imported_objects, ca) -> ([ fun : fun_defs ], c_defs, imports, imported_objects, ca) // -> reorganiseDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "function body expected (1)" ca) _ - -> reorganiseDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "function alternative expected (2)" ca) -reorganiseDefinitions icl_module [PD_TypeSpec pos name prio (Yes fun_type=:{st_arity}) specials : defs] cons_count sel_count mem_count ca + -> reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count (postParseError fun_pos "function alternative expected (2)" ca) +reorganiseDefinitions icl_module [PD_TypeSpec pos name prio (Yes fun_type=:{st_arity}) specials : defs] cons_count sel_count mem_count type_count ca # (bodies, fun_kind, defs, ca) = collectFunctionBodies name st_arity prio FK_Unknown defs ca - (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count ca | isEmpty bodies # fun_type = MakeNewFunctionType name st_arity prio fun_type pos specials nilPtr c_defs = { c_defs & def_funtypes = [ fun_type : c_defs.def_funtypes ]} @@ -938,9 +938,9 @@ reorganiseDefinitions icl_module [PD_TypeSpec pos name prio (Yes fun_type=:{st_a | icl_module = ([fun : fun_defs], c_defs, imports, imported_objects, ca) = ([fun : fun_defs], c_defs, imports, imported_objects, postParseError pos "function body not allowed in definition module" ca) -reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = ConsList cons_defs} : defs] cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = ConsList cons_defs} : defs] cons_count sel_count mem_count type_count ca # (cons_symbs, cons_count) = determine_symbols_of_conses cons_defs cons_count - (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count (type_count+1) ca type_def = { type_def & td_rhs = AlgType cons_symbs } c_defs = { c_defs & def_types = [type_def : c_defs.def_types], def_constructors = mapAppend ParsedConstructorToConsDef cons_defs c_defs.def_constructors } = (fun_defs, c_defs, imports, imported_objects, ca) @@ -952,16 +952,16 @@ where = ([cons : conses], next_cons_index) determine_symbols_of_conses [] next_cons_index = ([], next_cons_index) -reorganiseDefinitions icl_module [PD_Type type_def=:{td_name, td_rhs = SelectorList rec_cons_id exivars sel_defs, td_pos } : defs] cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Type type_def=:{td_name, td_rhs = SelectorList rec_cons_id exivars sel_defs, td_pos } : defs] cons_count sel_count mem_count type_count ca # (sel_syms, new_count) = determine_symbols_of_selectors sel_defs sel_count - (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs (inc cons_count) new_count mem_count ca + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs (inc cons_count) new_count mem_count (type_count+1) ca cons_arity = new_count - sel_count cons_def = { pc_cons_name = rec_cons_id, pc_cons_prio = NoPrio, pc_cons_arity = cons_arity, pc_cons_pos = td_pos, pc_arg_types = [ ps_field_type \\ {ps_field_type} <- sel_defs ], pc_exi_vars = exivars } type_def = { type_def & td_rhs = RecordType {rt_constructor = { ds_ident = rec_cons_id, ds_arity = cons_arity, ds_index = cons_count }, rt_fields = { sel \\ sel <- sel_syms }}} c_defs = { c_defs & def_types = [type_def : c_defs.def_types], def_constructors = [ParsedConstructorToConsDef cons_def : c_defs.def_constructors], - def_selectors = mapAppend ParsedSelectorToSelectorDef sel_defs c_defs.def_selectors } + def_selectors = mapAppend (ParsedSelectorToSelectorDef type_count) sel_defs c_defs.def_selectors } = (fun_defs, c_defs, imports, imported_objects, ca) where determine_symbols_of_selectors :: [ParsedSelector] Index -> ([FieldSymbol], Index) @@ -972,22 +972,22 @@ where determine_symbols_of_selectors [] next_selector_index = ([], next_selector_index) -reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = TypeSpec type} : defs] cons_count sel_count mem_count ca - # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = TypeSpec type} : defs] cons_count sel_count mem_count type_count ca + # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count (type_count+1) ca type_def = { type_def & td_rhs = SynType type } c_defs = { c_defs & def_types = [type_def : c_defs.def_types] } = (fun_defs, c_defs, imports, imported_objects, ca) -reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = EmptyRhs properties} : defs] cons_count sel_count mem_count ca - # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = EmptyRhs properties} : defs] cons_count sel_count mem_count type_count ca + # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count (type_count+1) ca type_def = { type_def & td_rhs = AbstractType properties } c_defs = { c_defs & def_types = [type_def : c_defs.def_types] } = (fun_defs, c_defs, imports, imported_objects, ca) -reorganiseDefinitions icl_module [PD_Class class_def=:{class_name,class_arity,class_args} members : defs] cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Class class_def=:{class_name,class_arity,class_args} members : defs] cons_count sel_count mem_count type_count ca # type_context = { tc_class = {glob_module = NoIndex, glob_object = {ds_ident = class_name, ds_arity = class_arity, ds_index = NoIndex }}, tc_types = [ TV tv \\ tv <- class_args ], tc_var = nilPtr } (mem_defs, mem_macros, ca) = check_symbols_of_class_members members type_context ca (mem_symbs, mem_defs, class_size) = reorganise_member_defs mem_defs mem_count - (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count (mem_count + class_size) ca + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count (mem_count + class_size) type_count ca class_def = { class_def & class_members = { member \\ member <- mem_symbs }} c_defs = { c_defs & def_classes = [class_def : c_defs.def_classes], def_macros = mem_macros ++ c_defs.def_macros, def_members = mem_defs ++ c_defs.def_members } @@ -1041,8 +1041,8 @@ where determine_indexes_of_class_members [] first_mem_index last_mem_offset = ([], [], last_mem_offset) -reorganiseDefinitions icl_module [PD_Instance class_instance=:{pi_members,pi_pos} : defs] cons_count sel_count mem_count ca - # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Instance class_instance=:{pi_members,pi_pos} : defs] cons_count sel_count mem_count type_count ca + # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count ca (mem_defs, ca) = collect_member_instances pi_members ca | icl_module || isEmpty mem_defs = (fun_defs, { c_defs & def_instances = [{class_instance & pi_members = mem_defs} : c_defs.def_instances] }, imports, imported_objects, ca) @@ -1070,18 +1070,18 @@ where -> collect_member_instances defs (postParseError fun_pos "function body expected" ca) collect_member_instances [] ca = ([], ca) -reorganiseDefinitions icl_module [PD_Instances class_instances : defs] cons_count sel_count mem_count ca - = reorganiseDefinitions icl_module ([PD_Instance class_instance \\ class_instance <- class_instances] ++ defs) cons_count sel_count mem_count ca -reorganiseDefinitions icl_module [PD_Import new_imports : defs] cons_count sel_count mem_count ca - # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Instances class_instances : defs] cons_count sel_count mem_count type_count ca + = reorganiseDefinitions icl_module ([PD_Instance class_instance \\ class_instance <- class_instances] ++ defs) cons_count sel_count mem_count type_count ca +reorganiseDefinitions icl_module [PD_Import new_imports : defs] cons_count sel_count mem_count type_count ca + # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count ca = (fun_defs, c_defs, new_imports ++ imports, imported_objects, ca) -reorganiseDefinitions icl_module [PD_ImportedObjects new_imported_objects : defs] cons_count sel_count mem_count ca - # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_ImportedObjects new_imported_objects : defs] cons_count sel_count mem_count type_count ca + # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count ca = (fun_defs, c_defs, imports, new_imported_objects ++ imported_objects, ca) -reorganiseDefinitions icl_module [def:defs] _ _ _ ca +reorganiseDefinitions icl_module [def:defs] _ _ _ _ ca = abort ("reorganiseDefinitions does not match" ---> def) -reorganiseDefinitions icl_module [] _ _ _ ca +reorganiseDefinitions icl_module [] _ _ _ _ ca = ([], { def_types = [], def_constructors = [], def_selectors = [], def_macros = [], def_classes = [], def_members = [], def_instances = [], def_funtypes = [] }, [], [], ca) diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 91f2457..91f5cc1 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -6,7 +6,7 @@ import scanner, general, typeproperties, Heap PA_BUG on off :== on -switch_import_syntax one_point_three two_point_zero :== one_point_three +switch_import_syntax one_point_three two_point_zero :== two_point_zero /* when finally removing this switch also remove the argument of STE_Instance and ID_OldSyntax */ SwitchFusion fuse dont_fuse :== dont_fuse @@ -1248,8 +1248,8 @@ MakeTypeSymbIdent type_index name arity MakeSymbIdent name arity :== { symb_name = name, symb_kind = SK_Unknown, symb_arity = arity } MakeConstant name :== MakeSymbIdent name 0 -ParsedSelectorToSelectorDef ps :== - { sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos = ps.ps_field_pos, sd_type_index = NoIndex, +ParsedSelectorToSelectorDef sd_type_index ps :== + { sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos = ps.ps_field_pos, sd_type_index = sd_type_index, sd_exi_vars = [], sd_type_ptr = nilPtr, sd_field = ps.ps_field_name, sd_type = { st_vars = [], st_args = [], st_result = ps.ps_field_type, st_arity = 0, st_context = [], st_attr_env = [], st_attr_vars = [] }} diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 62e5fc6..9ed4cf7 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -5,7 +5,7 @@ import StdEnv, compare_constructor // ,RWSDebug import scanner, general, Heap, typeproperties, utilities PA_BUG on off :== on -switch_import_syntax one_point_three two_point_zero :== one_point_three +switch_import_syntax one_point_three two_point_zero :== two_point_zero SwitchFusion fuse dont_fuse :== dont_fuse switch_port_to_new_syntax port dont_port :== dont_port @@ -1968,8 +1968,8 @@ MakeTypeSymbIdentMacro type_index name arity MakeSymbIdent name arity :== { symb_name = name, symb_kind = SK_Unknown, symb_arity = arity } MakeConstant name :== MakeSymbIdent name 0 -ParsedSelectorToSelectorDef ps :== - { sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos = ps.ps_field_pos, sd_type_index = NoIndex, +ParsedSelectorToSelectorDef sd_type_index ps :== + { sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos = ps.ps_field_pos, sd_type_index = sd_type_index, sd_exi_vars = [], sd_type_ptr = nilPtr, sd_field = ps.ps_field_name, sd_type = { st_vars = [], st_args = [], st_result = ps.ps_field_type, st_arity = 0, st_context = [], st_attr_env = [], st_attr_vars = [] }} diff --git a/frontend/trans.icl b/frontend/trans.icl index 7dae3e8..ca95a66 100644 --- a/frontend/trans.icl +++ b/frontend/trans.icl @@ -665,9 +665,6 @@ where = foldSt (\(var_type, {fv_info_ptr}) var_heap ->setExtendedVarInfo fv_info_ptr (EVI_VarType var_type) var_heap) (zip2 var_types ap_vars) var_heap - store_type_info_of_dyn_pattern ([var_type:_],{dp_var}) var_heap - = setExtendedVarInfo dp_var.fv_info_ptr (EVI_VarType var_type) var_heap - transform (Selection opt_type expr selectors) ro ti # (expr, ti) = transform expr ro ti = transformSelection opt_type selectors expr ti @@ -1346,24 +1343,6 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi # ([st_result:new_arg_types], (coercions, subst, ti_type_heaps=:{th_vars}, ti_type_def_infos)) = mapSt (expand_type ro.ro_common_defs cons_vars) [st_result:new_arg_types] (coercions, subst, ti_type_heaps, ti_type_def_infos) - with - expand_type ro_common_defs cons_vars atype (coercions, subst, ti_type_heaps, ti_type_def_infos) - | is_dictionary atype ti_type_def_infos - # (atype, subst) = arraySubst atype subst - = (atype, (coercions, subst, ti_type_heaps, ti_type_def_infos)) - # es - = { es_type_heaps = ti_type_heaps, es_td_infos = ti_type_def_infos } - (btype, (subst, es)) - = expandType ro_common_defs cons_vars atype (subst, es) - { es_type_heaps = ti_type_heaps, es_td_infos = ti_type_def_infos } - = es - cs - = { crc_type_heaps = ti_type_heaps, crc_coercions = coercions, crc_td_infos = ti_type_def_infos } - # (_, cs) - = coerce PositiveSign ro_common_defs cons_vars [] btype btype cs - { crc_type_heaps = ti_type_heaps, crc_coercions = coercions, crc_td_infos = ti_type_def_infos } - = cs - = (btype, (coercions, subst, ti_type_heaps, ti_type_def_infos)) /* | False--->("unified type", new_arg_types, "->", st_result) = undef @@ -1842,6 +1821,24 @@ where (new_info_ptr, var_heap) = newPtr VI_Empty var_heap = ([{ form & fv_info_ptr = new_info_ptr } : vars], writeVarInfo fv_info_ptr (VI_Variable fv_name new_info_ptr) var_heap) + expand_type ro_common_defs cons_vars atype (coercions, subst, ti_type_heaps, ti_type_def_infos) + | is_dictionary atype ti_type_def_infos + # (atype, subst) = arraySubst atype subst + = (atype, (coercions, subst, ti_type_heaps, ti_type_def_infos)) + # es + = { es_type_heaps = ti_type_heaps, es_td_infos = ti_type_def_infos } + (btype, (subst, es)) + = expandType ro_common_defs cons_vars atype (subst, es) + { es_type_heaps = ti_type_heaps, es_td_infos = ti_type_def_infos } + = es + cs + = { crc_type_heaps = ti_type_heaps, crc_coercions = coercions, crc_td_infos = ti_type_def_infos } + # (_, cs) + = coerce PositiveSign ro_common_defs cons_vars [] btype btype cs + { crc_type_heaps = ti_type_heaps, crc_coercions = coercions, crc_td_infos = ti_type_def_infos } + = cs + = (btype, (coercions, subst, ti_type_heaps, ti_type_def_infos)) + max_group_index prod_index producers current_max fun_defs fun_heap cons_args | prod_index == size producers = current_max |