diff options
| -rw-r--r-- | backend/backendconvert.icl | 2 | ||||
| -rw-r--r-- | backend/backendinterface.icl | 2 | ||||
| -rw-r--r-- | frontend/check.icl | 147 | ||||
| -rw-r--r-- | frontend/checkFunctionBodies.icl | 44 | ||||
| -rw-r--r-- | frontend/convertDynamics.icl | 24 | ||||
| -rw-r--r-- | frontend/explicitimports.dcl | 7 | ||||
| -rw-r--r-- | frontend/explicitimports.icl | 75 | ||||
| -rw-r--r-- | frontend/generics.icl | 23 | ||||
| -rw-r--r-- | frontend/hashtable.dcl | 2 | ||||
| -rw-r--r-- | frontend/hashtable.icl | 49 | ||||
| -rw-r--r-- | frontend/mergecases.icl | 4 | ||||
| -rw-r--r-- | frontend/overloading.icl | 3 | ||||
| -rw-r--r-- | frontend/parse.dcl | 4 | ||||
| -rw-r--r-- | frontend/parse.icl | 209 | ||||
| -rw-r--r-- | frontend/postparse.dcl | 4 | ||||
| -rw-r--r-- | frontend/postparse.icl | 156 | ||||
| -rw-r--r-- | frontend/predef.dcl | 11 | ||||
| -rw-r--r-- | frontend/predef.icl | 557 | ||||
| -rw-r--r-- | frontend/transform.icl | 5 | ||||
| -rw-r--r-- | frontend/type.dcl | 1 | ||||
| -rw-r--r-- | frontend/type.icl | 15 |
21 files changed, 710 insertions, 634 deletions
diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl index b80b0e6..98d92b5 100644 --- a/backend/backendconvert.icl +++ b/backend/backendconvert.icl @@ -462,7 +462,7 @@ backEndConvertModulesH predefs {fe_icl = #! backEnd = adjustStrictListFunctions fe_arrayInstances.ali_list_first_instance_indices fe_arrayInstances.ali_tail_strict_list_first_instance_indices predefs fe_dcls icl_used_module_numbers main_dcl_module_n backEnd; #! (rules, backEnd) - = convertRules [(index, icl_functions.[index]) \\ (_, index) <- functionIndices] main_dcl_module_n predefs.[PD_DummyForStrictAliasFun].pds_ident (backEnd -*-> "convertRules") + = convertRules [(index, icl_functions.[index]) \\ (_, index) <- functionIndices] main_dcl_module_n predefined_idents.[PD_DummyForStrictAliasFun] (backEnd -*-> "convertRules") #! backEnd = appBackEnd (BEDefineRules rules) (backEnd -*-> "BEDefineRules") #! backEnd diff --git a/backend/backendinterface.icl b/backend/backendinterface.icl index da493d2..afb53af 100644 --- a/backend/backendinterface.icl +++ b/backend/backendinterface.icl @@ -47,7 +47,7 @@ backEndInterface outputFileName commandLineArgs listTypes typesPath predef_symbo | not compatible = (False, var_heap, attrHeap, errorFile, files) # varHeap - = backEndPreprocess predef_symbols.[PD_DummyForStrictAliasFun].pds_ident functionIndices fe_icl var_heap + = backEndPreprocess predefined_idents.[PD_DummyForStrictAliasFun] functionIndices fe_icl var_heap with functionIndices = flatten [[member \\ member <- group.group_members] \\ group <-: fe_components] diff --git a/frontend/check.icl b/frontend/check.icl index 5217fcc..3ec10e9 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -1487,23 +1487,17 @@ checkDclModules imports_of_icl_mod dcl_modules icl_functions macro_defs heaps cs = foldSt restoreHeap expl_imp_symbols cs_symbol_table = ((reverse expl_imp_symbols, reverse expl_imp_indices), (dcl_modules, cs_symbol_table)) - get_expl_imp_symbols_of_module imports_of_icl_mod mod_index - (expl_imp_symbols_accu, nr_of_expl_imp_symbols, expl_imp_indices_accu, dcl_modules, cs_symbol_table) - #! siz - = size dcl_modules + get_expl_imp_symbols_of_module imports_of_icl_mod mod_index (expl_imp_symbols_accu, nr_of_expl_imp_symbols, expl_imp_indices_accu, dcl_modules, cs_symbol_table) + #! siz = size dcl_modules # (mod_imports, dcl_modules, cs_symbol_table) = get_mod_imports (mod_index==siz) imports_of_icl_mod dcl_modules cs_symbol_table (expl_imp_symbols_accu, nr_of_expl_imp_symbols, expl_imp_indices, cs_symbol_table) - = foldSt get_expl_imp_symbols mod_imports - (expl_imp_symbols_accu, nr_of_expl_imp_symbols, [], cs_symbol_table) - = (expl_imp_symbols_accu, nr_of_expl_imp_symbols, [expl_imp_indices:expl_imp_indices_accu], - dcl_modules, cs_symbol_table) + = foldSt get_expl_imp_symbols mod_imports (expl_imp_symbols_accu, nr_of_expl_imp_symbols, [], cs_symbol_table) + = (expl_imp_symbols_accu, nr_of_expl_imp_symbols, [expl_imp_indices:expl_imp_indices_accu],dcl_modules, cs_symbol_table) where get_mod_imports is_icl_mod=:False _ dcl_modules cs_symbol_table - # ({dcl_name}, dcl_modules) - = dcl_modules![mod_index] - ({ste_kind}, cs_symbol_table) - = readPtr dcl_name.id_info cs_symbol_table + # ({dcl_name}, dcl_modules) = dcl_modules![mod_index] + ({ste_kind}, cs_symbol_table) = readPtr dcl_name.id_info cs_symbol_table = case ste_kind of STE_Module {mod_imports} -> (mod_imports, dcl_modules, cs_symbol_table) @@ -1511,16 +1505,12 @@ checkDclModules imports_of_icl_mod dcl_modules icl_functions macro_defs heaps cs -> ([], dcl_modules, cs_symbol_table) get_mod_imports _ imports_of_icl_mod dcl_modules cs_symbol_table = (imports_of_icl_mod, dcl_modules, cs_symbol_table) - - get_expl_imp_symbols {import_module, import_symbols, import_file_position} - (expl_imp_symbols_accu, nr_of_expl_imp_symbols, expl_imp_indices_accu, cs_symbol_table) + + get_expl_imp_symbols {import_module, import_symbols, import_file_position} (expl_imp_symbols_accu, nr_of_expl_imp_symbols, expl_imp_indices_accu, cs_symbol_table) # (expl_imp_symbols_accu, nr_of_expl_imp_symbols, expl_imp_indices, cs_symbol_table) - = foldSt get_expl_imp_symbol import_symbols - (expl_imp_symbols_accu, nr_of_expl_imp_symbols, [], cs_symbol_table) - ({ste_index}, cs_symbol_table) - = readPtr import_module.id_info cs_symbol_table - = (expl_imp_symbols_accu, nr_of_expl_imp_symbols, - [(ste_index, import_file_position, expl_imp_indices):expl_imp_indices_accu], cs_symbol_table) + = foldSt get_expl_imp_symbol import_symbols (expl_imp_symbols_accu, nr_of_expl_imp_symbols, [], cs_symbol_table) + ({ste_index}, cs_symbol_table) = readPtr import_module.id_info cs_symbol_table + = (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 imp_decl=:(ID_OldSyntax idents) state = foldSt (get_symbol imp_decl) idents state @@ -1658,8 +1648,7 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices # (changed_symbols, (expl_imp_infos, cs_symbol_table)) = markExplImpSymbols component_nr (expl_imp_infos, cs.cs_symbol_table) (expl_imp_infos, dcl_modules, cs_symbol_table) - = foldSt collect_expl_imp_info_per_module mod_indices - (expl_imp_infos, dcl_modules, cs_symbol_table) + = foldSt collect_expl_imp_info_per_module mod_indices (expl_imp_infos, dcl_modules, cs_symbol_table) cs_symbol_table = foldSt restoreHeap changed_symbols cs_symbol_table = (expl_imp_infos, dcl_modules, { cs & cs_symbol_table = cs_symbol_table }) @@ -1671,8 +1660,7 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices = foldlArraySt ((switch_import_syntax update_expl_imp_for_marked_symbol update_expl_imp_for_marked_local_symbol) mod_index) - dcls_local_for_import - (dcl_modules, expl_imp_infos, cs_symbol_table) + dcls_local_for_import (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) @@ -1888,7 +1876,7 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde adjust_predefined_module_symbol :: !Index !(!*PredefinedSymbols, !*SymbolTable) -> (!*PredefinedSymbols, !*SymbolTable) adjust_predefined_module_symbol predef_index (pre_def_symbols, symbol_table) # (mod_symb, pre_def_symbols) = pre_def_symbols![predef_index] - # (mod_entry, symbol_table) = readPtr mod_symb.pds_ident.id_info symbol_table + # (mod_entry, symbol_table) = readPtr predefined_idents.[predef_index].id_info symbol_table = case mod_entry.ste_kind of STE_Module _ -> ({ pre_def_symbols & [predef_index] = { mod_symb & pds_module = cs_x.x_main_dcl_module_n, pds_def = mod_entry.ste_index }}, symbol_table) @@ -1900,7 +1888,7 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde (mods, macro_defs, cs) = add_modules_to_symbol_table mods (inc mod_index) cs = ([mod_sizes_and_defs:mods],[dcl_macro_defs:macro_defs], cs) - add_module_to_symbol_table mod=:{mod_defs} mod_index cs=:{cs_predef_symbols,cs_symbol_table, cs_error} + add_module_to_symbol_table mod=:{mod_defs} mod_index cs=:{cs_symbol_table, cs_error} # def_instances = convert_class_instances mod_defs.def_instances mod_defs = { mod_defs & def_instances = def_instances } sizes_and_defs = collectFunctionTypes mod_defs.def_funtypes (collectCommonfinitions mod_defs) @@ -2109,25 +2097,24 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo icl_import = icl_imported ,icl_modification_time = mod_modification_time} = (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_name icl_global_functions_ranges cs=:{cs_predef_symbols,cs_symbol_table,cs_x} - # (pre_symb, cs_predef_symbols) = cs_predef_symbols![PD_Start] - ({ste_kind, ste_index}, cs_symbol_table) = readPtr pre_symb.pds_ident.id_info cs_symbol_table - cs = { cs & cs_predef_symbols = cs_predef_symbols, cs_symbol_table = cs_symbol_table } + check_start_rule mod_kind mod_name icl_global_functions_ranges cs=:{cs_symbol_table,cs_x} + # ({ste_kind, ste_index}, cs_symbol_table) = readPtr predefined_idents.[PD_Start].id_info cs_symbol_table + cs = { cs & cs_symbol_table = cs_symbol_table } = case ste_kind of STE_FunctionOrMacro _ | index_in_ranges ste_index icl_global_functions_ranges - -> { cs & cs_predef_symbols = { cs.cs_predef_symbols & [PD_Start] = { pre_symb & pds_def = ste_index, pds_module = cs_x.x_main_dcl_module_n }}} + -> { cs & cs_predef_symbols.[PD_Start] = { pds_def = ste_index, pds_module = cs_x.x_main_dcl_module_n }} where index_in_ranges index [{ir_from, ir_to}:ranges] = (index>=ir_from && index < ir_to) || index_in_ranges index ranges; index_in_ranges index [] = False STE_Imported STE_DclFunction mod_index - -> { cs & cs_predef_symbols = { cs.cs_predef_symbols & [PD_Start] = { pre_symb & pds_def = ste_index, pds_module = mod_index }}} + -> { cs & cs_predef_symbols.[PD_Start] = { pds_def = ste_index, pds_module = mod_index }} _ -> case mod_kind of MK_Main - # pos = newPosition pre_symb.pds_ident (LinePos (mod_name.id_name+++".icl") 1) + # pos = newPosition predefined_idents.[PD_Start] (LinePos (mod_name.id_name+++".icl") 1) -> { cs & cs_error = checkErrorWithIdentPos pos " has not been declared" cs.cs_error } _ -> cs @@ -2275,10 +2262,10 @@ check_needed_modules_are_imported mod_name extension cs=:{cs_x={x_needed_modules _ -> check_it PD_StdStrictLists mod_name " (needed for strict lists)" extension cs = cs where - check_it pd mod_name explanation extension cs=:{cs_predef_symbols, cs_symbol_table} - # (pds_ident, cs_predef_symbols) = cs_predef_symbols![pd].pds_ident + check_it pd mod_name explanation extension cs=:{cs_symbol_table} + # pds_ident = predefined_idents.[pd] # ({ste_kind}, cs_symbol_table) = readPtr pds_ident.id_info cs_symbol_table - cs = { cs & cs_symbol_table = cs_symbol_table, cs_predef_symbols = cs_predef_symbols } + cs = { cs & cs_symbol_table = cs_symbol_table } = case ste_kind of STE_ClosedModule -> cs @@ -2290,13 +2277,13 @@ check_needed_modules_are_imported mod_name extension cs=:{cs_x={x_needed_modules -> { cs & cs_error = cs_error } // MV ... - switched_off_Clean_feature pd mod_name explanation extension cs=:{cs_predef_symbols, cs_symbol_table} - # (ident,cs_predef_symbols) = cs_predef_symbols![pd].pds_ident - # error_location = { ip_ident = mod_name, ip_line = 1, ip_file = mod_name.id_name+++extension} + switched_off_Clean_feature pd mod_name explanation extension cs=:{cs_symbol_table} + # ident = predefined_idents.[pd] + # error_location = { ip_ident = mod_name, ip_line = 1, ip_file = mod_name.id_name+++extension} cs_error = pushErrorAdmin error_location cs.cs_error cs_error = checkError ident ("not supported"+++explanation) cs_error cs_error = popErrorAdmin cs_error - = { cs & cs_error = cs_error, cs_predef_symbols = cs_predef_symbols } + = { cs & cs_error = cs_error} // ... MV arrayFunOffsetToPD_IndexTable :: !w:{# MemberDef} !v:{# PredefinedSymbol} -> (!{# Index}, !x:{#MemberDef}, !v:{#PredefinedSymbol}) , [w<=x] @@ -2461,6 +2448,7 @@ addImportedSymbolsToSymbolTable importing_mod opt_macro_range modules_in_compone | is_new = ([declaration:declarations_accu], dcl_modules, cs) = (declarations_accu, dcl_modules, cs) + add_member importing_mod mod_index {ds_ident, ds_index} (declarations_accu, dcl_modules, cs) # (sd=:{me_symb, me_pos}, dcl_modules) = dcl_modules![mod_index].dcl_common.com_member_defs.[ds_index] @@ -2478,11 +2466,9 @@ add_declaration_to_symbol_table opt_dcl_macro_range (Declaration {decl_kind=STE_ add_declaration_to_symbol_table yes_for_icl_module (Declaration {decl_kind=decl_kind=:STE_Imported def_kind def_mod, decl_ident, decl_index, decl_pos}) importing_mod cs = addSymbol yes_for_icl_module decl_ident decl_pos decl_kind def_kind decl_index def_mod importing_mod cs -updateExplImpInfo :: [Int] Index {!Declaration} {!Declaration} u:{#DclModule} - {!{!*ExplImpInfo}} *SymbolTable +updateExplImpInfo :: [Int] Index {!Declaration} {!Declaration} u:{#DclModule} {!{!*ExplImpInfo}} *SymbolTable -> (u:{#DclModule},!{!{!.ExplImpInfo}},.SymbolTable) -updateExplImpInfo super_components mod_index dcls_import dcls_local_for_import - dcl_modules expl_imp_infos cs_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)) = mapSt markExplImpSymbols super_components (expl_imp_infos, cs_symbol_table) @@ -2500,8 +2486,7 @@ updateExplImpInfo super_components mod_index dcls_import dcls_local_for_import (dcl_modules, expl_imp_infos, cs_symbol_table) = update_expl_imp_for_marked_symbols mod_index dcls_import (dcl_modules, expl_imp_infos, cs_symbol_table) cs_symbol_table - = foldSt (\l cs_symbol_table->foldSt restoreHeap l cs_symbol_table) - changed_symbols cs_symbol_table + = foldSt (\l cs_symbol_table->foldSt restoreHeap l cs_symbol_table) changed_symbols cs_symbol_table = (dcl_modules, expl_imp_infos, cs_symbol_table) updateExplImpInfoForCachedModule :: [Int] Index {!Declaration} {!Declaration} {!{!*ExplImpInfo}} u:{#DclModule} *SymbolTable @@ -2683,30 +2668,25 @@ update_expl_imp_for_marked_symbol mod_index decl=:(Declaration {decl_ident}) (dc update_expl_imp_for_marked_local_symbol mod_index decl=:(Declaration {decl_ident}) (dcl_modules, expl_imp_infos, cs_symbol_table) # (ste, cs_symbol_table) = readPtr decl_ident.id_info cs_symbol_table = updateExplImpForMarkedLocalSymbol mod_index decl ste dcl_modules expl_imp_infos cs_symbol_table - -updateExplImpForMarkedLocalSymbol :: !Index Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable - -> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !.SymbolTable) -updateExplImpForMarkedLocalSymbol mod_index decl {ste_kind=STE_ExplImpComponentNrs component_numbers inst_indices} - dcl_modules expl_imp_infos cs_symbol_table - = foldSt (addExplImpInfo mod_index decl) component_numbers - (dcl_modules, expl_imp_infos, cs_symbol_table) - where - addExplImpInfo :: !Index Declaration !ComponentNrAndIndex !(!u:{#DclModule}, !{!{!*ExplImpInfo}}, !v:SymbolTable) - -> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !v:SymbolTable) - addExplImpInfo mod_index decl { cai_component_nr, cai_index } (dcl_modules, expl_imp_infos, cs_symbol_table) - # (ExplImpInfo eii_ident eii_declaring_modules, expl_imp_infos) - = replaceTwoDimArrElt cai_component_nr cai_index TemporarilyFetchedAway expl_imp_infos - (all_belongs, dcl_modules) - = getBelongingSymbols decl dcl_modules - di_belonging - = nsFromTo (nrOfBelongingSymbols all_belongs) - di - = { di_decl = decl, di_instances = [], di_belonging = di_belonging } - new_expl_imp_info - = ExplImpInfo eii_ident (ikhInsert` False mod_index di eii_declaring_modules) - = (dcl_modules, { expl_imp_infos & [cai_component_nr,cai_index] = new_expl_imp_info }, cs_symbol_table) -updateExplImpForMarkedLocalSymbol _ _ entry dcl_modules expl_imp_infos cs_symbol_table - = (dcl_modules, expl_imp_infos, cs_symbol_table) +where + updateExplImpForMarkedLocalSymbol :: !Index Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable + -> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !.SymbolTable) + updateExplImpForMarkedLocalSymbol mod_index decl {ste_kind=STE_ExplImpComponentNrs component_numbers inst_indices} + dcl_modules expl_imp_infos cs_symbol_table + = foldSt (addExplImpInfo mod_index decl) component_numbers (dcl_modules, expl_imp_infos, cs_symbol_table) + where + addExplImpInfo :: !Index Declaration !ComponentNrAndIndex !(!u:{#DclModule}, !{!{!*ExplImpInfo}}, !v:SymbolTable) + -> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !v:SymbolTable) + addExplImpInfo mod_index decl { cai_component_nr, cai_index } (dcl_modules, expl_imp_infos, cs_symbol_table) + # (ExplImpInfo eii_ident eii_declaring_modules, expl_imp_infos) + = replaceTwoDimArrElt cai_component_nr cai_index TemporarilyFetchedAway expl_imp_infos + (all_belongs, dcl_modules) = getBelongingSymbols decl dcl_modules + di_belonging = nsFromTo (nrOfBelongingSymbols all_belongs) + di = { di_decl = decl, di_instances = [], di_belonging = di_belonging } + new_expl_imp_info = ExplImpInfo eii_ident (ikhInsert` False mod_index di eii_declaring_modules) + = (dcl_modules, { expl_imp_infos & [cai_component_nr,cai_index] = new_expl_imp_info }, cs_symbol_table) + updateExplImpForMarkedLocalSymbol _ _ entry dcl_modules expl_imp_infos cs_symbol_table + = (dcl_modules, expl_imp_infos, cs_symbol_table) checkInstancesOfDclModule :: !.Int !(!.Int,.Int,.[FunType]) !(!*{#DclModule},!*Heaps,!*CheckState) -> (!.{#DclModule},!.Heaps,!.CheckState); @@ -2902,13 +2882,13 @@ where <=< adjustPredefSymbol PD_ModuleID mod_index STE_Constructor) // AA.. # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdGeneric] - # (pd_type_iso, cs_predef_symbols) = cs_predef_symbols![PD_TypeISO] + # type_iso_ident = predefined_idents.[PD_TypeISO] | pre_mod.pds_def == mod_index = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} <=< adjustPredefSymbol PD_TypeISO mod_index STE_Type <=< adjustPredefSymbol PD_ConsISO mod_index STE_Constructor - <=< adjustPredefSymbol PD_iso_from mod_index (STE_Field pd_type_iso.pds_ident) - <=< adjustPredefSymbol PD_iso_to mod_index (STE_Field pd_type_iso.pds_ident) + <=< adjustPredefSymbol PD_iso_from mod_index (STE_Field type_iso_ident) + <=< adjustPredefSymbol PD_iso_to mod_index (STE_Field type_iso_ident) <=< adjustPredefSymbol PD_TypeUNIT mod_index STE_Type <=< adjustPredefSymbol PD_ConsUNIT mod_index STE_Constructor <=< adjustPredefSymbol PD_TypePAIR mod_index STE_Type @@ -2941,7 +2921,7 @@ where unused = { id_name = "unused", id_info = nilPtr } - adjust_predef_symbols next_symb last_symb mod_index symb_kind cs=:{cs_predef_symbols, cs_symbol_table, cs_error} + adjust_predef_symbols next_symb last_symb mod_index symb_kind cs | next_symb > last_symb = cs = cs @@ -2961,13 +2941,12 @@ where = getClassDef ins_class mod_index com_class_defs modules = (size class_members + sum, com_class_defs, modules) -adjustPredefSymbol predef_index mod_index symb_kind cs=:{cs_predef_symbols,cs_symbol_table,cs_error} - # (pre_symb, cs_predef_symbols) = cs_predef_symbols![predef_index] - # pre_id = pre_symb.pds_ident +adjustPredefSymbol predef_index mod_index symb_kind cs=:{cs_symbol_table,cs_error} + # pre_id = predefined_idents.[predef_index] #! pre_index = determine_index_of_symbol (sreadPtr pre_id.id_info cs_symbol_table) symb_kind | pre_index <> NoIndex - = { cs & cs_predef_symbols = {cs_predef_symbols & [predef_index] = { pre_symb & pds_def = pre_index, pds_module = mod_index }}} - = { cs & cs_predef_symbols = cs_predef_symbols, cs_error = checkError pre_id " function not defined" cs_error } + = { cs & cs_predef_symbols.[predef_index] = { pds_def = pre_index, pds_module = mod_index }} + = { cs & cs_error = checkError pre_id " function not defined" cs_error } where determine_index_of_symbol {ste_kind, ste_index} symb_kind | ste_kind == symb_kind @@ -2976,9 +2955,6 @@ where 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 }) - -file_and_status {ea_file,ea_ok} - = (ea_file, ea_ok) instance <<< AuxiliaryPattern where @@ -3097,11 +3073,6 @@ groupify { dag_nr_of_nodes, dag_get_children } component_numbers nr_of_component = ({ visited_array & [child_component_number] = True }, [child_component_number : visited_list], { node_to_components & [node_nr] = [child_component_number:current_components] }) -array_to_list a = [el\\el<-:a] - -dummy_decl - =: { decl_ident = { id_name = "", id_info = nilPtr }, decl_pos = NoPos, decl_kind = STE_Empty, decl_index = cUndef } - arg_string 0 = "result" arg_string arg_nr = toString arg_nr+++". arg" diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl index 8591fa1..d7a7144 100644 --- a/frontend/checkFunctionBodies.icl +++ b/frontend/checkFunctionBodies.icl @@ -62,7 +62,7 @@ get_unboxed_list_indices_and_decons_u_ident cs=:{cs_predef_symbols,cs_x} # decons_u_index=decons_u_symbol.pds_def # (nil_u_index,cs_predef_symbols)=cs_predef_symbols![PD_nil_u].pds_def # cs={cs & cs_predef_symbols=cs_predef_symbols,cs_x.x_needed_modules=cs_x.x_needed_modules bitor cNeedStdStrictLists} - = (stdStrictLists_index,cons_u_index,decons_u_index,nil_u_index,decons_u_symbol.pds_ident,cs) + = (stdStrictLists_index,cons_u_index,decons_u_index,nil_u_index,predefined_idents.[PD_decons_u],cs) make_unboxed_list type_symbol expr_heap cs # (stdStrictLists_index,cons_u_index,decons_u_index,nil_u_index,decons_u_ident,cs) = get_unboxed_list_indices_and_decons_u_ident cs @@ -79,7 +79,7 @@ get_unboxed_tail_strict_list_indices_and_decons_u_ident cs=:{cs_predef_symbols,c # decons_uts_index=decons_uts_symbol.pds_def # (nil_uts_index,cs_predef_symbols)=cs_predef_symbols![PD_nil_uts].pds_def # cs={cs & cs_predef_symbols=cs_predef_symbols,cs_x.x_needed_modules=cs_x.x_needed_modules bitor cNeedStdStrictLists} - = (stdStrictLists_index,cons_uts_index,decons_uts_index,nil_uts_index,decons_uts_symbol.pds_ident,cs) + = (stdStrictLists_index,cons_uts_index,decons_uts_index,nil_uts_index,predefined_idents.[PD_decons_uts],cs) make_unboxed_tail_strict_list type_symbol expr_heap cs # (stdStrictLists_index,cons_uts_index,decons_uts_index,nil_uts_index,decons_uts_ident,cs) = get_unboxed_tail_strict_list_indices_and_decons_u_ident cs @@ -96,7 +96,7 @@ get_overloaded_list_indices_and_decons_ident cs=:{cs_predef_symbols,cs_x} # decons_index=decons_symbol.pds_def # (nil_index,cs_predef_symbols)=cs_predef_symbols![PD_nil].pds_def # cs={cs & cs_predef_symbols=cs_predef_symbols,cs_x.x_needed_modules=cs_x.x_needed_modules bitor cNeedStdStrictLists} - = (stdStrictLists_index,cons_index,decons_index,nil_index,decons_symbol.pds_ident,cs) + = (stdStrictLists_index,cons_index,decons_index,nil_index,predefined_idents.[PD_decons],cs) make_overloaded_list type_symbol expr_heap cs # (stdStrictLists_index,cons_index,decons_index,nil_index,decons_ident,cs) = get_overloaded_list_indices_and_decons_ident cs @@ -795,11 +795,13 @@ where | glob_module==cPredefinedModuleIndex # index=glob_object.ds_index+FirstConstructorPredefinedSymbolIndex | index==PD_OverloadedConsSymbol - # ({pds_ident,pds_def},cs) = cs!cs_predef_symbols.[pd_cons_symbol] + # ({pds_def},cs) = cs!cs_predef_symbols.[pd_cons_symbol] + # pds_ident = predefined_idents.[pd_cons_symbol] # glob_object = {glob_object & ds_index=pds_def,ds_ident=pds_ident} = ({pattern & ap_symbol.glob_object=glob_object},cs) | index==PD_OverloadedNilSymbol - # ({pds_ident,pds_def},cs) = cs!cs_predef_symbols.[pd_nil_symbol] + # ({pds_def},cs) = cs!cs_predef_symbols.[pd_nil_symbol] + # pds_ident = predefined_idents.[pd_nil_symbol] # glob_object = {glob_object & ds_index=pds_def,ds_ident=pds_ident} = ({pattern & ap_symbol.glob_object=glob_object},cs) = abort "replace_overloaded_symbol_in_pattern" @@ -1239,26 +1241,28 @@ where -> (!Expression, ![FreeVar], !*ExpressionState, !u:ExpressionInfo, !*CheckState) check_id_expression {ste_kind = STE_Empty} is_expr_list free_vars id e_input e_state e_info cs=:{cs_error,cs_predef_symbols,cs_x} - # ({pds_ident=from_ident}) = cs_predef_symbols.[PD_From] - ({pds_ident=from_then_ident}) = cs_predef_symbols.[PD_FromThen] - ({pds_ident=from_to_ident}) = cs_predef_symbols.[PD_FromTo] - ({pds_ident=from_then_to_ident}) = cs_predef_symbols.[PD_FromThenTo] + # local_predefined_idents = predefined_idents + # from_ident = local_predefined_idents.[PD_From] + from_then_ident = local_predefined_idents.[PD_FromThen] + from_to_ident = local_predefined_idents.[PD_FromTo] + from_then_to_ident = local_predefined_idents.[PD_FromThenTo] + | id==from_ident || id==from_then_ident || id==from_to_ident || id==from_then_to_ident = (EE, free_vars, e_state, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdEnum}) // instead of giving an error message remember that StdEnum should have been imported. // Error will be given in function check_needed_modules_are_imported - # ({pds_ident=createArray_ident}) = cs_predef_symbols.[PD__CreateArrayFun] - ({pds_ident=uselect_ident}) = cs_predef_symbols.[PD_UnqArraySelectFun] - ({pds_ident=update_ident}) = cs_predef_symbols.[PD_ArrayUpdateFun] - ({pds_ident=usize_ident}) = cs_predef_symbols.[PD_UnqArraySizeFun] + # createArray_ident = local_predefined_idents.[PD__CreateArrayFun] + uselect_ident = local_predefined_idents.[PD_UnqArraySelectFun] + update_ident = local_predefined_idents.[PD_ArrayUpdateFun] + usize_ident = local_predefined_idents.[PD_UnqArraySizeFun] | id==createArray_ident || id==uselect_ident || id==update_ident || id==usize_ident = (EE, free_vars, e_state, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdArray}) // instead of giving an error message remember that StdArray should have been be imported. // Error will be given in function check_needed_modules_are_imported - | id==cs_predef_symbols.[PD_cons].pds_ident || id==cs_predef_symbols.[PD_decons].pds_ident - || id==cs_predef_symbols.[PD_cons_u].pds_ident || id==cs_predef_symbols.[PD_decons_u].pds_ident - || id==cs_predef_symbols.[PD_cons_uts].pds_ident || id==cs_predef_symbols.[PD_decons_uts].pds_ident - || id==cs_predef_symbols.[PD_nil].pds_ident || id==cs_predef_symbols.[PD_nil_u].pds_ident || id==cs_predef_symbols.[PD_nil_uts].pds_ident + | id==local_predefined_idents.[PD_cons] || id==local_predefined_idents.[PD_decons] + || id==local_predefined_idents.[PD_cons_u] || id==local_predefined_idents.[PD_decons_u] + || id==local_predefined_idents.[PD_cons_uts] || id==local_predefined_idents.[PD_decons_uts] + || id==local_predefined_idents.[PD_nil] || id==local_predefined_idents.[PD_nil_u] || id==local_predefined_idents.[PD_nil_uts] = (EE, free_vars, e_state, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdStrictLists}) // instead report that StdStrictLists should be imported in function check_needed_modules_are_imported = (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "undefined" cs_error }) @@ -2249,8 +2253,7 @@ buildPattern mod_index (APK_Macro is_dcl_macro) {glob_module,glob_object} args o getPredefinedGlobalSymbol :: !Index !Index !STE_Kind !Int !*CheckState -> (!Global DefinedSymbol, !*CheckState) getPredefinedGlobalSymbol symb_index module_index req_ste_kind arity cs=:{cs_predef_symbols,cs_symbol_table} - # (pre_def_mod, cs_predef_symbols) = cs_predef_symbols![module_index] - # mod_id = pre_def_mod.pds_ident + # mod_id = predefined_idents.[module_index] # (mod_entry, cs_symbol_table) = readPtr mod_id.id_info cs_symbol_table | mod_entry.ste_kind == STE_ClosedModule # (glob_object, cs) = get_predefined_symbol symb_index req_ste_kind arity mod_entry.ste_index @@ -2261,8 +2264,7 @@ getPredefinedGlobalSymbol symb_index module_index req_ste_kind arity cs=:{cs_pre where get_predefined_symbol :: !Index !STE_Kind !Int !Index !*CheckState -> (!DefinedSymbol,!*CheckState) get_predefined_symbol symb_index req_ste_kind arity mod_index cs=:{cs_predef_symbols,cs_symbol_table,cs_error} - # (pre_def_symb, cs_predef_symbols) = cs_predef_symbols![symb_index] - symb_id = pre_def_symb.pds_ident + # symb_id = predefined_idents.[symb_index] (symb_entry, cs_symbol_table) = readPtr symb_id.id_info cs_symbol_table cs = { cs & cs_predef_symbols = cs_predef_symbols, cs_symbol_table = cs_symbol_table } | symb_entry.ste_kind == req_ste_kind diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl index aab9f70..a76e0e0 100644 --- a/frontend/convertDynamics.icl +++ b/frontend/convertDynamics.icl @@ -138,11 +138,13 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_ True # arity = 2 // get tuple arity 2 constructor - # ({pds_module, pds_def, pds_ident}, predefined_symbols) = predefined_symbols![GetTupleConsIndex arity] + # ({pds_module, pds_def}, predefined_symbols) = predefined_symbols![GetTupleConsIndex arity] + # pds_ident = predefined_idents.[GetTupleConsIndex arity] # twoTuple_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = arity } // get tuple, type and value selectors - # ({pds_def, pds_ident}, predefined_symbols) = predefined_symbols![GetTupleConsIndex arity] + # ({pds_def}, predefined_symbols) = predefined_symbols![GetTupleConsIndex arity] + # pds_ident = predefined_idents.[GetTupleConsIndex arity] # twotuple = {ds_ident = pds_ident, ds_arity = arity, ds_index = pds_def} # type_selector = TupleSelect twotuple 1 # value_selector = TupleSelect twotuple 0 @@ -933,7 +935,8 @@ where # (ci=:{ci_predef_symb}) = ci; - # ({pds_module, pds_def, pds_ident}, ci_predef_symb) = ci_predef_symb![PD_ModuleConsSymbol] + # ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![PD_ModuleConsSymbol] + # pds_ident = predefined_idents.[PD_ModuleConsSymbol] # module_symb1 = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = 0 } # ci = { ci & ci_predef_symb = ci_predef_symb }; @@ -1187,13 +1190,15 @@ getResultType case_info_ptr ci=:{ci_expr_heap} getSymbol :: Index ((Global Index) -> SymbKind) Int !*ConversionInfo -> (SymbIdent, !*ConversionInfo) getSymbol index symb_kind arity ci=:{ci_predef_symb} - # ({pds_module, pds_def, pds_ident}, ci_predef_symb) = ci_predef_symb![index] + # ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![index] + # pds_ident = predefined_idents.[index] ci = {ci & ci_predef_symb = ci_predef_symb} symbol = { symb_name = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def}, symb_arity = arity } = (symbol, ci) getTupleSymbol arity ci=:{ci_predef_symb} - # ({pds_def, pds_ident}, ci_predef_symb) = ci_predef_symb![GetTupleConsIndex arity] + # ({pds_def}, ci_predef_symb) = ci_predef_symb![GetTupleConsIndex arity] + # pds_ident = predefined_idents.[GetTupleConsIndex arity] = ( {ds_ident = pds_ident, ds_arity = arity, ds_index = pds_def}, {ci & ci_predef_symb = ci_predef_symb }) getGlobalIndex :: Index !*ConversionInfo -> (Global Index, !*ConversionInfo) @@ -1203,7 +1208,8 @@ getGlobalIndex index ci=:{ci_predef_symb} getConstructor :: Index Int !*ConversionInfo -> (Global DefinedSymbol, !*ConversionInfo) getConstructor index arity ci=:{ci_predef_symb} - # ({pds_module, pds_def, pds_ident}, ci_predef_symb) = ci_predef_symb![index] + # ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![index] + # pds_ident = predefined_idents.[index] defined_symbol = { ds_ident = pds_ident, ds_arity = arity, ds_index = pds_def} = ( {glob_object = defined_symbol, glob_module = pds_module} , {ci & ci_predef_symb = ci_predef_symb} ) @@ -1274,14 +1280,16 @@ where get_module_id_app :: !*PredefinedSymbols -> (App,Expression,!*PredefinedSymbols) get_module_id_app predef_symbols // get module id symbol - # ({pds_module, pds_def, pds_ident}, predef_symbols) = predef_symbols![PD_ModuleConsSymbol] + # ({pds_module, pds_def}, predef_symbols) = predef_symbols![PD_ModuleConsSymbol] + # pds_ident = predefined_idents.[PD_ModuleConsSymbol] # module_symb = { app_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = 0 } , app_args = [] , app_info_ptr = nilPtr } - # ({pds_module, pds_def, pds_ident}, predef_symbols) = predef_symbols![PD_ModuleID] + # ({pds_module, pds_def}, predef_symbols) = predef_symbols![PD_ModuleID] + # pds_ident = predefined_idents.[PD_ModuleID] # module_id_symb = { app_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = 1 } , app_args = [App module_symb] diff --git a/frontend/explicitimports.dcl b/frontend/explicitimports.dcl index 8562e5e..3dfa47a 100644 --- a/frontend/explicitimports.dcl +++ b/frontend/explicitimports.dcl @@ -19,12 +19,11 @@ markExplImpSymbols :: !Int !*(!*{!*{!u:ExplImpInfo}}, !*SymbolTable) updateExplImpForMarkedSymbol :: !Index !Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable -> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !.SymbolTable) -optStoreInstanceWithClassSymbol :: Declaration !Ident !*SymbolTable - -> .SymbolTable +optStoreInstanceWithClassSymbol :: Declaration !Ident !*SymbolTable -> .SymbolTable solveExplicitImports :: !(IntKeyHashtable [(Int,Position,[ImportNrAndIdents])]) !{#Int} !Index - !*(!v:{#DclModule},!*{#Int},!{!*ExplImpInfo},!*CheckState) - -> (!.SolvedImports,!(!v:{#DclModule},!.{#Int},!{!.ExplImpInfo},!.CheckState)) + !*(!v:{#DclModule},!*{#Int},!{!*ExplImpInfo},!*CheckState) + -> (!.SolvedImports,! (!v:{#DclModule},!.{#Int},!{!.ExplImpInfo},!.CheckState)) checkExplicitImportCompleteness :: ![([Declaration], Position)] !*{#DclModule} !*{#FunDef} !*{#*{#FunDef}} !*ExpressionHeap !*CheckState -> (!.{#DclModule},!.{#FunDef},!*{#*{#FunDef}},!.ExpressionHeap,!.CheckState) diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl index a73c1d8..ea4d7b5 100644 --- a/frontend/explicitimports.icl +++ b/frontend/explicitimports.icl @@ -42,13 +42,11 @@ markExplImpSymbols component_nr (expl_imp_info, cs_symbol_table) # (eii, expl_imp_info) = replaceTwoDimArrElt component_nr i TemporarilyFetchedAway expl_imp_info (eii_ident, eii) = get_eei_ident eii = (eii_ident, { expl_imp_info & [component_nr, i] = eii }) - + 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 - = foldSt (addExplImpInfo mod_index decl inst_indices) component_numbers - (dcl_modules, expl_imp_infos, cs_symbol_table) +updateExplImpForMarkedSymbol mod_index decl {ste_kind=STE_ExplImpComponentNrs component_numbers inst_indices} dcl_modules expl_imp_infos cs_symbol_table + = foldSt (addExplImpInfo mod_index decl inst_indices) component_numbers (dcl_modules, expl_imp_infos, cs_symbol_table) updateExplImpForMarkedSymbol _ _ entry dcl_modules expl_imp_infos cs_symbol_table = (dcl_modules, expl_imp_infos, cs_symbol_table) @@ -59,19 +57,15 @@ addExplImpInfo mod_index decl instances { cai_component_nr, cai_index } (dcl_mod = replaceTwoDimArrElt cai_component_nr cai_index TemporarilyFetchedAway expl_imp_infos (di_belonging, dcl_modules, cs_symbol_table) = get_belonging_symbol_nrs decl dcl_modules cs_symbol_table - di - = { di_decl = decl, di_instances = instances, di_belonging = di_belonging } - new_expl_imp_info - = ExplImpInfo eii_ident (ikhInsert` False mod_index di eii_declaring_modules) + di = { di_decl = decl, di_instances = instances, di_belonging = di_belonging } + new_expl_imp_info = ExplImpInfo eii_ident (ikhInsert` False mod_index di eii_declaring_modules) = (dcl_modules, { expl_imp_infos & [cai_component_nr,cai_index] = new_expl_imp_info }, cs_symbol_table) where get_belonging_symbol_nrs :: !Declaration !v:{#DclModule} !u:(Heap SymbolTableEntry) - -> (!.NumberSet,!v:{#DclModule},!u:Heap SymbolTableEntry) + -> (!.NumberSet,!v:{#DclModule},!u: Heap SymbolTableEntry) get_belonging_symbol_nrs decl dcl_modules cs_symbol_table - # (all_belonging_symbols, dcl_modules) - = getBelongingSymbols decl dcl_modules - nr_of_belongs - = nrOfBelongingSymbols all_belonging_symbols + # (all_belonging_symbols, dcl_modules) = getBelongingSymbols decl dcl_modules + nr_of_belongs = nrOfBelongingSymbols all_belonging_symbols (_, belonging_bitvect, cs_symbol_table) = foldlBelongingSymbols set_bit all_belonging_symbols (0, bitvectCreate nr_of_belongs, cs_symbol_table) = (bitvectToNumberSet belonging_bitvect, dcl_modules, cs_symbol_table) @@ -131,15 +125,12 @@ getBelongingSymbolsFromID (ID_Record _ x) = x getBelongingSymbolsFromID _ = No solveExplicitImports :: !(IntKeyHashtable [(Int,Position,[ImportNrAndIdents])]) !{#Int} !Index - !*(!v:{#DclModule},!*{#Int},!{!*ExplImpInfo},!*CheckState) - -> (!.SolvedImports,!(!v:{#DclModule},!.{#Int},!{!.ExplImpInfo},!.CheckState)) + !*(!v:{#DclModule},!*{#Int},!{!*ExplImpInfo},!*CheckState) + -> (!.SolvedImports,! (!v:{#DclModule},!.{#Int},!{!.ExplImpInfo},!.CheckState)) solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod (dcl_modules, visited_modules, expl_imp_info, cs) - # import_indices - = ikhSearch` importing_mod expl_imp_indices_ikh - expl_imp_indices - = [ imports \\ imports=:(_, _, [_:_]) <- import_indices ] - impl_imports - = [ (mod_index, position) \\ imports=:(mod_index, position, []) <- import_indices ] + # import_indices = ikhSearch` importing_mod expl_imp_indices_ikh + expl_imp_indices = [ imports \\ imports=:(_, _, [_:_]) <- import_indices ] + impl_imports = [ (mod_index, position) \\ imports=:(mod_index, position, []) <- import_indices ] (expl_imports, state) = mapSt (solve_expl_imp_from_module expl_imp_indices_ikh modules_in_component_set importing_mod) expl_imp_indices (dcl_modules, visited_modules, expl_imp_info, cs) @@ -203,20 +194,15 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod eii_declaring_modules (bitvectResetAll visited_modules) = case found of Yes _ - # eii_declaring_modules - = foldSt (store_belonging belong_nr ini_symbol_nr) path eii_declaring_modules - (belong_decl, dcl_modules) - = get_nth_belonging_decl position belong_nr decl dcl_modules + # eii_declaring_modules = foldSt (store_belonging belong_nr ini_symbol_nr) path eii_declaring_modules + (belong_decl, dcl_modules) = get_nth_belonging_decl position belong_nr decl dcl_modules -> ([belong_decl:decls_accu], dcl_modules, eii_declaring_modules, visited_modules, cs_error) _ # cs_error = case need_all of True - # cs_error - = pushErrorAdmin (newPosition import_ident position) cs_error - cs_error - = checkError belong_ident ("of "+++eii_ident.id_name+++" not exported by the specified module") - cs_error + # cs_error = pushErrorAdmin (newPosition import_ident position) cs_error + cs_error = checkError belong_ident ("of "+++eii_ident.id_name+++" not exported by the specified module") cs_error -> popErrorAdmin cs_error _ -> cs_error @@ -271,23 +257,18 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod -> ([], dcl_modules) numerate_belongs {id_info} (i, cs_symbol_table) - # (ste, cs_symbol_table) - = readPtr id_info cs_symbol_table - new_ste - = { ste & ste_kind = STE_BelongingSymbol i, ste_previous = ste } + # (ste, cs_symbol_table) = readPtr id_info cs_symbol_table + new_ste = { ste & ste_kind = STE_BelongingSymbol i, ste_previous = ste } = (i+1, writePtr id_info new_ste cs_symbol_table) get_opt_nr_and_ident position eii_ident {ii_ident=ii_ident=:{id_info}} (cs_error, cs_symbol_table) - # ({ste_kind}, cs_symbol_table) - = readPtr id_info cs_symbol_table + # ({ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table = case ste_kind of STE_BelongingSymbol i -> (Yes (i, ii_ident), (cs_error, cs_symbol_table)) _ - # cs_error - = pushErrorAdmin (newPosition import_ident position) cs_error - cs_error - = checkError ii_ident ("does not belong to "+++eii_ident.id_name) cs_error + # cs_error = pushErrorAdmin (newPosition import_ident position) cs_error + cs_error = checkError ii_ident ("does not belong to "+++eii_ident.id_name) cs_error -> (No, (popErrorAdmin cs_error, cs_symbol_table)) search_expl_imp_symbol expl_imp_indices_ikh modules_in_component_set importing_mod imported_mod @@ -322,14 +303,12 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod -> belonging_accu Yes _ -> [(di_decl, ini, imported_mod):belonging_accu] - new_eii - = ExplImpInfo eii_ident new_eii_declaring_modules + new_eii = ExplImpInfo eii_ident new_eii_declaring_modules -> (True, ([di_decl:di_instances++decls_accu], new_belonging_accu, visited_modules, { expl_imp_info & [ini_symbol_nr] = new_eii })) // otherwise GOTO next alternative _ - # eii - = ExplImpInfo eii_ident eii_declaring_modules + # eii = ExplImpInfo eii_ident eii_declaring_modules -> (False, (decls_accu, belonging_accu, visited_modules, { expl_imp_info & [ini_symbol_nr] = eii })) depth_first_search expl_imp_indices_ikh modules_in_component_set @@ -450,10 +429,8 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod = (expl_imp_info, popErrorAdmin cs_error) do_a_lot_just_to_read_an_array_2 i expl_imp_info - # (eii, expl_imp_info) - = replace expl_imp_info i TemporarilyFetchedAway - (eii_ident, eii) - = get_eei_ident eii + # (eii, expl_imp_info) = replace expl_imp_info i TemporarilyFetchedAway + (eii_ident, eii) = get_eei_ident eii = (eii_ident, { expl_imp_info & [i] = eii }) impDeclToNameSpaceString (ID_Function _) = "function/macro" diff --git a/frontend/generics.icl b/frontend/generics.icl index 40c2d0f..590a744 100644 --- a/frontend/generics.icl +++ b/frontend/generics.icl @@ -3573,7 +3573,8 @@ buildTypeApp td_module {td_name, td_arity, td_index} args buildPredefTypeApp :: !Int [AType] !PredefinedSymbols -> !AType buildPredefTypeApp predef_index args predefs - # {pds_ident, pds_module, pds_def} = predefs.[predef_index] + # {pds_module, pds_def} = predefs.[predef_index] + # pds_ident = predefined_idents.[predef_index] # global_index = {glob_module = pds_module, glob_object = pds_def} # type_symb = MakeTypeSymbIdent global_index pds_ident (length args) = makeAType (TA type_symb args) TA_Multi @@ -3715,7 +3716,8 @@ where buildPredefConsPattern :: !Int ![FreeVar] !Expression !PredefinedSymbols -> AlgebraicPattern buildPredefConsPattern predef_index vars expr predefs - # {pds_ident, pds_module, pds_def} = predefs.[predef_index] + # {pds_module, pds_def} = predefs.[predef_index] + # pds_ident = predefined_idents.[predef_index] # cons_def_symbol = { ds_ident = pds_ident, ds_arity = length vars, @@ -3840,7 +3842,8 @@ buildCaseCONSExpr arg_expr cons_info_var arg_var body_expr predefs heaps buildPredefConsApp :: !Int [Expression] !PredefinedSymbols !*Heaps -> (!Expression, !*Heaps) buildPredefConsApp predef_index args predefs heaps=:{hp_expression_heap} - # {pds_ident, pds_module, pds_def} = predefs.[predef_index] + # {pds_module, pds_def} = predefs.[predef_index] + # pds_ident = predefined_idents.[predef_index] # global_index = {glob_module = pds_module, glob_object = pds_def} # symb_ident = { symb_name = pds_ident, @@ -3862,7 +3865,8 @@ buildCONS cons_info arg predefs heaps :== buildPredefConsApp PD_ConsCONS [cons_i buildPredefFunApp :: !Int [Expression] !PredefinedSymbols !*Heaps -> (!Expression, !*Heaps) buildPredefFunApp predef_index args predefs heaps=:{hp_expression_heap} - # {pds_ident, pds_module, pds_def} = predefs.[predef_index] + # {pds_module, pds_def} = predefs.[predef_index] + # pds_ident = predefined_idents.[predef_index] # global_index = {glob_module = pds_module, glob_object = pds_def} # symb_ident = { symb_name = pds_ident, @@ -3879,7 +3883,8 @@ buildIsomapIdApp predefs heaps :== buildPredefFunApp PD_isomap_ID [] predefs hea buildIsoToSelectionExpr :: !Expression !PredefinedSymbols -> Expression buildIsoToSelectionExpr record_expr predefs - # {pds_module, pds_def, pds_ident} = predefs . [PD_iso_to] + # {pds_module, pds_def} = predefs . [PD_iso_to] + # pds_ident = predefined_idents . [PD_iso_to] # selector = { glob_module = pds_module, glob_object = {ds_ident = pds_ident, ds_index = pds_def, ds_arity = 1}} @@ -3887,7 +3892,8 @@ buildIsoToSelectionExpr record_expr predefs buildIsoFromSelectionExpr :: !Expression !PredefinedSymbols -> Expression buildIsoFromSelectionExpr record_expr predefs - # {pds_module, pds_def, pds_ident} = predefs . [PD_iso_from] + # {pds_module, pds_def} = predefs . [PD_iso_from] + # pds_ident = predefined_idents . [PD_iso_from] # selector = { glob_module = pds_module, glob_object = {ds_ident = pds_ident, ds_index = pds_def, ds_arity = 1}} @@ -4108,7 +4114,7 @@ where = (fresh_vars, heaps) collect_local_vars body_expr fun_arg_vars heaps=:{hp_var_heap, hp_expression_heap} - # dummy_pds = {pds_ident=makeIdent "dummy", pds_module=NoIndex,pds_def=NoIndex} + # dummy_pds = {pds_module=NoIndex,pds_def=NoIndex} #! cs = { cos_error = {ea_file = stderr, ea_ok = True, ea_loc=[]} , cos_var_heap = hp_var_heap @@ -4177,7 +4183,8 @@ makeIntExpr value = BasicExpr (BVI (toString value)) BT_Int makeStringExpr :: String !PredefinedSymbols -> Expression makeStringExpr str predefs - #! {pds_ident, pds_module, pds_def} = predefs.[PD_StringType] + #! {pds_module, pds_def} = predefs.[PD_StringType] + #! pds_ident = predefined_idents.[PD_StringType] #! type_symb = MakeTypeSymbIdent { glob_module = pds_module, glob_object = pds_def } pds_ident 0 = BasicExpr (BVS str) (BT_String (TA type_symb [])) diff --git a/frontend/hashtable.dcl b/frontend/hashtable.dcl index fea7b26..88db318 100644 --- a/frontend/hashtable.dcl +++ b/frontend/hashtable.dcl @@ -26,7 +26,7 @@ set_hte_mark :: !Int !*HashTable -> *HashTable :: BoxedIdent = {boxed_ident::!Ident} -//putIdentInHashTable :: !String !IdentClass !*HashTable -> (!Ident, !*HashTable) putIdentInHashTable :: !String !IdentClass !*HashTable -> (!BoxedIdent, !*HashTable) +putPredefinedIdentInHashTable :: !Ident !IdentClass !*HashTable -> !*HashTable remove_icl_symbols_from_hash_table :: !*HashTable -> *HashTable diff --git a/frontend/hashtable.icl b/frontend/hashtable.icl index 0f8cd27..a63393b 100644 --- a/frontend/hashtable.icl +++ b/frontend/hashtable.icl @@ -80,29 +80,6 @@ where char = name.[index] = hash_value name index (val << 2 + toInt char) -/* -putIdentInHashTable :: !String !IdentClass !*HashTable -> (!Ident, !*HashTable) -putIdentInHashTable name ident_class {hte_symbol_heap,hte_entries} - # hash_val = hashValue name - (entries,hte_entries) = replace hte_entries hash_val HTE_Empty - (ident, hte_symbol_heap, entries) = insert name ident_class hte_symbol_heap entries - hte_entries = update hte_entries hash_val entries - = (ident, { hte_symbol_heap = hte_symbol_heap, hte_entries = hte_entries }) -where - insert :: !String !IdentClass !*SymbolTable *HashTableEntry -> (!Ident, !*SymbolTable, !*HashTableEntry) - insert name ident_class hte_symbol_heap HTE_Empty - # (hte_symbol_ptr, hte_symbol_heap) = newPtr EmptySymbolTableEntry hte_symbol_heap - = ({ id_name = name, id_info = hte_symbol_ptr}, hte_symbol_heap, HTE_Ident name hte_symbol_ptr ident_class HTE_Empty HTE_Empty) - insert name ident_class hte_symbol_heap (HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right) - # cmp = (name,ident_class) =< (hte_name,hte_class) - | cmp == Equal - = ({ id_name = hte_name, id_info = hte_symbol_ptr}, hte_symbol_heap, HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right) - | cmp == Smaller - #! (ident, hte_symbol_heap, hte_left) = insert name ident_class hte_symbol_heap hte_left - = (ident, hte_symbol_heap, HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right) - #! (ident, hte_symbol_heap, hte_right) = insert name ident_class hte_symbol_heap hte_right - = (ident, hte_symbol_heap, HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right) -*/ putIdentInHashTable :: !String !IdentClass !*HashTable -> (!BoxedIdent, !*HashTable) putIdentInHashTable name ident_class {hte_symbol_heap,hte_entries,hte_mark} # hash_val = hashValue name @@ -115,14 +92,11 @@ where insert name ident_class hte_mark0 hte_symbol_heap HTE_Empty # (hte_symbol_ptr, hte_symbol_heap) = newPtr EmptySymbolTableEntry hte_symbol_heap # ident = { id_name = name, id_info = hte_symbol_ptr} -// = ({boxed_ident=ident}, hte_symbol_heap, HTE_Ident ident ident_class hte_mark0 HTE_Empty HTE_Empty) # boxed_ident={boxed_ident=ident} = (boxed_ident, hte_symbol_heap, HTE_Ident boxed_ident ident_class hte_mark0 HTE_Empty HTE_Empty) -// insert name ident_class hte_mark0 hte_symbol_heap (HTE_Ident hte_ident=:{id_name,id_info} hte_class hte_mark hte_left hte_right) insert name ident_class hte_mark0 hte_symbol_heap (HTE_Ident hte_ident=:{boxed_ident={id_name,id_info}} hte_class hte_mark hte_left hte_right) # cmp = (name,ident_class) =< (id_name,hte_class) | cmp == Equal -// = ({boxed_ident=hte_ident}, hte_symbol_heap, HTE_Ident hte_ident hte_class (hte_mark bitand hte_mark0) hte_left hte_right) = (hte_ident, hte_symbol_heap, HTE_Ident hte_ident hte_class (hte_mark bitand hte_mark0) hte_left hte_right) | cmp == Smaller #! (boxed_ident, hte_symbol_heap, hte_left) = insert name ident_class hte_mark0 hte_symbol_heap hte_left @@ -130,6 +104,29 @@ where #! (boxed_ident, hte_symbol_heap, hte_right) = insert name ident_class hte_mark0 hte_symbol_heap hte_right = (boxed_ident, hte_symbol_heap, HTE_Ident hte_ident hte_class hte_mark hte_left hte_right) +putPredefinedIdentInHashTable :: !Ident !IdentClass !*HashTable -> !*HashTable +putPredefinedIdentInHashTable predefined_ident=:{id_name} ident_class {hte_symbol_heap,hte_entries,hte_mark} + # hash_val = hashValue id_name + (entries,hte_entries) = replace hte_entries hash_val HTE_Empty + (hte_symbol_heap, entries) = insert id_name ident_class hte_mark hte_symbol_heap entries + hte_entries = update hte_entries hash_val entries + = { hte_symbol_heap = hte_symbol_heap, hte_entries = hte_entries,hte_mark=hte_mark } +where + insert :: !String !IdentClass !Int !*SymbolTable *HashTableEntry -> (!*SymbolTable, !*HashTableEntry) + insert name ident_class hte_mark0 hte_symbol_heap HTE_Empty + # hte_symbol_heap = writePtr predefined_ident.id_info EmptySymbolTableEntry hte_symbol_heap + # boxed_ident={boxed_ident=predefined_ident} + = (hte_symbol_heap, HTE_Ident boxed_ident ident_class hte_mark0 HTE_Empty HTE_Empty) + insert name ident_class hte_mark0 hte_symbol_heap (HTE_Ident hte_ident=:{boxed_ident={id_name,id_info}} hte_class hte_mark hte_left hte_right) + # cmp = (name,ident_class) =< (id_name,hte_class) + | cmp == Equal + = (hte_symbol_heap, HTE_Ident hte_ident hte_class (hte_mark bitand hte_mark0) hte_left hte_right) + | cmp == Smaller + #! (hte_symbol_heap, hte_left) = insert name ident_class hte_mark0 hte_symbol_heap hte_left + = (hte_symbol_heap, HTE_Ident hte_ident hte_class hte_mark hte_left hte_right) + #! (hte_symbol_heap, hte_right) = insert name ident_class hte_mark0 hte_symbol_heap hte_right + = (hte_symbol_heap, HTE_Ident hte_ident hte_class hte_mark hte_left hte_right) + remove_icl_symbols_from_hash_table :: !*HashTable -> *HashTable remove_icl_symbols_from_hash_table hash_table=:{hte_entries} # hte_entries=remove_icl_symbols_from_array 0 hte_entries diff --git a/frontend/mergecases.icl b/frontend/mergecases.icl index a89dba2..f182af7 100644 --- a/frontend/mergecases.icl +++ b/frontend/mergecases.icl @@ -376,12 +376,12 @@ where # index=glob_object.ds_index+FirstConstructorPredefinedSymbolIndex | index==PD_OverloadedConsSymbol # new_cons_index=pd_cons_symbol-FirstConstructorPredefinedSymbolIndex - # new_cons_ident=cons_and_nil_idents.[new_cons_index] + # new_cons_ident=predefined_idents.[pd_cons_symbol] # glob_object = {glob_object & ds_index=new_cons_index,ds_ident=new_cons_ident} = {pattern & ap_symbol.glob_object=glob_object} | index==PD_OverloadedNilSymbol # new_nil_index=pd_nil_symbol-FirstConstructorPredefinedSymbolIndex - # new_nil_ident=cons_and_nil_idents.[new_nil_index] + # new_nil_ident=predefined_idents.[pd_nil_symbol] # glob_object = {glob_object & ds_index=new_nil_index,ds_ident=new_nil_ident} = {pattern & ap_symbol.glob_object=glob_object} = abort "replace_overloaded_symbol_in_pattern" diff --git a/frontend/overloading.icl b/frontend/overloading.icl index bdc55d0..0a95fd4 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -1636,7 +1636,8 @@ where getSymbol :: !Int !(!(Global !Int) -> !SymbKind) !Int !*UpdateInfo -> (SymbIdent,*UpdateInfo) getSymbol index symb_kind arity ui=:{ui_x} - # ({pds_module, pds_def, pds_ident}, ui_x) = ui_x!x_predef_symbols.[index] + # ({pds_module, pds_def}, ui_x) = ui_x!x_predef_symbols.[index] + # pds_ident = predefined_idents.[index] symbol = { symb_name = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def}, symb_arity = arity } = (symbol, { ui & ui_x = ui_x}) diff --git a/frontend/parse.dcl b/frontend/parse.dcl index ac78a2f..86d4e41 100644 --- a/frontend/parse.dcl +++ b/frontend/parse.dcl @@ -10,5 +10,5 @@ import syntax, hashtable, scanner, predef cWantIclFile :== True cWantDclFile :== False -wantModule :: !Bool !Ident !Position !Bool !*HashTable !*File !SearchPaths !*PredefinedSymbols (ModTimeFunction *Files) !*Files - -> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files) +wantModule :: !Bool !Ident !Position !Bool !*HashTable !*File !SearchPaths (ModTimeFunction *Files) !*Files + -> (!Bool, !ParsedModule, !*HashTable, !*File, !*Files) diff --git a/frontend/parse.icl b/frontend/parse.icl index 8dbce55..e68201b 100644 --- a/frontend/parse.icl +++ b/frontend/parse.icl @@ -47,9 +47,9 @@ Conventions: , ps_error :: !*ParseErrorAdmin , ps_skipping :: !Bool , ps_hash_table :: !*HashTable - , ps_pre_def_symbols :: !*PredefinedSymbols , ps_support_generics :: !Bool // AA: compiler option "-generics" } + /* appScanState :: (ScanState -> ScanState) !ParseState -> ParseState appScanState f pState=:{ps_scanState} @@ -78,45 +78,45 @@ instance getFilename ParseState where getFilename pState = accScanState getFilename pState -makeStringTypeSymbol pState=:{ps_pre_def_symbols} - #! string_id = ps_pre_def_symbols.[PD_StringType] - = (MakeNewTypeSymbIdent string_id.pds_ident 0, pState) +makeStringType + #! string_ident = predefined_idents.[PD_StringType] + =: TA (MakeNewTypeSymbIdent string_ident 0) [] -makeListTypeSymbol :: Int Int !*ParseState -> *(!TypeSymbIdent,!*ParseState) -makeListTypeSymbol head_strictness arity pState=:{ps_pre_def_symbols} +makeListTypeSymbol :: Int Int -> TypeSymbIdent +makeListTypeSymbol head_strictness arity # pre_def_list_index=if (head_strictness==HeadLazy) PD_ListType (if (head_strictness==HeadStrict) PD_StrictListType PD_UnboxedListType) - #! list_id = ps_pre_def_symbols.[pre_def_list_index] - = (MakeNewTypeSymbIdent list_id.pds_ident arity, pState) + #! list_ident = predefined_idents.[pre_def_list_index] + = MakeNewTypeSymbIdent list_ident arity -makeTailStrictListTypeSymbol :: Int Int !*ParseState -> *(!TypeSymbIdent,!*ParseState) -makeTailStrictListTypeSymbol head_strictness arity pState=:{ps_pre_def_symbols} +makeTailStrictListTypeSymbol :: Int Int -> TypeSymbIdent +makeTailStrictListTypeSymbol head_strictness arity # pre_def_list_index=if (head_strictness==HeadLazy) PD_TailStrictListType (if (head_strictness==HeadStrict) PD_StrictTailStrictListType PD_UnboxedTailStrictListType) - #! list_id = ps_pre_def_symbols.[pre_def_list_index] - = (MakeNewTypeSymbIdent list_id.pds_ident arity, pState) + #! list_ident = predefined_idents.[pre_def_list_index] + = MakeNewTypeSymbIdent list_ident arity -makeLazyArraySymbol arity pState=:{ps_pre_def_symbols} - #! lazy_array_id = ps_pre_def_symbols.[PD_LazyArrayType] - = (MakeNewTypeSymbIdent lazy_array_id.pds_ident arity, pState) +makeLazyArraySymbol arity + #! lazy_array_ident = predefined_idents.[PD_LazyArrayType] + = MakeNewTypeSymbIdent lazy_array_ident arity -makeStrictArraySymbol arity pState=:{ps_pre_def_symbols} - #! strict_array_id = ps_pre_def_symbols.[PD_StrictArrayType] - = (MakeNewTypeSymbIdent strict_array_id.pds_ident arity, pState) +makeStrictArraySymbol arity + #! strict_array_ident = predefined_idents.[PD_StrictArrayType] + = MakeNewTypeSymbIdent strict_array_ident arity -makeUnboxedArraySymbol arity pState=:{ps_pre_def_symbols} - #! unboxed_array_id = ps_pre_def_symbols.[PD_UnboxedArrayType] - = (MakeNewTypeSymbIdent unboxed_array_id.pds_ident arity, pState) +makeUnboxedArraySymbol arity + #! unboxed_array_ident = predefined_idents.[PD_UnboxedArrayType] + = MakeNewTypeSymbIdent unboxed_array_ident arity -makeTupleTypeSymbol form_arity act_arity pState=:{ps_pre_def_symbols} - #! tuple_id = ps_pre_def_symbols.[GetTupleTypeIndex form_arity] - = (MakeNewTypeSymbIdent tuple_id.pds_ident act_arity, pState) +makeTupleTypeSymbol form_arity act_arity + #! tuple_ident = predefined_idents.[GetTupleTypeIndex form_arity] + = MakeNewTypeSymbIdent tuple_ident act_arity class try a :: !Token !*ParseState -> (!Optional a, !*ParseState) class want a :: !*ParseState -> (!a, !*ParseState) @@ -279,30 +279,30 @@ isGlobalOrClassOrInstanceDefsContext parseContext :== parseContext bitand (cGlob cWantIclFile :== True cWantDclFile :== False -wantModule :: !Bool !Ident !Position !Bool !*HashTable !*File !SearchPaths !*PredefinedSymbols (ModTimeFunction *Files) !*Files - -> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files) -wantModule iclmodule file_id=:{id_name} import_file_position support_generics hash_table error searchPaths pre_def_symbols modtimefunction files +wantModule :: !Bool !Ident !Position !Bool !*HashTable !*File !SearchPaths (ModTimeFunction *Files) !*Files + -> (!Bool, !ParsedModule, !*HashTable, !*File, !*Files) +wantModule iclmodule file_id=:{id_name} import_file_position support_generics hash_table error searchPaths modtimefunction files = case openScanner file_name searchPaths modtimefunction files of (Yes (scanState, modification_time), files) # hash_table=set_hte_mark (if iclmodule 1 0) hash_table - # (ok,mod,hash_table,file,pre_def_symbols,files) = initModule file_name modification_time scanState hash_table error pre_def_symbols files + # (ok,mod,hash_table,file,files) = initModule file_name modification_time scanState hash_table error files # hash_table=set_hte_mark 0 hash_table - ->(ok,mod,hash_table,file,pre_def_symbols,files) + ->(ok,mod,hash_table,file,files) (No, files) -> let mod = { mod_name = file_id, mod_modification_time = "", mod_type = MK_None, mod_imports = [], mod_imported_objects = [], mod_defs = [] } in - (False, mod, hash_table, error <<< "Error " <<< import_file_position <<< ": " <<< file_name <<< " could not be imported\n", pre_def_symbols, files) + (False, mod, hash_table, error <<< "Error " <<< import_file_position <<< ": " <<< file_name <<< " could not be imported\n", files) where file_name = if iclmodule (id_name +++ ".icl") (id_name +++ ".dcl") - initModule :: String String ScanState !*HashTable !*File !*PredefinedSymbols *Files - -> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files) - initModule file_name modification_time scanState hash_table error pre_def_symbols files + + initModule :: String String ScanState !*HashTable !*File *Files + -> (!Bool, !ParsedModule, !*HashTable, !*File, !*Files) + initModule file_name modification_time scanState hash_table error files # (succ, mod_type, mod_name, scanState) = try_module_header iclmodule scanState | succ # pState = { ps_scanState = scanState , ps_error = { pea_file = error, pea_ok = True } , ps_skipping = False , ps_hash_table = hash_table - , ps_pre_def_symbols = pre_def_symbols , ps_support_generics = support_generics } pState = verify_name mod_name id_name file_name pState @@ -312,7 +312,7 @@ where // MV ... # (defs, pState) = add_module_id mod_name defs pState; // ... MV - {ps_scanState,ps_hash_table,ps_error,ps_pre_def_symbols} + {ps_scanState,ps_hash_table,ps_error} = pState defs = if (ParseOnly && id_name <> "StdOverloaded" && id_name <> "StdArray" && id_name <> "StdEnum" && id_name <> "StdBool" && id_name <> "StdDynamics" && id_name <> "StdGeneric") [PD_Import imports \\ PD_Import imports <- defs] @@ -321,14 +321,13 @@ where = ( ps_error.pea_ok , mod, ps_hash_table , ps_error.pea_file - , ps_pre_def_symbols , closeScanner ps_scanState files ) // otherwise // ~ succ # ({fp_line}, scanState) = getPosition scanState mod = { mod_name = file_id, mod_modification_time = modification_time, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = [] } = (False, mod, hash_table, error <<< "Error [" <<< file_name <<< ',' <<< fp_line <<< "]: incorrect module header", - pre_def_symbols, closeScanner scanState files) + closeScanner scanState files) where // MV... add_module_id mod_name defs pState @@ -1863,30 +1862,30 @@ trySimpleTypeT SquareOpenToken annot attr pState | head_strictness==HeadStrict # (tail_strict,pState) = is_tail_strict_list_or_nil pState | tail_strict - # (list_symbol, pState) = makeTailStrictListTypeSymbol HeadLazy 0 pState + # list_symbol = makeTailStrictListTypeSymbol HeadLazy 0 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA list_symbol []}, pState) - # (list_symbol, pState) = makeListTypeSymbol head_strictness 0 pState + # list_symbol = makeListTypeSymbol head_strictness 0 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA list_symbol []}, pState) - # (list_symbol, pState) = makeListTypeSymbol head_strictness 0 pState + # list_symbol = makeListTypeSymbol head_strictness 0 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA list_symbol []}, pState) | token==ExclamationToken # (token,pState) = nextToken TypeContext pState | token==SquareCloseToken - # (list_symbol, pState) = makeTailStrictListTypeSymbol head_strictness 0 pState + # list_symbol = makeTailStrictListTypeSymbol head_strictness 0 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA list_symbol []}, pState) = (False, {at_annotation = annot, at_attribute = attr, at_type = TE}, parseError "List type" (Yes token) "]" pState) # (type, pState) = wantAType (tokenBack pState) (token, pState) = nextToken TypeContext pState | token == SquareCloseToken - # (list_symbol, pState) = makeListTypeSymbol head_strictness 1 pState + # list_symbol = makeListTypeSymbol head_strictness 1 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA list_symbol [type]}, pState) | token==ExclamationToken # (token,pState) = nextToken TypeContext pState | token==SquareCloseToken - # (list_symbol, pState) = makeTailStrictListTypeSymbol head_strictness 1 pState + # list_symbol = makeTailStrictListTypeSymbol head_strictness 1 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA list_symbol [type]}, pState) = (False, {at_annotation = annot, at_attribute = attr, at_type = TE}, parseError "List type" (Yes token) "]" pState) @@ -1896,7 +1895,7 @@ trySimpleTypeT OpenToken annot attr pState # (token, pState) = nextToken TypeContext pState | token == CommaToken # (tup_arity, pState) = determine_arity_of_tuple 2 pState - (tuple_symbol, pState) = makeTupleTypeSymbol tup_arity 0 pState + tuple_symbol = makeTupleTypeSymbol tup_arity 0 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA tuple_symbol []}, pState) | token == ArrowToken # (token, pState) = nextToken TypeContext pState @@ -1917,7 +1916,7 @@ trySimpleTypeT OpenToken annot attr pState pState = wantToken TypeContext "tuple type" CloseToken pState atypes = [atype:atypes] arity = length atypes - (tuple_symbol, pState) = makeTupleTypeSymbol arity arity pState + tuple_symbol = makeTupleTypeSymbol arity arity = (True, {at_annotation = annot, at_attribute = attr, at_type = TA tuple_symbol atypes}, pState) // otherwise // token <> CloseToken && token <> CommaToken = (False, atype, parseError "Simple type" (Yes token) "')' or ','" pState) @@ -1933,36 +1932,36 @@ where trySimpleTypeT CurlyOpenToken annot attr pState # (token, pState) = nextToken TypeContext pState | token == CurlyCloseToken - # (array_symbol, pState) = makeLazyArraySymbol 0 pState + # array_symbol = makeLazyArraySymbol 0 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol []}, pState) | token == HashToken # (token, pState) = nextToken TypeContext pState | token == CurlyCloseToken - # (array_symbol, pState) = makeUnboxedArraySymbol 0 pState + # array_symbol = makeUnboxedArraySymbol 0 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol []}, pState) // otherwise // token <> CurlyCloseToken # (atype, pState) = wantAType (tokenBack pState) pState = wantToken TypeContext "unboxed array type" CurlyCloseToken pState - (array_symbol, pState) = makeUnboxedArraySymbol 1 pState + array_symbol = makeUnboxedArraySymbol 1 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol [atype]}, pState) | token == ExclamationToken # (token, pState) = nextToken TypeContext pState | token == CurlyCloseToken - # (array_symbol, pState) = makeStrictArraySymbol 0 pState + # array_symbol = makeStrictArraySymbol 0 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol []}, pState) // otherwise // token <> CurlyCloseToken # (atype,pState) = wantAType (tokenBack pState) pState = wantToken TypeContext "strict array type" CurlyCloseToken pState - (array_symbol, pState) = makeStrictArraySymbol 1 pState + array_symbol = makeStrictArraySymbol 1 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol [atype]}, pState) // otherwise # (atype,pState) = wantAType (tokenBack pState) pState = wantToken TypeContext "lazy array type" CurlyCloseToken pState - (array_symbol, pState) = makeLazyArraySymbol 1 pState + array_symbol = makeLazyArraySymbol 1 = (True, {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol [atype]}, pState) trySimpleTypeT StringTypeToken annot attr pState - # (type, pState) = makeStringTypeSymbol pState - = (True, {at_annotation = annot, at_attribute = attr, at_type = TA type []}, pState) + # type = makeStringType + = (True, {at_annotation = annot, at_attribute = attr, at_type = type}, pState) trySimpleTypeT token annot attr pState # (bt, pState) = try token pState = case bt of @@ -2380,23 +2379,23 @@ wantListExp is_pattern pState | token==ExclamationToken && (head_strictness<>HeadOverloaded && head_strictness<>HeadUnboxedAndTailStrict) # (token, pState) = nextToken FunctionContext pState | token==SquareCloseToken - = makeTailStrictNilExpression head_strictness is_pattern pState + = (makeTailStrictNilExpression head_strictness is_pattern,pState) = (PE_Empty,parseError "list" (Yes token) (toString SquareCloseToken) pState) | token==SquareCloseToken | head_strictness==HeadUnboxedAndTailStrict - = makeTailStrictNilExpression HeadUnboxed is_pattern pState + = (makeTailStrictNilExpression HeadUnboxed is_pattern,pState) | head_strictness==HeadStrict # (tail_strict,pState) = is_tail_strict_list_or_nil pState | tail_strict - = makeTailStrictNilExpression HeadLazy is_pattern pState - = makeNilExpression head_strictness is_pattern pState - = makeNilExpression head_strictness is_pattern pState + = (makeTailStrictNilExpression HeadLazy is_pattern,pState) + = (makeNilExpression head_strictness is_pattern,pState) + = (makeNilExpression head_strictness is_pattern,pState) | head_strictness==HeadUnboxedAndTailStrict = (PE_Empty,parseError "list" (Yes token) (toString SquareCloseToken) pState) | head_strictness==HeadLazy && (case token of (IdentToken "!!") -> True; _ -> False) # (next_token,pState) = nextToken FunctionContext pState | next_token==SquareCloseToken - = makeTailStrictNilExpression HeadStrict is_pattern pState + = (makeTailStrictNilExpression HeadStrict is_pattern,pState) = want_LGraphExpr token [] head_strictness (tokenBack pState) = want_LGraphExpr token [] head_strictness pState where @@ -2415,14 +2414,14 @@ wantListExp is_pattern pState # (token, pState) = nextToken FunctionContext pState = case token of SquareCloseToken - # (nil_expr, pState) = makeNilExpression head_strictness is_pattern pState - -> gen_cons_nodes acc nil_expr pState + # nil_expr = makeNilExpression head_strictness is_pattern + -> (gen_cons_nodes acc nil_expr,pState) ExclamationToken | head_strictness<>HeadOverloaded # (token, pState) = nextToken FunctionContext pState | token==SquareCloseToken - # (nil_expr,pState) = makeTailStrictNilExpression head_strictness is_pattern pState - -> gen_tail_strict_cons_nodes acc nil_expr pState + # nil_expr = makeTailStrictNilExpression head_strictness is_pattern + -> (gen_tail_strict_cons_nodes acc nil_expr,pState) -> (PE_Empty,parseError "list" (Yes token) (toString SquareCloseToken) pState) CommaToken # (token, pState) = nextToken FunctionContext pState @@ -2431,21 +2430,21 @@ wantListExp is_pattern pState # (exp, pState) = wantExpression is_pattern pState # (token,pState) = nextToken FunctionContext pState | token==SquareCloseToken - -> gen_cons_nodes acc exp pState + -> (gen_cons_nodes acc exp,pState) | token==ExclamationToken && head_strictness<>HeadOverloaded # pState = wantToken FunctionContext "list" SquareCloseToken pState - -> gen_tail_strict_cons_nodes acc exp pState + -> (gen_tail_strict_cons_nodes acc exp,pState) | token==ColonToken // to allow [1:2:[]] etc. -> want_list [exp:acc] (tokenBack pState) # pState = parseError "list" (Yes token) "] or :" pState - -> gen_cons_nodes acc exp pState + -> (gen_cons_nodes acc exp,pState) DotDotToken | is_pattern -> (PE_Empty, parseError "want list expression" No "No dot dot expression in a pattern" pState) | length acc > 2 || isEmpty acc - # (nil_expr, pState) = makeNilExpression head_strictness is_pattern pState + # nil_expr = makeNilExpression head_strictness is_pattern pState = parseError "list expression" No "one or two expressions before .." pState - -> gen_cons_nodes acc nil_expr pState + -> (gen_cons_nodes acc nil_expr,pState) # (token, pState) = nextToken FunctionContext pState -> case token of SquareCloseToken @@ -2467,27 +2466,39 @@ wantListExp is_pattern pState | length acc == 1 -> wantListComprehension head_strictness (acc!!0) pState // otherwise // length acc <> 1 - # (nil_expr, pState) = makeNilExpression head_strictness is_pattern pState + # nil_expr = makeNilExpression head_strictness is_pattern pState = parseError "list comprehension" No "one expressions before \\\\" pState - -> gen_cons_nodes acc nil_expr pState - _ # (nil_expr, pState) = makeNilExpression head_strictness is_pattern pState + -> (gen_cons_nodes acc nil_expr,pState) + _ # nil_expr = makeNilExpression head_strictness is_pattern pState = parseError "list" (Yes token) "list element separator" pState - -> gen_cons_nodes acc nil_expr pState + -> (gen_cons_nodes acc nil_expr,pState) - gen_cons_nodes [] exp pState - = (exp, pState) - gen_cons_nodes [e:r] exp pState - # (exp, pState) = makeConsExpression head_strictness is_pattern e exp pState - = gen_cons_nodes r exp pState + gen_cons_nodes [] exp + = exp + gen_cons_nodes l exp + = gen_cons_nodes l exp + where + cons_ident_exp = makeConsIdentExpression head_strictness is_pattern + + gen_cons_nodes [e:r] exp + = gen_cons_nodes r (PE_List [cons_ident_exp,e,exp]) + gen_cons_nodes [] exp + = exp - gen_tail_strict_cons_nodes [] exp pState - = (exp, pState) - gen_tail_strict_cons_nodes [e:r] exp pState - # (exp, pState) = makeTailStrictConsExpression head_strictness is_pattern e exp pState - = gen_tail_strict_cons_nodes r exp pState - -makeNilExpression :: Int Bool *ParseState -> *(!ParsedExpr,!*ParseState) -makeNilExpression head_strictness is_pattern pState=:{ps_pre_def_symbols} + gen_tail_strict_cons_nodes [] exp + = exp + gen_tail_strict_cons_nodes r exp + = gen_tail_strict_cons_nodes r exp + where + tail_strict_cons_ident_exp = makeTailStrictConsIdentExpression head_strictness is_pattern + + gen_tail_strict_cons_nodes [e:r] exp + = gen_tail_strict_cons_nodes r (PE_List [tail_strict_cons_ident_exp,e,exp]) + gen_tail_strict_cons_nodes [] exp + = exp + +makeNilExpression :: Int Bool -> ParsedExpr +makeNilExpression head_strictness is_pattern # pre_def_nil_index= if (head_strictness==HeadLazy) PD_NilSymbol (if (head_strictness==HeadStrict) @@ -2495,21 +2506,21 @@ makeNilExpression head_strictness is_pattern pState=:{ps_pre_def_symbols} (if (head_strictness==HeadOverloaded) (if is_pattern PD_OverloadedNilSymbol PD_nil) (if is_pattern PD_UnboxedNilSymbol PD_nil_u))) - #! nil_id = ps_pre_def_symbols.[pre_def_nil_index] - = (PE_Ident nil_id.pds_ident, pState) + #! nil_ident = predefined_idents.[pre_def_nil_index] + = PE_Ident nil_ident -makeTailStrictNilExpression :: Int Bool *ParseState -> *(!ParsedExpr,!*ParseState) -makeTailStrictNilExpression head_strictness is_pattern pState=:{ps_pre_def_symbols} +makeTailStrictNilExpression :: Int Bool -> ParsedExpr +makeTailStrictNilExpression head_strictness is_pattern # pre_def_nil_index= if (head_strictness==HeadLazy) PD_TailStrictNilSymbol (if (head_strictness==HeadStrict) PD_StrictTailStrictNilSymbol (if is_pattern PD_UnboxedTailStrictNilSymbol PD_nil_uts)) - #! nil_id = ps_pre_def_symbols.[pre_def_nil_index] - = (PE_Ident nil_id.pds_ident, pState) + #! nil_ident = predefined_idents.[pre_def_nil_index] + = PE_Ident nil_ident -makeConsExpression :: Int Bool ParsedExpr ParsedExpr *ParseState -> *(!ParsedExpr,!*ParseState) -makeConsExpression head_strictness is_pattern a1 a2 pState=:{ps_pre_def_symbols} +makeConsIdentExpression :: Int Bool -> ParsedExpr +makeConsIdentExpression head_strictness is_pattern # pre_def_cons_index=if (head_strictness==HeadLazy) PD_ConsSymbol (if (head_strictness==HeadStrict) @@ -2517,23 +2528,23 @@ makeConsExpression head_strictness is_pattern a1 a2 pState=:{ps_pre_def_symbols} (if (head_strictness==HeadOverloaded) (if is_pattern PD_OverloadedConsSymbol PD_cons) (if is_pattern PD_UnboxedConsSymbol PD_cons_u))) - #! cons_id = ps_pre_def_symbols.[pre_def_cons_index] - = (PE_List [PE_Ident cons_id.pds_ident, a1, a2], pState) + #! cons_ident = predefined_idents.[pre_def_cons_index] + = PE_Ident cons_ident cons_and_nil_symbol_index HeadLazy = (PD_ConsSymbol,PD_NilSymbol) cons_and_nil_symbol_index HeadStrict = (PD_StrictConsSymbol,PD_StrictNilSymbol) cons_and_nil_symbol_index HeadUnboxed = (PD_cons_u,PD_nil_u) cons_and_nil_symbol_index HeadOverloaded = (PD_cons,PD_nil) -makeTailStrictConsExpression :: Int Bool ParsedExpr ParsedExpr *ParseState -> *(!ParsedExpr,!*ParseState) -makeTailStrictConsExpression head_strictness is_pattern a1 a2 pState=:{ps_pre_def_symbols} +makeTailStrictConsIdentExpression :: Int Bool -> ParsedExpr +makeTailStrictConsIdentExpression head_strictness is_pattern # pre_def_cons_index=if (head_strictness==HeadLazy) PD_TailStrictConsSymbol (if (head_strictness==HeadStrict) PD_StrictTailStrictConsSymbol (if is_pattern PD_UnboxedTailStrictConsSymbol PD_cons_uts)) - #! cons_id = ps_pre_def_symbols.[pre_def_cons_index] - = (PE_List [PE_Ident cons_id.pds_ident, a1, a2], pState) + #! cons_ident = predefined_idents.[pre_def_cons_index] + = PE_Ident cons_ident tail_strict_cons_and_nil_symbol_index HeadLazy = (PD_TailStrictConsSymbol,PD_TailStrictNilSymbol) tail_strict_cons_and_nil_symbol_index HeadStrict = (PD_StrictTailStrictConsSymbol,PD_StrictTailStrictNilSymbol) diff --git a/frontend/postparse.dcl b/frontend/postparse.dcl index c437224..ba90a4b 100644 --- a/frontend/postparse.dcl +++ b/frontend/postparse.dcl @@ -4,5 +4,5 @@ import StdEnv import syntax, parse, predef -scanModule :: !ParsedModule ![Ident] !Bool !*HashTable !*File !SearchPaths !*PredefinedSymbols (ModTimeFunction *Files) !*Files - -> (!Bool, !ScannedModule, !IndexRange, ![FunDef], !Optional ScannedModule, ![ScannedModule],!Int,!Int,!*HashTable, !*File, !*PredefinedSymbols, !*Files) +scanModule :: !ParsedModule ![Ident] !Bool !*HashTable !*File !SearchPaths (ModTimeFunction *Files) !*Files + -> (!Bool, !ScannedModule, !IndexRange, ![FunDef], !Optional ScannedModule, ![ScannedModule],!Int,!Int,!*HashTable, !*File, !*Files) diff --git a/frontend/postparse.icl b/frontend/postparse.icl index 25fe1d9..a5153fe 100644 --- a/frontend/postparse.icl +++ b/frontend/postparse.icl @@ -8,31 +8,15 @@ import syntax, parse, utilities, StdCompare { ca_error :: !*ParseErrorAdmin , ca_fun_count :: !Int , ca_rev_fun_defs :: ![FunDef] - , ca_predefs :: !PredefinedIdents - , ca_u_predefs :: !*PredefinedSymbols , ca_hash_table :: !*HashTable } cIsAGlobalDef :== True cIsNotAGlobalDef :== False -:: PredefinedIdents :== {!Ident} - -SelectPredefinedIdents :: *PredefinedSymbols -> (!PredefinedIdents, !*PredefinedSymbols) -SelectPredefinedIdents predefs - = selectIdents 0 (createArray PD_NrOfPredefSymbols {id_name="", id_info = nilPtr}) predefs - where - selectIdents :: Int *PredefinedIdents *PredefinedSymbols -> (*PredefinedIdents, *PredefinedSymbols) - selectIdents i idents symbols - | i == PD_NrOfPredefSymbols - = (idents, symbols) - // otherwise - # (symbol, symbols) = symbols![i] - = selectIdents (i+1) {idents & [i] = symbol.pds_ident} symbols - -predef :: Int PredefinedIdents -> ParsedExpr -predef index ids - = PE_Ident ids.[index] +predef_ident_expr :: Int -> ParsedExpr +predef_ident_expr index + = PE_Ident predefined_idents.[index] optGuardedAltToRhs :: OptGuardedAlts -> Rhs optGuardedAltToRhs optGuardedAlt @@ -62,7 +46,7 @@ prefixAndPositionToIdentExp prefix {lc_line, lc_column} ca=:{ca_hash_table} (`) infixl 9 (`) f a - :== \idents -> apply (f idents) (toParsedExpr a idents) + :== apply f (toParsedExpr a) // apply :: ParsedExpr ParsedExpr -> ParsedExpr @@ -72,21 +56,21 @@ apply (PE_List application) a apply f a = PE_List [f, a] -class toParsedExpr a :: !a -> !PredefinedIdents -> ParsedExpr +class toParsedExpr a :: !a -> ParsedExpr instance toParsedExpr [a] | toParsedExpr a where toParsedExpr [] - = predef PD_NilSymbol + = predef_ident_expr PD_NilSymbol toParsedExpr [hd:tl] - = predef PD_ConsSymbol ` hd ` tl + = predef_ident_expr PD_ConsSymbol ` hd ` tl instance toParsedExpr ParsedExpr where toParsedExpr x - = const x + = x instance toParsedExpr Int where toParsedExpr x - = const (PE_Basic (BVI (toString x))) + = PE_Basic (BVI (toString x)) postParseError :: Position {#Char} *CollectAdmin -> *CollectAdmin postParseError pos msg ps=:{ca_error={pea_file}} @@ -173,10 +157,10 @@ where collectFunctions (PE_UpdateComprehension expr updateExpr identExpr qualifiers) icl_module ca # (compr, ca) = transformUpdateComprehension [expr] [updateExpr] [identExpr] identExpr qualifiers ca = collectFunctions compr icl_module ca - collectFunctions (PE_Sequ sequence) icl_module ca=:{ca_predefs} - = collectFunctions (transformSequence sequence ca_predefs) icl_module ca - collectFunctions (PE_ArrayDenot exprs) icl_module ca=:{ca_predefs} - = collectFunctions (transformArrayDenot exprs ca_predefs) icl_module ca + collectFunctions (PE_Sequ sequence) icl_module ca + = collectFunctions (transformSequence sequence) icl_module ca + collectFunctions (PE_ArrayDenot exprs) icl_module ca + = collectFunctions (transformArrayDenot exprs) icl_module ca collectFunctions (PE_Dynamic exprs opt_dyn_type) icl_module ca # (exprs, ca) = collectFunctions exprs icl_module ca = (PE_Dynamic exprs opt_dyn_type, ca) @@ -380,20 +364,23 @@ transformLambda lam_ident args result pos = MakeNewImpOrDefFunction lam_ident (length args) lam_body (FK_Function cNameLocationDependent) NoPrio No pos makeConsExpressionForGenerator :: GeneratorKind ParsedExpr ParsedExpr *CollectAdmin -> (ParsedExpr,*CollectAdmin) -makeConsExpressionForGenerator gen_kind a1 a2 ca=:{ca_predefs} - #! cons_id = ca_predefs.[case gen_kind of IsListGenerator -> PD_ConsSymbol ; _ -> PD_OverloadedConsSymbol] +makeConsExpressionForGenerator gen_kind a1 a2 ca + #! cons_id = predefined_idents.[case gen_kind of IsListGenerator -> PD_ConsSymbol ; _ -> PD_OverloadedConsSymbol] = (PE_List [PE_Ident cons_id, a1, a2], ca) makeNilExpression :: Int *CollectAdmin -> (ParsedExpr,*CollectAdmin) -makeNilExpression predef_nil_index ca=:{ca_predefs} - #! nil_id = ca_predefs.[predef_nil_index] +makeNilExpression predef_nil_index ca + #! nil_id = predefined_idents.[predef_nil_index] = (PE_Ident nil_id, ca) makeConsExpression :: Int ParsedExpr ParsedExpr *CollectAdmin -> (ParsedExpr,*CollectAdmin) -makeConsExpression predef_cons_index a1 a2 ca=:{ca_predefs} - #! cons_id = ca_predefs.[predef_cons_index] +makeConsExpression predef_cons_index a1 a2 ca + #! cons_id = predefined_idents.[predef_cons_index] = (PE_List [PE_Ident cons_id, a1, a2], ca) +//get_predef_id :: Int -> Ident +get_predef_id predef_index :== predefined_idents.[predef_index] + // +++ change to accessor functions :: TransformedGenerator = { tg_expr :: ([ParsedDefinition],[ParsedExpr]) @@ -418,15 +405,15 @@ transformGenerator {gen_kind=IsArrayGenerator, gen_expr, gen_pattern, gen_positi (a2, ca) = prefixAndPositionToIdentExp "g_a2" gen_position ca (gen_var_case1, ca) = prefixAndPositionToIdent "g_c1" gen_position ca (gen_var_case2, ca) = prefixAndPositionToIdent "g_c2" gen_position ca - (less_or_equal, ca) = get_predef_id PD_LessOrEqualFun ca - (sub, ca) = get_predef_id PD_SubFun ca - (usize, ca) = get_predef_id PD_UnqArraySizeFun ca - (uselect, ca) = get_predef_id PD_UnqArraySelectFun ca + less_or_equal = get_predef_id PD_LessOrEqualFun + sub = get_predef_id PD_SubFun + usize = get_predef_id PD_UnqArraySizeFun + uselect = get_predef_id PD_UnqArraySelectFun pattern = PE_Tuple [gen_pattern, array] = case index_generator of No # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca - (inc, ca) = get_predef_id PD_IncFun ca + inc = get_predef_id PD_IncFun # dec_n = PE_List [n,PE_Ident sub,PE_Basic (BVI "1")] # transformed_generator = { tg_expr = ([PD_NodeDef (LinePos qual_filename gen_position.lc_line) (PE_Tuple [n,a2]) (exprToRhs (PE_List [PE_Ident usize, gen_expr]))], @@ -442,7 +429,7 @@ transformGenerator {gen_kind=IsArrayGenerator, gen_expr, gen_pattern, gen_positi } -> (transformed_generator,Yes (i,[([],dec_n,n2)]),2,ca) Yes (i,[]) - # (inc, ca) = get_predef_id PD_IncFun ca + # inc = get_predef_id PD_IncFun # dec_n = PE_List [n,PE_Ident sub,PE_Basic (BVI "1")] # transformed_generator = { tg_expr = ([PD_NodeDef (LinePos qual_filename gen_position.lc_line) (PE_Tuple [n,a2]) (exprToRhs (PE_List [PE_Ident usize, gen_expr]))], @@ -482,8 +469,8 @@ transformGenerator {gen_kind, gen_expr=PE_Sequ (SQ_FromTo from_exp to_exp), gen_ -> case index_generator of No # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca - # (inc, ca) = get_predef_id PD_IncFun ca - (less_or_equal, ca) = get_predef_id PD_LessOrEqualFun ca + # inc = get_predef_id PD_IncFun + less_or_equal = get_predef_id PD_LessOrEqualFun # transformed_generator = { tg_expr = ([],[from_exp,to_exp]) , tg_lhs_arg = [i,n] @@ -497,8 +484,8 @@ transformGenerator {gen_kind, gen_expr=PE_Sequ (SQ_FromTo from_exp to_exp), gen_ } -> (transformed_generator,Yes (i,[([],to_exp,n)]),2,ca) Yes (i,[]) - # (inc, ca) = get_predef_id PD_IncFun ca - (less_or_equal, ca) = get_predef_id PD_LessOrEqualFun ca + # inc = get_predef_id PD_IncFun + less_or_equal = get_predef_id PD_LessOrEqualFun # transformed_generator = { tg_expr = ([],[to_exp]) , tg_lhs_arg = [n] @@ -526,8 +513,8 @@ transformGenerator {gen_kind, gen_expr=PE_Sequ (SQ_FromTo from_exp to_exp), gen_ -> (transformed_generator,Yes (i,[([],to_exp,n):size_expressions]),0,ca) _ # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca - # (inc, ca) = get_predef_id PD_IncFun ca - (less_or_equal, ca) = get_predef_id PD_LessOrEqualFun ca + # inc = get_predef_id PD_IncFun + less_or_equal = get_predef_id PD_LessOrEqualFun # transformed_generator = { tg_expr = ([],[from_exp,to_exp]) , tg_lhs_arg = [i,n] @@ -548,7 +535,7 @@ transformGenerator {gen_kind, gen_expr=PE_Sequ (SQ_From from_exp), gen_pattern, -> case index_generator of No # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca - # (inc, ca) = get_predef_id PD_IncFun ca + # inc = get_predef_id PD_IncFun # transformed_generator = { tg_expr = ([],[from_exp]) , tg_lhs_arg = [i] @@ -576,7 +563,7 @@ transformGenerator {gen_kind, gen_expr=PE_Sequ (SQ_From from_exp), gen_pattern, -> (transformed_generator,index_generator,0,ca) _ # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca - # (inc, ca) = get_predef_id PD_IncFun ca + # inc = get_predef_id PD_IncFun # transformed_generator = { tg_expr = ([],[from_exp]) , tg_lhs_arg = [i] @@ -636,7 +623,7 @@ transformGeneratorsAndReturnSize [generator:generators] qual_filename index_gene -> (node_defs++[PD_NodeDef NoPos ident (exprToRhs size_exp)],ident) # transformed_generator = store_minimum_of_sizes_in_generator node_defs size_exp index_argument_n transformed_generator - # (inc,ca) = get_predef_id PD_IncFun ca + # inc = get_predef_id PD_IncFun # size_exp = PE_List [PE_Ident inc,size_exp] = ([transformed_generator:transformed_generators],index_generator,size_exp,ca) @@ -674,7 +661,7 @@ where = (PE_Let cIsNotStrict (LocalParsedDefs [node_def1,node_def2]) min_exp,ca) minimum_of_idents ident1 ident2 ca - # (smaller_fun,ca) = get_predef_id PD_SmallerFun ca + # smaller_fun = get_predef_id PD_SmallerFun # (case_ident,ca) = prefixAndPositionToIdent ("g_s"+++toString n) gen_position ca = (PE_Case case_ident (PE_List [ident1,PE_Ident smaller_fun,ident2]) [{calt_pattern = PE_Basic (BVB True), calt_rhs = exprToRhs ident1}, @@ -770,7 +757,7 @@ transformArrayComprehension expr qualifiers ca qual_position = hd_qualifier.qual_position (c_i_ident_exp, ca) = prefixAndPositionToIdentExp "c_i" qual_position ca (c_a_ident_exp, ca) = prefixAndPositionToIdentExp "c_a" qual_position ca - (create_array, ca) = get_predef_id PD__CreateArrayFun ca + create_array = get_predef_id PD__CreateArrayFun | same_index_for_update_and_array_generators qualifiers # index_range = PE_Sequ (SQ_From (PE_Basic (BVI "0"))) # index_generator = {gen_kind=IsListGenerator, gen_pattern=c_i_ident_exp, gen_expr=PE_Sequ (SQ_From (PE_Basic (BVI "0"))), gen_position=qual_position} @@ -790,7 +777,7 @@ transformArrayComprehension expr qualifiers ca # (length, ca) = computeSize qualifiers qual_position hd_qualifier.qual_filename ca # new_array = PE_List [PE_Ident create_array,length] - # (inc,ca) = get_predef_id PD_IncFun ca + # inc = get_predef_id PD_IncFun new_array_and_index = [new_array,PE_Basic (BVI "0")] update = [PE_Update c_a_ident_exp [PS_Array c_i_ident_exp] expr,PE_List [PE_Ident inc,c_i_ident_exp]] = transformUpdateComprehension new_array_and_index update [c_a_ident_exp,c_i_ident_exp] c_a_ident_exp qualifiers ca @@ -853,7 +840,7 @@ computeSize :: [Qualifier] LineAndColumn FileName *CollectAdmin -> (!ParsedExpr, computeSize qualifiers qual_position qual_filename ca # (counter_ident_exp, ca) = prefixAndPositionToIdentExp "c_l_i" qual_position ca (transformed_qualifiers,ca) = transformUpdateQualifiers [counter_ident_exp] [PE_Basic (BVI "0")] qualifiers ca - (inc,ca) = get_predef_id PD_IncFun ca + inc = get_predef_id PD_IncFun success = insert_inc_in_inner_loop (last transformed_qualifiers).tq_continue with insert_inc_in_inner_loop (PE_List [f, a : args]) @@ -976,34 +963,29 @@ makeComprehensions [{tq_generators, tq_filter, tq_end, tq_call, tq_lhs_args, tq_ , {calt_pattern = PE_WildCard, calt_rhs = exprToRhs default_rhs} ]) -get_predef_id :: Int *CollectAdmin -> (Ident, *CollectAdmin) -get_predef_id predef_index ca=:{ca_predefs} - = ca!ca_predefs.[predef_index] - -transformSequence :: Sequence -> PredefinedIdents -> ParsedExpr +transformSequence :: Sequence -> ParsedExpr transformSequence (SQ_FromThen frm then) - = predef PD_FromThen ` frm ` then + = predef_ident_expr PD_FromThen ` frm ` then transformSequence (SQ_FromThenTo frm then to) - = predef PD_FromThenTo ` frm ` then ` to + = predef_ident_expr PD_FromThenTo ` frm ` then ` to transformSequence (SQ_From frm) - = predef PD_From ` frm + = predef_ident_expr PD_From ` frm transformSequence (SQ_FromTo frm to) - = predef PD_FromTo ` frm ` to + = predef_ident_expr PD_FromTo ` frm ` to -transformArrayUpdate :: ParsedExpr [Bind ParsedExpr ParsedExpr] PredefinedIdents -> ParsedExpr -transformArrayUpdate expr updates pi - = foldr (update pi (predef PD_ArrayUpdateFun)) expr updates +transformArrayUpdate :: ParsedExpr [Bind ParsedExpr ParsedExpr] -> ParsedExpr +transformArrayUpdate expr updates + = foldr (update (predef_ident_expr PD_ArrayUpdateFun)) expr updates where - update :: PredefinedIdents (PredefinedIdents -> ParsedExpr) (Bind ParsedExpr ParsedExpr) ParsedExpr -> ParsedExpr - update pi updateIdent {bind_src=value, bind_dst=index} expr - = (updateIdent ` expr ` index ` value) pi + update :: ParsedExpr (Bind ParsedExpr ParsedExpr) ParsedExpr -> ParsedExpr + update updateIdent {bind_src=value, bind_dst=index} expr + = updateIdent ` expr ` index ` value -transformArrayDenot :: [ParsedExpr] PredefinedIdents -> ParsedExpr -transformArrayDenot exprs pi +transformArrayDenot :: [ParsedExpr] -> ParsedExpr +transformArrayDenot exprs = transformArrayUpdate - ((predef PD__CreateArrayFun ` length exprs) pi) - [{bind_dst=toParsedExpr i pi, bind_src=expr} \\ expr <- exprs & i <- [0..]] - pi + (predef_ident_expr PD__CreateArrayFun ` length exprs) + [{bind_dst=toParsedExpr i, bind_src=expr} \\ expr <- exprs & i <- [0..]] scanModules :: [ParsedImport] [ScannedModule] [Ident] SearchPaths Bool (ModTimeFunction *Files) *Files *CollectAdmin -> (Bool, [ScannedModule],*Files, *CollectAdmin) scanModules [] parsed_modules cached_modules searchPaths support_generics modtimefunction files ca @@ -1049,9 +1031,9 @@ MakeEmptyModule name mod_type parseAndScanDclModule :: !Ident !Position ![ScannedModule] ![Ident] !SearchPaths !Bool (ModTimeFunction *Files) !*Files !*CollectAdmin -> *(!Bool, ![ScannedModule],!*Files, !*CollectAdmin) parseAndScanDclModule dcl_module import_file_position parsed_modules cached_modules searchPaths support_generics modtimefunction files ca - # {ca_error, ca_u_predefs, ca_hash_table} = ca - # (parse_ok, mod, ca_hash_table, err_file, ca_u_predefs, files) = wantModule cWantDclFile dcl_module import_file_position support_generics ca_hash_table ca_error.pea_file searchPaths ca_u_predefs modtimefunction files - # ca = {ca & ca_hash_table=ca_hash_table, ca_error={pea_file=err_file,pea_ok=True}, ca_u_predefs=ca_u_predefs } + # {ca_error, ca_hash_table} = ca + # (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 = (False, [MakeEmptyModule mod.mod_name MK_None: parsed_modules],files, ca) @@ -1071,15 +1053,13 @@ where = scanModules imports [mod : parsed_modules] cached_modules searchPaths support_generics modtimefunction files ca = (pea_ok && import_ok, parsed_modules,files, ca) -scanModule :: !ParsedModule ![Ident] !Bool !*HashTable !*File !SearchPaths !*PredefinedSymbols (ModTimeFunction *Files) !*Files - -> (!Bool, !ScannedModule, !IndexRange, ![FunDef], !Optional ScannedModule, ![ScannedModule],!Int,!Int,!*HashTable, !*File, !*PredefinedSymbols, !*Files) -scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules support_generics hash_table err_file searchPaths predefs modtimefunction files - # (predefIdents, predefs) = SelectPredefinedIdents predefs +scanModule :: !ParsedModule ![Ident] !Bool !*HashTable !*File !SearchPaths (ModTimeFunction *Files) !*Files + -> (!Bool, !ScannedModule, !IndexRange, ![FunDef], !Optional ScannedModule, ![ScannedModule],!Int,!Int,!*HashTable, !*File, !*Files) +scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules support_generics hash_table err_file searchPaths /*predefs*/ modtimefunction files + # predefIdents = predefined_idents # ca = { ca_error = {pea_file = err_file, pea_ok = True} , ca_fun_count = 0 , ca_rev_fun_defs = [] - , ca_predefs = predefIdents - , ca_u_predefs = predefs , ca_hash_table = hash_table } (fun_defs, defs, imports, imported_objects, ca) = reorganiseDefinitions True pdefs 0 0 0 0 ca @@ -1112,7 +1092,7 @@ scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules support_gene (macro_range, ca) = addFunctionsRange macro_defs ca (def_instances, ca) = collectFunctions defs.def_instances True ca - { ca_error = {pea_file = err_file,pea_ok}, ca_predefs = predefs, ca_rev_fun_defs, ca_u_predefs, ca_hash_table } = ca + { ca_error = {pea_file = err_file,pea_ok}, ca_predefs = predefs, ca_rev_fun_defs, ca_hash_table } = ca mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = { defs & def_instances = def_instances, def_macro_indices = macro_range }} @@ -1121,7 +1101,7 @@ scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules support_gene fun_defs = fun_defs++reverse ca_rev_fun_defs fun_range = {ir_from=0,ir_to=n_global_functions} - = (reorganise_icl_ok && pea_ok && import_dcl_ok && import_dcls_ok, mod, fun_range, fun_defs, optional_dcl_mod, modules, dcl_module_n,n_functions_and_macros_in_dcl_modules,hash_table, err_file, ca_u_predefs, files) + = (reorganise_icl_ok && pea_ok && import_dcl_ok && import_dcls_ok, mod, fun_range, fun_defs, optional_dcl_mod, modules, dcl_module_n,n_functions_and_macros_in_dcl_modules,hash_table, err_file, files) where scan_main_dcl_module :: Ident ModuleKind (ModTimeFunction *Files) *Files *CollectAdmin -> (!Bool,!Optional (Module (CollectedDefinitions (ParsedInstance FunDef) [FunDef])),!Int,![ScannedModule],![Ident],!*Files,!*CollectAdmin) scan_main_dcl_module mod_name MK_Main _ files ca @@ -1139,9 +1119,9 @@ where = in_cache (module_n+1) pmods | module_n_in_cache<>NoIndex = (True,No,module_n_in_cache,[],cached_modules,files,ca) - # {ca_error, ca_u_predefs, ca_hash_table} = ca - # (parse_ok, mod, hash_table, err_file, predefs, files) = wantModule cWantDclFile mod_name NoPos support_generics ca_hash_table ca_error.pea_file searchPaths ca_u_predefs modtimefunction files - # ca = {ca & ca_hash_table=hash_table, ca_error={pea_file=err_file,pea_ok=True}, ca_u_predefs=predefs} + # {ca_error, ca_hash_table} = ca + # (parse_ok, mod, hash_table, err_file, /*predefs,*/ files) = wantModule cWantDclFile mod_name NoPos support_generics ca_hash_table ca_error.pea_file searchPaths modtimefunction files + # ca = {ca & ca_hash_table=hash_table, ca_error={pea_file=err_file,pea_ok=True}} | not parse_ok = (False, No,NoIndex, [],cached_modules, files, ca) # pdefs = mod.mod_defs diff --git a/frontend/predef.dcl b/frontend/predef.dcl index 30f62b7..958b35a 100644 --- a/frontend/predef.dcl +++ b/frontend/predef.dcl @@ -6,10 +6,9 @@ cPredefinedModuleIndex :== 1 :: PredefinedSymbols :== {# PredefinedSymbol} -:: PredefinedSymbol = - { pds_ident :: !Ident - , pds_module :: !Index - , pds_def :: !Index +:: PredefinedSymbol = { + pds_module :: !Index, + pds_def :: !Index } /* identifiers not present the hastable */ @@ -185,9 +184,9 @@ PD_NrOfPredefSymbols :== 201 GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2 GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2 -init_identifiers :: *SymbolTable -> *SymbolTable +init_identifiers :: !*SymbolTable !*World -> (!*SymbolTable,!*World) -cons_and_nil_idents :: {!Ident} +predefined_idents :: {!Ident} buildPredefinedSymbols :: !*HashTable -> (!.PredefinedSymbols,!*HashTable) diff --git a/frontend/predef.icl b/frontend/predef.icl index 3e71661..c4f0bca 100644 --- a/frontend/predef.icl +++ b/frontend/predef.icl @@ -6,13 +6,12 @@ cPredefinedModuleIndex :== 1 :: PredefinedSymbols :== {# PredefinedSymbol} -:: PredefinedSymbol = - { pds_ident :: !Ident - , pds_module :: !Index - , pds_def :: !Index +:: PredefinedSymbol = { + pds_module :: !Index, + pds_def :: !Index } -/* identifiers not present the hastable */ +/* identifiers not present the hashtable */ PD_PredefinedModule :== 0 @@ -183,195 +182,317 @@ PD_ConsTypeVar :== 200 PD_NrOfPredefSymbols :== 201 (<<=) infixl -(<<=) state val - :== let (array, symbol_table) = state - (name, index) = val - (id_info, new_symbol_table) = newPtr EmptySymbolTableEntry symbol_table - in ({ array & [index] = { pds_ident = { id_name = name, id_info = id_info }, pds_module = NoIndex, pds_def = NoIndex } }, new_symbol_table) - -(<<+) infixl -(<<+) state val - :== let (array, symbol_table) = state - (cons_and_nil_idents, index) = val - in ({ array & [index] = { pds_ident = cons_and_nil_idents.[index-FirstConstructorPredefinedSymbolIndex], pds_module = NoIndex, pds_def = NoIndex } }, symbol_table) +(<<=) symbol_table val + :== let (predefined_idents, index) = val + in writePtr predefined_idents.[index].id_info EmptySymbolTableEntry symbol_table (<<-) infixl -(<<-) (array, hash_table) (name, table_kind, index) -// # (id, hash_table) = putIdentInHashTable name table_kind hash_table - # ({boxed_ident=id}, hash_table) = putIdentInHashTable name table_kind hash_table - = ({ array & [index] = { pds_ident = id, pds_module = NoIndex, pds_def = NoIndex } }, hash_table) - +(<<-) hash_table val + :== let (predefined_idents, table_kind, index) = val + in putPredefinedIdentInHashTable predefined_idents.[index] table_kind hash_table + GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2 GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2 -cons_and_nil_idents :: {!Ident} -cons_and_nil_idents =: { - { id_name = PD_ConsSymbol_String, id_info = allocPtr }, - { id_name = "_!Cons", id_info = allocPtr }, - { id_name = "_#Cons", id_info = allocPtr }, - { id_name = "_Cons!", id_info = allocPtr }, - { id_name = "_!Cons!", id_info = allocPtr }, - { id_name = "_#Cons!", id_info = allocPtr }, - { id_name = "_|Cons", id_info = allocPtr }, - { id_name = PD_NilSymbol_String, id_info = allocPtr }, - { id_name = "_!Nil", id_info = allocPtr }, - { id_name = "_#Nil", id_info = allocPtr }, - { id_name = "_Nil!", id_info = allocPtr }, - { id_name = "_!Nil!", id_info = allocPtr }, - { id_name = "_#Nil!", id_info = allocPtr }, - { id_name = "_|Nil", id_info = allocPtr } - } - -init_identifiers :: *SymbolTable -> *SymbolTable -init_identifiers heap - # local_cons_and_nil_idents = cons_and_nil_idents - # heap = init_cons_and_nil_idents 0 heap +predefined_idents :: {!Ident} +predefined_idents + # idents = createArray PD_NrOfPredefSymbols {id_name="",id_info=nilPtr} + # idents = { idents & + [PD_ConsSymbol] = i PD_ConsSymbol_String, + [PD_StrictConsSymbol] = i "_!Cons", + [PD_UnboxedConsSymbol] = i "_#Cons", + [PD_TailStrictConsSymbol] = i "_Cons!", + [PD_StrictTailStrictConsSymbol] = i "_!Cons!", + [PD_UnboxedTailStrictConsSymbol] = i "_#Cons!", + [PD_OverloadedConsSymbol] = i "_|Cons", + [PD_NilSymbol] = i PD_NilSymbol_String, + [PD_StrictNilSymbol] = i "_!Nil", + [PD_UnboxedNilSymbol] = i "_#Nil", + [PD_TailStrictNilSymbol] = i "_Nil!", + [PD_StrictTailStrictNilSymbol] = i "_!Nil!", + [PD_UnboxedTailStrictNilSymbol] = i "_#Nil!", + [PD_OverloadedNilSymbol] = i "_|Nil", + + [PD_PredefinedModule] = i "_predefined", + [PD_StringType] = i "_String", + [PD_ListType] = i PD_ListType_String, + [PD_StrictListType] = i "_!List", + [PD_UnboxedListType] = i "_#List", + [PD_TailStrictListType] = i "_List!", + [PD_StrictTailStrictListType] = i "_!List!", + [PD_UnboxedTailStrictListType] = i "_#List!", + [PD_OverloadedListType] = i "_|List", + [PD_LazyArrayType] = i "_Array", + [PD_StrictArrayType] = i "_!Array", + [PD_UnboxedArrayType] = i PD_UnboxedArray_String, + [PD_TypeCodeMember] = i "_type_code", + [PD_DummyForStrictAliasFun] = i "_dummyForStrictAlias" + } + # idents = build_tuples 2 32 idents + # idents = build_variables 0 32 idents + + # idents = { idents & + [PD_StdArray] = i "_SystemArray", + [PD_StdEnum] = i "StdEnum", + [PD_StdBool] = i "StdBool", + [PD_AndOp] = i "&&", + [PD_OrOp] = i "||", + [PD_ArrayClass] = i "Array", + [PD_CreateArrayFun] = i "createArray", + [PD__CreateArrayFun] = i "_createArray", + [PD_ArraySelectFun] = i "select", + [PD_UnqArraySelectFun] = i "uselect", + [PD_ArrayUpdateFun] = i "update", + [PD_ArrayReplaceFun] = i "replace", + [PD_ArraySizeFun] = i "size", + [PD_UnqArraySizeFun] = i "usize", + + [PD_StdStrictLists] = i "StdStrictLists", + [PD_cons] = i "cons", + [PD_decons] = i "decons", + [PD_nil] = i "nil", + + [PD_cons_u] = i "cons_u", + [PD_decons_u] = i "decons_u", + [PD_nil_u] = i "nil_u", + + [PD_cons_uts] = i "cons_uts", + [PD_decons_uts] = i "decons_uts", + [PD_nil_uts] = i "nil_uts", + + [PD_ListClass] = i "List", + [PD_UListClass] = i "UList", + [PD_UTSListClass] = i "UTSList", + + [PD_SmallerFun] = i "<", + [PD_LessOrEqualFun] = i "<=", + [PD_IncFun] = i "inc", + [PD_SubFun] = i "-", + + [PD_From] = i "_from", + [PD_FromThen] = i "_from_then", + [PD_FromTo] = i "_from_to", + [PD_FromThenTo] = i "_from_then_to", + + [PD_TypeCodeClass] = i "TC", + [PD_TypeObjectType] = i "T_ypeObjectType", + [PD_TypeConsSymbol] = i "T_ypeConsSymbol", + [PD_variablePlaceholder] = i "P_laceholder", + [PD_unify] = i "_unify", + [PD_coerce] = i "_coerce", + [PD_StdDynamic] = i UnderscoreSystemDynamicModule_String, + [PD_undo_indirections] = i "_undo_indirections", + + [PD_DynamicTemp] = i DynamicRepresentation_String, + [PD_ModuleConsSymbol] = i "__Module", + [PD_TypeID] = i "T_ypeID", + [PD_ModuleID] = i "ModuleID", + + [PD_StdGeneric] = i "StdGeneric", + [PD_TypeISO] = i "ISO", + [PD_ConsISO] = i "_ISO", + [PD_TypeUNIT] = i "UNIT", + [PD_ConsUNIT] = i "UNIT", + [PD_TypeEITHER] = i "EITHER", + [PD_ConsLEFT] = i "LEFT", + [PD_ConsRIGHT] = i "RIGHT", + [PD_TypePAIR] = i "PAIR", + [PD_ConsPAIR] = i "PAIR", + [PD_TypeARROW] = i "ARROW", + [PD_ConsARROW] = i "ARROW", + [PD_isomap_ARROW_] = i "isomap_ARROW_", + [PD_isomap_ID] = i "isomap_ID", + [PD_TypeConsDefInfo] = i "ConsDefInfo", + [PD_ConsConsDefInfo] = i "_ConsDefInfo", + [PD_TypeTypeDefInfo] = i "TypeDefInfo", + [PD_ConsTypeDefInfo] = i "_TypeDefInfo", + [PD_TypeCONS] = i "CONS", + [PD_ConsCONS] = i "CONS", + [PD_cons_info] = i "CONS_INFO", + [PD_TypeType] = i "Type", + [PD_ConsTypeApp] = i "TypeApp", + [PD_ConsTypeVar] = i "TypeVar", + + [PD_StdMisc] = i "StdMisc", + [PD_abort] = i "abort", + [PD_undef] = i "undef", + + [PD_Start] = i "Start", + + [PD_iso_from] = i "iso_from", + [PD_iso_to] = i "iso_to", + + [PD_DynamicType] = i "type", + [PD_DynamicValue] = i "value" + } + =: idents + where + i s = { id_name = s, id_info = allocPtr }; + + build_tuples tup_arity max_arity idents + | tup_arity > max_arity + = idents + # tup_name = "_Tuple" +++ toString tup_arity + # idents = {idents & [GetTupleTypeIndex tup_arity]=i tup_name, [GetTupleConsIndex tup_arity]=i tup_name} + = build_tuples (inc tup_arity) max_arity idents + + build_variables var_number max_arity idents + | var_number == max_arity + = idents + # var_name = "a" +++ toString var_number + # idents = {idents & [PD_TypeVar_a0 + var_number] = i var_name} + = build_variables (inc var_number) max_arity idents + +init_identifiers :: !*SymbolTable !*World -> (!*SymbolTable,!*World) +init_identifiers heap world + # local_predefined_idents = predefined_idents + # (heap,world) = init_predefined_idents 0 heap world with - init_cons_and_nil_idents i heap - | i<size local_cons_and_nil_idents - # heap=initPtr local_cons_and_nil_idents.[i].id_info EmptySymbolTableEntry heap - = init_cons_and_nil_idents (i+1) heap - = heap - = heap + init_predefined_idents i heap world + | i<size local_predefined_idents + | size local_predefined_idents.[i].id_name>0 + # (heap,world) = initPtr local_predefined_idents.[i].id_info EmptySymbolTableEntry heap world + = init_predefined_idents (i+1) heap world + = init_predefined_idents (i+1) heap world + = (heap,world) + = (heap,world) buildPredefinedSymbols :: !*HashTable -> (!.PredefinedSymbols,!*HashTable) buildPredefinedSymbols hash_table=:{hte_symbol_heap} - # predef_symbol_table = createArray PD_NrOfPredefSymbols { pds_ident = { id_name = "", id_info = nilPtr }, pds_module = NoIndex, pds_def = NoIndex } - (predef_symbol_table, hte_symbol_heap) = fill_table_without_hashing (predef_symbol_table, hte_symbol_heap) - = fill_table_with_hashing (predef_symbol_table, { hash_table & hte_symbol_heap = hte_symbol_heap }) + # predef_symbol_table = createArray PD_NrOfPredefSymbols { pds_module = NoIndex, pds_def = NoIndex } + hte_symbol_heap = fill_table_without_hashing hte_symbol_heap + = (predef_symbol_table,fill_table_with_hashing { hash_table & hte_symbol_heap = hte_symbol_heap }) where - local_cons_and_nil_idents = cons_and_nil_idents + local_predefined_idents = predefined_idents - fill_table_without_hashing tables - = build_variables 0 32 (build_tuples 2 32 tables) - <<= ("_predefined", PD_PredefinedModule) - <<= ("_String", PD_StringType) - <<= (PD_ListType_String, PD_ListType) <<+ (local_cons_and_nil_idents, PD_ConsSymbol)<<+ (local_cons_and_nil_idents, PD_NilSymbol) - <<= ("_!List", PD_StrictListType) <<+ (local_cons_and_nil_idents, PD_StrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_StrictNilSymbol) - <<= ("_#List", PD_UnboxedListType) <<+ (local_cons_and_nil_idents, PD_UnboxedConsSymbol) <<+ (local_cons_and_nil_idents, PD_UnboxedNilSymbol) - <<= ("_List!", PD_TailStrictListType) <<+ (local_cons_and_nil_idents, PD_TailStrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_TailStrictNilSymbol) - <<= ("_!List!", PD_StrictTailStrictListType) <<+ (local_cons_and_nil_idents, PD_StrictTailStrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_StrictTailStrictNilSymbol) - <<= ("_#List!", PD_UnboxedTailStrictListType) <<+ (local_cons_and_nil_idents, PD_UnboxedTailStrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_UnboxedTailStrictNilSymbol) - <<= ("_|List", PD_OverloadedListType) <<+ (local_cons_and_nil_idents, PD_OverloadedConsSymbol) <<+ (local_cons_and_nil_idents, PD_OverloadedNilSymbol) - <<= ("_Array", PD_LazyArrayType) <<= ("_!Array", PD_StrictArrayType) <<= (PD_UnboxedArray_String, PD_UnboxedArrayType) - <<= ("_type_code", PD_TypeCodeMember) - <<= ("_dummyForStrictAlias", PD_DummyForStrictAliasFun) // MW++ + fill_table_without_hashing hash_table + = build_variables 0 32 (build_tuples 2 32 hash_table) + <<= (local_predefined_idents, PD_PredefinedModule) + <<= (local_predefined_idents, PD_StringType) + <<= (local_predefined_idents, PD_ListType) <<= (local_predefined_idents, PD_ConsSymbol)<<= (local_predefined_idents, PD_NilSymbol) + <<= (local_predefined_idents, PD_StrictListType) <<= (local_predefined_idents, PD_StrictConsSymbol) <<= (local_predefined_idents, PD_StrictNilSymbol) + <<= (local_predefined_idents, PD_UnboxedListType) <<= (local_predefined_idents, PD_UnboxedConsSymbol) <<= (local_predefined_idents, PD_UnboxedNilSymbol) + <<= (local_predefined_idents, PD_TailStrictListType) <<= (local_predefined_idents, PD_TailStrictConsSymbol) <<= (local_predefined_idents, PD_TailStrictNilSymbol) + <<= (local_predefined_idents, PD_StrictTailStrictListType) <<= (local_predefined_idents, PD_StrictTailStrictConsSymbol) <<= (local_predefined_idents, PD_StrictTailStrictNilSymbol) + <<= (local_predefined_idents, PD_UnboxedTailStrictListType) <<= (local_predefined_idents, PD_UnboxedTailStrictConsSymbol) <<= (local_predefined_idents, PD_UnboxedTailStrictNilSymbol) + <<= (local_predefined_idents, PD_OverloadedListType) <<= (local_predefined_idents, PD_OverloadedConsSymbol) <<= (local_predefined_idents, PD_OverloadedNilSymbol) + <<= (local_predefined_idents, PD_LazyArrayType) + <<= (local_predefined_idents, PD_StrictArrayType) + <<= (local_predefined_idents, PD_UnboxedArrayType) + <<= (local_predefined_idents, PD_TypeCodeMember) + <<= (local_predefined_idents, PD_DummyForStrictAliasFun) // MW++ where - - build_tuples tup_arity max_arity tables + build_tuples tup_arity max_arity hash_table | tup_arity > max_arity - = tables - # tup_name = "_Tuple" +++ toString tup_arity - = build_tuples (inc tup_arity) max_arity (tables <<= (tup_name, GetTupleTypeIndex tup_arity) - <<= (tup_name, GetTupleConsIndex tup_arity)) + = hash_table + = build_tuples (inc tup_arity) max_arity (hash_table <<= (local_predefined_idents, GetTupleTypeIndex tup_arity) + <<= (local_predefined_idents, GetTupleConsIndex tup_arity)) - build_variables var_number max_arity tables + build_variables var_number max_arity hash_table | var_number == max_arity - = tables - # var_name = "a" +++ toString var_number - = build_variables (inc var_number) max_arity (tables <<= (var_name, PD_TypeVar_a0 + var_number)) - - fill_table_with_hashing tables - # (predefs, hash_table) = tables - <<- ("_SystemArray", IC_Module, PD_StdArray) <<- ("StdEnum", IC_Module, PD_StdEnum) <<- ("StdBool", IC_Module, PD_StdBool) - <<- ("&&", IC_Expression, PD_AndOp) <<- ("||", IC_Expression, PD_OrOp) - <<- ("Array", IC_Class, PD_ArrayClass) - <<- ("createArray", IC_Expression, PD_CreateArrayFun) - <<- ("_createArray", IC_Expression, PD__CreateArrayFun) - <<- ("select", IC_Expression, PD_ArraySelectFun) - <<- ("uselect", IC_Expression, PD_UnqArraySelectFun) - <<- ("update", IC_Expression, PD_ArrayUpdateFun) - <<- ("replace", IC_Expression, PD_ArrayReplaceFun) - <<- ("size", IC_Expression, PD_ArraySizeFun) - <<- ("usize", IC_Expression, PD_UnqArraySizeFun) - - <<- ("StdStrictLists", IC_Module, PD_StdStrictLists) - <<- ("cons", IC_Expression, PD_cons) - <<- ("decons", IC_Expression, PD_decons) - <<- ("nil", IC_Expression, PD_nil) - - <<- ("cons_u", IC_Expression, PD_cons_u) - <<- ("decons_u", IC_Expression, PD_decons_u) - <<- ("nil_u", IC_Expression, PD_nil_u) - - <<- ("cons_uts", IC_Expression, PD_cons_uts) - <<- ("decons_uts", IC_Expression, PD_decons_uts) - <<- ("nil_uts", IC_Expression, PD_nil_uts) - - <<- ("List", IC_Class, PD_ListClass) - <<- ("UList", IC_Class, PD_UListClass) - <<- ("UTSList", IC_Class, PD_UTSListClass) - -// RWS ... <<- ("_smaller", IC_Expression, PD_SmallerFun) <<- ("_inc", IC_Expression, PD_IncFun) - <<- ("<", IC_Expression, PD_SmallerFun) - <<- ("<=", IC_Expression, PD_LessOrEqualFun) - <<- ("inc", IC_Expression, PD_IncFun) - <<- ("-", IC_Expression, PD_SubFun) -// ... RWS - <<- ("_from", IC_Expression, PD_From) <<- ("_from_then", IC_Expression, PD_FromThen) - <<- ("_from_to", IC_Expression, PD_FromTo) <<- ("_from_then_to", IC_Expression, PD_FromThenTo) + = hash_table + = build_variables (inc var_number) max_arity (hash_table <<= (local_predefined_idents, PD_TypeVar_a0 + var_number)) + + fill_table_with_hashing hash_table + # hash_table = hash_table + <<- (local_predefined_idents, IC_Module, PD_StdArray) + <<- (local_predefined_idents, IC_Module, PD_StdEnum) + <<- (local_predefined_idents, IC_Module, PD_StdBool) + <<- (local_predefined_idents, IC_Expression, PD_AndOp) + <<- (local_predefined_idents, IC_Expression, PD_OrOp) + <<- (local_predefined_idents, IC_Class, PD_ArrayClass) + <<- (local_predefined_idents, IC_Expression, PD_CreateArrayFun) + <<- (local_predefined_idents, IC_Expression, PD__CreateArrayFun) + <<- (local_predefined_idents, IC_Expression, PD_ArraySelectFun) + <<- (local_predefined_idents, IC_Expression, PD_UnqArraySelectFun) + <<- (local_predefined_idents, IC_Expression, PD_ArrayUpdateFun) + <<- (local_predefined_idents, IC_Expression, PD_ArrayReplaceFun) + <<- (local_predefined_idents, IC_Expression, PD_ArraySizeFun) + <<- (local_predefined_idents, IC_Expression, PD_UnqArraySizeFun) + + <<- (local_predefined_idents, IC_Module, PD_StdStrictLists) + <<- (local_predefined_idents, IC_Expression, PD_cons) + <<- (local_predefined_idents, IC_Expression, PD_decons) + <<- (local_predefined_idents, IC_Expression, PD_nil) + + <<- (local_predefined_idents, IC_Expression, PD_cons_u) + <<- (local_predefined_idents, IC_Expression, PD_decons_u) + <<- (local_predefined_idents, IC_Expression, PD_nil_u) + + <<- (local_predefined_idents, IC_Expression, PD_cons_uts) + <<- (local_predefined_idents, IC_Expression, PD_decons_uts) + <<- (local_predefined_idents, IC_Expression, PD_nil_uts) + + <<- (local_predefined_idents, IC_Class, PD_ListClass) + <<- (local_predefined_idents, IC_Class, PD_UListClass) + <<- (local_predefined_idents, IC_Class, PD_UTSListClass) - <<- ("TC", IC_Class, PD_TypeCodeClass) - <<- ("T_ypeObjectType", IC_Type, PD_TypeObjectType) - <<- ("T_ypeConsSymbol", IC_Expression, PD_TypeConsSymbol) - <<- ("P_laceholder", IC_Expression, PD_variablePlaceholder) - <<- ("_unify", IC_Expression, PD_unify) - <<- ("_coerce", IC_Expression, PD_coerce) /* MV */ - <<- (UnderscoreSystemDynamicModule_String, IC_Module, PD_StdDynamic) - <<- ("_undo_indirections", IC_Expression, PD_undo_indirections) -// MV.. - <<- (DynamicRepresentation_String, IC_Type, PD_DynamicTemp) - <<- ("__Module", IC_Expression, PD_ModuleConsSymbol) - <<- ("T_ypeID", IC_Type, PD_TypeID) - <<- ("ModuleID", IC_Expression, PD_ModuleID) -// ..MV + <<- (local_predefined_idents, IC_Expression, PD_SmallerFun) + <<- (local_predefined_idents, IC_Expression, PD_LessOrEqualFun) + <<- (local_predefined_idents, IC_Expression, PD_IncFun) + <<- (local_predefined_idents, IC_Expression, PD_SubFun) + + <<- (local_predefined_idents, IC_Expression, PD_From) + <<- (local_predefined_idents, IC_Expression, PD_FromThen) + <<- (local_predefined_idents, IC_Expression, PD_FromTo) + <<- (local_predefined_idents, IC_Expression, PD_FromThenTo) -// AA.. - <<- ("StdGeneric", IC_Module, PD_StdGeneric) - <<- ("ISO", IC_Type, PD_TypeISO) - <<- ("_ISO", IC_Expression, PD_ConsISO) - //<<- ("iso_from", IC_Field {id_name="", id_info=nilPtr}, PD_iso_from) - //<<- ("iso_to", IC_Field {id_name="", id_info=nilPtr}, PD_iso_to) - <<- ("UNIT", IC_Type, PD_TypeUNIT) - <<- ("UNIT", IC_Expression, PD_ConsUNIT) - <<- ("EITHER", IC_Type, PD_TypeEITHER) - <<- ("LEFT", IC_Expression, PD_ConsLEFT) - <<- ("RIGHT", IC_Expression, PD_ConsRIGHT) - <<- ("PAIR", IC_Type, PD_TypePAIR) - <<- ("PAIR", IC_Expression, PD_ConsPAIR) - <<- ("ARROW", IC_Type, PD_TypeARROW) - <<- ("ARROW", IC_Expression, PD_ConsARROW) - <<- ("isomap_ARROW_", IC_Expression, PD_isomap_ARROW_) - <<- ("isomap_ID", IC_Expression, PD_isomap_ID) - <<- ("ConsDefInfo", IC_Type, PD_TypeConsDefInfo) - <<- ("_ConsDefInfo", IC_Expression, PD_ConsConsDefInfo) - <<- ("TypeDefInfo", IC_Type, PD_TypeTypeDefInfo) - <<- ("_TypeDefInfo", IC_Expression, PD_ConsTypeDefInfo) - <<- ("CONS", IC_Type, PD_TypeCONS) - <<- ("CONS", IC_Expression, PD_ConsCONS) - <<- ("CONS_INFO", IC_Expression, PD_cons_info) - <<- ("Type", IC_Type, PD_TypeType) - <<- ("TypeApp", IC_Expression, PD_ConsTypeApp) - <<- ("TypeVar", IC_Expression, PD_ConsTypeVar) - - <<- ("StdMisc", IC_Module, PD_StdMisc) - <<- ("abort", IC_Expression, PD_abort) - <<- ("undef", IC_Expression, PD_undef) -// ..AA + <<- (local_predefined_idents, IC_Class, PD_TypeCodeClass) + <<- (local_predefined_idents, IC_Type, PD_TypeObjectType) + <<- (local_predefined_idents, IC_Expression, PD_TypeConsSymbol) + <<- (local_predefined_idents, IC_Expression, PD_variablePlaceholder) + <<- (local_predefined_idents, IC_Expression, PD_unify) + <<- (local_predefined_idents, IC_Expression, PD_coerce) /* MV */ + <<- (local_predefined_idents, IC_Module, PD_StdDynamic) + <<- (local_predefined_idents, IC_Expression, PD_undo_indirections) + + <<- (local_predefined_idents, IC_Type, PD_DynamicTemp) + <<- (local_predefined_idents, IC_Expression, PD_ModuleConsSymbol) + <<- (local_predefined_idents, IC_Type, PD_TypeID) + <<- (local_predefined_idents, IC_Expression, PD_ModuleID) + + <<- (local_predefined_idents, IC_Module, PD_StdGeneric) + <<- (local_predefined_idents, IC_Type, PD_TypeISO) + <<- (local_predefined_idents, IC_Expression, PD_ConsISO) + <<- (local_predefined_idents, IC_Type, PD_TypeUNIT) + <<- (local_predefined_idents, IC_Expression, PD_ConsUNIT) + <<- (local_predefined_idents, IC_Type, PD_TypeEITHER) + <<- (local_predefined_idents, IC_Expression, PD_ConsLEFT) + <<- (local_predefined_idents, IC_Expression, PD_ConsRIGHT) + <<- (local_predefined_idents, IC_Type, PD_TypePAIR) + <<- (local_predefined_idents, IC_Expression, PD_ConsPAIR) + <<- (local_predefined_idents, IC_Type, PD_TypeARROW) + <<- (local_predefined_idents, IC_Expression, PD_ConsARROW) + <<- (local_predefined_idents, IC_Expression, PD_isomap_ARROW_) + <<- (local_predefined_idents, IC_Expression, PD_isomap_ID) + <<- (local_predefined_idents, IC_Type, PD_TypeConsDefInfo) + <<- (local_predefined_idents, IC_Expression, PD_ConsConsDefInfo) + <<- (local_predefined_idents, IC_Type, PD_TypeTypeDefInfo) + <<- (local_predefined_idents, IC_Expression, PD_ConsTypeDefInfo) + <<- (local_predefined_idents, IC_Type, PD_TypeCONS) + <<- (local_predefined_idents, IC_Expression, PD_ConsCONS) + <<- (local_predefined_idents, IC_Expression, PD_cons_info) + <<- (local_predefined_idents, IC_Type, PD_TypeType) + <<- (local_predefined_idents, IC_Expression, PD_ConsTypeApp) + <<- (local_predefined_idents, IC_Expression, PD_ConsTypeVar) + + <<- (local_predefined_idents, IC_Module, PD_StdMisc) + <<- (local_predefined_idents, IC_Expression, PD_abort) + <<- (local_predefined_idents, IC_Expression, PD_undef) - <<- ("Start", IC_Expression, PD_Start) + <<- (local_predefined_idents, IC_Expression, PD_Start) - # ({pds_ident}, predefs) = predefs![PD_TypeISO] - # (predefs, hash_table)= (predefs, hash_table) - <<- ("iso_from", IC_Field pds_ident, PD_iso_from) - <<- ("iso_to", IC_Field pds_ident, PD_iso_to) + # type_iso_ident = local_predefined_idents.[PD_TypeISO] + # hash_table= hash_table + <<- (local_predefined_idents, IC_Field type_iso_ident, PD_iso_from) + <<- (local_predefined_idents, IC_Field type_iso_ident, PD_iso_to) - # ({pds_ident}, predefs) = predefs![PD_DynamicTemp] - # (predefs, hash_table)= (predefs, hash_table) - <<- ("type", IC_Field pds_ident, PD_DynamicType) - <<- ("value", IC_Field pds_ident, PD_DynamicValue) - <<- ("Start", IC_Expression, PD_Start) - = (predefs, hash_table) + # dynamic_temp_ident = local_predefined_idents.[PD_DynamicTemp] + # hash_table = hash_table + <<- (local_predefined_idents, IC_Field dynamic_temp_ident, PD_DynamicType) + <<- (local_predefined_idents, IC_Field dynamic_temp_ident, PD_DynamicValue) + + = hash_table MakeTupleConsSymbIndex arity :== arity - 2 + (PD_Arity2TupleSymbol-FirstConstructorPredefinedSymbolIndex) @@ -385,62 +506,62 @@ cTCInstanceSymbIndex :== 0 make_type_def :: !Int ![TypeVar] !a !*{#PredefinedSymbol} -> (!TypeDef a,!.{#PredefinedSymbol}) make_type_def type_cons_index type_vars type_rhs pre_def_symbols - # (type_ident, pre_def_symbols) = pre_def_symbols![type_cons_index] - = (MakeTypeDef type_ident.pds_ident (map (\tv -> MakeAttributedTypeVar tv) type_vars) type_rhs TA_None [] NoPos, pre_def_symbols) + # type_cons_ident = predefined_idents.[type_cons_index] + = (MakeTypeDef type_cons_ident (map (\tv -> MakeAttributedTypeVar tv) type_vars) type_rhs TA_None [] NoPos, pre_def_symbols) make_list_definition :: Int Int Int Ident TypeVar AType *{#PredefinedSymbol} -> (!TypeDef TypeRhs,!ConsDef,!ConsDef,!.{#PredefinedSymbol}) make_list_definition list_type_pre_def_symbol_index cons_pre_def_symbol_index nil_pre_def_symbol_index pre_mod_id type_var type_var_with_attr pre_def_symbols - # (cons_id, pre_def_symbols) = pre_def_symbols![cons_pre_def_symbol_index] - (nil_id, pre_def_symbols) = pre_def_symbols![nil_pre_def_symbol_index] - (list_id, pre_def_symbols) = pre_def_symbols![list_type_pre_def_symbol_index] - cons_symb = { ds_ident = cons_id.pds_ident, ds_arity = 2, ds_index = cons_pre_def_symbol_index-FirstConstructorPredefinedSymbolIndex } - nil_symb = { ds_ident = nil_id.pds_ident, ds_arity=0 ,ds_index = nil_pre_def_symbol_index-FirstConstructorPredefinedSymbolIndex } + # cons_ident = predefined_idents.[cons_pre_def_symbol_index] + nil_ident = predefined_idents.[nil_pre_def_symbol_index] + list_ident = predefined_idents.[list_type_pre_def_symbol_index] + + cons_symb = { ds_ident = cons_ident, ds_arity = 2, ds_index = cons_pre_def_symbol_index-FirstConstructorPredefinedSymbolIndex } + nil_symb = { ds_ident = nil_ident, ds_arity=0 ,ds_index = nil_pre_def_symbol_index-FirstConstructorPredefinedSymbolIndex } (list_def, pre_def_symbols) = make_type_def list_type_pre_def_symbol_index [type_var] (AlgType [cons_symb,nil_symb]) pre_def_symbols - list_type = MakeAttributedType (TA (MakeNewTypeSymbIdent list_id.pds_ident 1) [type_var_with_attr]) - cons_def = { pc_cons_name = cons_id.pds_ident, pc_cons_arity = 2, pc_arg_types = [type_var_with_attr, list_type], + list_type = MakeAttributedType (TA (MakeNewTypeSymbIdent list_ident 1) [type_var_with_attr]) + cons_def = { pc_cons_name = cons_ident, pc_cons_arity = 2, pc_arg_types = [type_var_with_attr, list_type], pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id} - nil_def = { pc_cons_name = nil_id.pds_ident, pc_cons_arity = 0, pc_arg_types = [], + nil_def = { pc_cons_name = nil_ident, pc_cons_arity = 0, pc_arg_types = [], pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id} = (list_def,ParsedConstructorToConsDef cons_def,ParsedConstructorToConsDef nil_def,pre_def_symbols); buildPredefinedModule :: !*PredefinedSymbols -> (!ScannedModule, !.PredefinedSymbols) buildPredefinedModule pre_def_symbols - # (type_var_id, pre_def_symbols) = pre_def_symbols![PD_TypeVar_a0] - (string_id, pre_def_symbols) = pre_def_symbols![PD_StringType] - (unb_array_id, pre_def_symbols) = pre_def_symbols![PD_UnboxedArrayType] - (pre_mod_symb, pre_def_symbols) = pre_def_symbols![PD_PredefinedModule] - (alias_dummy_symb,pre_def_symbols)= pre_def_symbols![PD_DummyForStrictAliasFun] - pre_mod_id = pre_mod_symb.pds_ident - - type_var = MakeTypeVar type_var_id.pds_ident + # type_var_ident = predefined_idents.[PD_TypeVar_a0] + string_ident = predefined_idents.[PD_StringType] + unb_array_ident = predefined_idents.[PD_UnboxedArrayType] + pre_mod_ident = predefined_idents.[PD_PredefinedModule] + alias_dummy_ident = predefined_idents.[PD_DummyForStrictAliasFun] + + type_var = MakeTypeVar type_var_ident type_var_with_attr = MakeAttributedType (TV type_var) - unb_arr_of_char_type = MakeAttributedType (TA (MakeNewTypeSymbIdent unb_array_id.pds_ident 1) [MakeAttributedType (TB BT_Char)]) + unb_arr_of_char_type = MakeAttributedType (TA (MakeNewTypeSymbIdent unb_array_ident 1) [MakeAttributedType (TB BT_Char)]) (string_def, pre_def_symbols) = make_type_def PD_StringType [] (SynType unb_arr_of_char_type) pre_def_symbols (list_def,cons_def,nil_def,pre_def_symbols) - = make_list_definition PD_ListType PD_ConsSymbol PD_NilSymbol pre_mod_id type_var type_var_with_attr pre_def_symbols + = make_list_definition PD_ListType PD_ConsSymbol PD_NilSymbol pre_mod_ident type_var type_var_with_attr pre_def_symbols (strict_list_def,strict_cons_def,strict_nil_def,pre_def_symbols) - = make_list_definition PD_StrictListType PD_StrictConsSymbol PD_StrictNilSymbol pre_mod_id type_var type_var_with_attr pre_def_symbols + = make_list_definition PD_StrictListType PD_StrictConsSymbol PD_StrictNilSymbol pre_mod_ident type_var type_var_with_attr pre_def_symbols (unboxed_list_def,unboxed_cons_def,unboxed_nil_def,pre_def_symbols) - = make_list_definition PD_UnboxedListType PD_UnboxedConsSymbol PD_UnboxedNilSymbol pre_mod_id type_var type_var_with_attr pre_def_symbols + = make_list_definition PD_UnboxedListType PD_UnboxedConsSymbol PD_UnboxedNilSymbol pre_mod_ident type_var type_var_with_attr pre_def_symbols (tail_strict_list_def,tail_strict_cons_def,tail_strict_nil_def,pre_def_symbols) - = make_list_definition PD_TailStrictListType PD_TailStrictConsSymbol PD_TailStrictNilSymbol pre_mod_id type_var type_var_with_attr pre_def_symbols + = make_list_definition PD_TailStrictListType PD_TailStrictConsSymbol PD_TailStrictNilSymbol pre_mod_ident type_var type_var_with_attr pre_def_symbols (strict_tail_strict_list_def,strict_tail_strict_cons_def,strict_tail_strict_nil_def,pre_def_symbols) - = make_list_definition PD_StrictTailStrictListType PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol pre_mod_id type_var type_var_with_attr pre_def_symbols + = make_list_definition PD_StrictTailStrictListType PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol pre_mod_ident type_var type_var_with_attr pre_def_symbols (unboxed_tail_strict_list_def,unboxed_tail_strict_cons_def,unboxed_tail_strict_nil_def,pre_def_symbols) - = make_list_definition PD_UnboxedTailStrictListType PD_UnboxedTailStrictConsSymbol PD_UnboxedTailStrictNilSymbol pre_mod_id type_var type_var_with_attr pre_def_symbols + = make_list_definition PD_UnboxedTailStrictListType PD_UnboxedTailStrictConsSymbol PD_UnboxedTailStrictNilSymbol pre_mod_ident type_var type_var_with_attr pre_def_symbols (overloaded_list_def,overloaded_cons_def,overloaded_nil_def,pre_def_symbols) - = make_list_definition PD_OverloadedListType PD_OverloadedConsSymbol PD_OverloadedNilSymbol pre_mod_id type_var type_var_with_attr pre_def_symbols + = make_list_definition PD_OverloadedListType PD_OverloadedConsSymbol PD_OverloadedNilSymbol pre_mod_ident type_var type_var_with_attr pre_def_symbols (array_def, pre_def_symbols) = make_type_def PD_LazyArrayType [type_var] (AbstractType cAllBitsClear) pre_def_symbols (strict_def, pre_def_symbols) = make_type_def PD_StrictArrayType [type_var] (AbstractType cIsHyperStrict) pre_def_symbols (unboxed_def, pre_def_symbols) = make_type_def PD_UnboxedArrayType [type_var] (AbstractType cIsHyperStrict) pre_def_symbols - (type_defs, cons_defs, pre_def_symbols) = add_tuple_defs pre_mod_id MaxTupleArity [array_def,strict_def,unboxed_def] [] pre_def_symbols - alias_dummy_type = make_identity_fun_type alias_dummy_symb.pds_ident type_var // MW++ + (type_defs, cons_defs, pre_def_symbols) = add_tuple_defs pre_mod_ident MaxTupleArity [array_def,strict_def,unboxed_def] [] pre_def_symbols + alias_dummy_type = make_identity_fun_type alias_dummy_ident type_var (class_def, member_def, pre_def_symbols) = make_TC_class_def pre_def_symbols - = ({ mod_name = pre_mod_id, mod_modification_time = "", mod_type = MK_System, mod_imports = [], mod_imported_objects = [], + = ({ mod_name = pre_mod_ident, mod_modification_time = "", mod_type = MK_System, mod_imports = [], mod_imported_objects = [], mod_defs = { def_types = [string_def, list_def,strict_list_def,unboxed_list_def,tail_strict_list_def,strict_tail_strict_list_def,unboxed_tail_strict_list_def,overloaded_list_def : type_defs], def_constructors = [cons_def,strict_cons_def,unboxed_cons_def,tail_strict_cons_def,strict_tail_strict_cons_def,unboxed_tail_strict_cons_def,overloaded_cons_def, @@ -452,11 +573,11 @@ where add_tuple_defs pre_mod_id tup_arity type_defs cons_defs pre_def_symbols | tup_arity >= 2 # (type_vars, pre_def_symbols) = make_type_vars tup_arity [] pre_def_symbols - (tuple_id, pre_def_symbols) = pre_def_symbols![GetTupleConsIndex tup_arity] - tuple_cons_symb = { ds_ident = tuple_id.pds_ident, ds_index = MakeTupleConsSymbIndex tup_arity, ds_arity = tup_arity } + tuple_ident = predefined_idents.[GetTupleConsIndex tup_arity] + tuple_cons_symb = { ds_ident = tuple_ident, ds_index = MakeTupleConsSymbIndex tup_arity, ds_arity = tup_arity } (tuple_type_def, pre_def_symbols) = make_type_def (GetTupleTypeIndex tup_arity) type_vars (AlgType [tuple_cons_symb]) pre_def_symbols - tuple_cons_def = { pc_cons_name = tuple_id.pds_ident, pc_cons_arity = tup_arity, pc_cons_pos = PreDefPos pre_mod_id, + tuple_cons_def = { pc_cons_name = tuple_ident, pc_cons_arity = tup_arity, pc_cons_pos = PreDefPos pre_mod_id, pc_arg_types = [ MakeAttributedType (TV tv) \\ tv <- type_vars], pc_cons_prio = NoPrio, pc_exi_vars = []} = add_tuple_defs pre_mod_id (dec tup_arity) [tuple_type_def : type_defs] [ParsedConstructorToConsDef tuple_cons_def : cons_defs] pre_def_symbols = (type_defs, cons_defs, pre_def_symbols) @@ -465,28 +586,28 @@ where | nr_of_vars == 0 = (type_vars, pre_def_symbols) # nr_of_vars = dec nr_of_vars - # (var_id, pre_def_symbols) = pre_def_symbols![PD_TypeVar_a0 + nr_of_vars] - = make_type_vars nr_of_vars [MakeTypeVar var_id.pds_ident : type_vars] pre_def_symbols + # var_ident = predefined_idents.[PD_TypeVar_a0 + nr_of_vars] + = make_type_vars nr_of_vars [MakeTypeVar var_ident : type_vars] pre_def_symbols make_TC_class_def pre_def_symbols - # (tc_class_name, pre_def_symbols) = pre_def_symbols![PD_TypeCodeClass] - (type_var_id, pre_def_symbols) = pre_def_symbols![PD_TypeVar_a0] - (tc_member_name, pre_def_symbols) = pre_def_symbols![PD_TypeCodeMember] + # tc_class_name = predefined_idents.[PD_TypeCodeClass] + type_var_ident = predefined_idents.[PD_TypeVar_a0] + tc_member_name = predefined_idents.[PD_TypeCodeMember] - class_var = MakeTypeVar type_var_id.pds_ident + class_var = MakeTypeVar type_var_ident me_type = { st_vars = [], st_args = [], st_arity = 0, st_result = { at_attribute = TA_None, at_annotation = AN_None, at_type = TV class_var }, - st_context = [ {tc_class = {glob_module = NoIndex, glob_object = {ds_ident = tc_class_name.pds_ident, ds_arity = 1, ds_index = NoIndex }}, + st_context = [ {tc_class = {glob_module = NoIndex, glob_object = {ds_ident = tc_class_name, ds_arity = 1, ds_index = NoIndex }}, tc_types = [ TV class_var ], tc_var = nilPtr}], st_attr_vars = [], st_attr_env = [] } - member_def = { me_symb = tc_member_name.pds_ident, me_type = me_type, me_pos = NoPos, me_priority = NoPrio, + member_def = { me_symb = tc_member_name, me_type = me_type, me_pos = NoPos, me_priority = NoPrio, me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr } - class_def = { class_name = tc_class_name.pds_ident, class_arity = 1, class_args = [class_var], class_context = [], - class_members = {{ds_ident = tc_member_name.pds_ident, ds_index = cTCMemberSymbIndex, ds_arity = 0 }}, class_cons_vars = 0, - class_dictionary = { ds_ident = { tc_class_name.pds_ident & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }, class_pos = NoPos, + class_def = { class_name = tc_class_name, class_arity = 1, class_args = [class_var], class_context = [], + class_members = {{ds_ident = tc_member_name, ds_index = cTCMemberSymbIndex, ds_arity = 0 }}, class_cons_vars = 0, + class_dictionary = { ds_ident = { tc_class_name & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }, class_pos = NoPos, class_arg_kinds = [] } = (class_def, member_def, pre_def_symbols) @@ -498,9 +619,7 @@ where st_attr_vars = [], st_attr_env = [] } // !.a -> .a = { ft_symb = alias_dummy_id, ft_arity = 1, ft_priority = NoPrio, ft_type = id_symbol_type, ft_pos = NoPos, ft_specials = SP_None, ft_type_ptr = nilPtr } -// ..MW -// MV ... // changes requires recompile of {static,dynamic}-linker plus all dynamics ever made UnderscoreSystemDynamicModule_String :== "_SystemDynamic" diff --git a/frontend/transform.icl b/frontend/transform.icl index a77b8b4..5f01351 100644 --- a/frontend/transform.icl +++ b/frontend/transform.icl @@ -1891,8 +1891,9 @@ where add_dummy_id_for_strict_alias bind_src cos=:{cos_symbol_heap, cos_predef_symbols_for_transform} # (new_app_info_ptr, cos_symbol_heap) = newPtr EI_Empty cos_symbol_heap - {pds_ident, pds_module, pds_def} = cos_predef_symbols_for_transform.predef_alias_dummy - app_symb = { symb_name = pds_ident, + {pds_module, pds_def} = cos_predef_symbols_for_transform.predef_alias_dummy + pds_ident = predefined_idents.[PD_DummyForStrictAliasFun] + app_symb = { symb_name = pds_ident, symb_kind = SK_Function {glob_module = pds_module, glob_object = pds_def}, symb_arity = 1 } = (App { app_symb = app_symb, app_args = [bind_src], app_info_ptr = new_app_info_ptr }, diff --git a/frontend/type.dcl b/frontend/type.dcl index 0d58e90..4e64092 100644 --- a/frontend/type.dcl +++ b/frontend/type.dcl @@ -30,6 +30,5 @@ instance unify AType } class arraySubst type :: !type !u:{!Type} -> (!Bool,!type, !u:{! Type}) -//class arraySubst type :: !type !u:{!Type} -> (!type, !u:{! Type}) instance arraySubst AType diff --git a/frontend/type.icl b/frontend/type.icl index b1f62b3..433a041 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -1735,10 +1735,12 @@ where # fresh_var = TempV var_store tdt_type = { at_attribute = TA_Multi, at_annotation = AN_None, at_type = fresh_var } - # ({pds_ident,pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeClass] + # ({pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeClass] + # pds_ident = predefined_idents.[PD_TypeCodeClass] tc_class_symb = {glob_module = pds_module, glob_object = {ds_ident = pds_ident, ds_arity = 1, ds_index = pds_def }} (pds, predef_symbols) = predef_symbols![PD_TypeCodeMember] - ({pds_ident,pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeMember] + ({pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeMember] + pds_ident = predefined_idents.[PD_TypeCodeMember] tc_member_symb = { symb_name = pds_ident, symb_kind = SK_OverloadedFunction {glob_module = pds_module, glob_object = pds_def }, symb_arity = 0} (new_var_ptr, var_heap) = newPtr VI_Empty var_heap context = {tc_class = tc_class_symb, tc_types = [fresh_var], tc_var = new_var_ptr} @@ -1795,9 +1797,11 @@ where -> (var_heap, var_store) determine_context_and_expr_ptr global_vars (var_heap, expr_heap, type_var_heap, predef_symbols) - # ({pds_ident,pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeClass] + # ({pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeClass] + # pds_ident = predefined_idents.[PD_TypeCodeClass] tc_class_symb = {glob_module = pds_module, glob_object = {ds_ident = pds_ident, ds_arity = 1, ds_index = pds_def }} - ({pds_ident,pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeMember] + ({pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeMember] + pds_ident = predefined_idents.[PD_TypeCodeMember] tc_member_symb = { symb_name = pds_ident, symb_kind = SK_TypeCode, symb_arity = 0} (contexts, (var_heap, type_var_heap)) = mapSt (build_type_context tc_class_symb) global_vars (var_heap, type_var_heap) (expr_ptr, expr_heap) = newPtr EI_Empty expr_heap @@ -2415,7 +2419,8 @@ where convert_array_instances array_instances common_defs fun_defs predef_symbols type_heaps error | isEmpty array_instances = ([],fun_defs, predef_symbols, type_heaps, error) - # ({pds_ident,pds_module,pds_def},predef_symbols) = predef_symbols![PD_UnboxedArrayType] + # ({pds_module,pds_def},predef_symbols) = predef_symbols![PD_UnboxedArrayType] + # pds_ident = predefined_idents.[PD_UnboxedArrayType] unboxed_array_type = TA (MakeTypeSymbIdent { glob_object = pds_def, glob_module = pds_module } pds_ident 0) [] ({pds_module,pds_def},predef_symbols) = predef_symbols![PD_ArrayClass] {class_members} = common_defs.[pds_module].com_class_defs.[pds_def] |