aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--backend/backendconvert.icl16
-rw-r--r--frontend/analtypes.dcl2
-rw-r--r--frontend/analtypes.icl6
-rw-r--r--frontend/check.icl1178
-rw-r--r--frontend/checksupport.dcl73
-rw-r--r--frontend/checksupport.icl465
-rw-r--r--frontend/checktypes.dcl3
-rw-r--r--frontend/checktypes.icl33
-rw-r--r--frontend/containers.dcl49
-rw-r--r--frontend/containers.icl309
-rw-r--r--frontend/explicitimports.dcl17
-rw-r--r--frontend/explicitimports.icl663
-rw-r--r--frontend/syntax.dcl36
-rw-r--r--frontend/syntax.icl94
-rw-r--r--frontend/type.dcl2
-rw-r--r--frontend/type.icl2
-rw-r--r--frontend/utilities.dcl47
-rw-r--r--frontend/utilities.icl133
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