diff options
| -rw-r--r-- | backend/backendconvert.icl | 16 | ||||
| -rw-r--r-- | frontend/analtypes.dcl | 2 | ||||
| -rw-r--r-- | frontend/analtypes.icl | 6 | ||||
| -rw-r--r-- | frontend/check.icl | 1178 | ||||
| -rw-r--r-- | frontend/checksupport.dcl | 73 | ||||
| -rw-r--r-- | frontend/checksupport.icl | 465 | ||||
| -rw-r--r-- | frontend/checktypes.dcl | 3 | ||||
| -rw-r--r-- | frontend/checktypes.icl | 33 | ||||
| -rw-r--r-- | frontend/containers.dcl | 49 | ||||
| -rw-r--r-- | frontend/containers.icl | 309 | ||||
| -rw-r--r-- | frontend/explicitimports.dcl | 17 | ||||
| -rw-r--r-- | frontend/explicitimports.icl | 663 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 36 | ||||
| -rw-r--r-- | frontend/syntax.icl | 94 | ||||
| -rw-r--r-- | frontend/type.dcl | 2 | ||||
| -rw-r--r-- | frontend/type.icl | 2 | ||||
| -rw-r--r-- | frontend/utilities.dcl | 47 | ||||
| -rw-r--r-- | frontend/utilities.icl | 133 |
18 files changed, 2202 insertions, 926 deletions
diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl index aa85086..ecca95b 100644 --- a/backend/backendconvert.icl +++ b/backend/backendconvert.icl @@ -415,24 +415,24 @@ backEndConvertModulesH predefs {fe_icl = fe_icl =: {icl_name, icl_functions, icl functionIndices = flatten [[(componentIndex, member) \\ member <- group.group_members] \\ group <-: fe_components & componentIndex <- [0..]] -declareOtherDclModules :: {#DclModule} Int ModuleNumberSet -> BackEnder +declareOtherDclModules :: {#DclModule} Int NumberSet -> BackEnder declareOtherDclModules dcls main_dcl_module_n used_module_numbers = foldStateWithIndexA declareOtherDclModule dcls where declareOtherDclModule :: ModuleIndex DclModule -> BackEnder declareOtherDclModule moduleIndex dclModule - | moduleIndex == main_dcl_module_n || moduleIndex == cPredefinedModuleIndex || not (in_module_number_set moduleIndex used_module_numbers) + | moduleIndex == main_dcl_module_n || moduleIndex == cPredefinedModuleIndex || not (inNumberSet moduleIndex used_module_numbers) = identity // otherwise = declareDclModule moduleIndex dclModule -defineOtherDclModules :: {#DclModule} Int ModuleNumberSet VarHeap -> BackEnder +defineOtherDclModules :: {#DclModule} Int NumberSet VarHeap -> BackEnder defineOtherDclModules dcls main_dcl_module_n used_module_numbers varHeap = foldStateWithIndexA (defineOtherDclModule varHeap) dcls where defineOtherDclModule :: VarHeap ModuleIndex DclModule -> BackEnder defineOtherDclModule varHeap moduleIndex dclModule - | moduleIndex == main_dcl_module_n || moduleIndex == cPredefinedModuleIndex || not (in_module_number_set moduleIndex used_module_numbers) + | moduleIndex == main_dcl_module_n || moduleIndex == cPredefinedModuleIndex || not (inNumberSet moduleIndex used_module_numbers) = identity // otherwise = defineDclModule varHeap moduleIndex dclModule @@ -455,13 +455,13 @@ defineDclModule varHeap moduleIndex {dcl_name, dcl_common, dcl_functions, dcl_is = declare moduleIndex varHeap dcl_common o` declareFunTypes moduleIndex dcl_functions dcl_instances.ir_from varHeap -removeExpandedTypesFromDclModules :: {#DclModule} ModuleNumberSet -> BackEnder +removeExpandedTypesFromDclModules :: {#DclModule} NumberSet -> BackEnder removeExpandedTypesFromDclModules dcls used_module_numbers = foldStateWithIndexA removeExpandedTypesFromDclModule dcls where removeExpandedTypesFromDclModule :: ModuleIndex DclModule -> BackEnder removeExpandedTypesFromDclModule moduleIndex dclModule=:{dcl_functions} - | moduleIndex == cPredefinedModuleIndex || not (in_module_number_set moduleIndex used_module_numbers) + | moduleIndex == cPredefinedModuleIndex || not (inNumberSet moduleIndex used_module_numbers) = identity = foldStateWithIndexA (removeExpandedTypesFromFunType moduleIndex) dcl_functions where @@ -877,7 +877,7 @@ predefineSymbols {dcl_common} predefs , asai_varHeap :: !VarHeap } -adjustArrayFunctions :: PredefinedSymbols IndexRange Int {#FunDef} {#DclModule} {#ClassInstance} ModuleNumberSet VarHeap -> BackEnder +adjustArrayFunctions :: PredefinedSymbols IndexRange Int {#FunDef} {#DclModule} {#ClassInstance} NumberSet VarHeap -> BackEnder adjustArrayFunctions predefs arrayInstancesRange main_dcl_module_n functions dcls icl_instances used_module_numbers varHeap = adjustStdArray arrayInfo predefs (if (arrayModuleIndex == main_dcl_module_n) icl_instances stdArray.dcl_common.com_instance_defs) @@ -931,7 +931,7 @@ adjustArrayFunctions predefs arrayInstancesRange main_dcl_module_n functions dcl adjustStdArray :: AdjustStdArrayInfo PredefinedSymbols {#ClassInstance} -> BackEnder adjustStdArray arrayInfo predefs instances - | arrayModuleIndex == NoIndex || not (in_module_number_set arrayModuleIndex used_module_numbers) + | arrayModuleIndex == NoIndex || not (inNumberSet arrayModuleIndex used_module_numbers) // || arrayModuleIndex <> main_dcl_module_n = identity // otherwise diff --git a/frontend/analtypes.dcl b/frontend/analtypes.dcl index b955243..5203a68 100644 --- a/frontend/analtypes.dcl +++ b/frontend/analtypes.dcl @@ -2,6 +2,6 @@ definition module analtypes import checksupport, typesupport -analTypeDefs :: !{#CommonDefs} !ModuleNumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin) +analTypeDefs :: !{#CommonDefs} !NumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin) instance <<< TypeKind diff --git a/frontend/analtypes.icl b/frontend/analtypes.icl index dd48784..2dd5715 100644 --- a/frontend/analtypes.icl +++ b/frontend/analtypes.icl @@ -199,7 +199,7 @@ where # (mark, ({con_var_binds,con_top_var_binds}, as)) = analTypeDef modules module_index type_index as = (mark, ({con_top_var_binds = con_top_var_binds ++ conds.con_top_var_binds, con_var_binds = con_var_binds ++ conds.con_var_binds}, as)) = (mark, (conds, as)) - + analTypes has_root_attr modules form_tvs (arg_type --> res_type) conds_as # (arg_ldep, arg_kind, arg_type_props, conds_as) = analTypes has_root_attr modules form_tvs arg_type conds_as (res_ldep, res_kind, res_type_props, (conds, as=:{as_kind_heap,as_error})) = analTypes has_root_attr modules form_tvs res_type conds_as @@ -456,12 +456,12 @@ where //import RWSDebug -analTypeDefs :: !{#CommonDefs} !ModuleNumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin) +analTypeDefs :: !{#CommonDefs} !NumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin) analTypeDefs modules used_module_numbers heaps error // #! modules = modules ---> "analTypeDefs" // # sizes = [ size mod.com_type_defs - size mod.com_class_defs \\ mod <-: modules ] // # used_module_numbers = used_module_numbers <<- used_module_numbers - # sizes = [ if (in_module_number_set module_n used_module_numbers) (size mod.com_type_defs - size mod.com_class_defs) 0 \\ mod <-: modules & module_n<-[0..]] + # sizes = [ if (inNumberSet module_n used_module_numbers) (size mod.com_type_defs - size mod.com_class_defs) 0 \\ mod <-: modules & module_n<-[0..]] check_marks = { createArray nr_of_types AS_NotChecked \\ nr_of_types <- sizes } type_def_infos = { createArray nr_of_types EmptyTypeDefInfo \\ nr_of_types <- sizes } diff --git a/frontend/check.icl b/frontend/check.icl index e8b6302..2ed07b4 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -3,9 +3,11 @@ implementation module check import StdEnv import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef -import explicitimports, comparedefimp, checkFunctionBodies +import explicitimports, comparedefimp, checkFunctionBodies, containers cPredefinedModuleIndex :== 1 +cUndef :== (-1) +cDummyArray :== {} isMainModule :: ModuleKind -> Bool isMainModule MK_Main = True @@ -570,8 +572,6 @@ createCommonDefinitions {def_types,def_constructors,def_selectors,def_macros,def , com_instance_defs = { next_instance \\ next_instance <- def_instances } } -//IsMainDclMod is_dcl module_index :== is_dcl && module_index == cIclModIndex - array_plus_list a [] = a array_plus_list a l = arrayPlusList a l @@ -739,7 +739,9 @@ renumber_icl_definitions_as_dcl_definitions _ icl_decl_symbols modules cdefs icl # modules = {modules & [main_dcl_module_n].dcl_conversions=Yes conversion_table} = (icl_decl_symbols,modules,cdefs,cs) -combineDclAndIclModule :: ModuleKind *{#.DclModule} [.Declaration] (CollectedDefinitions a b) *{#.Int} *CheckState -> (!*{#DclModule},![Declaration],!CollectedDefinitions a b,!*{#Int},!.CheckState); + + +combineDclAndIclModule :: ModuleKind *{#.DclModule} [Declaration] (CollectedDefinitions a b) *{#.Int} *CheckState -> (!*{#DclModule},![Declaration],!CollectedDefinitions a b,!*{#Int},!.CheckState); combineDclAndIclModule MK_Main modules icl_decl_symbols icl_definitions icl_sizes cs = (modules, icl_decl_symbols, icl_definitions, icl_sizes, cs) combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs @@ -753,7 +755,8 @@ combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs) = foldSt (add_dcl_definition dcl_common) moved_dcl_defs ([], [], [], [], [], cs) - cs_symbol_table = removeDeclarationsFromSymbolTable icl_decl_symbols cGlobalScope cs.cs_symbol_table + cs_symbol_table + = removeDeclarationsFromSymbolTable icl_decl_symbols cGlobalScope cs.cs_symbol_table = ( { modules & [main_dcl_module_n] = { dcl_mod & dcl_conversions = Yes conversion_table }} , icl_decl_symbols @@ -890,9 +893,359 @@ where (<=<) infixl (<=<) state fun :== fun state +checkDclModules imports_of_icl_mod dcl_modules icl_functions heaps cs=:{cs_symbol_table} + #! nr_of_dcl_modules + = size dcl_modules + # (bitvect, dependencies, dcl_modules, cs_symbol_table) + = iFoldSt add_dependencies 0 nr_of_dcl_modules + (createArray (nr_of_dcl_modules+1) False, gimme_a_strict_array_type (createArray (nr_of_dcl_modules+1) []), + dcl_modules, cs_symbol_table) + index_of_icl_module + = nr_of_dcl_modules + (dependencies_of_icl_mod, (_, cs_symbol_table)) + = mapFilterYesSt get_opt_dependency imports_of_icl_mod (bitvect, cs_symbol_table) + dependencies + = { dependencies & [index_of_icl_module] = dependencies_of_icl_mod } + module_dag + = { dag_nr_of_nodes = nr_of_dcl_modules+1, dag_get_children = select dependencies } + components + = partitionateDAG module_dag [cs.cs_x.x_main_dcl_module_n,index_of_icl_module] + (nr_of_components, component_numbers) + = getComponentNumbers components module_dag.dag_nr_of_nodes + reversed_dag1 + = reverseDAG module_dag + reversed_dag + = { module_dag & dag_get_children = select reversed_dag1 } + super_components + = groupify reversed_dag component_numbers nr_of_components + // module i is imported by components with _component_ numbers super_components.[i] + components_array + = gimme_a_strict_array_type { component \\ component <- components } + (expl_imp_symbols_and_indices_in_components, (dcl_modules, cs_symbol_table)) + = mapSt (get_expl_imp_symbols_of_component imports_of_icl_mod) components (dcl_modules, cs_symbol_table) + (expl_imp_symbols_in_components, expl_imp_indices) + = unzip expl_imp_symbols_and_indices_in_components + expl_imp_infos + = { { ExplImpInfo expl_imp_symbol ikhEmpty + \\ expl_imp_symbol <- expl_imp_symbols_in_component + } + \\ expl_imp_symbols_in_component<-expl_imp_symbols_in_components } + // eii_declaring_modules will be updated later + cs + = { cs & cs_symbol_table = cs_symbol_table } // --->("expl_imp_symbols_in_components", expl_imp_symbols_in_components) + nr_of_icl_component + = component_numbers.[index_of_icl_module] + (_, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + = unsafeFold2St (checkDclComponent super_components) (reverse expl_imp_indices) (reverse components) + (nr_of_components-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) +// # cs = cs--->"------------------------------------" + = (nr_of_icl_component, hd expl_imp_indices!!nr_of_icl_component, expl_imp_infos, + dcl_modules, icl_functions, heaps, cs) + where + add_dependencies mod_index (bitvect, dependencies, dcl_modules, cs_symbol_table) + // all i: not bitvect.[i] + | mod_index==cPredefinedModuleIndex + = (bitvect, dependencies, dcl_modules, cs_symbol_table) + # ({dcl_name}, dcl_modules) + = dcl_modules![mod_index] + ({ste_kind=STE_Module {mod_imports}, ste_index}, cs_symbol_table) + = readPtr dcl_name.id_info cs_symbol_table + (dependencies_of_mod, (bitvect, cs_symbol_table)) + = mapFilterYesSt get_opt_dependency mod_imports (bitvect, cs_symbol_table) + (bitvect, cs_symbol_table) + = foldSt set_to_false mod_imports (bitvect, cs_symbol_table) + = (bitvect, { dependencies & [mod_index] = dependencies_of_mod }, dcl_modules, cs_symbol_table) + + get_opt_dependency {import_module} (already_visited, cs_symbol_table) + # ({ste_index}, cs_symbol_table) + = readPtr import_module.id_info cs_symbol_table + | already_visited.[ste_index] + = (No, (already_visited, cs_symbol_table)) + = (Yes ste_index, ({ already_visited & [ste_index] = True }, cs_symbol_table)) + + set_to_false :: (Import x) !(!*{#Bool}, !u:SymbolTable) -> !(!*{#Bool}, !u:SymbolTable) + set_to_false {import_module} (bitvect, cs_symbol_table) + #! ste_index + = (sreadPtr import_module.id_info cs_symbol_table).ste_index + = ({ bitvect & [ste_index] = False }, cs_symbol_table) + + get_expl_imp_symbols_of_component imports_of_icl_mod component (dcl_modules, cs_symbol_table) + # (expl_imp_symbols, _, expl_imp_indices, dcl_modules, cs_symbol_table) + = foldSt (get_expl_imp_symbols_of_module imports_of_icl_mod) component ([], 0, [], dcl_modules, cs_symbol_table) + cs_symbol_table + = 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 + # (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) + where + get_mod_imports is_icl_mod=:False _ dcl_modules cs_symbol_table + # ({dcl_name}, dcl_modules) + = dcl_modules![mod_index] + ({ste_kind=STE_Module {mod_imports}}, cs_symbol_table) + = readPtr dcl_name.id_info cs_symbol_table + = (mod_imports, 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) + # (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) + + get_expl_imp_symbol (ID_OldSyntax idents) state + = foldSt (get_symbol No) idents state + get_expl_imp_symbol import_declaration state + = get_symbol (getBelongingSymbolsFromID import_declaration) (get_ident import_declaration) state + + get_symbol belonging_symbols ident=:{id_info} (expl_imp_symbols_accu, nr_of_expl_imp_symbols, expl_imp_indices_accu, cs_symbol_table) + # (ste, cs_symbol_table) + = readPtr id_info cs_symbol_table + = case ste.ste_kind of + STE_ExplImpSymbol expl_imp_symbols_nr + # ini + = { ini_symbol_nr = expl_imp_symbols_nr, ini_belonging = belonging_symbols } + -> (expl_imp_symbols_accu, nr_of_expl_imp_symbols, + [ini:expl_imp_indices_accu], cs_symbol_table) + STE_Empty + # cs_symbol_table + = writePtr id_info { ste & ste_kind = STE_ExplImpSymbol nr_of_expl_imp_symbols, ste_previous = ste } + cs_symbol_table + ini + = { ini_symbol_nr = nr_of_expl_imp_symbols, ini_belonging = belonging_symbols } + -> ([ident:expl_imp_symbols_accu], nr_of_expl_imp_symbols+1, + [ini:expl_imp_indices_accu], cs_symbol_table) + +checkDclComponent :: !{![Int]} ![[(Index, Position, [ImportNrAndIdents])]] ![Int] + !(!Int, !*ExplImpInfos, !*{# DclModule}, !*{# FunDef}, !*Heaps,!*CheckState) + -> (!Int, !.ExplImpInfos, !.{# DclModule}, !.{# FunDef}, !.Heaps,!.CheckState) +checkDclComponent super_components expl_imp_indices mod_indices + (component_nr, expl_imp_infos, dcl_modules, icl_functions, heaps, cs=:{cs_error}) +// | False--->("checkDclComponent", mod_indices) = undef + # is_on_cycle + = case expl_imp_indices of + [_] -> False + _ -> True + cs_error + = fold2St check_whether_module_imports_itself expl_imp_indices mod_indices cs_error + cs_error + = case temp_try_a_new_thing_XXX False is_on_cycle of + True + -> checkError "" + (switch_import_syntax + "You can't have cyclic module dependencies _and_ Clean 1.3 import syntax" + "cyclic module dependencies currently not implemented") // XXX + cs_error + _ + -> cs_error + cs + = { cs & cs_error = cs_error } + | not cs.cs_error.ea_ok || hd mod_indices==size dcl_modules // the icl module! + = (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + # (expl_imp_infos, dcl_modules, cs) + = case is_on_cycle of + True + -> collect_expl_imp_info component_nr mod_indices (expl_imp_infos, dcl_modules, cs) + False + -> (expl_imp_infos, dcl_modules, cs) + #! nr_of_modules + = size dcl_modules + # modules_in_component_set = foldSt bitvectSet mod_indices (bitvectCreate nr_of_modules) + (dcl_imported_module_numbers, dcl_modules) + = foldSt (\imports_per_module state + -> foldSt compute_used_module_nrs imports_per_module state) + expl_imp_indices + (foldSt addNr mod_indices EndNumbers, dcl_modules) + expl_imp_indices_ikh + = fold2St (ikhInsert` False) mod_indices expl_imp_indices ikhEmpty + (expl_imp_info, expl_imp_infos) + = replace expl_imp_infos component_nr cDummyArray + (imports, (dcl_modules, _, expl_imp_info, cs)) + = mapSt (solveExplicitImports expl_imp_indices_ikh modules_in_component_set) mod_indices + (dcl_modules, bitvectCreate nr_of_modules, expl_imp_info, cs) + imports_ikh + = fold2St (ikhInsert` False) mod_indices imports ikhEmpty + // maps the module indices of all modules in the actual component to all explicit + // imports of that module + + (dcl_modules, cs) + = switch_port_to_new_syntax + (possibly_write_expl_imports_of_main_dcl_mod_to_file imports_ikh dcl_modules cs) + (dcl_modules, cs) + + (expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + = foldSt (checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cycle modules_in_component_set + super_components imports_ikh) mod_indices + (expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + + (dcl_modules, hp_type_heaps, cs_error) + = foldSt expand_syn_types (temp_try_a_new_thing_XXX mod_indices []) (dcl_modules, heaps.hp_type_heaps, cs.cs_error) + with + expand_syn_types mod_index (dcl_modules, hp_type_heaps, cs_error) + | temp_try_a_new_thing_XXX False True + = abort "expand_syn_types" + # (type_defs, dcl_modules) + = dcl_modules![mod_index].dcl_common.com_type_defs + unique_type_defs + = { el \\ el <-:type_defs } + (expanded_type_defs, dcl_modules, hp_type_heaps, cs_error) + = expandSynonymTypes mod_index unique_type_defs dcl_modules hp_type_heaps cs_error + dcl_modules + = { dcl_modules & [mod_index].dcl_common.com_type_defs = expanded_type_defs } + = (dcl_modules, hp_type_heaps, cs_error) + (cs, heaps) + = ({ cs & cs_error = cs_error }, { heaps & hp_type_heaps = hp_type_heaps}) + + (dcl_modules, icl_functions, heaps, cs) + = case is_on_cycle of + False + -> (dcl_modules, icl_functions, heaps, cs) + True + # (dcl_modules, icl_functions, hp_expression_heap, cs) + = fold2St check_expl_imp_completeness_of_dcl_mod_within_non_trivial_component + mod_indices imports + (dcl_modules, icl_functions, heaps.hp_expression_heap, cs) + -> (dcl_modules, icl_functions, { heaps & hp_expression_heap = hp_expression_heap }, cs) + = (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + where + check_whether_module_imports_itself expl_imp_indices_for_module mod_index cs_error + = foldSt (check_that mod_index) expl_imp_indices_for_module cs_error + where + check_that mod_index (imported_mod_index, position, _) cs_error + | mod_index==imported_mod_index + = checkErrorWithIdentPos (newPosition import_ident position) + "a dcl module cannot import from itself" cs_error + = cs_error + + collect_expl_imp_info component_nr mod_indices (expl_imp_infos, dcl_modules, cs) + # (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) + cs_symbol_table + = foldSt restoreHeap changed_symbols cs_symbol_table + = (expl_imp_infos, dcl_modules, { cs & cs_symbol_table = cs_symbol_table }) + + collect_expl_imp_info_per_module mod_index (expl_imp_infos, dcl_modules, cs_symbol_table) + # (dcls_local_for_import, dcl_modules) + = dcl_modules![mod_index].dcl_declared.dcls_local_for_import + (dcl_modules, expl_imp_infos, cs_symbol_table) + = 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) + = (expl_imp_infos, dcl_modules, cs_symbol_table) + + check_expl_imp_completeness_of_dcl_mod_within_non_trivial_component mod_index {si_explicit} + (dcl_modules, icl_functions, hp_expression_heap, cs) + # ({dcl_declared}, dcl_modules) + = dcl_modules![mod_index] + ({dcls_local_for_import, dcls_import}) + = dcl_declared + // XXX possibly adding dcls_local_for_import is not necessary! + cs + = addDeclaredSymbolsToSymbolTable2 cIsADclModule mod_index dcls_local_for_import dcls_import cs + (dcl_modules, icl_functions, hp_expression_heap, cs=:{cs_symbol_table}) + = checkExplicitImportCompleteness (fuck_it si_explicit) + dcl_modules icl_functions hp_expression_heap cs + cs_symbol_table + = removeImportsAndLocalsOfModuleFromSymbolTable dcl_declared cs.cs_symbol_table + = (dcl_modules, icl_functions, hp_expression_heap, { cs & cs_symbol_table = cs_symbol_table }) + +compute_used_module_nrs (mod_index, _, _) (mod_nr_accu, dcl_modules) + | inNumberSet mod_index mod_nr_accu + = (mod_nr_accu, dcl_modules) + # ({dcl_imported_module_numbers}, dcl_modules) + = dcl_modules![mod_index] + = (addNr mod_index (numberSetUnion dcl_imported_module_numbers mod_nr_accu), + dcl_modules) + + +checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cycle modules_in_component_set + super_components imports_ikh mod_index + (expl_imp_infos, dcl_modules, icl_functions, heaps, cs=:{cs_symbol_table}) + # ({dcl_name}, dcl_modules) + = dcl_modules![mod_index] + (mod_entry, cs_symbol_table) + = readPtr dcl_name.id_info cs_symbol_table + cs + = { cs & cs_symbol_table = cs_symbol_table } + = case mod_entry of + ({ ste_kind = STE_Module mod, ste_index }) + # cs_symbol_table + = writePtr dcl_name.id_info { mod_entry & ste_kind = STE_ClosedModule } cs.cs_symbol_table + (expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + = checkDclModule dcl_imported_module_numbers super_components.[mod_index] imports_ikh component_nr + is_on_cycle modules_in_component_set + mod ste_index expl_imp_infos dcl_modules icl_functions heaps + { cs & cs_symbol_table = cs_symbol_table } + -> (expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + ({ ste_kind = STE_ClosedModule }) + # ({dcls_local_for_import, dcls_import}, dcl_modules) + = dcl_modules![mod_index].dcl_declared + (dcl_modules, expl_imp_infos, cs_symbol_table) + = updateExplImpInfo super_components.[mod_index] mod_index dcls_import dcls_local_for_import + dcl_modules expl_imp_infos cs.cs_symbol_table + -> (expl_imp_infos, dcl_modules, icl_functions, heaps, { cs & cs_symbol_table = cs_symbol_table }) + +markExplImpSymbols component_nr (expl_imp_info, cs_symbol_table) + #! nr_of_expl_imp_symbols + = size expl_imp_info.[component_nr] + (new_symbols, expl_imp_info, cs_symbol_table) + = iFoldSt (mark_symbol component_nr) 0 nr_of_expl_imp_symbols ([], expl_imp_info, cs_symbol_table) + = (new_symbols, (expl_imp_info, cs_symbol_table)) + where + mark_symbol component_nr i + (changed_symbols_accu, expl_imp_info, cs_symbol_table) + # (eii_ident, expl_imp_info) + = do_a_lot_just_to_read_an_array component_nr i expl_imp_info + (ste, cs_symbol_table) + = readPtr eii_ident.id_info cs_symbol_table + cai + = { cai_component_nr = component_nr, cai_index = i } + = case ste.ste_kind of + STE_ExplImpComponentNrs component_nrs _ + # new_ste_kind + = STE_ExplImpComponentNrs [cai:component_nrs] [] + cs_symbol_table + = writePtr eii_ident.id_info { ste & ste_kind = new_ste_kind } cs_symbol_table + -> (changed_symbols_accu, expl_imp_info, cs_symbol_table) + _ + # new_ste + = { ste & ste_kind = STE_ExplImpComponentNrs [cai] [], ste_previous = ste } + -> ([eii_ident:changed_symbols_accu], expl_imp_info, writePtr eii_ident.id_info new_ste cs_symbol_table) + + do_a_lot_just_to_read_an_array component_nr i expl_imp_info + # (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 }) + + get_eei_ident (eii=:ExplImpInfo eii_ident _) = (eii_ident, eii) + + checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !{#FunDef} !*PredefinedSymbols !*SymbolTable !*File !*Heaps -> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef}, !Int,!*Heaps, !*PredefinedSymbols, !*SymbolTable, *File) checkModule m icl_global_function_range fun_defs n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache optional_dcl_mod scanned_modules dcl_modules functions_and_macros predef_symbols symbol_table err_file heaps +// | False--->("checkModule", m.mod_name) +// = undef # (optional_pre_def_mod,predef_symbols) = case size dcl_modules of 0 # (predef_mod,predef_symbols) = buildPredefinedModule predef_symbols @@ -901,9 +1254,7 @@ checkModule m icl_global_function_range fun_defs n_functions_and_macros_in_dcl_m # (mod_name,mod_imported_objects,mod_imports,mod_type,icl_global_function_range,nr_of_functions,first_inst_index,local_defs,icl_functions,init_dcl_modules,main_dcl_module_n,cdefs,sizes,cs) = check_module1 m icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules functions_and_macros dcl_module_n_in_cache predef_symbols symbol_table err_file # icl_instance_range = {ir_from = first_inst_index, ir_to = nr_of_functions} -// # (ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, heaps, cs_predef_symbols, cs_symbol_table, ea_file) = check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range nr_of_functions n_functions_and_macros_in_dcl_modules optional_pre_def_mod local_defs icl_functions init_dcl_modules cdefs sizes heaps cs -// = (ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, cached_functions_and_macros, heaps, cs_predef_symbols, cs_symbol_table, ea_file) check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs} icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules functions_and_macros dcl_module_n_in_cache predef_symbols symbol_table err_file # error = {ea_file = err_file, ea_loc = [], ea_ok = True } @@ -965,18 +1316,6 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde -> ({ pre_def_symbols & [predef_index] = { mod_symb & pds_module = cs_x.x_main_dcl_module_n, pds_def = mod_entry.ste_index }}, symbol_table) _ -> (pre_def_symbols, symbol_table) -/* - add_modules_to_symbol_table [mod=:{mod_defs} : mods] mod_index macro_and_fun_defs cs=:{cs_predef_symbols,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) - (macro_and_fun_defs, (sizes, defs)) = collectMacros mod_defs.def_macros macro_and_fun_defs sizes_and_defs - mod = { mod & mod_defs = mod_defs } - (cs_symbol_table, cs_error) = addDefToSymbolTable cGlobalScope mod_index mod.mod_name (STE_Module mod) cs_symbol_table cs_error - (mods, macro_and_fun_defs, cs) - = add_modules_to_symbol_table mods (inc mod_index) macro_and_fun_defs { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error } - = ([(mod, sizes, defs) : mods], macro_and_fun_defs, cs) -*/ add_modules_to_symbol_table [mod : mods] mod_index macro_and_fun_defs cs # (mod_sizes_and_defs,macro_and_fun_defs,cs) = add_module_to_symbol_table mod mod_index macro_and_fun_defs cs @@ -1066,12 +1405,13 @@ add_function_conversion_table dcl_to_icl_function_conversions main_dcl_module_n -> dcl_modules check_module2 :: Ident [.ImportedObject] .[Import ImportDeclaration] .ModuleKind !.IndexRange !.IndexRange !Int !Int - (Optional (Module a)) [.Declaration] *{#FunDef} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange) + (Optional (Module a)) [Declaration] *{#FunDef} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange) *{#.Int} *Heaps *CheckState -> (!Bool,!.IclModule,!.{#DclModule},.{!Group},!Optional {#Int},!.{#FunDef},!Int,!.Heaps,!.{#PredefinedSymbol}, !.Heap SymbolTableEntry,!.File); check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range nr_of_functions n_functions_and_macros_in_dcl_modules optional_pre_def_mod local_defs icl_functions init_dcl_modules cdefs sizes heaps cs - # (icl_sizes_without_added_dcl_defs, sizes) = memcpy sizes + # (main_dcl_module_n,cs)=cs!cs_x.x_main_dcl_module_n + (icl_sizes_without_added_dcl_defs, sizes) = memcpy sizes (dcl_modules, local_defs, cdefs, icl_sizes, cs) = combineDclAndIclModule mod_type init_dcl_modules local_defs cdefs sizes cs @@ -1083,35 +1423,62 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func (dcl_modules, icl_functions, heaps, cs) = check_predefined_module optional_pre_def_mod dcl_modules icl_functions heaps cs - # (main_dcl_module_n,cs)=cs!cs_x.x_main_dcl_module_n (dcl_to_icl_function_conversions,dcl_modules) = remove_function_conversion_table main_dcl_module_n dcl_modules - iinfo = { ii_modules = dcl_modules, ii_funs_and_macros = icl_functions, ii_next_num = 0, ii_deps = [] } - (iinfo, heaps, cs) = check_dcl_module iinfo heaps cs + (nr_of_icl_component, expl_imp_indices, expl_imp_info, dcl_modules, icl_functions, heaps, cs) + = checkDclModules mod_imports dcl_modules icl_functions heaps cs - (_, imported_module_numbers,{ii_modules,ii_funs_and_macros = icl_functions}, heaps, cs) = checkImports mod_imports EndModuleNumbers iinfo heaps cs + (imported_module_numbers, dcl_modules) + = foldSt compute_used_module_nrs + expl_imp_indices + (addNr main_dcl_module_n (addNr cPredefinedModuleIndex EndNumbers), + dcl_modules) - ii_modules = add_function_conversion_table dcl_to_icl_function_conversions main_dcl_module_n ii_modules + dcl_modules = add_function_conversion_table dcl_to_icl_function_conversions main_dcl_module_n dcl_modules cs = { cs & cs_x.x_needed_modules = 0 } - # imported_module_numbers = add_module_n main_dcl_module_n (add_module_n 1 imported_module_numbers) -// ii_modules = print_imported_modules 0 ii_modules - (used_module_numbers,ii_modules) = compute_used_module_numbers imported_module_numbers imported_module_numbers ii_modules - # - (nr_of_modules, ii_modules) = usize ii_modules - hp_expression_heap = heaps.hp_expression_heap + + (nr_of_modules, dcl_modules) = usize dcl_modules - (dcls_explicit, dcl_modules, cs) = addImportsToSymbolTable mod_imports [] ii_modules cs + (dcl_macros, dcl_modules) + = dcl_modules![main_dcl_module_n].dcl_macros + + expl_imp_indices_ikh + = ikhInsert` False nr_of_modules expl_imp_indices ikhEmpty + + modules_in_component_set + = bitvectCreate nr_of_modules + + (imports, (dcl_modules, _, _, cs)) + = solveExplicitImports expl_imp_indices_ikh modules_in_component_set nr_of_modules + (dcl_modules, bitvectCreate nr_of_modules, expl_imp_info.[nr_of_icl_component], cs) + + (dcl_modules, cs) + = switch_port_to_new_syntax + (write_expl_imports_to_file "icl.txt" imports.si_explicit dcl_modules cs) + (dcl_modules, cs) + imports_ikh + = ikhInsert` False nr_of_modules imports ikhEmpty + // maps the module indices of all modules in the actual component to all explicit + // imports of that module - (local_defs,dcl_modules,cs ) = replace_icl_macros_by_dcl_macros mod_type cdefs.def_macros local_defs dcl_modules cs - cs = addGlobalDefinitionsToSymbolTable local_defs cs + (dcls_import_list, dcl_modules, cs) + = addImportedSymbolsToSymbolTable nr_of_modules (Yes dcl_macros) modules_in_component_set + imports_ikh dcl_modules cs + (dcl_modules, icl_functions, hp_expression_heap, cs) - = checkExplicitImportCompleteness main_dcl_module_n dcls_explicit dcl_modules icl_functions hp_expression_heap cs + = checkExplicitImportCompleteness (fuck_it imports.si_explicit) + dcl_modules icl_functions heaps.hp_expression_heap cs heaps = { heaps & hp_expression_heap=hp_expression_heap } + icl_imported + = { el \\ el<-dcls_import_list } + + (local_defs,dcl_modules,cs ) = replace_icl_macros_by_dcl_macros mod_type cdefs.def_macros local_defs dcl_modules cs + (icl_common, dcl_modules, hp_type_heaps, hp_var_heap, cs) = checkCommonDefinitions cIsNotADclModule main_dcl_module_n icl_common dcl_modules heaps.hp_type_heaps heaps.hp_var_heap cs @@ -1135,9 +1502,10 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func cs_symbol_table = removeDeclarationsFromSymbolTable local_defs cGlobalScope cs_symbol_table - (icl_imported, dcl_modules, cs_symbol_table) = retrieveImportsFromSymbolTable mod_imports [] e_info.ef_modules cs_symbol_table - - icl_imported = {icl_import\\icl_import<-icl_imported} + cs_symbol_table + = foldlArraySt mw_removeImportedSymbolsFromSymbolTable icl_imported cs_symbol_table + + dcl_modules = e_info.ef_modules | cs_error.ea_ok # {hp_var_heap,hp_type_heaps=hp_type_heaps=:{th_vars},hp_expression_heap} = heaps @@ -1153,7 +1521,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func (untransformed_fun_bodies, icl_functions) = copy_bodies icl_functions - # (cached_functions_and_macros,icl_functions) = arrayCopyBegin icl_functions n_functions_and_macros_in_dcl_modules + (cached_functions_and_macros,icl_functions) = arrayCopyBegin icl_functions n_functions_and_macros_in_dcl_modules (pds_alias_dummy, cs_predef_symbols) = cs_predef_symbols![PD_DummyForStrictAliasFun] @@ -1163,13 +1531,14 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs, com_instance_defs = class_instances } icl_mod = { icl_name = mod_name, icl_functions = icl_functions, icl_common = icl_common, icl_instances = icl_instances, icl_specials = icl_specials, - icl_imported_objects = mod_imported_objects, icl_used_module_numbers = used_module_numbers, + icl_imported_objects = mod_imported_objects, icl_used_module_numbers = imported_module_numbers, icl_import = icl_imported } heaps = { heaps & hp_var_heap = var_heap, hp_expression_heap = expr_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}} (dcl_modules, icl_mod, heaps, cs_error) - = compareDefImp icl_sizes_without_added_dcl_defs untransformed_fun_bodies main_dcl_module_n dcl_modules icl_mod heaps cs_error + = temp_try_a_new_thing_XXX (dcl_modules, icl_mod, heaps, cs_error) + (compareDefImp icl_sizes_without_added_dcl_defs untransformed_fun_bodies main_dcl_module_n dcl_modules icl_mod heaps cs_error) = (cs_error.ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, cached_functions_and_macros, cs_x.x_main_dcl_module_n, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file) # icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, @@ -1177,7 +1546,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func icl_mod = { icl_name = mod_name, icl_functions = icl_functions, icl_common = icl_common, icl_instances = icl_instance_range, icl_specials = {ir_from = nr_of_functions, ir_to = nr_of_functions}, - icl_imported_objects = mod_imported_objects, icl_used_module_numbers = used_module_numbers, + icl_imported_objects = mod_imported_objects, icl_used_module_numbers = imported_module_numbers, icl_import = icl_imported } = (False, icl_mod, dcl_modules, {}, No, {}, cs_x.x_main_dcl_module_n,heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file) where @@ -1203,22 +1572,15 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table # cs = { cs & cs_symbol_table = cs_symbol_table <:= (id_info, { entry & ste_kind = STE_ClosedModule })} {ste_kind = STE_Module mod, ste_index} = entry - (modules, macro_and_fun_defs, heaps, cs) - = checkDclModule False mod ste_index modules macro_and_fun_defs heaps cs + solved_imports + = { si_explicit = [], si_implicit = [] } + (_, modules, macro_and_fun_defs, heaps, cs) + = checkDclModule EndNumbers [] (ikhInsert` False cPredefinedModuleIndex solved_imports ikhEmpty) cUndef False cDummyArray mod ste_index cDummyArray modules macro_and_fun_defs heaps cs ({dcl_declared={dcls_import,dcls_local,dcls_local_for_import}}, modules) = modules![ste_index] -// = (modules, macro_and_fun_defs, heaps, addDeclaredSymbolsToSymbolTable cIsADclModule ste_index dcls_local dcls_import cs) = (modules, macro_and_fun_defs, heaps, addDeclaredSymbolsToSymbolTable2 cIsADclModule ste_index dcls_local_for_import dcls_import cs) check_predefined_module No modules macro_and_fun_defs heaps cs = (modules, macro_and_fun_defs, heaps, cs) - check_dcl_module :: *ImportInfo *Heaps *CheckState -> (!.ImportInfo,!.Heaps,!.CheckState); - check_dcl_module iinfo=:{ii_modules} heaps cs=:{cs_symbol_table,cs_x} - # (dcl_mod, ii_modules) = ii_modules![cs_x.x_main_dcl_module_n] - # dcl_info = dcl_mod.dcl_name.id_info - # (entry, cs_symbol_table) = readPtr dcl_info cs_symbol_table - # (_, iinfo, heaps, cs) = checkImport dcl_info entry { iinfo & ii_modules = ii_modules } heaps { cs & cs_symbol_table = cs_symbol_table } - = (iinfo, heaps, cs) - collect_specialized_functions_in_dcl_module :: !w:{# DclModule} !v:{# ClassInstance} !u:{# FunDef} !Index !Int !*VarHeap !*TypeVarHeap !*ExpressionHeap -> (![FunDef], !w:{# DclModule}, !v:{# ClassInstance}, !u:{# FunDef}, !Index, !(Optional {# Index}), !*VarHeap, !*TypeVarHeap, !*ExpressionHeap) collect_specialized_functions_in_dcl_module modules icl_instances icl_functions first_free_index main_dcl_module_n var_heap type_var_heap expr_heap @@ -1405,132 +1767,6 @@ makeElemTypeOfArrayFunctionStrict st=:{st_args,st_result} me_offset offset_table st_result = { st_result & at_type = TA tuple [{ elem & at_annotation = AN_Strict } : res_array]}} = st -add_module_n n EndModuleNumbers - | n<32 - = ModuleNumbers (1<<n) EndModuleNumbers - = ModuleNumbers 0 (add_module_n (n-32) EndModuleNumbers) -add_module_n n (ModuleNumbers module_numbers rest_module_numbers) - | n<32 - = ModuleNumbers (module_numbers bitor (1<<n)) rest_module_numbers - = ModuleNumbers module_numbers (add_module_n (n-32) rest_module_numbers) - -is_empty_module_n_set EndModuleNumbers - = True; -is_empty_module_n_set (ModuleNumbers 0 module_numbers) - = is_empty_module_n_set module_numbers -is_empty_module_n_set _ - = False; - -remove_first_module_number (ModuleNumbers 0 rest_module_numbers) - # (bit_n,rest_module_numbers) = remove_first_module_number rest_module_numbers - = (bit_n+32,ModuleNumbers 0 rest_module_numbers) -remove_first_module_number (ModuleNumbers module_numbers rest_module_numbers) - # bit_n = first_one_bit module_numbers - = (bit_n,ModuleNumbers (module_numbers bitand (bitnot (1<<bit_n))) rest_module_numbers) - -first_one_bit module_numbers - | module_numbers bitand 0xff<>0 - = first_one_bit_in_byte 0 module_numbers - | module_numbers bitand 0xff00<>0 - = first_one_bit_in_byte 8 module_numbers - | module_numbers bitand 0xff0000<>0 - = first_one_bit_in_byte 16 module_numbers - = first_one_bit_in_byte 24 module_numbers - -first_one_bit_in_byte n module_numbers - | module_numbers bitand (1<<n)<>0 - = n - = first_one_bit_in_byte (n+1) module_numbers - -add_new_module_numbers EndModuleNumbers module_numbers used_module_numbers - = (module_numbers,used_module_numbers) -add_new_module_numbers (ModuleNumbers new_module_numbers new_rest_module_numbers) EndModuleNumbers EndModuleNumbers - # (rest_module_numbers,rest_used_module_numbers) = add_new_module_numbers new_rest_module_numbers EndModuleNumbers EndModuleNumbers - = (ModuleNumbers new_module_numbers rest_module_numbers,ModuleNumbers new_module_numbers rest_used_module_numbers) -add_new_module_numbers (ModuleNumbers new_module_numbers new_rest_module_numbers) EndModuleNumbers (ModuleNumbers used_module_numbers rest_used_module_numbers) - # (rest_module_numbers,rest_used_module_numbers) = add_new_module_numbers new_rest_module_numbers EndModuleNumbers rest_used_module_numbers - = (ModuleNumbers (new_module_numbers bitand (bitnot used_module_numbers)) rest_module_numbers,ModuleNumbers (used_module_numbers bitor new_module_numbers) rest_used_module_numbers) -add_new_module_numbers (ModuleNumbers new_module_numbers new_rest_module_numbers) (ModuleNumbers module_numbers rest_module_numbers) EndModuleNumbers - # (rest_module_numbers,rest_used_module_numbers) = add_new_module_numbers new_rest_module_numbers rest_module_numbers EndModuleNumbers - = (ModuleNumbers (new_module_numbers bitor module_numbers) rest_module_numbers,ModuleNumbers new_module_numbers rest_used_module_numbers) -add_new_module_numbers (ModuleNumbers new_module_numbers new_rest_module_numbers) (ModuleNumbers module_numbers rest_module_numbers) (ModuleNumbers used_module_numbers rest_used_module_numbers) - # (rest_module_numbers,rest_used_module_numbers) = add_new_module_numbers new_rest_module_numbers rest_module_numbers rest_used_module_numbers - = (ModuleNumbers (module_numbers bitor (new_module_numbers bitand (bitnot used_module_numbers))) rest_module_numbers,ModuleNumbers (used_module_numbers bitor new_module_numbers) rest_used_module_numbers) - -compute_used_module_numbers module_numbers used_numbers modules - | is_empty_module_n_set module_numbers - = (used_numbers,modules) - # (first_module_number,module_numbers) = remove_first_module_number module_numbers - # (dcl_imported_module_numbers,modules) = modules![first_module_number].dcl_imported_module_numbers - # (module_numbers,used_numbers) = add_new_module_numbers dcl_imported_module_numbers module_numbers used_numbers - = compute_used_module_numbers module_numbers used_numbers modules - -:: ImportInfo = - { ii_modules :: !.{# DclModule} - , ii_funs_and_macros :: !.{# FunDef} - , ii_next_num :: !Int - , ii_deps :: ![SymbolPtr] - } - -checkImports :: ![ParsedImport] !ModuleNumberSet !*ImportInfo !*Heaps !*CheckState -> (!Int,!ModuleNumberSet,!*ImportInfo, !*Heaps, !*CheckState) -checkImports [] imported_module_numbers iinfo=:{ii_modules} heaps cs - #! mod_num = size ii_modules - = (mod_num, imported_module_numbers,iinfo, heaps, cs) -checkImports [ {import_module = {id_info}}: mods ] imported_module_numbers iinfo heaps cs=:{cs_symbol_table} - # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table - # imported_module_numbers = add_module_n entry.ste_index imported_module_numbers - # (min_mod_num1, iinfo, heaps, cs) = checkImport id_info entry iinfo heaps { cs & cs_symbol_table = cs_symbol_table } - (min_mod_num2, imported_module_numbers,iinfo, heaps, cs) = checkImports mods imported_module_numbers iinfo heaps cs - = (min min_mod_num1 min_mod_num2, imported_module_numbers,iinfo, heaps, cs) - -checkImport :: SymbolPtr SymbolTableEntry *ImportInfo *Heaps *CheckState -> *(Int,*ImportInfo,*Heaps,*CheckState) -checkImport module_id_info entry=:{ste_kind = STE_OpenModule mod_num _} iinfo heaps cs - = (mod_num, iinfo, heaps, cs) -checkImport module_id_info entry=:{ste_kind = STE_ClosedModule} iinfo=:{ii_modules} heaps cs - #! mod_num = size ii_modules - = (mod_num, iinfo, heaps, cs) -checkImport module_id_info entry=:{ste_kind = STE_Module mod, ste_index} iinfo=:{ii_next_num,ii_deps} heaps cs=:{cs_symbol_table} - # entry = { entry & ste_kind = STE_OpenModule ii_next_num mod} - cs = { cs & cs_symbol_table = cs_symbol_table <:= (module_id_info,entry) } - iinfo = { iinfo & ii_next_num = inc ii_next_num, ii_deps = [module_id_info : ii_deps] } - (min_mod_num, imported_module_numbers,iinfo, heaps, cs) = checkImports mod.mod_imports EndModuleNumbers iinfo heaps cs - iinfo = {iinfo & ii_modules.[ste_index].dcl_imported_module_numbers=imported_module_numbers} - | ii_next_num <= min_mod_num - # {ii_deps,ii_modules,ii_funs_and_macros} = iinfo - (ii_deps, ii_modules, ii_funs_and_macros, heaps, cs) - = check_component [] module_id_info ii_deps ii_modules ii_funs_and_macros heaps cs - #! max_mod_num = size ii_modules - = (max_mod_num, { iinfo & ii_deps = ii_deps, ii_modules = ii_modules, ii_funs_and_macros = ii_funs_and_macros }, heaps, cs) - = (min_mod_num, iinfo, heaps, cs) - where - check_component component lowest_mod_info [mod_info : ds] modules macro_and_fun_defs heaps - cs=:{cs_symbol_table} - # (entry, cs_symbol_table) = readPtr mod_info cs_symbol_table - {ste_kind=STE_OpenModule _ mod,ste_index} = entry - is_on_cycle = lowest_mod_info<>mod_info || not (isEmpty component) - (modules, macro_and_fun_defs, heaps=:{hp_expression_heap}, cs) - = checkDclModule is_on_cycle mod ste_index modules macro_and_fun_defs heaps { cs & cs_symbol_table = cs_symbol_table } - cs = { cs & cs_symbol_table = cs.cs_symbol_table <:= (mod_info, { entry & ste_kind = STE_ClosedModule })} - | lowest_mod_info == mod_info - | is_on_cycle - # (modules, macro_and_fun_defs, hp_expression_heap, cs) - = foldSt check_explicit_import_completeness [ste_index:component] - (modules, macro_and_fun_defs, hp_expression_heap, cs) - = (ds, modules, macro_and_fun_defs, { heaps & hp_expression_heap = hp_expression_heap }, cs) - = (ds, modules, macro_and_fun_defs, heaps, cs) - = check_component [ste_index:component] lowest_mod_info ds modules macro_and_fun_defs heaps cs - - check_explicit_import_completeness mod_index (modules, macro_and_fun_defs, hp_expression_heap, cs=:{cs_x}) - # ({dcl_declared}, modules) = modules![mod_index] - ({dcls_local, dcls_import, dcls_explicit}) = dcl_declared - cs = addDeclaredSymbolsToSymbolTable cIsADclModule mod_index dcls_local dcls_import cs - dcls_explicit = [dcl_explicit \\ dcl_explicit <-:dcls_explicit] - (modules, macro_and_fun_defs, hp_expression_heap, cs=:{cs_symbol_table}) - = checkExplicitImportCompleteness cs_x.x_main_dcl_module_n dcls_explicit modules macro_and_fun_defs hp_expression_heap cs - cs_symbol_table = removeImportsAndLocalsOfModuleFromSymbolTable dcl_declared cs.cs_symbol_table - // XXX optimise by using version that does not allocate the first result value - = (modules, macro_and_fun_defs, hp_expression_heap, { cs & cs_symbol_table = cs_symbol_table }) - initialDclModule ({mod_name, mod_defs=mod_defs=:{def_funtypes,def_macros}, mod_type}, sizes, all_defs) module_n # dcl_common= createCommonDefinitions mod_defs = { dcl_name = mod_name @@ -1546,25 +1782,243 @@ initialDclModule ({mod_name, mod_defs=mod_defs=:{def_funtypes,def_macros}, mod_t dcls_import = {} , dcls_local = all_defs , dcls_local_for_import = {local_declaration_for_import decl module_n \\ decl<-all_defs} - , dcls_explicit = {} } , dcl_conversions = No , dcl_is_system = case mod_type of MK_System -> True _ -> False - , dcl_imported_module_numbers = EndModuleNumbers + , dcl_imported_module_numbers = EndNumbers } -checkDclModule :: !Bool !(Module (CollectedDefinitions ClassInstance IndexRange)) !Index !*{#DclModule} !*{#FunDef} !*Heaps !*CheckState - -> (!*{#DclModule}, !*{#FunDef}, !*Heaps, !*CheckState) -checkDclModule is_on_cycle {mod_name,mod_imports,mod_defs} mod_index modules icl_functions heaps=:{hp_var_heap, hp_type_heaps,hp_expression_heap} cs +addImportedSymbolsToSymbolTable importing_mod opt_macro_range modules_in_component_set imports_ikh + dcl_modules cs + #! nr_of_dcl_modules + = size dcl_modules + # {si_explicit, si_implicit} + = ikhSearch` importing_mod imports_ikh + (decls_accu, visited_modules, dcl_modules, cs) + = foldSt (add_impl_imported_symbols_with_new_error_pos opt_macro_range importing_mod + modules_in_component_set imports_ikh) + si_implicit ([], bitvectCreate nr_of_dcl_modules, dcl_modules, cs) + = foldSt (add_expl_imported_symbols_with_new_error_pos opt_macro_range importing_mod) si_explicit + (decls_accu, dcl_modules, cs) + where + add_impl_imported_symbols_with_new_error_pos opt_macro_range importing_mod modules_in_component_set imports_ikh + (mod_index, position) (decls_accu, visited_modules, dcl_modules, cs) + # cs + = pushErrorAdmin (newPosition import_ident position) cs + (decls_accu, visited_modules, dcl_modules, cs) + = add_impl_imported_symbols opt_macro_range importing_mod modules_in_component_set imports_ikh + mod_index (decls_accu, visited_modules, dcl_modules, cs) + = (decls_accu, visited_modules, dcl_modules, popErrorAdmin cs) + + add_impl_imported_symbols opt_macro_range importing_mod modules_in_component_set imports_ikh mod_index + (decls_accu, visited_modules, dcl_modules, cs) + | bitvectSelect mod_index visited_modules + = (decls_accu, visited_modules, dcl_modules, cs) + # visited_modules + = bitvectSet mod_index visited_modules + ({ dcls_import, dcls_local_for_import }, dcl_modules) + = dcl_modules![mod_index].dcl_declared + (decls_accu, cs) + = foldlArraySt (add_declaration opt_macro_range importing_mod) + dcls_local_for_import (decls_accu, cs) + | not (bitvectSelect mod_index modules_in_component_set) + // this module is outside of the actual component. All imported symbols are + // already known + # (decls_accu, cs) + = foldlArraySt (add_declaration opt_macro_range importing_mod) + dcls_import (decls_accu, cs) + = (decls_accu, visited_modules, dcl_modules, cs) + # {si_explicit, si_implicit} + = ikhSearch` mod_index imports_ikh + (decls_accu, cs) + = foldSt (\(decls, _) state -> + foldSt (\decl state -> add_declaration opt_macro_range importing_mod decl state) + decls state) + si_explicit (decls_accu, cs) + = foldSt (\(mod_index, _) state + -> add_impl_imported_symbols opt_macro_range importing_mod modules_in_component_set + imports_ikh mod_index state) + si_implicit + (decls_accu, visited_modules, dcl_modules, cs) + + + add_expl_imported_symbols_with_new_error_pos opt_macro_range importing_mod (decls, position) + (decls_accu, dcl_modules, cs) + # cs + = pushErrorAdmin (newPosition import_ident position) cs + (decls_accu, dcl_modules, cs) + = foldSt (add_expl_imp_declaration opt_macro_range importing_mod) decls + (decls_accu, dcl_modules, cs) + = (decls_accu, dcl_modules, popErrorAdmin cs) + + add_declaration opt_dcl_macro_range importing_mod declaration (decls_accu, cs) + # (not_already_imported, cs) + = add_declaration_to_symbol_table opt_dcl_macro_range declaration importing_mod cs + | not_already_imported + = ([declaration:decls_accu], cs) + = (decls_accu, cs) + + add_expl_imp_declaration opt_dcl_macro_range importing_mod declaration + (decls_accu, dcl_modules, cs) + # (not_already_imported, cs) + = add_declaration_to_symbol_table opt_dcl_macro_range declaration importing_mod cs + | not_already_imported + # (consequence_declarations, dcl_modules, cs) + = switch_import_syntax + (add_consequences_to_symbol_table importing_mod declaration dcl_modules cs) + ([], dcl_modules, cs) + = (consequence_declarations++[declaration:decls_accu], dcl_modules, cs) + = (decls_accu, dcl_modules, cs) + + // this function is for old syntax only + add_consequences_to_symbol_table _ {dcl_kind=STE_FunctionOrMacro _} dcl_modules cs + = ([], dcl_modules, cs) + add_consequences_to_symbol_table importing_mod {dcl_index, dcl_kind=STE_Imported ste_kind mod_index} dcl_modules cs + = add_consequences importing_mod dcl_index ste_kind mod_index dcl_modules cs + where + add_consequences _ dcl_index STE_Type mod_index dcl_modules cs + # (td=:{td_rhs}, dcl_modules) + = dcl_modules![mod_index].dcl_common.com_type_defs.[dcl_index] + = case td_rhs of + RecordType {rt_fields} + -> foldlArraySt (add_field importing_mod mod_index) rt_fields ([], dcl_modules, cs) + _ + -> ([], dcl_modules, cs) + add_consequences importing_mod dcl_index STE_Class mod_index dcl_modules cs + # (cd=:{class_members}, dcl_modules) + = dcl_modules![mod_index].dcl_common.com_class_defs.[dcl_index] + = foldlArraySt (add_member importing_mod mod_index) class_members ([], dcl_modules, cs) + add_consequences _ dcl_index _ mod_index dcl_modules cs + = ([], dcl_modules, cs) + + add_field importing_mod mod_index {fs_index} (declarations_accu, dcl_modules, cs) + # (sd=:{sd_symb, sd_field, sd_pos}, dcl_modules) + = dcl_modules![mod_index].dcl_common.com_selector_defs.[fs_index] + declaration + = { dcl_ident = sd_field, dcl_pos = sd_pos, + dcl_kind = STE_Imported (STE_Field sd_symb) mod_index, dcl_index = fs_index } + (true, cs) + = add_declaration_to_symbol_table No declaration importing_mod cs + | not true + = abort "fatal error 123 in module check" + = ([declaration:declarations_accu], dcl_modules, cs) + add_member importing_mod mod_index {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] + declaration + = { dcl_ident = me_symb, dcl_pos = me_pos, + dcl_kind = STE_Imported STE_Member mod_index, dcl_index = ds_index } + (true, cs) + = add_declaration_to_symbol_table No declaration importing_mod cs + | not true + = abort "fatal error 124 in module check" + = ([declaration:declarations_accu], dcl_modules, cs) + +add_declaration_to_symbol_table opt_dcl_macro_range {dcl_kind=STE_FunctionOrMacro _, dcl_ident, dcl_index} _ cs + = mw_addImportedFunctionOrMacro opt_dcl_macro_range dcl_ident dcl_index cs +add_declaration_to_symbol_table yes_for_icl_module {dcl_kind=dcl_kind=:STE_Imported def_kind def_mod, dcl_ident, dcl_index, dcl_pos} importing_mod cs + = mw_addIndirectlyImportedSymbol yes_for_icl_module dcl_ident dcl_pos dcl_kind def_kind dcl_index def_mod importing_mod cs + +mw_addImportedFunctionOrMacro :: !(Optional IndexRange) !Ident !Int !*CheckState -> (!Bool, !.CheckState) +mw_addImportedFunctionOrMacro opt_dcl_macro_range ident=:{id_info} def_index cs=:{cs_symbol_table} + #! entry = sreadPtr id_info cs_symbol_table + = case entry.ste_kind of + STE_Empty + -> (True, { cs & cs_symbol_table = NewEntry cs.cs_symbol_table id_info (STE_FunctionOrMacro []) + def_index cModuleScope entry}) + STE_FunctionOrMacro _ + | entry.ste_index == def_index || within_opt_range opt_dcl_macro_range def_index + -> (False, cs) + _ + -> (False, { cs & cs_error = checkError ident "multiply defined" cs.cs_error}) + +within_opt_range (Yes {ir_from, ir_to}) i + = ir_from<=i && i<ir_to +within_opt_range No _ + = False + +mw_removeImportedSymbolsFromSymbolTable :: Declaration !*SymbolTable -> .SymbolTable +mw_removeImportedSymbolsFromSymbolTable {dcl_ident=dcl_ident=:{id_info}, dcl_index} symbol_table + # ({ste_kind,ste_def_level,ste_previous}, symbol_table) + = readPtr id_info symbol_table + symbol_table + = symbol_table <:= (id_info, ste_previous) + = case ste_kind of + STE_Imported (STE_Field selector_id) def_mod + -> removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table + _ + -> symbol_table + +updateExplImpInfo super_components mod_index dcls_import dcls_local_for_import + dcl_modules expl_imp_infos cs_symbol_table + # (changed_symbols, (expl_imp_infos, cs_symbol_table)) + = mapSt markExplImpSymbols super_components (expl_imp_infos, cs_symbol_table) + (dcl_modules, expl_imp_infos, cs_symbol_table) + = foldlArraySt (update_expl_imp_for_marked_symbol mod_index) dcls_local_for_import + (dcl_modules, expl_imp_infos, cs_symbol_table) + (dcl_modules, expl_imp_infos, cs_symbol_table) + = foldlArraySt (update_expl_imp_for_marked_symbol 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 + = (dcl_modules, expl_imp_infos, cs_symbol_table) + +update_expl_imp_for_marked_symbol mod_index decl=:{dcl_ident} (dcl_modules, expl_imp_infos, cs_symbol_table) + # (ste, cs_symbol_table) + = readPtr dcl_ident.id_info cs_symbol_table + = updateExplImpForMarkedSymbol mod_index decl ste dcl_modules expl_imp_infos cs_symbol_table + +update_expl_imp_for_marked_local_symbol mod_index decl=:{dcl_ident} (dcl_modules, expl_imp_infos, cs_symbol_table) + # (ste, cs_symbol_table) + = readPtr dcl_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) + +checkDclModule :: !NumberSet ![Int] !(IntKeyHashtable SolvedImports) !Int !Bool !LargeBitvect + !(Module (CollectedDefinitions ClassInstance IndexRange)) !Index + !*ExplImpInfos !*{#DclModule} !*{#FunDef} !*Heaps !*CheckState + -> (!*ExplImpInfos, !*{#DclModule}, !*{#FunDef}, !*Heaps, !*CheckState) +checkDclModule dcl_imported_module_numbers super_components imports_ikh component_nr is_on_cycle modules_in_component_set + {mod_name,mod_imports,mod_defs} mod_index + expl_imp_info modules icl_functions heaps=:{hp_var_heap, hp_type_heaps,hp_expression_heap} cs +// | False--->("checkDclModule", mod_name, mod_index) //, modules.[mod_index].dcl_declared.dcls_local) +// = undef # (dcl_mod, modules) = modules![mod_index] - # dcl_defined = dcl_mod.dcl_declared.dcls_local + dcl_defined = dcl_mod.dcl_declared.dcls_local dcl_common = createCommonDefinitions mod_defs dcl_macros = mod_defs.def_macros - (imports, modules, cs) = collect_imported_symbols mod_imports [] modules cs - cs = add_imported_symbols_to_symbol_table imports cs cs = addGlobalDefinitionsToSymbolTable dcl_defined cs + (dcls_import_list, modules, cs) + = addImportedSymbolsToSymbolTable mod_index No modules_in_component_set + imports_ikh modules cs + dcls_import + = { el \\ el<-dcls_import_list } cs = { cs & cs_x.x_needed_modules = 0 } nr_of_dcl_functions = size dcl_mod.dcl_functions @@ -1608,11 +2062,10 @@ checkDclModule is_on_cycle {mod_name,mod_imports,mod_defs} mod_index modules icl (ef_member_defs, com_instance_defs, dcl_functions, cs) = adjust_predefined_symbols mod_index e_info.ef_member_defs com_instance_defs dcl_functions cs -// dcls_explicit = flatten [dcls_explicit \\ (_,{dcls_explicit})<-imports] - dcls_explicit = flatten [[dcls_explicit\\dcls_explicit<-:dcls_explicit] \\ (_,{dcls_explicit})<-imports] (modules, icl_functions, hp_expression_heap, cs) = case is_on_cycle of - False -> checkExplicitImportCompleteness main_dcl_module_n dcls_explicit modules icl_functions hp_expression_heap cs + False -> checkExplicitImportCompleteness (fuck_it (ikhSearch` mod_index imports_ikh).si_explicit) + modules icl_functions hp_expression_heap cs True -> (modules, icl_functions, hp_expression_heap, cs) heaps = { heaps & hp_expression_heap = hp_expression_heap } @@ -1622,63 +2075,23 @@ checkDclModule is_on_cycle {mod_name,mod_imports,mod_defs} mod_index modules icl dcl_common = { dcl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, com_instance_defs = com_instance_defs, com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs } - (dcl_imported, cs_symbol_table) = retrieveAndRemoveImportsFromSymbolTable imports [] cs.cs_symbol_table - - dcl_imported = {dcl_import\\dcl_import<-dcl_imported} - - cs_symbol_table = removeDeclarationsFromSymbolTable dcl_defined cModuleScope cs_symbol_table - -// dcls_explicit = flatten [dcls_explicit \\ (_,{dcls_explicit})<-imports] - dcls_explicit = {dcls_explicit \\ dcls_explicit<-dcls_explicit} + (modules, expl_imp_info, cs_symbol_table) + = updateExplImpInfo super_components mod_index dcls_import dcl_mod.dcl_declared.dcls_local_for_import + modules expl_imp_info cs.cs_symbol_table + + cs_symbol_table + = removeDeclarationsFromSymbolTable dcl_defined cModuleScope cs_symbol_table - dcl_mod = { dcl_mod & dcl_declared = { dcl_mod.dcl_declared & dcls_import = dcl_imported, dcls_explicit = dcls_explicit }, + cs_symbol_table + = foldlArraySt mw_removeImportedSymbolsFromSymbolTable dcls_import cs_symbol_table + dcl_mod = { dcl_mod & dcl_declared = { dcl_mod.dcl_declared & dcls_import = dcls_import }, dcl_common = dcl_common, dcl_functions = dcl_functions, dcl_instances = { ir_from = nr_of_dcl_functions, ir_to = nr_of_dcl_functions_and_instances }, dcl_specials = { ir_from = nr_of_dcl_functions_and_instances, ir_to = nr_of_dcl_funs_insts_and_specs }, - dcl_class_specials = { ir_from = first_special_class_index, ir_to = last_special_class_index }} - = ({ modules & [ mod_index ] = dcl_mod }, icl_functions, heaps, { cs & cs_symbol_table = cs_symbol_table }) + dcl_class_specials = { ir_from = first_special_class_index, ir_to = last_special_class_index }, + dcl_imported_module_numbers = dcl_imported_module_numbers} + = (expl_imp_info, { modules & [ mod_index ] = dcl_mod }, icl_functions, heaps, { cs & cs_symbol_table = cs_symbol_table }) where - collect_imported_symbols [{import_module={id_info},import_symbols,import_file_position} : mods ] all_decls modules cs=:{cs_symbol_table} - # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table - # (decls_of_imported_module, modules, cs) = collect_declarations_of_module id_info entry [] modules { cs & cs_symbol_table = cs_symbol_table} - (imported_decls, modules, cs) = possiblyFilterExplImportedDecls - import_symbols decls_of_imported_module import_file_position modules cs - = collect_imported_symbols mods (imported_decls++all_decls) modules cs - collect_imported_symbols [] all_decls modules cs - = (all_decls, modules, cs) - - collect_declarations_of_module module_id_info entry=:{ste_index, ste_kind= old_kind=:STE_OpenModule mod_num {mod_imports} } - all_decls modules cs=:{cs_symbol_table} - # cs = { cs & cs_symbol_table = cs_symbol_table <:= (module_id_info, { entry & ste_kind = STE_LockedModule })} - (imported_decls, modules, cs) = collect_imported_symbols mod_imports [] modules cs - # (dcl_mod, modules) = modules![ste_index] - # (declared, cs) = determine_declared_symbols ste_index dcl_mod.dcl_declared imported_decls cs - = ( [(ste_index, declared) : all_decls] - , modules - , { cs & cs_symbol_table = cs.cs_symbol_table <:= (module_id_info, { entry & ste_kind = old_kind })} - ) - collect_declarations_of_module module_id_info entry=:{ste_index, ste_kind= STE_ClosedModule} all_decls modules cs - # ({dcl_declared}, modules) = modules![ste_index] - = ([(ste_index, dcl_declared) : all_decls], modules, cs) - collect_declarations_of_module module_id_info entry=:{ste_kind= STE_LockedModule} all_decls modules cs - = (all_decls, modules, cs) - - determine_declared_symbols mod_index {dcls_local,dcls_local_for_import} imported_decls cs - # cs = addGlobalDefinitionsToSymbolTable dcls_local (add_imported_symbols_to_symbol_table imported_decls cs) - (dcls_import, cs_symbol_table) = retrieveAndRemoveImportsFromSymbolTable imported_decls [] cs.cs_symbol_table - - dcls_import = {dcl_import\\dcl_import<-dcls_import} - - cs_symbol_table = removeDeclarationsFromSymbolTable dcls_local cModuleScope cs_symbol_table - = ( {dcls_import = dcls_import, dcls_local = dcls_local, dcls_local_for_import = dcls_local_for_import, - dcls_explicit = {}}, { cs & cs_symbol_table = cs_symbol_table }) - - add_imported_symbols_to_symbol_table [(mod_index, {dcls_import,dcls_local,dcls_local_for_import}) : imports] cs -// = add_imported_symbols_to_symbol_table imports (addDeclaredSymbolsToSymbolTable cIsADclModule mod_index dcls_local dcls_import cs) - = add_imported_symbols_to_symbol_table imports (addDeclaredSymbolsToSymbolTable2 cIsADclModule mod_index dcls_local_for_import dcls_import cs) - add_imported_symbols_to_symbol_table [] cs - = cs - adjust_predefined_symbols mod_index class_members class_instances fun_types cs=:{cs_predef_symbols} # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdArray] | pre_mod.pds_def == mod_index @@ -1761,23 +2174,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 }) -//addImportsToSymbolTable :: ![ParsedImport] ![(!Declaration, !LineNr)] !*{# DclModule} !*CheckState -// -> (![(!Declaration, !LineNr)], !*{# DclModule}, !*CheckState) -addImportsToSymbolTable :: ![ParsedImport] ![ExplicitImport] !*{# DclModule} !*CheckState - -> (![ExplicitImport], !*{# DclModule}, !*CheckState) -addImportsToSymbolTable [{import_module={id_info},import_symbols, import_file_position} : mods ] explicit_akku modules cs=:{cs_symbol_table} - # ({ste_index}, cs_symbol_table) = readPtr id_info cs_symbol_table - # ({dcl_declared=decls_of_imported_module}, modules) = modules![ste_index] - (imported_decls, modules, cs) - = possiblyFilterExplImportedDecls import_symbols [(ste_index, decls_of_imported_module)] import_file_position modules { cs & cs_symbol_table = cs_symbol_table } - | isEmpty imported_decls - = addImportsToSymbolTable mods explicit_akku modules cs - # (_,{dcls_import,dcls_local,dcls_local_for_import,dcls_explicit}) = hd imported_decls -// = addImportsToSymbolTable mods (dcls_explicit++explicit_akku) modules (addDeclaredSymbolsToSymbolTable cIsNotADclModule ste_index dcls_local dcls_import cs) - = addImportsToSymbolTable mods ([dcls_explicit\\dcls_explicit<-:dcls_explicit]++explicit_akku) modules (addDeclaredSymbolsToSymbolTable2 cIsNotADclModule ste_index dcls_local_for_import dcls_import cs) -addImportsToSymbolTable [] explicit_akku modules cs - = (explicit_akku, modules, cs) - file_and_status {ea_file,ea_ok} = (ea_file, ea_ok) @@ -1841,3 +2237,265 @@ instance <<< (Ptr a) where (<<<) file ptr = file <<< "[[" <<< ptrToInt ptr <<< "]]" +:: NodeNr :== Int +:: ComponentNr :== Int +:: NodesToComponents :== {#ComponentNr} // mapping from node numbers to component numbers + +getComponentNumbers :: ![[NodeNr]] !Int -> (!Int, !.{#ComponentNr}) +getComponentNumbers components nr_of_nodes + # nodes_to_components + = createArray nr_of_nodes cUndef + = foldSt get_component_numbers components (0, nodes_to_components) + where + get_component_numbers component (component_nr, nodes_to_components) + = ( component_nr+1 + , foldSt (\node_nr nodes_to_components -> { nodes_to_components & [node_nr] = component_nr }) + component nodes_to_components + ) + +reverseDAG :: !DAG -> {![NodeNr]} +reverseDAG { dag_nr_of_nodes, dag_get_children } + # reversed_children + = createArray dag_nr_of_nodes [] + = iFoldSt reverse_arrows_of_node 0 dag_nr_of_nodes reversed_children + where + reverse_arrows_of_node parent_node_nr reversed_children + # children + = dag_get_children parent_node_nr + = foldSt (reverse_arrow parent_node_nr) children reversed_children + reverse_arrow parent_node_nr child_node_nr reversed_children + # (current_parents, reversed_children) + = reversed_children![child_node_nr] + = { reversed_children & [child_node_nr] = [parent_node_nr : current_parents] } + + +groupify :: !DAG !{#ComponentNr} !Int -> .{![ComponentNr]} +groupify { dag_nr_of_nodes, dag_get_children } component_numbers nr_of_components + # visited_array + = createArray nr_of_components False + node_to_components + = createArray dag_nr_of_nodes [] + = snd (iFoldSt (groupifyPerNode component_numbers) 0 dag_nr_of_nodes (visited_array, node_to_components)) + where + groupifyPerNode component_numbers node_nr (visited_array, node_to_components) + // all i: not visited.[i] + # children + = dag_get_children node_nr + (visited_array, visited_list, node_to_components) + = foldSt (groupifyPerArrow component_numbers node_nr) children (visited_array, [], node_to_components) + visited_array + = foldSt (\i visited_array->{ visited_array & [i] = False }) visited_list visited_array + = (visited_array, node_to_components) + groupifyPerArrow :: !{#ComponentNr} !Int !Int !(!*{#Bool}, ![Int], !*{![ComponentNr]}) + -> (!.{#Bool}, ![Int], !.{![ComponentNr]}) + groupifyPerArrow component_numbers node_nr child_node_nr (visited_array, visited_list, node_to_components) + # child_component_number + = component_numbers.[child_node_nr] + | visited_array.[child_component_number] || child_component_number==component_numbers.[node_nr] + = (visited_array, visited_list, node_to_components) + # (current_components, node_to_components) + = node_to_components![node_nr] + = ({ 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] + +Ste_Empty :== STE_Empty + +dummy_decl + =: { dcl_ident = { id_name = "", id_info = nilPtr }, dcl_pos = NoPos, dcl_kind = STE_Empty, dcl_index = cUndef } + +// XXX +fuck_it l + = flatten [[(decl, position) \\ decl<-decls] \\ (decls, position) <- l] + +// BEGIN only for portToNewSyntax +// BEGIN only for portToNewSyntax +// BEGIN only for portToNewSyntax +// BEGIN only for portToNewSyntax +// BEGIN only for portToNewSyntax +// BEGIN only for portToNewSyntax +possibly_write_expl_imports_of_main_dcl_mod_to_file imports_ikh dcl_modules cs + #! x_main_dcl_module_n + = cs.cs_x.x_main_dcl_module_n + = case ikhSearch x_main_dcl_module_n imports_ikh of + No + // the main dcl module is not part of the currently checked module component + -> (dcl_modules, cs) + Yes {si_explicit} + -> write_expl_imports_to_file "dcl.txt" si_explicit dcl_modules cs + +write_expl_imports_to_file file_name si_explicit dcl_modules cs + | switch_port_to_new_syntax False True + = abort "write_expl_imports_to_file is only used for portToNewSyntax" + # (file, cs) + = openFile file_name cs + (dcl_modules, file) + = foldSt (write_expl_import (flatten (map fst si_explicit))) (reverse si_explicit) (dcl_modules, file) + = (dcl_modules, closeFile file cs) + +write_expl_import all_expl_imp_decls (declarations, _) (dcl_modules, file) + # (declaration_strings, dcl_modules) + = mapFilterYesSt (decl_to_opt_string all_expl_imp_decls) (reverse declarations) dcl_modules + = (dcl_modules, fwriteNewSyntax declaration_strings file) + +// only for portToNewSyntax +decl_to_opt_string all_expl_imp_decls decl=:{dcl_ident, dcl_index, dcl_kind=STE_Imported ste_kind def_mod_index} + dcl_modules + = imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index ste_kind def_mod_index + dcl_modules +decl_to_opt_string _ {dcl_ident, dcl_kind=STE_FunctionOrMacro _} dcl_modules + = (Yes dcl_ident.id_name, dcl_modules) +decl_to_opt_string all_expl_imp_decls decl dcl_modules + = abort ("decl_to_opt_string failed"--->decl) + +// only for portToNewSyntax +imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Constructor def_mod_index + dcl_modules + = (No, dcl_modules) +imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Member def_mod_index + dcl_modules + = (No, dcl_modules) +imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_DclFunction def_mod_index + dcl_modules + = (Yes dcl_ident.id_name, dcl_modules) +imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Class def_mod_index + dcl_modules + = (Yes ("class "+++dcl_ident.id_name+++"(..)"), dcl_modules) +imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index (STE_Instance _) def_mod_index + dcl_modules + # ({ins_type}, dcl_modules) + = dcl_modules![def_mod_index].dcl_common.com_instance_defs.[dcl_index] + = (Yes ("instance "+++dcl_ident.id_name+++" "+++ + separated " " (map type_to_string ins_type.it_types)), dcl_modules) +imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Type def_mod_index + dcl_modules + # ({td_rhs}, dcl_modules) + = dcl_modules![def_mod_index].dcl_common.com_type_defs.[dcl_index] + dcl_string + = ":: "+++(case td_rhs of + AlgType constructors + -> dcl_ident.id_name+++constructor_bracket def_mod_index all_expl_imp_decls constructors + RecordType _ + -> dcl_ident.id_name+++"{..}" + _ + -> dcl_ident.id_name) + = (Yes dcl_string, dcl_modules) + +// only for portToNewSyntax +type_to_string (TA {type_name} _) = possibly_replace_predef_symbols type_name.id_name +type_to_string (TB type) = toString type +type_to_string (TV {tv_name}) = tv_name.id_name +type_to_string x = abort ("bug nr 945 in module check"--->x) + +possibly_replace_predef_symbols s + | s=="_list" + = "[]" + | s % (0,5) == "_tuple" + = (toString ['(':repeatn ((toInt (s%(6, (size s) - 1))) - 1) ','])+++")" + | s=="_array" + = "{}" + | s=="_!array" + = "{!}" + | s=="_#array" + = "{#}" + = s + +instance toString BasicType + where + toString BT_Int = "Int" + toString BT_Char = "Char" + toString BT_Real = "Real" + toString BT_Bool = "Bool" + toString BT_Dynamic = "Dynamic" + toString BT_File = "File" + toString BT_World = "World" + toString _ = abort "bug nr 346 in module check" + +// only for portToNewSyntax +separated _ [] + = "" +separated separator [h:t] + = foldl (\l r->l+++separator+++r) h t + +constructor_bracket def_mod_index all_expl_imp_decls constructors + # expl_imp_constructor_strings + = [ ds_ident.id_name \\ {ds_ident} <- constructors + | is_expl_imported_constructor def_mod_index ds_ident all_expl_imp_decls ] + | isEmpty expl_imp_constructor_strings + = "" + = "("+++separated "," expl_imp_constructor_strings+++")" + +// only for portToNewSyntax +is_expl_imported_constructor def_mod_index ds_ident [] + = False +is_expl_imported_constructor def_mod_index ds_ident [{dcl_ident, dcl_kind=STE_Imported STE_Constructor def_mod_index2}:_] + | dcl_ident==ds_ident && def_mod_index==def_mod_index2 + = True + // GOTO next alternative +is_expl_imported_constructor def_mod_index ds_ident [h:t] + = is_expl_imported_constructor def_mod_index ds_ident t + +fwriteNewSyntax importStrings file + | isEmpty importStrings + = fwrites "import @#$@@!!" file + # with_commas = (map (\s->s+++", ") (butLast importStrings))++[last importStrings+++";"] + lines = split_in_lines 12 with_commas [] [] + lines = [hd lines:[["\t":line]\\ line<-tl lines]] + line_strings = [ foldl (+++) " " (line++["\n"]) \\ line<-lines ] + = fwrites (foldl (+++) "import" line_strings) file + where + max_line_length = 80 + split_in_lines i [] inner_accu outer_accu + # accu = if (isEmpty inner_accu) outer_accu [reverse inner_accu:outer_accu] + = reverse accu + split_in_lines i [h:t] inner_accu outer_accu + # s = size h + | s+i>max_line_length + | isEmpty inner_accu + = split_in_lines (s+i) t [h] outer_accu + = split_in_lines (s+cTabWidth) t [h] [inner_accu:outer_accu] + = split_in_lines (s+i) t [h:inner_accu] outer_accu +// only for portToNewSyntax + +butLast [] = [] +butLast [x] = [] +butLast [h:t] = [h: butLast t] + +// MW: fake.. +openFile file_name cs + # world = bigBang + (ok, newFile, world) = fopen file_name FWriteText world + cs = forget world cs + cs = case ok of + True -> cs + _ # cs_error = checkError "" ("can't open file \""+++file_name+++" in current directory.") cs.cs_error + -> { cs & cs_error=cs_error } + = (newFile, cs) + +closeFile file cs + # world = bigBang + (ok, world) = fclose file world + = forget world cs + +bigBang :: .World +bigBang = cast 1 +// creates a world from scratch + +forget :: !.x !.y -> .y +forget x y = y + +cast :: !.a -> .b +cast a + = code + { + pop_a 0 + } +// ..fake +// END only for portToNewSyntax +// END only for portToNewSyntax +// END only for portToNewSyntax +// END only for portToNewSyntax +// END only for portToNewSyntax +// END only for portToNewSyntax +// END only for portToNewSyntax diff --git a/frontend/checksupport.dcl b/frontend/checksupport.dcl index 01bd14d..2fbd3a2 100644 --- a/frontend/checksupport.dcl +++ b/frontend/checksupport.dcl @@ -1,9 +1,7 @@ definition module checksupport import StdEnv -import syntax, predef - -//cIclModIndex :== 0 +import syntax, predef, containers, utilities CS_NotChecked :== -1 NotFound :== -1 @@ -14,11 +12,9 @@ cGlobalScope :== 1 cIsNotADclModule :== False cIsADclModule :== True -// MW.. cNeedStdArray :== 1 cNeedStdEnum :== 2 cNeedStdDynamics:== 4 -// ..MW :: VarHeap :== Heap VarInfo @@ -61,21 +57,25 @@ cConversionTableSize :== 8 // , com_instance_types :: !.{ SymbolType} } -:: Declaration = - { dcl_ident :: !Ident - , dcl_pos :: !Position - , dcl_kind :: !STE_Kind - , dcl_index :: !Index - } - :: Declarations = { dcls_import ::!{!Declaration} , dcls_local ::![Declaration] , dcls_local_for_import ::!{!Declaration} - , dcls_explicit ::!{!ExplicitImport} } -:: ExplicitImport = ExplicitImport !Declaration !Position +:: ExplImpInfos :== {!{!.ExplImpInfo}} + +:: ExplImpInfo + = ExplImpInfo Ident !.DeclaringModulesSet + | TemporarilyFetchedAway + +:: DeclaringModulesSet :== IntKeyHashtable DeclarationInfo + +:: DeclarationInfo = + { di_decl :: !Declaration + , di_instances :: ![Declaration] + , di_belonging :: !NumberSet + } :: IclModule = { icl_name :: !Ident @@ -86,13 +86,9 @@ cConversionTableSize :== 8 // , icl_declared :: !Declarations , icl_import :: !{!Declaration} , icl_imported_objects :: ![ImportedObject] - , icl_used_module_numbers :: !ModuleNumberSet + , icl_used_module_numbers :: !NumberSet } -:: ModuleNumberSet = ModuleNumbers !Int !ModuleNumberSet | EndModuleNumbers; - -in_module_number_set :: !Int !ModuleNumberSet -> Bool - :: DclModule = { dcl_name :: !Ident , dcl_functions :: !{# FunType } @@ -105,7 +101,7 @@ in_module_number_set :: !Int !ModuleNumberSet -> Bool , dcl_declared :: !Declarations , dcl_conversions :: !Optional ConversionTable , dcl_is_system :: !Bool - , dcl_imported_module_numbers :: !ModuleNumberSet + , dcl_imported_module_numbers :: !NumberSet } class Erroradmin state @@ -116,7 +112,7 @@ where instance Erroradmin ErrorAdmin, CheckState -newPosition :: !Ident !Position -> IdentPos +newPosition :: !Ident !Position -> IdentPos checkError :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b checkWarning :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b @@ -132,7 +128,7 @@ instance toIdent ConsDef, (TypeDef a), ClassDef, MemberDef, FunDef, SelectorDef instance toIdent SymbIdent, TypeSymbIdent, BoundVar, TypeVar, ATypeVar, Ident instance toInt STE_Kind -instance <<< STE_Kind, IdentPos, Declaration +instance <<< IdentPos, ExplImpInfo, DeclarationInfo :: ExpressionInfo = { ef_type_defs :: !.{# CheckedTypeDef} @@ -150,16 +146,14 @@ checkLocalFunctions :: !Index !Level !LocalDefs !*{#FunDef} !*ExpressionInfo !*H convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index) -retrieveAndRemoveImportsFromSymbolTable :: ![(.a,.Declarations)] [Declaration] *(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry); +//retrieveAndRemoveImportsFromSymbolTable :: !Index ![(.a,.Declarations)] !Int ![Declaration] !*ExplImpInfos !*(Heap SymbolTableEntry) +// -> (!Int, ![Declaration], !.ExplImpInfos, !.Heap SymbolTableEntry); addLocalFunctionDefsToSymbolTable :: !Level !Index !Index !Bool !*{#FunDef} !*SymbolTable !*ErrorAdmin -> (!*{# FunDef}, !*SymbolTable, !*ErrorAdmin) addDefToSymbolTable :: !Level !Index !Ident !STE_Kind !*SymbolTable !*ErrorAdmin -> (!* SymbolTable, !*ErrorAdmin) -addDeclaredSymbolsToSymbolTable :: .Bool .Int ![.Declaration] !{!.Declaration} !*CheckState -> .CheckState; -addDeclaredSymbolsToSymbolTable2 :: .Bool .Int !{!.Declaration} !{!.Declaration} !*CheckState -> .CheckState; -addFieldToSelectorDefinition :: !Ident (Global .Int) !*CheckState -> .CheckState; -addGlobalDefinitionsToSymbolTable :: ![.Declaration] !*CheckState -> .CheckState; -retrieveImportsFromSymbolTable :: ![Import ImportDeclaration] ![Declaration] !*{#DclModule} !*(Heap SymbolTableEntry) -> *(![Declaration],!*{#DclModule},!*Heap SymbolTableEntry); +addDeclaredSymbolsToSymbolTable2 :: .Bool .Int !{!Declaration} !{!Declaration} !*CheckState -> .CheckState; +addGlobalDefinitionsToSymbolTable :: ![Declaration] !*CheckState -> .CheckState; removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; -removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*(Heap SymbolTableEntry) -> *Heap SymbolTableEntry; +removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *SymbolTable removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; removeIdentFromSymbolTable :: !.Int !Ident !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; removeImportsAndLocalsOfModuleFromSymbolTable :: !Declarations !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry @@ -169,3 +163,24 @@ removeLocalsFromSymbolTable :: !Level ![Ident] !LocalDefs !u:{# FunDef} !*(Heap newFreeVariable :: !FreeVar ![FreeVar] ->(!Bool, ![FreeVar]) local_declaration_for_import :: !u:Declaration .Index -> v:Declaration, [u <= v] + +get_ident :: !ImportDeclaration -> Ident +getBelongingSymbolsFromID :: !ImportDeclaration -> Optional [ImportedIdent] + +mw_addIndirectlyImportedSymbol :: !(Optional a) !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !Int !*CheckState -> (!Bool, !.CheckState) +updateExplImpForMarkedSymbol :: !Index Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable + -> (!u:{#DclModule}, !{!{!.ExplImpInfo}},!.SymbolTable) + +:: BelongingSymbols + = BS_Constructors ![DefinedSymbol] + | BS_Fields !{#FieldSymbol} + | BS_Members !{#DefinedSymbol} + | BS_Nothing + +getBelongingSymbols :: !Declaration !{#x:DclModule} -> (!.BelongingSymbols, !{#x:DclModule}) +nrOfBelongingSymbols :: !BelongingSymbols -> Int + +import_ident :: Ident +restoreHeap :: !Ident !*SymbolTable -> .SymbolTable + +temp_try_a_new_thing_XXX yes no :== no diff --git a/frontend/checksupport.icl b/frontend/checksupport.icl index 1377fa2..1510546 100644 --- a/frontend/checksupport.icl +++ b/frontend/checksupport.icl @@ -1,13 +1,13 @@ implementation module checksupport import StdEnv, compare_constructor -import syntax, predef +import syntax, predef, containers import utilities from check import checkFunctions -:: VarHeap :== Heap VarInfo +import RWSDebug -//cIclModIndex :== 0 +:: VarHeap :== Heap VarInfo CS_NotChecked :== -1 NotFound :== -1 @@ -68,22 +68,26 @@ where , com_instance_defs :: !.{# ClassInstance} } -:: Declaration = - { dcl_ident :: !Ident - , dcl_pos :: !Position - , dcl_kind :: !STE_Kind - , dcl_index :: !Index - } - :: Declarations = { dcls_import ::!{!Declaration} , dcls_local ::![Declaration] , dcls_local_for_import ::!{!Declaration} - , dcls_explicit ::!{!ExplicitImport} } -:: ExplicitImport = ExplicitImport !Declaration !Position - +:: ExplImpInfos :== {!{!.ExplImpInfo}} + +:: ExplImpInfo + = ExplImpInfo Ident !.DeclaringModulesSet + | TemporarilyFetchedAway + +:: DeclaringModulesSet :== IntKeyHashtable DeclarationInfo + +:: DeclarationInfo = + { di_decl :: !Declaration + , di_instances :: ![Declaration] + , di_belonging :: !NumberSet + } + :: IclModule = { icl_name :: !Ident , icl_functions :: !.{# FunDef } @@ -93,7 +97,7 @@ where // , icl_declared :: !Declarations , icl_import :: !{!Declaration} , icl_imported_objects :: ![ImportedObject] - , icl_used_module_numbers :: !ModuleNumberSet + , icl_used_module_numbers :: !NumberSet } :: DclModule = @@ -108,19 +112,9 @@ where , dcl_declared :: !Declarations , dcl_conversions :: !Optional ConversionTable , dcl_is_system :: !Bool - , dcl_imported_module_numbers :: !ModuleNumberSet + , dcl_imported_module_numbers :: !NumberSet } -:: ModuleNumberSet = ModuleNumbers !Int !ModuleNumberSet | EndModuleNumbers; - -in_module_number_set :: !Int !ModuleNumberSet -> Bool -in_module_number_set n EndModuleNumbers - = False; -in_module_number_set n (ModuleNumbers module_numbers rest_module_numbers) - | n<32 - = (module_numbers bitand (1<<n))<>0 - = in_module_number_set (n-32) rest_module_numbers - class Erroradmin state // PK... where pushErrorAdmin :: !IdentPos *state -> *state @@ -240,106 +234,120 @@ retrieveGlobalDefinition {ste_kind,ste_def_level,ste_index} requ_kind mod_index = (ste_index, mod_index) = (NotFound, mod_index) -retrieveAndRemoveImportsFromSymbolTable :: ![(.a,.Declarations)] [Declaration] *(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry); -retrieveAndRemoveImportsFromSymbolTable [(_, {dcls_import,dcls_local,dcls_local_for_import}) : imports] all_decls symbol_table -// # (all_decls, symbol_table) = retrieveAndRemoveImportsOfModuleFromSymbolTable dcls_import dcls_local all_decls symbol_table - # (all_decls, symbol_table) = retrieveAndRemoveImportsOfModuleFromSymbolTable2 dcls_import dcls_local_for_import all_decls symbol_table - = retrieveAndRemoveImportsFromSymbolTable imports all_decls symbol_table -retrieveAndRemoveImportsFromSymbolTable [] all_decls symbol_table - = (all_decls, symbol_table) - -retrieveAndRemoveImportsOfModuleFromSymbolTable2 :: !{!.Declaration} !{!.Declaration} ![.Declaration] !*(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry); -retrieveAndRemoveImportsOfModuleFromSymbolTable2 imports locals_for_import all_decls symbol_table - # (all_decls, symbol_table) = retrieve_declared_symbols_in_array ((size imports)-1) imports all_decls symbol_table - = retrieve_declared_symbols_in_array ((size locals_for_import)-1) locals_for_import all_decls symbol_table - -retrieveAndRemoveImportsOfModuleFromSymbolTable :: !{!.Declaration} ![.Declaration] ![.Declaration] !*(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry); -retrieveAndRemoveImportsOfModuleFromSymbolTable imports locals all_decls symbol_table - # (all_decls, symbol_table) = retrieve_declared_symbols_in_array ((size imports)-1) imports all_decls symbol_table - = retrieve_declared_symbols locals all_decls symbol_table -where - retrieve_declared_symbols :: ![Declaration] ![Declaration] !*SymbolTable -> (![Declaration], !*SymbolTable) - retrieve_declared_symbols [declaration=:{dcl_ident=ident=:{id_info},dcl_kind,dcl_index}:symbols] decls symbol_table - #! entry = sreadPtr id_info symbol_table - # {ste_kind,ste_def_level} = entry - | ste_kind == STE_Empty || ste_def_level > cModuleScope - = retrieve_declared_symbols symbols decls symbol_table - # symbol_table = symbol_table <:= (id_info, entry.ste_previous) - = case ste_kind of - STE_Field selector_id - | case dcl_kind of - STE_Field f -> f==selector_id - _ -> False - -> retrieve_declared_symbols symbols [declaration : decls ] (removeFieldFromSelectorDefinition selector_id NoIndex dcl_index symbol_table) - #! declaration = { declaration & dcl_kind = ste_kind } - -> retrieve_declared_symbols symbols [declaration : decls ] (removeFieldFromSelectorDefinition selector_id NoIndex dcl_index symbol_table) - STE_Imported (STE_Field selector_id) def_mod - | case dcl_kind of - STE_Imported (STE_Field f) d -> d==def_mod && f==selector_id - _ -> False - -> retrieve_declared_symbols symbols [declaration : decls ] (removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table) - #! declaration = { declaration & dcl_kind = ste_kind } - -> retrieve_declared_symbols symbols [declaration : decls ] (removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table) - _ - | same_STE_Kind ste_kind dcl_kind - -> retrieve_declared_symbols symbols [declaration : decls ] symbol_table - #! declaration = { declaration & dcl_kind = ste_kind } - -> retrieve_declared_symbols symbols [declaration : decls ] symbol_table - retrieve_declared_symbols [] decls symbol_table - = (decls, symbol_table) - -retrieve_declared_symbols_in_array :: !Int !{!Declaration} ![Declaration] !*SymbolTable -> (![Declaration], !*SymbolTable) -retrieve_declared_symbols_in_array symbol_index symbols decls symbol_table - | symbol_index>=0 - #! (declaration,symbols) = symbols![symbol_index] - # {dcl_ident=ident=:{id_info},dcl_kind}=declaration - #! entry = sreadPtr id_info symbol_table - # {ste_kind,ste_def_level} = entry - | ste_kind == STE_Empty || ste_def_level > cModuleScope - = retrieve_declared_symbols_in_array (symbol_index-1) symbols decls symbol_table - # symbol_table = symbol_table <:= (id_info, entry.ste_previous) - = case ste_kind of - STE_Field selector_id - | case dcl_kind of - STE_Field f -> f==selector_id - _ -> False - #! (declaration,symbols) = symbols![symbol_index] - #! dcl_index = symbols.[symbol_index].dcl_index - -> retrieve_declared_symbols_in_array (symbol_index-1) symbols [declaration : decls ] (removeFieldFromSelectorDefinition selector_id NoIndex dcl_index symbol_table) - #! (declaration,symbols) = symbols![symbol_index] - #! dcl_index = declaration.dcl_index - #! declaration = { declaration & dcl_kind = ste_kind } - -> retrieve_declared_symbols_in_array (symbol_index-1) symbols [declaration : decls ] (removeFieldFromSelectorDefinition selector_id NoIndex dcl_index symbol_table) - STE_Imported (STE_Field selector_id) def_mod - | case dcl_kind of - STE_Imported (STE_Field f) d -> d==def_mod && f==selector_id - _ -> False - #! (declaration,symbols) = symbols![symbol_index] - #! dcl_index = symbols.[symbol_index].dcl_index - -> retrieve_declared_symbols_in_array (symbol_index-1) symbols [declaration : decls ] (removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table) - #! (declaration,symbols) = symbols![symbol_index] - #! dcl_index = declaration.dcl_index - #! declaration = { declaration & dcl_kind = ste_kind } - -> retrieve_declared_symbols_in_array (symbol_index-1) symbols [declaration : decls ] (removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table) - _ - | same_STE_Kind ste_kind dcl_kind - #! (declaration,symbols) = symbols![symbol_index] - -> retrieve_declared_symbols_in_array (symbol_index-1) symbols [declaration : decls ] symbol_table - #! (declaration,symbols) = symbols![symbol_index] - #! declaration = { declaration & dcl_kind = ste_kind } - -> retrieve_declared_symbols_in_array (symbol_index-1) symbols [declaration : decls ] symbol_table - = (decls, symbol_table) - -same_STE_Kind (STE_Imported s1 i1) (STE_Imported s2 i2) = i1==i2 && same_STE_Kind s1 s2 -same_STE_Kind STE_DclFunction STE_DclFunction = True -same_STE_Kind (STE_FunctionOrMacro []) (STE_FunctionOrMacro []) = True -same_STE_Kind STE_Type STE_Type = True -same_STE_Kind STE_Constructor STE_Constructor = True -same_STE_Kind (STE_Field f1) (STE_Field f2) = f1==f2 -same_STE_Kind (STE_Instance _) (STE_Instance _) = True -same_STE_Kind STE_Member STE_Member = True -same_STE_Kind STE_Class STE_Class = True -same_STE_Kind _ _ = False + +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 _ decl {ste_kind=STE_Instance class_ident} dcl_modules expl_imp_infos cs_symbol_table + // this alternative is only for old syntax (cs_symbol_table argument is not necessary for new syntax) + # cs_symbol_table + = checkExplImpForInstance decl class_ident cs_symbol_table + = (dcl_modules, expl_imp_infos, cs_symbol_table) +updateExplImpForMarkedSymbol _ decl {ste_kind=STE_Imported (STE_Instance class_ident) _} dcl_modules expl_imp_infos cs_symbol_table + // this alternative is only for old syntax (cs_symbol_table argument is not necessary for new syntax) + # cs_symbol_table + = checkExplImpForInstance decl class_ident cs_symbol_table + = (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) + +addExplImpInfo :: !Index Declaration ![Declaration] !ComponentNrAndIndex !(!u:{#DclModule}, !{!{!*ExplImpInfo}}, !v:SymbolTable) + -> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !v:SymbolTable) +addExplImpInfo mod_index decl instances { 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 + (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) + = (dcl_modules, { expl_imp_infos & [cai_component_nr,cai_index] = new_expl_imp_info }, cs_symbol_table) + where + get_belonging_symbol_nrs :: !Declaration !{#x:DclModule} !u:(Heap SymbolTableEntry) + -> (!.NumberSet,!{#x: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 + (_, 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) + + set_bit {id_info} (bit_nr, bitvect, cs_symbol_table) + # ({ste_kind}, cs_symbol_table) + = readPtr id_info cs_symbol_table + = ( bit_nr+1 + , case ste_kind of + STE_Empty -> bitvect + _ -> bitvectSet bit_nr bitvect + , cs_symbol_table + ) + +getBelongingSymbols :: !Declaration !{#x:DclModule} -> (!.BelongingSymbols, !{#x:DclModule}) +getBelongingSymbols {dcl_kind=STE_Imported STE_Type def_mod_index, dcl_index} dcl_modules + # ({td_rhs}, dcl_modules) + = dcl_modules![def_mod_index].dcl_common.com_type_defs.[dcl_index] + = case td_rhs of + AlgType constructors + -> (BS_Constructors constructors, dcl_modules) + RecordType {rt_fields} + -> (BS_Fields rt_fields, dcl_modules) + _ + -> (BS_Nothing, dcl_modules) +getBelongingSymbols {dcl_kind=STE_Imported STE_Class def_mod_index, dcl_index} dcl_modules + # ({class_members}, dcl_modules) + = dcl_modules![def_mod_index].dcl_common.com_class_defs.[dcl_index] + = (BS_Members class_members, dcl_modules) +getBelongingSymbols _ dcl_modules + = (BS_Nothing, dcl_modules) + +nrOfBelongingSymbols :: !BelongingSymbols -> Int +nrOfBelongingSymbols (BS_Constructors constructors) + = length constructors +nrOfBelongingSymbols (BS_Fields fields) + = size fields +nrOfBelongingSymbols (BS_Members members) + = size members +nrOfBelongingSymbols BS_Nothing + = 0 + +:: BelongingSymbols + = BS_Constructors ![DefinedSymbol] + | BS_Fields !{#FieldSymbol} + | BS_Members !{#DefinedSymbol} + | BS_Nothing + +foldlBelongingSymbols f bs st + :== case bs of + BS_Constructors constructors + -> foldSt (\{ds_ident} st -> f ds_ident st) constructors st + BS_Fields fields + -> foldlArraySt (\{fs_name} st -> f fs_name st) fields st + BS_Members members + -> foldlArraySt (\{ds_ident} st -> f ds_ident st) members st + BS_Nothing + -> st + +checkExplImpForInstance decl class_ident cs_symbol_table + // this function is only for old syntax + | switch_import_syntax False True + = cs_symbol_table + # (class_ste, cs_symbol_table) + = readPtr class_ident.id_info cs_symbol_table + = case class_ste.ste_kind of + STE_ExplImpComponentNrs component_numbers inst_indices_accu + -> writePtr class_ident.id_info + { class_ste & ste_kind = STE_ExplImpComponentNrs component_numbers [decl:inst_indices_accu]} + cs_symbol_table + _ + -> cs_symbol_table + + removeImportsAndLocalsOfModuleFromSymbolTable :: !Declarations !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry removeImportsAndLocalsOfModuleFromSymbolTable {dcls_import,dcls_local} symbol_table @@ -406,65 +414,38 @@ addDefToSymbolTable level def_index def_ident=:{id_info} def_kind symbol_table e = (symbol_table <:= (id_info,entry), error) = (symbol_table, checkError def_ident " already defined" error) -addDeclaredSymbolsToSymbolTable2 :: .Bool .Int !{!.Declaration} !{!.Declaration} !*CheckState -> .CheckState; +addDeclaredSymbolsToSymbolTable2 :: .Bool .Int !{!Declaration} !{!Declaration} !*CheckState -> .CheckState; addDeclaredSymbolsToSymbolTable2 is_dcl_mod ste_index locals imported cs # cs=add_imports_in_array_to_symbol_table 0 is_dcl_mod imported cs = addLocalSymbolsForImportToSymbolTable 0 locals ste_index cs -addDeclaredSymbolsToSymbolTable :: .Bool .Int ![.Declaration] !{!.Declaration} !*CheckState -> .CheckState; -addDeclaredSymbolsToSymbolTable is_dcl_mod ste_index locals imported cs - # cs=add_imports_in_array_to_symbol_table 0 is_dcl_mod imported cs - = addLocalSymbolsToSymbolTable locals ste_index cs -where - add_imports_to_symbol_table is_dcl_mod [{dcl_ident,dcl_pos,dcl_kind,dcl_index} : symbols] cs=:{cs_x} - = case dcl_kind of - STE_Imported def_kind def_mod - | is_dcl_mod || def_mod <> cs_x.x_main_dcl_module_n - // -> add_imports_to_symbol_table is_dcl_mod symbols (addImportedSymbol dcl_ident dcl_pos def_kind dcl_index def_mod cs) - -> add_imports_to_symbol_table is_dcl_mod symbols (addIndirectlyImportedSymbol dcl_ident dcl_pos dcl_kind def_kind dcl_index def_mod cs) - -> add_imports_to_symbol_table is_dcl_mod symbols cs - STE_FunctionOrMacro _ - -> add_imports_to_symbol_table is_dcl_mod symbols (addImportedFunctionOrMacro dcl_ident dcl_index cs) - add_imports_to_symbol_table is_dcl_mod [] cs - = cs - add_imports_in_array_to_symbol_table symbol_index is_dcl_mod symbols cs=:{cs_x} | symbol_index<size symbols #! ({dcl_ident,dcl_pos,dcl_kind},symbols) = symbols![symbol_index] = case dcl_kind of STE_Imported def_kind def_mod -// | is_dcl_mod || def_mod <> cIclModIndex | is_dcl_mod || def_mod <> cs_x.x_main_dcl_module_n -// -> add_imports_in_array_to_symbol_table (symbol_index+1) is_dcl_mod symbols (addImportedSymbol dcl_ident dcl_pos def_kind dcl_index def_mod cs) #! dcl_index= symbols.[symbol_index].dcl_index - -> add_imports_in_array_to_symbol_table (symbol_index+1) is_dcl_mod symbols (addIndirectlyImportedSymbol dcl_ident dcl_pos dcl_kind def_kind dcl_index def_mod cs) + -> add_imports_in_array_to_symbol_table (symbol_index+1) is_dcl_mod symbols (addIndirectlyImportedSymbolOld dcl_ident dcl_pos dcl_kind def_kind dcl_index def_mod cs) -> add_imports_in_array_to_symbol_table (symbol_index+1) is_dcl_mod symbols cs STE_FunctionOrMacro _ #! dcl_index= symbols.[symbol_index].dcl_index -> add_imports_in_array_to_symbol_table (symbol_index+1) is_dcl_mod symbols (addImportedFunctionOrMacro dcl_ident dcl_index cs) = cs -addLocalSymbolsForImportToSymbolTable :: !Int !{!.Declaration} Int !*CheckState -> .CheckState; +addLocalSymbolsForImportToSymbolTable :: !Int !{!Declaration} Int !*CheckState -> .CheckState; addLocalSymbolsForImportToSymbolTable symbol_index symbols mod_index cs | symbol_index<size symbols # ({dcl_ident,dcl_pos,dcl_kind,dcl_index},symbols) = symbols![symbol_index] = case dcl_kind of STE_FunctionOrMacro _ - -> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index (addImportedFunctionOrMacro dcl_ident dcl_index cs) + -> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index + (addImportedFunctionOrMacro dcl_ident dcl_index cs) STE_Imported def_kind def_mod - -> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index (addIndirectlyImportedSymbol dcl_ident dcl_pos dcl_kind def_kind dcl_index mod_index cs) + -> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index + (addIndirectlyImportedSymbolOld dcl_ident dcl_pos dcl_kind def_kind dcl_index mod_index cs) = cs -addLocalSymbolsToSymbolTable :: ![.Declaration] Int !*CheckState -> .CheckState; -addLocalSymbolsToSymbolTable [{dcl_ident,dcl_pos,dcl_kind,dcl_index} : symbols] mod_index cs - = case dcl_kind of - STE_FunctionOrMacro _ - -> addLocalSymbolsToSymbolTable symbols mod_index (addImportedFunctionOrMacro dcl_ident dcl_index cs) - _ - -> addLocalSymbolsToSymbolTable symbols mod_index (addImportedSymbol dcl_ident dcl_pos dcl_kind dcl_index mod_index cs) -addLocalSymbolsToSymbolTable [] mod_index cs - = cs - addImportedFunctionOrMacro :: !Ident .Int !*CheckState -> .CheckState; addImportedFunctionOrMacro ident=:{id_info} def_index cs=:{cs_symbol_table} #! entry = sreadPtr id_info cs_symbol_table @@ -487,48 +468,54 @@ addFieldToSelectorDefinition {id_info} glob_field_index cs=:{cs_symbol_table} _ -> { cs & cs_symbol_table = NewEntry cs.cs_symbol_table id_info (STE_Selector [glob_field_index]) NoIndex cModuleScope entry } -addImportedSymbol :: !Ident !Position !STE_Kind !.Int !.Int !*CheckState -> .CheckState; -addImportedSymbol ident pos def_kind def_index def_mod cs=:{cs_symbol_table} - # (entry, cs_symbol_table) = readPtr ident.id_info cs_symbol_table - = add_imported_symbol entry ident pos def_kind def_index def_mod { cs & cs_symbol_table = cs_symbol_table } +addIndirectlyImportedSymbolOld :: !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !*CheckState -> .CheckState; +addIndirectlyImportedSymbolOld ident pos dcl_kind def_kind def_index def_mod cs=:{cs_symbol_table} + # (entry, cs_symbol_table) = readPtr ident.id_info cs_symbol_table + = add_indirectly_imported_symbol entry ident pos def_kind def_index def_mod { cs & cs_symbol_table = cs_symbol_table } where - add_imported_symbol /*entry=:*/{ste_kind = STE_Empty} {id_name,id_info} _ def_kind def_index def_mod cs=:{cs_symbol_table} + add_indirectly_imported_symbol /*entry=:*/{ste_kind = STE_Empty} {id_name,id_info} _ def_kind def_index def_mod cs=:{cs_symbol_table} // JVG: read the entry again, because it is boxed # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table - # cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info (STE_Imported def_kind def_mod) def_index cModuleScope entry} + # cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info dcl_kind def_index cModuleScope entry} = case def_kind of STE_Field selector_id -> addFieldToSelectorDefinition selector_id { glob_module = def_mod, glob_object = def_index } cs _ -> cs - add_imported_symbol /*entry=:*/{ste_kind = STE_Imported kind mod_index, ste_index} ident=:{id_info} _ def_kind def_index def_mod cs + add_indirectly_imported_symbol /*entry=:*/{ste_kind = STE_Imported kind mod_index, ste_index} ident=:{id_info} _ def_kind def_index def_mod cs | kind == def_kind && mod_index == def_mod && ste_index == def_index = cs - add_imported_symbol entry ident pos def_kind def_index def_mod cs=:{cs_error} + add_indirectly_imported_symbol entry ident pos def_kind def_index def_mod cs=:{cs_error} = { cs & cs_error = checkErrorWithIdentPos (newPosition ident pos) " multiply imported" cs_error} -// same as addImportedSymbol but does not create a new STE_Imported -addIndirectlyImportedSymbol :: !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !*CheckState -> .CheckState; -addIndirectlyImportedSymbol ident pos dcl_kind def_kind def_index def_mod cs=:{cs_symbol_table} +mw_addIndirectlyImportedSymbol :: !(Optional a) !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !Int !*CheckState -> (!Bool, !.CheckState) +mw_addIndirectlyImportedSymbol yes_for_icl_module ident pos dcl_kind def_kind def_index def_mod importing_mod cs=:{cs_symbol_table} # (entry, cs_symbol_table) = readPtr ident.id_info cs_symbol_table - = add_indirectly_imported_symbol entry ident pos def_kind def_index def_mod { cs & cs_symbol_table = cs_symbol_table } + = add_indirectly_imported_symbol yes_for_icl_module entry ident pos def_kind def_index def_mod + importing_mod { cs & cs_symbol_table = cs_symbol_table } where - add_indirectly_imported_symbol /*entry=:*/{ste_kind = STE_Empty} {id_name,id_info} _ def_kind def_index def_mod cs=:{cs_symbol_table} - // JVG: read the entry again, because it is boxed + add_indirectly_imported_symbol _ {ste_kind = STE_Empty} {id_info} _ def_kind def_index def_mod _ cs=:{cs_symbol_table} # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table - # cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info dcl_kind def_index cModuleScope entry} + cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info dcl_kind def_index cModuleScope entry} = case def_kind of STE_Field selector_id - -> addFieldToSelectorDefinition selector_id { glob_module = def_mod, glob_object = def_index } cs + -> (True, addFieldToSelectorDefinition selector_id { glob_module = def_mod, glob_object = def_index } cs) _ - -> cs - add_indirectly_imported_symbol /*entry=:*/{ste_kind = STE_Imported kind mod_index, ste_index} ident=:{id_info} _ def_kind def_index def_mod cs + -> (True, cs) + add_indirectly_imported_symbol _ {ste_kind = STE_Imported kind mod_index, ste_index} _ _ def_kind def_index def_mod _ cs | kind == def_kind && mod_index == def_mod && ste_index == def_index - = cs - add_indirectly_imported_symbol entry ident pos def_kind def_index def_mod cs=:{cs_error} - = { cs & cs_error = checkErrorWithIdentPos (newPosition ident pos) " multiply imported" cs_error} - -addGlobalDefinitionsToSymbolTable :: ![.Declaration] !*CheckState -> .CheckState; + = (False, cs) + add_indirectly_imported_symbol (Yes _) _ _ _ def_kind def_index def_mod _ cs + | def_mod == cs.cs_x.x_main_dcl_module_n + // an icl module imports one of it's definitions from the dcl module + = (False, cs) + add_indirectly_imported_symbol _ _ _ _ def_kind def_index def_mod importing_mod cs + | importing_mod==def_mod // a dcl module imports a definition from itself (cycle) + = (False, cs) + add_indirectly_imported_symbol _ entry ident pos def_kind def_index def_mod _ cs=:{cs_error} + = (False, { cs & cs_error = checkError ident "multiply defined" cs_error}) + +addGlobalDefinitionsToSymbolTable :: ![Declaration] !*CheckState -> .CheckState; addGlobalDefinitionsToSymbolTable decls cs = foldSt add_global_definition decls cs where @@ -541,18 +528,8 @@ where -> addFieldToSelectorDefinition selector_id { glob_module = NoIndex, glob_object = dcl_index } cs _ -> cs - = { cs & cs_error = checkErrorWithIdentPos (newPosition ident dcl_pos) "(global definition) already defined" cs.cs_error} - -retrieveImportsFromSymbolTable :: ![Import ImportDeclaration] ![Declaration] !*{#DclModule} !*(Heap SymbolTableEntry) -> *(![Declaration],!*{#DclModule},!*Heap SymbolTableEntry); -retrieveImportsFromSymbolTable [{import_module=import_module=:{id_info},import_symbols} : mods ] decls modules symbol_table - # ({ste_index}, symbol_table) = readPtr id_info symbol_table - ({dcl_declared={dcls_import,dcls_local,dcls_local_for_import}}, modules) = modules![ste_index] -// (decls, symbol_table) = retrieveAndRemoveImportsOfModuleFromSymbolTable dcls_import dcls_local decls symbol_table - (decls, symbol_table) = retrieveAndRemoveImportsOfModuleFromSymbolTable2 dcls_import dcls_local_for_import decls symbol_table - = retrieveImportsFromSymbolTable mods decls modules symbol_table -retrieveImportsFromSymbolTable [] decls modules symbol_table - = (decls, modules, symbol_table) - + = { cs & cs_error = checkErrorWithIdentPos (newPosition ident dcl_pos) " multiply defined" cs.cs_error} + removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; removeFieldFromSelectorDefinition {id_info} field_mod field_index symbol_table # (entry, symbol_table) = readPtr id_info symbol_table @@ -568,12 +545,13 @@ where remove_field field_mod field_index [] = [] -removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*(Heap SymbolTableEntry) -> *Heap SymbolTableEntry; +removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *SymbolTable removeDeclarationsFromSymbolTable decls scope symbol_table - = foldSt (remove_declaration scope) decls symbol_table + = unsafeFold2St (remove_declaration scope) decls [1..] symbol_table where - remove_declaration scope {dcl_ident={id_name,id_info}, dcl_index} symbol_table - # ({ste_kind,ste_previous}, symbol_table) = readPtr id_info symbol_table + remove_declaration scope decl=:{dcl_ident={id_info}, dcl_index} decl_nr symbol_table + # ({ste_kind,ste_previous}, symbol_table) + = readPtr id_info symbol_table = case ste_kind of STE_Field field_id # symbol_table = removeFieldFromSelectorDefinition field_id NoIndex dcl_index symbol_table @@ -638,6 +616,19 @@ local_declaration_for_import decl=:{dcl_kind} module_n = {decl & dcl_kind = STE_Imported dcl_kind module_n} +get_ident :: !ImportDeclaration -> Ident +get_ident (ID_Function {ii_ident}) = ii_ident +get_ident (ID_Class {ii_ident} _) = ii_ident +get_ident (ID_Type {ii_ident} _) = ii_ident +get_ident (ID_Record {ii_ident} _) = ii_ident +get_ident (ID_Instance class_ident instance_ident _) = instance_ident + +getBelongingSymbolsFromID :: !ImportDeclaration -> Optional [ImportedIdent] +getBelongingSymbolsFromID (ID_Class _ x) = x +getBelongingSymbolsFromID (ID_Type _ x) = x +getBelongingSymbolsFromID (ID_Record _ x) = x +getBelongingSymbolsFromID _ = No + class toIdent a :: !a -> Ident instance toIdent SymbIdent @@ -713,65 +704,23 @@ where = file <<< '[' <<< ip_file <<< ',' <<< ip_line <<< ',' <<< ip_ident <<< ']' -instance <<< STE_Kind -where - (<<<) file - (STE_FunctionOrMacro _) - = file <<< "STE_FunctionOrMacro" - (<<<) file - STE_Type - = file <<< "STE_Type" - (<<<) file - STE_Constructor - = file <<< "STE_Constructor" - (<<<) file - (STE_Selector _) - = file <<< "STE_Selector" - (<<<) file - STE_Class - = file <<< "STE_Class" - (<<<) file - STE_Member - = file <<< "STE_Member" - (<<<) file - (STE_Instance _) - = file <<< "STE_Instance" - (<<<) file - (STE_Variable _) - = file <<< "STE_Variable" - (<<<) file - (STE_TypeVariable _) - = file <<< "STE_TypeVariable" - (<<<) file - (STE_TypeAttribute _) - = file <<< "STE_TypeAttribute" - (<<<) file - (STE_BoundTypeVariable _) - = file <<< "STE_BoundTypeVariable" - (<<<) file - (STE_Imported _ _) - = file <<< "STE_Imported" - (<<<) file - STE_DclFunction - = file <<< "STE_DclFunction" - (<<<) file - (STE_Module _) - = file <<< "STE_Module" - (<<<) file - (STE_OpenModule _ _) - = file <<< "STE_OpenModule" - (<<<) file - STE_ClosedModule - = file <<< "STE_ClosedModule" - (<<<) file - STE_LockedModule - = file <<< "STE_LockedModule" - (<<<) file - STE_Empty - = file <<< "STE_Empty" - -instance <<< Declaration +instance <<< ExplImpInfo where - (<<<) file { dcl_ident } - = file <<< dcl_ident + (<<<) file (ExplImpInfo eii_ident eii_declaring_modules) + = file <<< eii_ident //<<< " is declared in " <<< eii_declaring_modules +instance <<< DeclarationInfo + where + (<<<) file {di_decl, di_instances} + = file <<< di_decl <<< di_instances + +import_ident :: Ident +import_ident =: { id_name = "import", id_info = nilPtr } + +restoreHeap :: !Ident !*SymbolTable -> .SymbolTable +restoreHeap {id_info} cs_symbol_table + # ({ste_previous}, cs_symbol_table) + = readPtr id_info cs_symbol_table + = writePtr id_info ste_previous cs_symbol_table + +temp_try_a_new_thing_XXX yes no :== no diff --git a/frontend/checktypes.dcl b/frontend/checktypes.dcl index 4e04a6d..c8d8f13 100644 --- a/frontend/checktypes.dcl +++ b/frontend/checktypes.dcl @@ -26,3 +26,6 @@ clearBindingsOfTypeVarsAndAttributes :: !TypeAttribute ![ATypeVar] !*TypeHeaps - isATopConsVar cv :== cv < 0 encodeTopConsVar cv :== dec (~cv) decodeTopConsVar cv :== ~(inc cv) + +expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin + -> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin) diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl index d54f715..198d7f5 100644 --- a/frontend/checktypes.icl +++ b/frontend/checktypes.icl @@ -422,7 +422,7 @@ where | type_index == nr_of_types | cs.cs_error.ea_ok && not is_main_dcl # marks = createArray nr_of_types CS_NotChecked - {exp_type_defs,exp_modules,exp_type_heaps,exp_error} = expand_syn_types module_index 0 nr_of_types + {exp_type_defs,exp_modules,exp_type_heaps,exp_error} = (temp_try_a_new_thing_XXX id (expand_syn_types module_index 0 nr_of_types)) { exp_type_defs = ts.ts_type_defs, exp_modules = ts.ts_modules, exp_marks = marks, exp_type_heaps = ti_type_heaps, exp_error = cs.cs_error } = (exp_type_defs, ts.ts_cons_defs, ts.ts_selector_defs, exp_modules, ti_var_heap, exp_type_heaps, { cs & cs_error = exp_error }) @@ -430,14 +430,29 @@ where # (ts, ti, cs) = checkTypeDef type_index module_index ts ti cs = check_type_defs is_main_dcl (inc type_index) nr_of_types module_index ts ti cs - expand_syn_types module_index type_index nr_of_types expst - | type_index == nr_of_types - = expst - | expst.exp_marks.[type_index] == CS_NotChecked - # expst = expandSynType module_index type_index expst - = expand_syn_types module_index (inc type_index) nr_of_types expst - = expand_syn_types module_index (inc type_index) nr_of_types expst - +expand_syn_types module_index type_index nr_of_types expst + | type_index == nr_of_types + = expst + | expst.exp_marks.[type_index] == CS_NotChecked + # expst = expandSynType module_index type_index expst + = expand_syn_types module_index (inc type_index) nr_of_types expst + = expand_syn_types module_index (inc type_index) nr_of_types expst + +expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin + -> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin) +expandSynonymTypes module_index exp_type_defs exp_modules exp_type_heaps exp_error + | temp_try_a_new_thing_XXX False True + = abort "expandSynonymTypes" + #! nr_of_types + = size exp_type_defs + # marks + = createArray nr_of_types CS_NotChecked + {exp_type_defs,exp_modules,exp_type_heaps,exp_error} + = expand_syn_types module_index 0 nr_of_types + { exp_type_defs = exp_type_defs, exp_modules = exp_modules, exp_marks = marks, + exp_type_heaps = exp_type_heaps, exp_error = exp_error } + = (exp_type_defs,exp_modules,exp_type_heaps,exp_error) + :: OpenTypeInfo = { oti_heaps :: !.TypeHeaps , oti_all_vars :: ![TypeVar] diff --git a/frontend/containers.dcl b/frontend/containers.dcl new file mode 100644 index 0000000..82e5f91 --- /dev/null +++ b/frontend/containers.dcl @@ -0,0 +1,49 @@ +definition module containers + +from syntax import Optional +from StdOverloaded import toString + +:: NumberSet = Numbers !Int !NumberSet | EndNumbers + +addNr :: !Int !NumberSet -> NumberSet +inNumberSet :: !Int !NumberSet -> Bool +numberSetUnion :: !NumberSet !NumberSet -> NumberSet +nsFromTo :: !Int -> NumberSet + // all numbers from 0 to (i-1) +bitvectToNumberSet :: !LargeBitvect -> .NumberSet + +:: LargeBitvect :== {#Int} + +bitvectSelect :: !Int !LargeBitvect -> Bool +bitvectSet :: !Int !*LargeBitvect -> .LargeBitvect +bitvectCreate :: !Int -> .LargeBitvect +bitvectReset :: !*LargeBitvect -> .LargeBitvect + +:: IntKey :== Int + +:: IntKeyHashtable a = + { ikh_rehash_threshold :: !Int + , ikh_nr_of_entries :: !Int + , ikh_bitmask :: !Int + , ikh_entries :: !.{!.IntKeyTree a} + } + +:: IntKeyTree a = IKT_Leaf | IKT_Node !IntKey a !.(IntKeyTree a) !.(IntKeyTree a) + +ikhEmpty :: .(IntKeyHashtable a) +ikhInsert :: !Bool !IntKey a !*(IntKeyHashtable a) -> (!Bool, !.IntKeyHashtable a) + // input bool: overide old value, output bool: a new element was inserted +ikhInsert` :: !Bool !IntKey a !*(IntKeyHashtable a) -> .IntKeyHashtable a + // bool: overide old value +ikhSearch :: !IntKey !(IntKeyHashtable a) -> .Optional a +ikhSearch` :: !IntKey !(IntKeyHashtable a) -> a +ikhUSearch :: !IntKey !*(IntKeyHashtable a) -> (!.Optional a, !*IntKeyHashtable a) + +iktUInsert :: !Bool !IntKey a !*(IntKeyTree a) -> (!Bool, !.IntKeyTree a) + // input bool: overide old value, output bool: a new element was inserted +iktFlatten :: !(IntKeyTree a) -> [(IntKey, a)] +iktSearch :: !IntKey !(IntKeyTree a) -> .Optional a +iktSearch` :: !IntKey !(IntKeyTree a) -> a +iktUSearch :: !IntKey !*(IntKeyTree a) -> (!.Optional a,.IntKeyTree a) + +instance toString (IntKeyTree a) | toString a, (IntKeyHashtable a) | toString a diff --git a/frontend/containers.icl b/frontend/containers.icl new file mode 100644 index 0000000..362d380 --- /dev/null +++ b/frontend/containers.icl @@ -0,0 +1,309 @@ +implementation module containers + +import StdEnv, utilities, syntax + +:: NumberSet = Numbers !Int !NumberSet | EndNumbers + +inNumberSet :: !Int !NumberSet -> Bool +inNumberSet n EndNumbers + = False; +inNumberSet n (Numbers module_numbers rest_module_numbers) + | n<32 + = (module_numbers bitand (1<<n))<>0 + = inNumberSet (n-32) rest_module_numbers + +nsFromTo :: !Int -> NumberSet + // all numbers from 0 to (i-1) +nsFromTo i + | i<=0 + = EndNumbers + | i<=31 + = Numbers (bitnot ((-1)<<i)) EndNumbers + = Numbers (-1) (nsFromTo (i-32)) + +addNr :: !Int !NumberSet -> NumberSet +addNr n EndNumbers + | n<32 + = Numbers (1<<n) EndNumbers + = Numbers 0 (addNr (n-32) EndNumbers) +addNr n (Numbers module_numbers rest_module_numbers) + | n<32 + = Numbers (module_numbers bitor (1<<n)) rest_module_numbers + = Numbers module_numbers (addNr (n-32) rest_module_numbers) + +numberSetUnion :: !NumberSet !NumberSet -> NumberSet +numberSetUnion EndNumbers x + = x +numberSetUnion x EndNumbers + = x +numberSetUnion (Numbers i1 tail1) (Numbers i2 tail2) + = Numbers (i1 bitor i2) (numberSetUnion tail1 tail2) + +is_empty_module_n_set EndNumbers + = True; +is_empty_module_n_set (Numbers 0 module_numbers) + = is_empty_module_n_set module_numbers +is_empty_module_n_set _ + = False; + +remove_first_module_number (Numbers 0 rest_module_numbers) + # (bit_n,rest_module_numbers) = remove_first_module_number rest_module_numbers + = (bit_n+32,Numbers 0 rest_module_numbers) +remove_first_module_number (Numbers module_numbers rest_module_numbers) + # bit_n = first_one_bit module_numbers + = (bit_n,Numbers (module_numbers bitand (bitnot (1<<bit_n))) rest_module_numbers) + +first_one_bit module_numbers + | module_numbers bitand 0xff<>0 + = first_one_bit_in_byte 0 module_numbers + | module_numbers bitand 0xff00<>0 + = first_one_bit_in_byte 8 module_numbers + | module_numbers bitand 0xff0000<>0 + = first_one_bit_in_byte 16 module_numbers + = first_one_bit_in_byte 24 module_numbers + +first_one_bit_in_byte n module_numbers + | module_numbers bitand (1<<n)<>0 + = n + = first_one_bit_in_byte (n+1) module_numbers + +bitvectToNumberSet :: !LargeBitvect -> .NumberSet +bitvectToNumberSet a + = loop a (size a - 1) + where + loop a (-1) + = EndNumbers + loop a i + | a.[i]==0 + = loop a (i-1) + = loop2 a i EndNumbers + + loop2 a (-1) accu + = accu + loop2 a i accu + = loop2 a (i-1) (Numbers a.[i] accu) + +BITINDEX index :== index >> 5 +BITNUMBER index :== index bitand 31 + +:: LargeBitvect :== {#Int} + +bitvectSelect :: !Int !LargeBitvect -> Bool +bitvectSelect index a + = a.[BITINDEX index] bitand (1 << BITNUMBER index) <> 0 + +bitvectSet :: !Int !*LargeBitvect -> .LargeBitvect +bitvectSet index a + #! bit_index = BITINDEX index + a_bit_index = a.[bit_index] + = { a & [bit_index] = a_bit_index bitor (1 << BITNUMBER index)} + +bitvectCreate :: !Int -> .LargeBitvect +bitvectCreate 0 = {} +bitvectCreate n_elements = createArray ((BITINDEX (n_elements-1)+1)) 0 + +bitvectReset :: !*LargeBitvect -> .LargeBitvect +bitvectReset arr + #! size + = size arr + = { arr & [i] = 0 \\ i<-[0..size-1] } // list should be optimized away +bitvectOr :: !u:LargeBitvect !*LargeBitvect -> (!Bool, !u:LargeBitvect, !*LargeBitvect) +// Boolean result: whether the unique bitvect has changed +bitvectOr op1 op2 + #! size + = size op1 + = iFoldSt word_or 0 size (False, op1, op2) + where + word_or i (has_changed, op1=:{[i]=op1_i}, op2=:{[i]=op2_i}) + # or = op1_i bitor op2_i + | or==op2_i + = (has_changed, op1, op2) + = (True, op1, { op2 & [i] = or }) + +screw :== 80 + +:: IntKey :== Int + +:: IntKeyHashtable a = + { ikh_rehash_threshold :: !Int + , ikh_nr_of_entries :: !Int + , ikh_bitmask :: !Int + , ikh_entries :: !.{!.IntKeyTree a} + } + +:: IntKeyTree a = IKT_Leaf | IKT_Node !IntKey a !.(IntKeyTree a) !.(IntKeyTree a) + +ikhEmpty :: .(IntKeyHashtable a) +ikhEmpty = { ikh_rehash_threshold = 0, ikh_nr_of_entries = 0, + ikh_bitmask = 0, ikh_entries = {} } + +ikhInsert :: !Bool !IntKey a !*(IntKeyHashtable a) -> (!Bool, !.IntKeyHashtable a) +ikhInsert overide int_key value ikh=:{ ikh_rehash_threshold, ikh_nr_of_entries, ikh_bitmask, ikh_entries } + | ikh_rehash_threshold<=ikh_nr_of_entries + = ikhInsert overide int_key value (grow ikh_entries) + #! hash_value + = int_key bitand ikh_bitmask + (tree, ikh_entries) + = replace ikh_entries hash_value IKT_Leaf + (is_new, tree) + = iktUInsert overide int_key value tree + ikh + = { ikh & ikh_entries = { ikh_entries & [hash_value] = tree }} + | is_new + = (is_new, { ikh & ikh_nr_of_entries = ikh_nr_of_entries+1 }) + = (is_new, ikh) + +grow :: !{!*(IntKeyTree a)} -> .(IntKeyHashtable a) +grow old_entries + #! size + = size old_entries + new_size + = if (size==0) 2 (2*size) + new_entries + = { IKT_Leaf \\ i<-[1..new_size] } + ikh + = { ikh_rehash_threshold = (new_size*screw)/100, ikh_nr_of_entries = 0, + ikh_bitmask = new_size-1, ikh_entries = new_entries } + (_, ikh) + = iFoldSt rehashTree 0 size (old_entries, ikh) + = ikh + where + rehashTree :: !Int (!{!*IntKeyTree a}, !*IntKeyHashtable a) + -> (!{!*IntKeyTree a}, !*IntKeyHashtable a) + rehashTree index (old_entries, ikh) + #! (tree, old_entries) + = replace old_entries index IKT_Leaf + list + = iktFlatten tree + ikh + = foldSt (\(key, value) ikh -> snd (ikhInsert False key value ikh)) list ikh + = (old_entries, ikh) + +ikhInsert` :: !Bool !IntKey a !*(IntKeyHashtable a) -> .IntKeyHashtable a +ikhInsert` overide int_key value ikh + = snd (ikhInsert overide int_key value ikh) + +ikhSearch :: !IntKey !(IntKeyHashtable a) -> .Optional a +ikhSearch int_key { ikh_bitmask, ikh_entries } + | size ikh_entries==0 + = No + = iktSearch int_key ikh_entries.[int_key bitand ikh_bitmask] + +ikhSearch` :: !IntKey !(IntKeyHashtable a) -> a +ikhSearch` int_key {ikh_bitmask, ikh_entries } + | size ikh_entries==0 + = abort "ikhSearch`: key not found" + = iktSearch` int_key ikh_entries.[int_key bitand ikh_bitmask] + +ikhUSearch :: !IntKey !*(IntKeyHashtable a) -> (!.Optional a, !*IntKeyHashtable a) +ikhUSearch int_key ikh=:{ikh_bitmask, ikh_entries} + | size ikh_entries==0 + = (No, ikh) + # hash_value + = int_key bitand ikh_bitmask + (ikt, ikh_entries) + = replace ikh_entries hash_value IKT_Leaf + (opt_result, ikt) + = iktUSearch int_key ikt + ikh_entries + = { ikh_entries & [hash_value] = ikt } + = (opt_result, { ikh & ikh_entries = ikh_entries }) + +iktUInsert :: !Bool !IntKey a !*(IntKeyTree a) -> (!Bool, !.IntKeyTree a) +iktUInsert overide int_key value IKT_Leaf + = (True, IKT_Node int_key value IKT_Leaf IKT_Leaf) +iktUInsert overide int_key value (IKT_Node key2 value2 left right) + | int_key<key2 + # (is_new, left`) + = iktUInsert overide int_key value left + = (is_new, IKT_Node key2 value2 left` right) + | int_key>key2 + # (is_new, right`) + = iktUInsert overide int_key value right + = (is_new, IKT_Node key2 value2 left right`) + | overide + = (False, IKT_Node int_key value left right) + = (False, IKT_Node key2 value2 left right) + +iktFlatten :: !(IntKeyTree a) -> [(IntKey, a)] +iktFlatten ikt + = flatten ikt [] + where + flatten IKT_Leaf accu + = accu + flatten (IKT_Node int_key value left right) accu + = flatten left [(int_key, value) : flatten right accu] + +iktUSearch :: !IntKey !*(IntKeyTree a) -> (!.Optional a,.IntKeyTree a) +iktUSearch int_key leaf=:IKT_Leaf + = (No, leaf) +iktUSearch int_key ikt=:(IKT_Node key2 value left right) + | int_key<key2 + # (opt_result, left) + = iktUSearch int_key left + = (opt_result, IKT_Node key2 value left right) + | int_key>key2 + # (opt_result, right) + = iktUSearch int_key right + = (opt_result, IKT_Node key2 value left right) + = (Yes value, ikt) + +iktSearch :: !IntKey !(IntKeyTree a) -> .Optional a +iktSearch int_key IKT_Leaf + = No +iktSearch int_key (IKT_Node key2 value left right) + | int_key<key2 + = iktSearch int_key left + | int_key>key2 + = iktSearch int_key right + = Yes value + +iktSearch` :: !IntKey !(IntKeyTree a) -> a +iktSearch` int_key (IKT_Node key2 value left right) + | int_key<key2 + = iktSearch` int_key left + | int_key>key2 + = iktSearch` int_key right + = value +iktSearch` int_key IKT_Leaf + = abort "iktSearch`: key not found" + +instance toString (IntKeyTree a) | toString a + where + toString ikt + # list + = iktFlatten ikt + = listToString "," list + + +listToString _ [] + = "[]" +listToString del l + = "["+++lts l + where + lts [a] + = toString a+++"]" + lts [h:t] + = toString h+++del+++lts t + +instance toString {!a} | toString a + where + toString arr + # list + = arrayToList arr + = listToString " , " list + where + arrayToList :: {!a} -> [a] + arrayToList arr = [el \\ el<-:arr] + +instance toString (IntKeyHashtable a) |toString a + where + toString { ikh_rehash_threshold, ikh_nr_of_entries, ikh_bitmask, ikh_entries } + = "(IKH "+++toString ikh_rehash_threshold+++" "+++toString ikh_nr_of_entries + +++" "+++toString ikh_bitmask+++" "+++toString ikh_entries + +instance toString (a, b) | toString a & toString b + where + toString (a, b) + = "("+++toString a+++","+++toString b+++")" +
\ No newline at end of file diff --git a/frontend/explicitimports.dcl b/frontend/explicitimports.dcl index 68f9690..0104e79 100644 --- a/frontend/explicitimports.dcl +++ b/frontend/explicitimports.dcl @@ -2,9 +2,20 @@ definition module explicitimports import syntax, checksupport -possiblyFilterExplImportedDecls :: ![ImportDeclaration] u:[w:(.Index,y:Declarations)] Position *{#DclModule} !*CheckState - -> (!v:[x:(Index,z:Declarations)],!.{#DclModule},!.CheckState), [y <= z, w <= x, u <= v] +:: ImportNrAndIdents = + { ini_symbol_nr :: !Index + , ini_belonging :: !Optional [ImportedIdent] + } -checkExplicitImportCompleteness :: !Int ![ExplicitImport] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState +:: SolvedImports = + { si_explicit :: ![([Declaration], Position)] + , si_implicit :: ![(Index, Position)] // module indices + } + + +solveExplicitImports :: !(IntKeyHashtable [(Int,Position,[ImportNrAndIdents])]) !{#Int} !Index + !*(!{#x:DclModule},!*{#Int},!{!*ExplImpInfo},!*CheckState) + -> (!.SolvedImports,!(!{#x:DclModule},!.{#Int},!{!.ExplImpInfo},!.CheckState)) +checkExplicitImportCompleteness :: ![(Declaration, Position)] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState -> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState) diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl index 1494fce..891f508 100644 --- a/frontend/explicitimports.icl +++ b/frontend/explicitimports.icl @@ -12,333 +12,327 @@ import StdEnv import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef, RWSDebug, cheat -possiblyFilterExplImportedDecls :: ![ImportDeclaration] u:[w:(.Index,y:Declarations)] Position *{#DclModule} !*CheckState - -> (!v:[x:(Index,z:Declarations)],!.{#DclModule},!.CheckState), [y <= z, w <= x, u <= v] -possiblyFilterExplImportedDecls [] decls_of_imported_module _ modules cs // implicit import - = (decls_of_imported_module, modules, cs) -possiblyFilterExplImportedDecls import_declarations decls_of_imported_module import_statement_pos modules cs=:{cs_error, cs_symbol_table} - // explicit import - # cs_error = pushErrorAdmin (newPosition { id_name="", id_info=nilPtr } import_statement_pos) cs_error - (wanted_symbols, cs_symbol_table, cs_error) - = foldSt add_wanted_symbol_to_symbol_table import_declarations ([], cs_symbol_table, cs_error) - fs = { fs_wanted_symbols = wanted_symbols, fs_modules = modules, - fs_symbol_table = cs_symbol_table, fs_error = cs_error } - (imported_decls, { fs_wanted_symbols, fs_modules, fs_symbol_table, fs_error }) - = foldSt (filter_decls_per_module import_statement_pos) decls_of_imported_module ([], fs) - cs = foldSt (switch_import_syntax restore_symbol_table_old_syntax restore_symbol_table) fs_wanted_symbols - { cs & cs_symbol_table = fs_symbol_table, cs_error = fs_error } - cs = { cs & cs_error = popErrorAdmin cs.cs_error } - = (imported_decls, fs_modules, cs) +cUndef :== (-1) +implies a b :== not a || b + +:: ImportNrAndIdents = + { ini_symbol_nr :: !Index + , ini_belonging :: !Optional [ImportedIdent] + } + +:: SolvedImports = + { si_explicit :: ![([Declaration], Position)] + , si_implicit :: ![(Index, Position)] // module indices + } + +solveExplicitImports :: !(IntKeyHashtable [(Int,Position,[ImportNrAndIdents])]) !{#Int} !Index + !*(!{#x:DclModule},!*{#Int},!{!*ExplImpInfo},!*CheckState) + -> (!.SolvedImports,!(!{#x: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 ] + (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) + = ({ si_explicit = expl_imports, si_implicit = impl_imports }, state) where - add_wanted_symbol_to_symbol_table import_declaration=:(ID_OldSyntax idents) (wanted_symbols_accu, cs_symbol_table, cs_error) - // this alternative is only for old syntax - = foldSt (add_symbols import_declaration) idents (wanted_symbols_accu, cs_symbol_table, cs_error) - where - add_symbols import_declaration ident=:{id_info} (wanted_symbols_accu, cs_symbol_table, cs_error) - # (ste=:{ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table - = case ste_kind of - STE_ExplImp _ _ _ _ - -> (wanted_symbols_accu, cs_symbol_table, cs_error) - _ # new_ste_kind = STE_ExplImp False (Yes import_declaration) STE_Empty False - new_ste = { ste & ste_kind = new_ste_kind, ste_previous = ste } - cs_symbol_table = writePtr id_info new_ste cs_symbol_table //--->("writing", ident) - -> ([ident:wanted_symbols_accu], cs_symbol_table, cs_error) - add_wanted_symbol_to_symbol_table import_declaration (wanted_symbols_accu, cs_symbol_table, cs_error) - // "wanted" means: a symbol is listed in an explicit import statement - # (ident=:{id_info}) = get_ident import_declaration - (ste=:{ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table - = case ste_kind of - STE_ExplImp _ _ _ _ - -> (wanted_symbols_accu, cs_symbol_table, - checkError ident "appeared twice in one explicit import statement" cs_error) - _ # new_ste_kind = STE_ExplImp False (Yes import_declaration) (imp_decl_to_ste_kind import_declaration) False - new_ste = { ste & ste_kind = new_ste_kind, ste_previous = ste } - cs_symbol_table = writePtr id_info new_ste cs_symbol_table - -> ([ident:wanted_symbols_accu], cs_symbol_table, cs_error) - where - imp_decl_to_ste_kind (ID_Function _) = STE_FunctionOrMacro [] - imp_decl_to_ste_kind (ID_Class _ _) = STE_Class - imp_decl_to_ste_kind (ID_Type _ _) = STE_Type - imp_decl_to_ste_kind (ID_Record _ _) = STE_Type - imp_decl_to_ste_kind (ID_Instance {ii_ident} _ _) = STE_Instance ii_ident + solve_expl_imp_from_module expl_imp_indices_ikh modules_in_component_set importing_mod + (imported_mod, position, imported_symbols) (dcl_modules, visited_modules, expl_imp_info, cs) + # (decl_infos, (visited_modules, expl_imp_info)) + = mapSt (search_expl_imp_symbol expl_imp_indices_ikh modules_in_component_set importing_mod imported_mod) + imported_symbols + (visited_modules, expl_imp_info) + (expl_imp_info, cs_error) + = (switch_import_syntax check_triples check_singles position) decl_infos imported_symbols + (expl_imp_info, cs.cs_error) + belonging_to_solve + = [ (di_decl, ini, imported_mod) \\ Yes ({di_decl}, ini=:{ini_belonging=Yes _}, imported_mod) <- decl_infos] + (belonging_decls, dcl_modules, visited_modules, expl_imp_info, cs) + = foldSt (solve_belonging position expl_imp_indices_ikh modules_in_component_set importing_mod) + belonging_to_solve + ([], dcl_modules, visited_modules, expl_imp_info, { cs & cs_error = cs_error }) +// XXX alles Scheisse + = ((flatten [[di_decl:di_instances] \\ Yes ({di_decl,di_instances}, _, _) <- decl_infos]++belonging_decls, position), + (dcl_modules, visited_modules, expl_imp_info, cs)) + + solve_belonging position expl_imp_indices_ikh modules_in_component_set importing_mod + (decl, {ini_symbol_nr, ini_belonging=Yes belongs}, imported_mod) + (decls_accu, dcl_modules, visited_modules, expl_imp_info, cs=:{cs_error, cs_symbol_table}) + # (all_belongs, dcl_modules) + = get_all_belongs decl dcl_modules + (ExplImpInfo eii_ident eii_declaring_modules, expl_imp_info) + = replace expl_imp_info ini_symbol_nr TemporarilyFetchedAway + (need_all, belongs_set, cs_error, cs_symbol_table) + = case belongs of + [] + // an import like ::A(..) or ::A{..} or class c{..} + -> (False, [(belong_nr, belong_ident) \\ belong_nr<-[0..] & belong_ident<-all_belongs], + cs_error, cs_symbol_table) + _ + // an import like ::A(C1, C2) or ::A{f1} or class c{m1} + # (nr_of_belongs, cs_symbol_table) + = foldSt numerate_belongs all_belongs (0, cs_symbol_table) + belongs_bitvect + = bitvectCreate nr_of_belongs + (belongs_set, (cs_error, cs_symbol_table)) + = mapFilterYesSt (get_opt_nr_and_ident position eii_ident) belongs (cs_error, cs_symbol_table) + cs_symbol_table + = foldSt restoreHeap all_belongs cs_symbol_table + -> (True, belongs_set, cs_error, cs_symbol_table) + (decls_accu, dcl_modules, eii_declaring_modules, visited_modules, cs_error) + = foldSt + (search_belonging need_all position eii_ident decl expl_imp_indices_ikh modules_in_component_set + imported_mod ini_symbol_nr importing_mod) + belongs_set (decls_accu, dcl_modules, eii_declaring_modules, visited_modules, cs_error) + expl_imp_info + = { expl_imp_info & [ini_symbol_nr] = ExplImpInfo eii_ident eii_declaring_modules } + = (decls_accu, dcl_modules, visited_modules, expl_imp_info, { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }) - add_bracket_symbol_to_symbol_table ste_kind all_bracket_ids_are_wanted ident=:{id_info} symbol_table - # (ste=:{ste_kind}, symbol_table) = readPtr id_info symbol_table - new_ste_kind = STE_ExplImp all_bracket_ids_are_wanted No ste_kind (not all_bracket_ids_are_wanted) - new_ste = { ste & ste_kind = new_ste_kind, ste_previous = ste } - symbol_table = writePtr id_info new_ste symbol_table //--->("writing", ident) - = symbol_table - - get_ident (ID_Function {ii_ident}) = ii_ident - get_ident (ID_Class {ii_ident} _) = ii_ident - get_ident (ID_Type {ii_ident} _) = ii_ident - get_ident (ID_Record {ii_ident} _) = ii_ident - get_ident (ID_Instance class_ident instance_ident _) = instance_ident - - restore_symbol_table id=:{id_info} cs=:{ cs_symbol_table, cs_error } - # (ste, cs_symbol_table) = readPtr id_info cs_symbol_table - cs_symbol_table = writePtr id_info ste.ste_previous cs_symbol_table //--->("restoring", id) - cs_error = case ste.ste_kind of - STE_ExplImp success _ ste_kind _ - | success - -> cs_error - -> checkError id ("not exported as a "+++toString ste_kind+++ - " by the specified module") cs_error - _ -> abort "assertion 1 failed in module explicitimports" - = { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error } + search_belonging need_all position eii_ident decl expl_imp_indices_ikh modules_in_component_set imported_mod ini_symbol_nr importing_mod + (belong_nr, belong_ident) (decls_accu, dcl_modules, eii_declaring_modules, visited_modules, cs_error) + # (found, path, eii_declaring_modules, visited_modules) + = depth_first_search expl_imp_indices_ikh modules_in_component_set + imported_mod ini_symbol_nr belong_nr belong_ident [importing_mod] + eii_declaring_modules (bitvectReset 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 + -> ([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 + -> popErrorAdmin cs_error + _ + -> cs_error + -> (decls_accu, dcl_modules, eii_declaring_modules, visited_modules, cs_error) + + store_belonging belong_nr ini_symbol_nr mod_index eii_declaring_modules + # (Yes di=:{di_belonging}, eii_declaring_modules) + = ikhUSearch mod_index eii_declaring_modules + (new, eii_declaring_modules) + = ikhInsert True mod_index { di & di_belonging = addNr belong_nr di_belonging } eii_declaring_modules + | new + = abort "sanity check nr 2765 failed in module check" + = eii_declaring_modules + + get_nth_belonging_decl position belong_nr decl dcl_modules + # (STE_Imported _ def_mod_index) = decl.dcl_kind + (belongin_symbols, dcl_modules) + = getBelongingSymbols decl dcl_modules + = case belongin_symbols of + BS_Constructors constructors + # {ds_ident, ds_index} = constructors!!belong_nr + -> ({ dcl_ident = ds_ident, dcl_pos = position, + dcl_kind = STE_Imported STE_Constructor def_mod_index, + dcl_index = ds_index }, dcl_modules) + BS_Fields rt_fields + # {fs_name, fs_index} = rt_fields.[belong_nr] + ({sd_symb}, dcl_modules) + = dcl_modules![def_mod_index].dcl_common.com_selector_defs.[fs_index] + -> ({ dcl_ident = fs_name, dcl_pos = position, + dcl_kind = STE_Imported (STE_Field sd_symb) def_mod_index, + dcl_index = fs_index }, dcl_modules) + BS_Members class_members + # {ds_ident, ds_index} = class_members.[belong_nr] + -> ({ dcl_ident = ds_ident, dcl_pos = position, + dcl_kind = STE_Imported STE_Member def_mod_index, + dcl_index = ds_index }, dcl_modules) + + get_all_belongs decl dcl_modules + # (belonging_symbols, dcl_modules) + = getBelongingSymbols decl dcl_modules + = case belonging_symbols of + BS_Constructors constructors + -> ([ds_ident \\ {ds_ident}<-constructors], dcl_modules) + BS_Fields rt_fields + -> ([fs_name \\ {fs_name}<-:rt_fields], dcl_modules) + BS_Members class_members + # (STE_Imported _ def_mod_index) = decl.dcl_kind + ({class_members}, dcl_modules) + = dcl_modules![def_mod_index].dcl_common.com_class_defs.[decl.dcl_index] + -> ([ds_ident \\ {ds_ident}<-:class_members], dcl_modules) + BS_Nothing + -> ([], 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 } + = (i+1, writePtr id_info new_ste cs_symbol_table) - restore_symbol_table_old_syntax id=:{id_info} cs=:{ cs_symbol_table } - # (ste, cs_symbol_table) = readPtr id_info cs_symbol_table - cs_symbol_table = writePtr id_info ste.ste_previous cs_symbol_table //--->("restoring", id) - cs = { cs & cs_symbol_table = cs_symbol_table } - = case ste.ste_kind of - STE_ExplImp success opt_id _ _ - | success - -> cs - # cs_symbol_table = opt_make_partners_succesful opt_id cs.cs_symbol_table - cs_error = checkError id "not exported by the specified module" cs.cs_error - -> { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table } - _ -> abort "assertion 54 failed in module explicitimports" - where - opt_make_partners_succesful No cs_symbol_table - = cs_symbol_table - opt_make_partners_succesful (Yes (ID_OldSyntax partners)) cs_symbol_table - = foldSt make_partner_succesful partners cs_symbol_table - - make_partner_succesful {id_info} cs_symbol_table - // set the success bit for the partner entries, because an error message has been - // given already - # (ste, cs_symbol_table) = readPtr id_info cs_symbol_table - = case ste.ste_kind of - STE_ExplImp _ a b c - -> writePtr id_info { ste & ste_kind = STE_ExplImp True a b c } cs_symbol_table - _ -> cs_symbol_table - - filter_decls_per_module import_statement_pos (mod_index, {dcls_import, dcls_local}) (imported_decls_per_module, fs) - # (dcls_import, fs) - = iMapFilterYesSt (i_filter_possibly_imported_decl mod_index dcls_import) - 0 (size dcls_import) fs - (dcls_local, fs) - = mapFilterYesSt (filter_possibly_imported_decl mod_index) dcls_local fs - dcls_import_array - = { el \\ el <- dcls_import} - size_dia - = size dcls_import_array - dcls_local_for_import - = {local_declaration_for_import decl mod_index \\ decl<-dcls_local} - dcls_explicit - = { ExplicitImport - (if (i<size_dia) dcls_import_array.[i] dcls_local_for_import.[i-size_dia]) - import_statement_pos - \\ i <- [0..size_dia+size dcls_local_for_import-1] } - = ( [ (mod_index, { dcls_import = dcls_import_array, dcls_local = dcls_local, - dcls_local_for_import = dcls_local_for_import, - dcls_explicit = dcls_explicit }) - :imported_decls_per_module - ], - fs) - - i_filter_possibly_imported_decl :: !Int !{!Declaration} !Int !*FilterState - -> (!Optional Declaration, !.FilterState) - i_filter_possibly_imported_decl mod_index dcls_import i state - = filter_possibly_imported_decl mod_index dcls_import.[i] state - - filter_possibly_imported_decl :: !Int !Declaration !*FilterState -> (!Optional Declaration, !.FilterState) - filter_possibly_imported_decl _ decl=:{dcl_kind=STE_Imported ste_kind mod_index} state - = filter_decl mod_index decl ste_kind state - filter_possibly_imported_decl mod_index decl=:{dcl_kind} state - = filter_decl mod_index decl dcl_kind state - - filter_decl :: !Int !Declaration !STE_Kind !*FilterState -> (!Optional Declaration, !.FilterState) - filter_decl mod_index decl (STE_Instance class_ident) fs - // this alternative is only for old syntax - | switch_import_syntax True False - = filter_instance_decl mod_index decl class_ident fs - filter_decl mod_index decl=:{dcl_ident={id_info}} dcl_kind fs=:{fs_symbol_table} - # (ste=:{ste_kind}, fs_symbol_table) = readPtr id_info fs_symbol_table - fs = { fs & fs_symbol_table = fs_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 = case ste_kind of - STE_ExplImp _ opt_import_declaration ste_kind_2 _ - // the symbol is wanted (see above). - # fs_symbol_table - = writePtr id_info { ste & ste_kind = STE_ExplImp True opt_import_declaration ste_kind_2 False} - fs.fs_symbol_table //--->("setting True", decl.dcl_ident) - // mark this symbol as being succesfully imported - fs = { fs & fs_symbol_table = fs_symbol_table} - -> case opt_import_declaration of - No -> (Yes decl, fs) - Yes import_declaration - # fs = switch_import_syntax (mark_partners import_declaration fs) fs - -> (Yes decl, add_bracketed_symbols_to_symbol_table import_declaration decl dcl_kind mod_index fs) - _ -> (No, fs) - - // only for old syntax - filter_instance_decl mod_index decl=:{dcl_index} class_ident fs=:{fs_symbol_table} - # (ste=:{ste_kind}, fs_symbol_table) = readPtr class_ident.id_info fs_symbol_table - fs = { fs & fs_symbol_table = fs_symbol_table } - = case ste_kind of - STE_ExplImp _ _ _ _ - -> (Yes decl, fs) - _ -> (No, fs) - - // only for old syntax - mark_partners (ID_OldSyntax partners) fs=:{fs_symbol_table} - # fs_symbol_table = foldSt mark_partner partners fs_symbol_table - = { fs & fs_symbol_table = fs_symbol_table } - where - mark_partner {id_info} fs_symbol_table - # (ste=:{ste_kind=STE_ExplImp _ a b c}, fs_symbol_table) = readPtr id_info fs_symbol_table - = writePtr id_info { ste & ste_kind = STE_ExplImp True a b c } fs_symbol_table + 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 + -> (No, (popErrorAdmin cs_error, cs_symbol_table)) - add_bracketed_symbols_to_symbol_table import_declaration decl dcl_kind mod_index fs - # (opt_bracket_info, fs=:{fs_symbol_table}) - = (switch_import_syntax get_opt_bracket_info_old_syntax get_opt_bracket_info) - import_declaration decl dcl_kind mod_index fs - | isNo opt_bracket_info - = { fs & fs_symbol_table = fs_symbol_table } - # (Yes (all_bracket_ids, wanted_bracket_ids, structure_name, ste_kind)) - = opt_bracket_info - all_bracket_ids_are_wanted - = isEmpty wanted_bracket_ids - fs_symbol_table - = foldSt (add_bracket_symbol_to_symbol_table ste_kind all_bracket_ids_are_wanted) all_bracket_ids - fs_symbol_table - fs = { fs & fs_symbol_table = fs_symbol_table } - | all_bracket_ids_are_wanted - // "import class C (..)" or "import :: T (..)" or "import :: T {..}" - = { fs & fs_wanted_symbols = all_bracket_ids++fs.fs_wanted_symbols } - // "import class C (m1, m2)" or "import :: T (C1, C2)" or "import :: T {f1, f2}" - // currently all bracket symbols have (STE_ExplImp _ _ _ True). Mark those that are really wanted False - // and overwrite the remaining again with STE_Empty - # fs = foldSt (check_wanted_idents structure_name) wanted_bracket_ids fs - fs_symbol_table = foldSt overwrite_wanted_idents wanted_bracket_ids fs.fs_symbol_table - (fs_wanted_symbols, fs_symbol_table) - = foldSt remove_and_collect all_bracket_ids (fs.fs_wanted_symbols, fs_symbol_table) - = { fs & fs_wanted_symbols = fs_wanted_symbols, fs_symbol_table = fs_symbol_table } + search_expl_imp_symbol expl_imp_indices_ikh modules_in_component_set importing_mod imported_mod + ini=:{ini_symbol_nr} (visited_modules, expl_imp_info) + # (ExplImpInfo eii_ident eii_declaring_modules, expl_imp_info) + = replace expl_imp_info ini_symbol_nr TemporarilyFetchedAway + (opt_decl, path, eii_declaring_modules, visited_modules) + = depth_first_search expl_imp_indices_ikh modules_in_component_set imported_mod + ini_symbol_nr cUndef stupid_ident [importing_mod] + eii_declaring_modules (bitvectReset visited_modules) + = case opt_decl of + Yes di=:{di_decl} + # new_eii_declaring_modules + = foldSt (\mod_index eei_dm->ikhInsert` False mod_index + {di_decl = di_decl, di_instances = [], di_belonging=EndNumbers} eei_dm) + path eii_declaring_modules + new_eii + = ExplImpInfo eii_ident new_eii_declaring_modules + -> (Yes (di, ini, imported_mod), (visited_modules, { expl_imp_info & [ini_symbol_nr] = new_eii })) + No + # eii + = ExplImpInfo eii_ident eii_declaring_modules + -> (No, (visited_modules, { expl_imp_info & [ini_symbol_nr] = eii })) + + depth_first_search expl_imp_indices_ikh modules_in_component_set + imported_mod imported_symbol belong_nr belong_ident path eii_declaring_modules visited_modules +// | False--->("depth_first_search imported_mod", imported_mod, "imported_symbol", imported_symbol) +// = undef + # (search_result, eii_declaring_modules) + = ikhUSearch imported_mod eii_declaring_modules + = case search_result of + yes_di=:(Yes di) + | belong_nr==cUndef + -> (yes_di, path, eii_declaring_modules, visited_modules) + | inNumberSet belong_nr di.di_belonging + -> (yes_di, path, eii_declaring_modules, visited_modules) + _ + | not (bitvectSelect imported_mod modules_in_component_set) + // the eii_declaring_modules is complete for modules that are outside + // (=beneath) the actual component=> no need to search further + -> (No, [], eii_declaring_modules, visited_modules) + # imports_of_imported_mod + = ikhSearch` imported_mod expl_imp_indices_ikh + -> try_children imports_of_imported_mod expl_imp_indices_ikh + modules_in_component_set imported_symbol belong_nr belong_ident + [imported_mod:path] + eii_declaring_modules (bitvectSet imported_mod visited_modules) + + try_children [(imp_imp_mod, _, imp_imp_symbols):imports] expl_imp_indices_ikh + modules_in_component_set imported_symbol belong_nr belong_ident path eii_declaring_modules visited_modules + | bitvectSelect imp_imp_mod visited_modules +// | False--->"visited" = undef + = try_children imports expl_imp_indices_ikh modules_in_component_set imported_symbol + belong_nr belong_ident path eii_declaring_modules visited_modules + | not (isEmpty imp_imp_symbols) + // follow the path trough an explicit import only if the symbol is listed there + # (found, ini_belonging) + = search_imported_symbol imported_symbol imp_imp_symbols + | not (found && implies (belong_nr<>cUndef) (belong_ident_found belong_ident ini_belonging)) + = try_children imports expl_imp_indices_ikh modules_in_component_set imported_symbol + belong_nr belong_ident path eii_declaring_modules visited_modules + = continue imp_imp_mod imports expl_imp_indices_ikh modules_in_component_set imported_symbol + belong_nr belong_ident path eii_declaring_modules visited_modules + = continue imp_imp_mod imports expl_imp_indices_ikh modules_in_component_set imported_symbol + belong_nr belong_ident path eii_declaring_modules visited_modules where - isNo No = True - isNo _ = False - - get_opt_bracket_info (ID_Class _ (Yes wanted_members)) {dcl_kind, dcl_index} mod_index fs - # (dcl_module, module_entry, fs) - = get_module_and_entry dcl_kind mod_index fs - class_def = case module_entry.ste_kind of - STE_OpenModule _ modul - -> modul.mod_defs.def_classes!!dcl_index - STE_ClosedModule - -> dcl_module.dcl_common.com_class_defs.[dcl_index] - all_member_idents = [ ds_ident \\ {ds_ident} <-: class_def.class_members ] - = (Yes (all_member_idents, wanted_members, class_def.class_name, STE_Member), fs) - get_opt_bracket_info (ID_Type ii (Yes wanted_constructors)) {dcl_kind, dcl_index} mod_index fs - # (dcl_module, module_entry, fs) - = get_module_and_entry dcl_kind mod_index fs - type_def = case module_entry.ste_kind of - STE_OpenModule _ modul - -> modul.mod_defs.def_types!!dcl_index - STE_ClosedModule - -> dcl_module.dcl_common.com_type_defs.[dcl_index] - | not (isAlgType type_def.td_rhs) - # fs = { fs & fs_error = checkError ii.ii_ident "is not an algebraic type" fs.fs_error } - = (No, fs) - # (AlgType constructors) = type_def.td_rhs - all_constructor_idents = [ ds_ident \\ {ds_ident} <- constructors ] - = (Yes (all_constructor_idents, wanted_constructors, type_def.td_name, STE_Constructor), fs) - where - isAlgType (AlgType _) = True - isAlgType _ = False - get_opt_bracket_info (ID_Record ii (Yes wanted_fields)) {dcl_kind, dcl_index} mod_index fs - # (dcl_module, module_entry, fs) - = get_module_and_entry dcl_kind mod_index fs - type_def = case module_entry.ste_kind of - STE_OpenModule _ modul - -> modul.mod_defs.def_types!!dcl_index - STE_ClosedModule - -> dcl_module.dcl_common.com_type_defs.[dcl_index] - | not (isRecordType type_def.td_rhs) - # fs = { fs & fs_error = checkError ii.ii_ident "is not a record type" fs.fs_error } - = (No, fs) - # (RecordType {rt_fields}) = type_def.td_rhs - all_field_idents = [ fs_name \\ {fs_name} <-: rt_fields ] - = (Yes (all_field_idents, wanted_fields, type_def.td_name, STE_Field (hd all_field_idents)), fs) - where - isRecordType (RecordType _) = True - isRecordType _ = False - get_opt_bracket_info _ _ _ fs - = (No, fs) - - // this function is only for old syntax - get_opt_bracket_info_old_syntax _ {dcl_index} STE_Class mod_index fs - # (dcl_module, module_entry, fs) - = get_module_and_entry STE_Class mod_index fs - class_def = case module_entry.ste_kind of - STE_OpenModule _ modul - -> modul.mod_defs.def_classes!!dcl_index - STE_ClosedModule - -> dcl_module.dcl_common.com_class_defs.[dcl_index] - all_member_idents = [ ds_ident \\ {ds_ident} <-: class_def.class_members ] - (all_member_idents_2, fs_symbol_table) - = foldSt filter_member all_member_idents ([], fs.fs_symbol_table) - = (Yes (all_member_idents_2, [], class_def.class_name, STE_Member), { fs & fs_symbol_table = fs_symbol_table }) - get_opt_bracket_info_old_syntax _ {dcl_index} STE_Type mod_index fs - # (dcl_module, module_entry, fs) - = get_module_and_entry STE_Type mod_index fs - type_def = case module_entry.ste_kind of - STE_OpenModule _ modul - -> modul.mod_defs.def_types!!dcl_index - STE_ClosedModule - -> dcl_module.dcl_common.com_type_defs.[dcl_index] - = case type_def.td_rhs of - RecordType {rt_fields} - # all_field_idents = [ fs_name \\ {fs_name} <-: rt_fields ] - -> (Yes (all_field_idents, [], type_def.td_name, STE_Field (hd all_field_idents)), fs) - _ -> (No, fs) - get_opt_bracket_info_old_syntax _ _ _ _ fs - = (No, fs) + continue imp_imp_mod imports expl_imp_indices_ikh modules_in_component_set imported_symbol + belong_nr belong_ident path eii_declaring_modules visited_modules + # (opt_decl, path, eii_declaring_modules, visited_modules) + = depth_first_search expl_imp_indices_ikh modules_in_component_set imp_imp_mod + imported_symbol belong_nr belong_ident path eii_declaring_modules visited_modules + = case opt_decl of + Yes _ + -> (opt_decl, path, eii_declaring_modules, visited_modules) + No + -> try_children imports expl_imp_indices_ikh modules_in_component_set + imported_symbol belong_nr belong_ident path eii_declaring_modules visited_modules - // only for old syntax - filter_member member_id=:{id_info} (accu, fs_symbol_table) - // it is possible that a member that had to be added the the list of wanted - // symbols is already in there because an identifier with the same name was - // explicitly imported. Special case: class and member have the same name - # ({ste_kind}, fs_symbol_table) = readPtr id_info fs_symbol_table - = case ste_kind of - STE_ExplImp _ _ _ _ - -> (accu, fs_symbol_table) - _ -> ([member_id:accu], fs_symbol_table) - - get_module_and_entry dcl_kind mod_index fs=:{fs_modules, fs_symbol_table} - # index_mod_with_def = case dcl_kind of - STE_Imported _ index_mod_with_def - -> abort "assertion 2 failed in module explicitimports" - _ -> mod_index - // get the index of the module where the symbol is defined - (dcl_module=:{dcl_name=dcl_name=:{id_info}}, fs_modules) = fs_modules![index_mod_with_def] - (module_entry, fs_symbol_table) = readPtr id_info fs_symbol_table - = (dcl_module, module_entry, { fs & fs_modules = fs_modules, fs_symbol_table = fs_symbol_table }) - - check_wanted_idents structure_name {ii_ident=ii_ident=:{id_info}} fs=:{fs_symbol_table} - # (ste=:{ste_kind}, fs_symbol_table) = readPtr id_info fs_symbol_table - fs = { fs & fs_symbol_table = fs_symbol_table } - = case ste_kind of - STE_ExplImp a b _ True - -> fs - _ -> { fs & fs_error = checkError ii_ident ("does not belong to "+++toString structure_name) fs.fs_error} - - overwrite_wanted_idents {ii_ident={id_info}} fs_symbol_table - # (ste=:{ste_kind}, fs_symbol_table) = readPtr id_info fs_symbol_table - = case ste_kind of - STE_ExplImp a b c _ - -> writePtr id_info { ste & ste_kind = STE_ExplImp a b c False } fs_symbol_table - STE_Empty - -> fs_symbol_table + try_children [] expl_imp_indices_ikh _ imported_symbol belong_nr belong_ident path + eii_declaring_modules visited_modules + = (No, [], eii_declaring_modules, visited_modules) + + search_imported_symbol :: !Int ![ImportNrAndIdents] -> (!Bool, !Optional [ImportedIdent]) + search_imported_symbol imported_symbol [] + = (False, No) + search_imported_symbol imported_symbol [{ini_symbol_nr, ini_belonging}:t] + | imported_symbol==ini_symbol_nr + = (True, ini_belonging) + = search_imported_symbol imported_symbol t + + + belong_ident_found :: !Ident !(Optional [ImportedIdent]) -> Bool + belong_ident_found belong_ident No + // like from m import ::T + = False + belong_ident_found belong_ident (Yes []) + // like from m import ::T(..) + = True + belong_ident_found belong_ident (Yes import_list) + // like from m import ::T(C1,C2) + = is_member belong_ident import_list + + is_member :: !Ident ![ImportedIdent] -> Bool + is_member belong_ident [] + = False + is_member belong_ident [{ii_ident}:t] + | belong_ident==ii_ident + = True + = is_member belong_ident t + + // No, No, No! + check_triples position [No, No, No: t1] [imported_symbol, _, _: t2] (expl_imp_info, cs_error) + # (expl_imp_info, cs_error) + = give_error position imported_symbol (expl_imp_info, cs_error) + = check_triples position t1 t2 (expl_imp_info, cs_error) + check_triples position [_, _, _: t1] [_, _, _: t2] (expl_imp_info, cs_error) + = check_triples position t1 t2 (expl_imp_info, cs_error) + check_triples position [] [] (expl_imp_info, cs_error) + = (expl_imp_info, cs_error) - remove_and_collect ident=:{id_info} (wanted_symbols_accu, fs_symbol_table) - # (ste=:{ste_kind=STE_ExplImp _ _ _ is_unwanted}, fs_symbol_table) = readPtr id_info fs_symbol_table - | is_unwanted - = (wanted_symbols_accu, writePtr id_info { ste & ste_kind = STE_Empty } fs_symbol_table) - = ([ident:wanted_symbols_accu], fs_symbol_table) - - + check_singles position [No: t1] [imported_symbol: t2] (expl_imp_info, cs_error) + # (expl_imp_info, cs_error) + = give_error position imported_symbol (expl_imp_info, cs_error) + = check_singles position t1 t2 (expl_imp_info, cs_error) + check_singles position [_:t1] [_:t2] (expl_imp_info, cs_error) + = check_singles position t1 t2 (expl_imp_info, cs_error) + check_singles position [] [] (expl_imp_info, cs_error) + = (expl_imp_info, cs_error) + + give_error position {ini_symbol_nr} (expl_imp_info, cs_error) + # (eii_ident, expl_imp_info) + = do_a_lot_just_to_read_an_array_2 ini_symbol_nr expl_imp_info + cs_error + = pushErrorAdmin (newPosition import_ident position) cs_error + cs_error + // XXX it should be also printed to which namespace eii_ident belongs + = checkError eii_ident "not exported by the specified module" cs_error + = (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_ident, { expl_imp_info & [i] = eii }) + + get_eei_ident (eii=:ExplImpInfo eii_ident _) = (eii_ident, eii) + :: CheckCompletenessState = { ccs_dcl_modules :: !.{#DclModule} , ccs_icl_functions :: !.{#FunDef} @@ -358,16 +352,18 @@ possiblyFilterExplImportedDecls import_declarations decls_of_imported_module imp :: CheckCompletenessInputBox = { box_cci :: !CheckCompletenessInput } -checkExplicitImportCompleteness :: !Int ![ExplicitImport] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState +checkExplicitImportCompleteness :: ![(Declaration, Position)] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState -> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState) -checkExplicitImportCompleteness main_dcl_module_n dcls_explicit dcl_modules icl_functions expr_heap +checkExplicitImportCompleteness dcls_explicit dcl_modules icl_functions expr_heap cs=:{cs_symbol_table, cs_error} #! nr_icl_functions = size icl_functions box_ccs = { ccs_dcl_modules = dcl_modules, ccs_icl_functions = icl_functions, ccs_set_of_visited_icl_funs = createArray nr_icl_functions False, ccs_expr_heap = expr_heap, ccs_symbol_table = cs_symbol_table, ccs_error = cs_error, ccs_heap_changes_accu = [] } - ccs = foldSt checkCompleteness dcls_explicit { box_ccs = box_ccs } + main_dcl_module_n + = cs.cs_x.x_main_dcl_module_n + ccs = foldSt (checkCompleteness main_dcl_module_n) dcls_explicit { box_ccs = box_ccs } { ccs_dcl_modules, ccs_icl_functions, ccs_expr_heap, ccs_symbol_table, ccs_error, ccs_heap_changes_accu } = ccs.box_ccs // repair heap contents @@ -375,12 +371,12 @@ checkExplicitImportCompleteness main_dcl_module_n dcls_explicit dcl_modules icl_ cs = { cs & cs_symbol_table = ccs_symbol_table, cs_error = ccs_error } = (ccs_dcl_modules, ccs_icl_functions, ccs_expr_heap, cs) where - checkCompleteness :: !ExplicitImport !*CheckCompletenessStateBox -> *CheckCompletenessStateBox - checkCompleteness (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_FunctionOrMacro _} import_position) ccs + checkCompleteness :: !Int !(Declaration, Position) !*CheckCompletenessStateBox -> *CheckCompletenessStateBox + checkCompleteness main_dcl_module_n ({dcl_ident, dcl_index, dcl_kind=STE_FunctionOrMacro _}, import_position) ccs = checkCompletenessOfMacro dcl_ident dcl_index main_dcl_module_n import_position ccs - checkCompleteness (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_Imported (STE_FunctionOrMacro _) mod_index} import_position) ccs + checkCompleteness main_dcl_module_n ({dcl_ident, dcl_index, dcl_kind=STE_Imported (STE_FunctionOrMacro _) mod_index}, import_position) ccs = checkCompletenessOfMacro dcl_ident dcl_index main_dcl_module_n import_position ccs - checkCompleteness (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_Imported expl_imp_kind mod_index} import_position) ccs + checkCompleteness main_dcl_module_n ({dcl_ident, dcl_index, dcl_kind=STE_Imported expl_imp_kind mod_index}, import_position) ccs #! ({dcl_common,dcl_functions}, ccs) = ccs!box_ccs.ccs_dcl_modules.[mod_index] cci = { box_cci = { cci_import_position = import_position, cci_main_dcl_module_n=main_dcl_module_n }} = continuation expl_imp_kind dcl_common dcl_functions cci ccs @@ -401,19 +397,19 @@ checkExplicitImportCompleteness main_dcl_module_n dcls_explicit dcl_modules icl_ = check_completeness dcl_common.com_instance_defs.[dcl_index] cci ccs continuation STE_DclFunction dcl_common dcl_functions cci ccs = check_completeness dcl_functions.[dcl_index] cci ccs - + checkCompletenessOfMacro :: !Ident !Index !Int !Position !*CheckCompletenessStateBox -> *CheckCompletenessStateBox checkCompletenessOfMacro dcl_ident dcl_index main_dcl_module_n import_position ccs #! ({fun_body}, ccs) = ccs!box_ccs.ccs_icl_functions.[dcl_index] ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[dcl_index] = True } cci = { box_cci = { cci_import_position = import_position, cci_main_dcl_module_n=main_dcl_module_n }} = check_completeness fun_body cci ccs - + replace_ste_with_previous :: !SymbolPtr !*SymbolTable -> .SymbolTable replace_ste_with_previous changed_ste_ptr symbol_table #! ({ste_previous}, symbol_table) = readPtr changed_ste_ptr symbol_table = writePtr changed_ste_ptr ste_previous symbol_table - + instance toString STE_Kind where toString (STE_FunctionOrMacro _) = "function/macro" toString STE_Type = "type" @@ -498,8 +494,9 @@ instance check_completeness ClassDef where = check_completeness class_context cci ccs instance check_completeness ClassInstance where - check_completeness {ins_type} cci ccs - = check_completeness ins_type cci ccs + check_completeness {ins_class, ins_type} cci ccs + = check_completeness ins_type cci + (check_whether_ident_is_imported ins_class.glob_object.ds_ident STE_Class cci ccs) instance check_completeness ConsDef where @@ -728,3 +725,7 @@ flipM f a b :== f b a ste_field =: STE_Field { id_name="", id_info=nilPtr } ste_fun_or_macro =: STE_FunctionOrMacro [] +stupid_ident =: { id_name = "stupid", id_info = nilPtr } + +// XXX from m import :: T(..) works also if T is a record type + diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 07e55e5..a846939 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -11,6 +11,10 @@ switch_import_syntax one_point_three two_point_zero :== one_point_three SwitchFusion fuse dont_fuse :== dont_fuse +switch_port_to_new_syntax port dont_port :== dont_port + +cTabWidth :== switch_port_to_new_syntax 4 (abort "cTabWidth is only used for portToNewSyntax") + :: Ident = { id_name :: !String , id_info :: !SymbolPtr @@ -47,13 +51,11 @@ instance toString Ident | STE_TypeVariable !TypeVarInfoPtr | STE_TypeAttribute !AttrVarInfoPtr | STE_BoundTypeVariable !STE_BoundTypeVariable -// | STE_BoundType !AType | STE_Imported !STE_Kind !Index | STE_DclFunction | STE_Module !(Module (CollectedDefinitions ClassInstance IndexRange)) | STE_OpenModule !Int !(Module (CollectedDefinitions ClassInstance IndexRange)) | STE_ClosedModule - | STE_LockedModule | STE_Empty /* for creating class dictionaries */ | STE_DictType !CheckedTypeDef @@ -69,7 +71,26 @@ instance toString Ident case of a selective import like "... import :: R {f1}" this bit is used to remove all fields different from "f1" from the symbol table again. */ - + | STE_ExplImpSymbol !Int + | STE_ExplImpComponentNrs ![ComponentNrAndIndex] ![Declaration] + /* stores the numbers of all module components that import the symbol from + the "actual" dcl module. Further for each class the all encountered + instances are accumulated. + */ + | STE_BelongingSymbol !Int + +:: Declaration = + { dcl_ident :: !Ident + , dcl_pos :: !Position + , dcl_kind :: !STE_Kind + , dcl_index :: !Index + } + +:: ComponentNrAndIndex = + { cai_component_nr :: !Int + , cai_index :: !Int // points into ExplImpInfos + } + :: Global object = { glob_object :: !object , glob_module :: !Index @@ -1183,7 +1204,7 @@ instance <<< (Module a) | <<< a, ParsedDefinition, InstanceType, AttributeVar, T Position, CaseAlt, AType, FunDef, ParsedExpr, TypeAttribute, (Bind a b) | <<< a & <<< b, ParsedConstructor, (TypeDef a) | <<< a, TypeVarInfo, BasicValue, ATypeVar, TypeRhs, FunctionPattern, (Import from_symbol) | <<< from_symbol, ImportDeclaration, ImportedIdent, CasePatterns, (Optional a) | <<< a, ConsVariable, BasicType, Annotation, Selection, SelectorDef, ConsDef, LocalDefs, FreeVar, ClassInstance, SignClassification, - TypeCodeExpression, CoercionPosition, AttrInequality, LetBind + TypeCodeExpression, CoercionPosition, AttrInequality, LetBind, Declaration, STE_Kind instance == TypeAttribute instance == Annotation @@ -1220,16 +1241,9 @@ PropClass :== bitnot 0 newTypeSymbIdentCAF :: TypeSymbIdent; -//MakeNewTypeSymbIdent name arity -// :== MakeTypeSymbIdent { glob_object = NoIndex, glob_module = NoIndex } name arity - MakeNewTypeSymbIdent name arity :== {newTypeSymbIdentCAF & type_name=name, type_arity=arity } -//MakeTypeSymbIdent type_index name arity -// :== { type_name = name, type_arity = arity, type_index = type_index, -// type_prop = { tsp_sign = BottomSignClass, tsp_propagation = NoPropClass, tsp_coercible = True }} - MakeTypeSymbIdent type_index name arity :== { newTypeSymbIdentCAF & type_name = name, type_arity = arity, type_index = type_index } diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 7e40d3c..f5ee540 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -7,6 +7,9 @@ import scanner, general, Heap, typeproperties, utilities PA_BUG on off :== on switch_import_syntax one_point_three two_point_zero :== one_point_three SwitchFusion fuse dont_fuse :== dont_fuse +switch_port_to_new_syntax port dont_port :== dont_port + +cTabWidth :== switch_port_to_new_syntax 4 (abort "cTabWidth is only used for portToNewSyntax") :: Ident = { id_name :: !String @@ -53,13 +56,27 @@ where toString {import_module} = toString import_module | STE_Module !(Module (CollectedDefinitions ClassInstance IndexRange)) | STE_OpenModule !Int !(Module (CollectedDefinitions ClassInstance IndexRange)) | STE_ClosedModule - | STE_LockedModule | STE_Empty | STE_DictType !CheckedTypeDef | STE_DictCons !ConsDef | STE_DictField !SelectorDef | STE_Called ![Index] /* used during macro expansion to indicate that this function is called */ | STE_ExplImp !Bool !(Optional ImportDeclaration) !STE_Kind !Bool /* auxiliary used in module explicitimports. */ + | STE_ExplImpSymbol !Int + | STE_ExplImpComponentNrs ![ComponentNrAndIndex] ![Declaration] + | STE_BelongingSymbol !Int + +:: Declaration = + { dcl_ident :: !Ident + , dcl_pos :: !Position + , dcl_kind :: !STE_Kind + , dcl_index :: !Index + } + +:: ComponentNrAndIndex = + { cai_component_nr :: !Int + , cai_index :: !Int + } :: Global object = { glob_object :: !object @@ -1304,7 +1321,8 @@ where (<<<) file symb=:{symb_kind = SK_LocalMacroFunction symb_index } = file <<< symb.symb_name <<< '@' <<< symb_index (<<<) file symb=:{symb_kind = SK_GeneratedFunction _ symb_index } = file <<< symb.symb_name <<< '@' <<< symb_index (<<<) file symb=:{symb_kind = SK_OverloadedFunction symb_index } = file <<< symb.symb_name <<< "[o]@" <<< symb_index - (<<<) file symb = file <<< symb.symb_name + (<<<) file symb=:{symb_kind = SK_Constructor symb_index } = file <<< symb.symb_name <<< '@' <<< symb_index + (<<<) file symb = file <<< symb.symb_name instance <<< TypeSymbIdent where @@ -1820,6 +1838,71 @@ where show_expression file _ = file +instance <<< Declaration + where + (<<<) file { dcl_ident, dcl_kind } + = file <<< dcl_ident <<< '<' <<< ptrToInt dcl_ident.id_info <<< '>' <<< '(' <<< dcl_kind <<< ')' + +instance <<< STE_Kind +where + (<<<) file + (STE_FunctionOrMacro _) + = file <<< "STE_FunctionOrMacro" + (<<<) file + STE_Type + = file <<< "STE_Type" + (<<<) file + STE_Constructor + = file <<< "STE_Constructor" + (<<<) file + (STE_Selector _) + = file <<< "STE_Selector" + (<<<) file + STE_Class + = file <<< "STE_Class" + (<<<) file + (STE_Field _) + = file <<< "STE_Field" + (<<<) file + STE_Member + = file <<< "STE_Member" + (<<<) file + (STE_Instance _) + = file <<< "STE_Instance" + (<<<) file + (STE_Variable _) + = file <<< "STE_Variable" + (<<<) file + (STE_TypeVariable _) + = file <<< "STE_TypeVariable" + (<<<) file + (STE_TypeAttribute _) + = file <<< "STE_TypeAttribute" + (<<<) file + (STE_BoundTypeVariable _) + = file <<< "STE_BoundTypeVariable" + (<<<) file + (STE_Imported a b) + = file <<< "STE_Imported (" <<< a <<< ")" <<< b + (<<<) file + STE_DclFunction + = file <<< "STE_DclFunction" + (<<<) file + (STE_Module _) + = file <<< "STE_Module" + (<<<) file + (STE_OpenModule _ _) + = file <<< "STE_OpenModule" + (<<<) file + STE_ClosedModule + = file <<< "STE_ClosedModule" + (<<<) file + STE_Empty + = file <<< "STE_Empty" + (<<<) file + _ + = file <<< "STE_???" + readable :: !Ident -> String // somewhat hacky readable {id_name} | id_name=="_cons" || id_name=="_nil" @@ -1877,16 +1960,9 @@ PropClass :== bitnot 0 newTypeSymbIdentCAF :: TypeSymbIdent; newTypeSymbIdentCAF =: MakeTypeSymbIdentMacro { glob_object = NoIndex, glob_module = NoIndex } {id_name="",id_info=nilPtr} 0 -//MakeNewTypeSymbIdent name arity -// :== MakeTypeSymbIdent { glob_object = NoIndex, glob_module = NoIndex } name arity - MakeNewTypeSymbIdent name arity :== {newTypeSymbIdentCAF & type_name=name, type_arity=arity } -//MakeTypeSymbIdent type_index name arity -// :== { type_name = name, type_arity = arity, type_index = type_index, -// type_prop = { tsp_sign = BottomSignClass, tsp_propagation = NoPropClass, tsp_coercible = True }} - MakeTypeSymbIdent type_index name arity :== { newTypeSymbIdentCAF & type_name = name, type_arity = arity, type_index = type_index } diff --git a/frontend/type.dcl b/frontend/type.dcl index 40a2352..6049c37 100644 --- a/frontend/type.dcl +++ b/frontend/type.dcl @@ -3,5 +3,5 @@ definition module type import StdArray import syntax, check -typeProgram ::!{! Group} !Int !*{# FunDef} !IndexRange !(Optional Bool) !CommonDefs ![Declaration] !{# DclModule} !ModuleNumberSet !*Heaps !*PredefinedSymbols !*File !*File +typeProgram ::!{! Group} !Int !*{# FunDef} !IndexRange !(Optional Bool) !CommonDefs ![Declaration] !{# DclModule} !NumberSet !*Heaps !*PredefinedSymbols !*File !*File -> (!Bool, !*{# FunDef}, !IndexRange, {! GlobalTCType}, !{# CommonDefs}, !{# {# FunType} }, !*Heaps, !*PredefinedSymbols, !*File, !*File) diff --git a/frontend/type.icl b/frontend/type.icl index bfe7033..01e69b6 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -1942,7 +1942,7 @@ addLiftedArgumentsToSymbolType st=:{st_arity,st_args,st_vars,st_attr_vars,st_con , fe_location :: !IdentPos } -typeProgram ::!{! Group} !Int !*{# FunDef} !IndexRange !(Optional Bool) !CommonDefs ![Declaration] !{# DclModule} !ModuleNumberSet !*Heaps !*PredefinedSymbols !*File !*File +typeProgram ::!{! Group} !Int !*{# FunDef} !IndexRange !(Optional Bool) !CommonDefs ![Declaration] !{# DclModule} !NumberSet !*Heaps !*PredefinedSymbols !*File !*File -> (!Bool, !*{# FunDef}, !IndexRange, {! GlobalTCType}, !{# CommonDefs}, !{# {# FunType} }, !*Heaps, !*PredefinedSymbols, !*File, !*File) typeProgram comps main_dcl_module_n fun_defs specials list_inferred_types icl_defs imports modules used_module_numbers heaps=:{hp_var_heap, hp_expression_heap, hp_type_heaps} predef_symbols file out #! fun_env_size = size fun_defs diff --git a/frontend/utilities.dcl b/frontend/utilities.dcl index 3cded9b..9d92475 100644 --- a/frontend/utilities.dcl +++ b/frontend/utilities.dcl @@ -1,4 +1,5 @@ definition module utilities +// compile with "reuse unique nodes" from StdEnv import Eq, not, Ord, IncDec import StdMisc, general @@ -93,10 +94,18 @@ unsafeFold2St op l1 l2 st :== ufold_st2 l1 l2 st where ufold_st2 [x : xs] [y : ys] st - = op x y (ufold_st2 xs ys st) + = ufold_st2 xs ys (op x y st) ufold_st2 _ _ st = st +unsafeFold3St op l1 l2 l3 st + :== ufold_st3 l1 l2 l3 st +where + ufold_st3 [x : xs] [y : ys] [z : zs] st + = ufold_st3 xs ys zs (op x y z st) + ufold_st3 _ _ _ st + = st + // foldSt :: !(.a -> .(.st -> .st)) ![.a] !.st -> .st foldSt op l st :== fold_st l st @@ -146,6 +155,31 @@ iMapFilterYesSt f fr to st st = st = (f_fr_t2, st) +foldlArrayStWithIndex f a st :== fold_a_st_i 0 a st + where + fold_a_st_i i a st + | i==size a + = st + # (ai, a) = a![i] + = fold_a_st_i (i+1) a (f i ai st) + +foldlArraySt f a st :== fold_a_st 0 a st + where + fold_a_st i a st + | i==size a + = st + # (ai, a) = a![i] + = fold_a_st (i+1) a (f ai st) + +foldrArraySt f a st + :== foldr_a_st (size a-1) a st + where + foldr_a_st i a st + | i==(-1) + = st + # (ai, a) = a![i] + = foldr_a_st (i-1) a (f ai st) + optCons :: !(Optional .a) !u:[.a] -> (!v:[.a], !Int) ,[u <= v] revAppend :: ![a] ![a] -> [a] // Reverse the list using the second argument as accumulator. @@ -156,3 +190,14 @@ revMap :: !(.a -> .b) ![.a] !u:[.b] -> u:[.b] uniqueBagToList :: !*(Bag x) -> [x] // exploits reuse of unique nodes (if compiled with that option) bagToList :: !(Bag x) -> [x] isEmptyBag :: !(Bag x) -> Bool + + +:: DAG = + { dag_nr_of_nodes :: !Int + , dag_get_children :: !Int -> [Int] + } + +partitionateDAG :: !DAG ![Int] -> [[Int]] + +replaceTwoDimArrElt :: !Int !Int !.e !{!*{!.e}} -> (!.e, !{!.{!.e}}) + // like "replace" for one dimensional arrays
\ No newline at end of file diff --git a/frontend/utilities.icl b/frontend/utilities.icl index 60a49d9..055f387 100644 --- a/frontend/utilities.icl +++ b/frontend/utilities.icl @@ -179,10 +179,18 @@ unsafeFold2St op l1 l2 st :== ufold_st2 l1 l2 st where ufold_st2 [x : xs] [y : ys] st - = op x y (ufold_st2 xs ys st) + = ufold_st2 xs ys (op x y st) ufold_st2 _ _ st = st +unsafeFold3St op l1 l2 l3 st + :== ufold_st3 l1 l2 l3 st +where + ufold_st3 [x : xs] [y : ys] [z : zs] st + = ufold_st3 xs ys zs (op x y z st) + ufold_st3 _ _ _ st + = st + // foldSt :: !(.a -> .(.st -> .st)) ![.a] !.st -> .st foldSt op r l :== fold_st r l where @@ -232,6 +240,31 @@ iMapFilterYesSt f fr to st st = st = (f_fr_t2, st) +foldlArrayStWithIndex f a st :== fold_a_st_i 0 a st + where + fold_a_st_i i a st + | i==size a + = st + # (ai, a) = a![i] + = fold_a_st_i (i+1) a (f i ai st) + +foldlArraySt f a st :== fold_a_st 0 a st + where + fold_a_st i a st + | i==size a + = st + # (ai, a) = a![i] + = fold_a_st (i+1) a (f ai st) + +foldrArraySt f a st + :== foldr_a_st (size a-1) a st + where + foldr_a_st i a st + | i==(-1) + = st + # (ai, a) = a![i] + = foldr_a_st (i-1) a (f ai st) + optCons :: !(Optional .a) !u:[.a] -> (!v:[.a], !Int) ,[u <= v] optCons No l = (l, 0) @@ -294,3 +327,101 @@ bagToList bag isEmptyBag :: !(Bag x) -> Bool isEmptyBag Empty = True isEmptyBag _ = False + +:: DAG = + { dag_nr_of_nodes :: !Int + , dag_get_children :: !Int -> [Int] + } + +:: PartitioningState = + { ps_marks :: !.{# Int} + , ps_next_num :: !Int + , ps_groups :: ![[Int]] + , ps_deps :: ![Int] + } + +NotChecked :== -1 + +partitionateDAG :: !DAG ![Int] -> [[Int]] +partitionateDAG pi=:{dag_nr_of_nodes} roots + # partitioning_info + = { ps_marks = createArray dag_nr_of_nodes NotChecked, ps_deps = [], + ps_next_num = 0, ps_groups = [] } + {ps_groups} + = foldSt (partitionate_node pi) roots partitioning_info + = ps_groups +where + partitionate_node :: !DAG !Int !*PartitioningState -> *PartitioningState + partitionate_node pi node_index ps=:{ps_marks} + | ps_marks.[node_index] == NotChecked + = snd (partitionate_unvisited_node node_index pi ps) + = ps + + partitionate_unvisited_node :: !Int !DAG !*PartitioningState + -> (!Int, !*PartitioningState) + partitionate_unvisited_node node_index pi ps=:{ps_next_num} + # children + = pi.dag_get_children node_index + (min_dep, ps) + = visit_children children pi.dag_nr_of_nodes pi (push_on_dep_stack node_index ps) + = try_to_close_group node_index ps_next_num min_dep pi ps + + push_on_dep_stack :: !Int !*PartitioningState -> *PartitioningState + push_on_dep_stack node_index ps=:{ps_deps,ps_marks,ps_next_num} + = { ps & ps_deps = [node_index : ps_deps], ps_marks = { ps_marks & [node_index] = ps_next_num}, + ps_next_num = inc ps_next_num} + + visit_children :: ![Int] !Int !DAG !*PartitioningState -> (!Int, !*PartitioningState) + visit_children [child:children] min_dep pi ps=:{ps_marks} + #! mark = ps_marks.[child] + | mark == NotChecked + # (mark, ps) = partitionate_unvisited_node child pi ps + = visit_children children (min min_dep mark) pi ps + = visit_children children (min min_dep mark) pi ps + visit_children [] min_dep nr_of_nodes ps + = (min_dep, ps) + + + try_to_close_group :: !Int !Int !Int !DAG !*PartitioningState -> (!Int, !*PartitioningState) + try_to_close_group node_index next_num min_dep pi ps=:{ps_marks, ps_deps, ps_groups} + | next_num <= min_dep + # (ps_deps, ps_marks, group) + = close_group node_index ps_deps ps_marks [] pi + ps = { ps & ps_deps = ps_deps, ps_marks = ps_marks, ps_groups = [group : ps_groups] } + = (pi.dag_nr_of_nodes, ps) + = (min_dep, ps) + + close_group :: !Int ![Int] !*{# Int} ![Int] !DAG -> (![Int], !*{# Int}, ![Int]) + close_group node_index [d:ds] marks group pi + # marks = { marks & [d] = pi.dag_nr_of_nodes } + | d == node_index + = (ds, marks, [d : group]) + = close_group node_index ds marks [d : group] pi + +replaceTwoDimArrElt :: !Int !Int !.e !{!*{!.e}} -> (!.e, !{!.{!.e}}) +replaceTwoDimArrElt ix1 ix2 el arr + # (inner_array, arr) + = replace arr ix1 {} + (el2, inner_array) + = replace inner_array ix2 el + = (el2, { arr & [ix1] = inner_array }) +/* crashes! +replaceTwoDimArrElt ix1 ix2 el arr = code + { | A:arr el B:ix2 ix1 + push_b 0 | A:arr el B:ix2 ix1 ix1 + update_b 2 1 | A:arr el B:ix2 ix2 ix1 + update_b 0 2 | A:arr el B:ix1 ix2 ix1 + push_a 1 | A:arr el arr B:ix1 ix2 ix1 + select _ 1 0 | A:arr el arr.[ix1] B:ix1 ix2 + push_array 0 + updatepop_a 0 1 + replace _ 1 0 | A:arr arr.[ix1]* new_el B:ix1 + push_a 2 | A:arr arr.[ix1]* new_el arr B:ix1 + update_a 1 3 | A:new_el arr.[ix1]* new_el arr B:ix1 + update_a 2 1 | A:new_el arr.[ix1]* arr.[ix1]* arr B:ix1 + update _ 1 0 | A:new_el arr.[ix1]* arr* + update_a 2 1 | A:new_el new_el arr* + update_a 0 2 | A:arr* new_el arr* + pop_a 1 | A:arr* new_el + } +*/
\ No newline at end of file |