implementation module explicitimports // compile with reuse unique nodes option import StdEnv :: FilterState = { fs_wanted_symbols :: ![Ident] , fs_modules :: !.{#DclModule} , fs_symbol_table :: !.SymbolTable , fs_error :: !.ErrorAdmin } import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef, cheat//, RWSDebug cUndef :== (-1) implies a b :== not a || b :: ImportNrAndIdents = { ini_symbol_nr :: !Index , ini_imp_decl :: !ImportDeclaration } :: SolvedImports = { si_explicit :: ![([Declaration], Position)] , si_implicit :: ![(Index, Position)] // module indices } markExplImpSymbols :: !Int !*(!*{!*{!u:ExplImpInfo}}, !*SymbolTable) -> (!.[Ident],!(!{!{!u:ExplImpInfo}},!.SymbolTable)) 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 }) 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 _ _ 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 !v:{#DclModule} !u:(Heap SymbolTableEntry) -> (!.NumberSet,!v:{#DclModule},!u:Heap SymbolTableEntry) get_belonging_symbol_nrs decl dcl_modules cs_symbol_table # (all_belonging_symbols, dcl_modules) = getBelongingSymbols decl dcl_modules nr_of_belongs = nrOfBelongingSymbols all_belonging_symbols (_, 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 ) optStoreInstanceWithClassSymbol :: Declaration !Ident !*SymbolTable -> .SymbolTable optStoreInstanceWithClassSymbol 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 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 /* imp_decl_to_string (ID_Function {ii_ident={id_name}}) = "ID_Function "+++toString id_name imp_decl_to_string (ID_Class {ii_ident={id_name}} _) = "ID_Class "+++toString id_name imp_decl_to_string (ID_Type {ii_ident={id_name}} _) = "ID_Type "+++toString id_name imp_decl_to_string (ID_Record {ii_ident={id_name}} _) = "ID_Record "+++toString id_name imp_decl_to_string (ID_Instance {ii_ident={id_name}} _ _ ) = "ID_Instance "+++toString id_name imp_decl_to_string (ID_OldSyntax idents) = "ID_OldSyntax "+++idents_to_string idents where idents_to_string [] = "" idents_to_string [{id_name}] = toString id_name idents_to_string [{id_name}:l] = toString id_name+++","+++idents_to_string l */ solveExplicitImports :: !(IntKeyHashtable [(Int,Position,[ImportNrAndIdents])]) !{#Int} !Index !*(!v:{#DclModule},!*{#Int},!{!*ExplImpInfo},!*CheckState) -> (!.SolvedImports,!(!v:{#DclModule},!.{#Int},!{!.ExplImpInfo},!.CheckState)) solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod (dcl_modules, visited_modules, expl_imp_info, cs) # import_indices = ikhSearch` importing_mod expl_imp_indices_ikh expl_imp_indices = [ imports \\ imports=:(_, _, [_:_]) <- import_indices ] impl_imports = [ (mod_index, position) \\ imports=:(mod_index, position, []) <- import_indices ] (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 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) # (successes, (decl_accu, unsolved_belonging, 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) successes imported_symbols (expl_imp_info, cs.cs_error) (decl_accu, dcl_modules, visited_modules, expl_imp_info, cs) = foldSt (solve_belonging position expl_imp_indices_ikh modules_in_component_set importing_mod) unsolved_belonging (decl_accu, dcl_modules, visited_modules, expl_imp_info, { cs & cs_error = cs_error }) = ((decl_accu, position), (dcl_modules, visited_modules, expl_imp_info, cs)) solve_belonging position expl_imp_indices_ikh modules_in_component_set importing_mod (decl, {ini_symbol_nr, ini_imp_decl}, imported_mod) (decls_accu, dcl_modules, visited_modules, expl_imp_info, cs=:{cs_error, cs_symbol_table}) # (Yes belongs) = getBelongingSymbolsFromID ini_imp_decl (all_belongs, dcl_modules) = get_all_belongs decl dcl_modules (ExplImpInfo eii_ident eii_declaring_modules, expl_imp_info) = replace expl_imp_info ini_symbol_nr TemporarilyFetchedAway (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 }) 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 (bitvectResetAll visited_modules) = case found of Yes _ # eii_declaring_modules = foldSt (store_belonging belong_nr ini_symbol_nr) path eii_declaring_modules (belong_decl, dcl_modules) = get_nth_belonging_decl position belong_nr decl dcl_modules -> ([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=:(Declaration {decl_kind}) dcl_modules # (STE_Imported _ def_mod_index) = decl_kind (belongin_symbols, dcl_modules) = getBelongingSymbols decl dcl_modules = case belongin_symbols of BS_Constructors constructors # {ds_ident, ds_index} = constructors!!belong_nr -> (Declaration { decl_ident = ds_ident, decl_pos = position, decl_kind = STE_Imported STE_Constructor def_mod_index, decl_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] -> (Declaration { decl_ident = fs_name, decl_pos = position, decl_kind = STE_Imported (STE_Field sd_symb) def_mod_index, decl_index = fs_index }, dcl_modules) BS_Members class_members # {ds_ident, ds_index} = class_members.[belong_nr] -> (Declaration { decl_ident = ds_ident, decl_pos = position, decl_kind = STE_Imported STE_Member def_mod_index, decl_index = ds_index }, dcl_modules) get_all_belongs decl=:(Declaration {decl_kind,decl_index}) 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_kind ({class_members}, dcl_modules) = dcl_modules![def_mod_index].dcl_common.com_class_defs.[decl_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) 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_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)) search_expl_imp_symbol expl_imp_indices_ikh modules_in_component_set importing_mod imported_mod ini=:{ini_symbol_nr} (decls_accu, belonging_accu, 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 (bitvectResetAll visited_modules) = case opt_decl of Yes di=:{di_decl, di_instances} # 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_belonging_accu = case getBelongingSymbolsFromID ini.ini_imp_decl of No -> belonging_accu Yes _ -> [(di_decl, ini, imported_mod):belonging_accu] new_eii = ExplImpInfo eii_ident new_eii_declaring_modules -> (True, ([di_decl:di_instances++decls_accu], new_belonging_accu, visited_modules, { expl_imp_info & [ini_symbol_nr] = new_eii })) No # eii = ExplImpInfo eii_ident eii_declaring_modules -> (False, (decls_accu, belonging_accu, visited_modules, { expl_imp_info & [ini_symbol_nr] = eii })) depth_first_search expl_imp_indices_ikh modules_in_component_set 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, opt_belongs) = search_imported_symbol imported_symbol imp_imp_symbols | not (found && implies (belong_nr<>cUndef) (belong_ident_found belong_ident opt_belongs)) = try_children imports expl_imp_indices_ikh modules_in_component_set imported_symbol belong_nr belong_ident path eii_declaring_modules visited_modules = continue imp_imp_mod imports expl_imp_indices_ikh modules_in_component_set imported_symbol 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 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 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_imp_decl}:t] | imported_symbol==ini_symbol_nr = (True, getBelongingSymbolsFromID ini_imp_decl) = 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 check_triples position [False, False, False: 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) check_singles position [False: 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, ini_imp_decl} (expl_imp_info, cs_error) # (eii_ident, expl_imp_info) = do_a_lot_just_to_read_an_array_2 ini_symbol_nr expl_imp_info cs_error = pushErrorAdmin (newPosition import_ident position) cs_error cs_error = checkError eii_ident (switch_import_syntax "not exported by the specified module" ("not exported as a "+++impDeclToNameSpaceString ini_imp_decl +++" by the specified module")) cs_error = (expl_imp_info, popErrorAdmin cs_error) do_a_lot_just_to_read_an_array_2 i expl_imp_info # (eii, expl_imp_info) = replace expl_imp_info i TemporarilyFetchedAway (eii_ident, eii) = get_eei_ident eii = (eii_ident, { expl_imp_info & [i] = eii }) impDeclToNameSpaceString (ID_Function _) = "function/macro" impDeclToNameSpaceString (ID_Class _ _) = "class" impDeclToNameSpaceString (ID_Type _ _) = "type" impDeclToNameSpaceString (ID_Record _ _) = "type" impDeclToNameSpaceString (ID_Instance _ _ _)= "instance" get_eei_ident (eii=:ExplImpInfo eii_ident _) = (eii_ident, eii) :: CheckCompletenessState = { ccs_dcl_modules :: !.{#DclModule} , ccs_icl_functions :: !.{#FunDef} , ccs_set_of_visited_icl_funs :: !.{#Bool} // ccs_set_of_visited_icl_funs.[i] <=> function nr i has been considered , ccs_expr_heap :: !.ExpressionHeap , ccs_symbol_table :: !.SymbolTable , ccs_error :: !.ErrorAdmin , ccs_heap_changes_accu :: ![SymbolPtr] } :: *CheckCompletenessStateBox = { box_ccs :: !*CheckCompletenessState } :: CheckCompletenessInput = { cci_import_position :: !Position , cci_main_dcl_module_n :: !Int } :: CheckCompletenessInputBox = { box_cci :: !CheckCompletenessInput } checkExplicitImportCompleteness :: ![([Declaration], Position)] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState -> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState) 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 = [] } 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 = foldSt (\(dcls, position) ccs -> foldSt (checkCompleteness main_dcl_module_n position) dcls ccs) 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 ccs_symbol_table = foldSt replace_ste_with_previous ccs_heap_changes_accu ccs_symbol_table cs = { cs & cs_symbol_table = ccs_symbol_table, cs_error = ccs_error } = (ccs_dcl_modules, ccs_icl_functions, ccs_expr_heap, cs) where checkCompleteness :: !Int !Position !Declaration !*CheckCompletenessStateBox -> *CheckCompletenessStateBox checkCompleteness main_dcl_module_n import_position (Declaration {decl_ident, decl_index, decl_kind=STE_FunctionOrMacro _}) ccs = checkCompletenessOfMacro decl_ident decl_index main_dcl_module_n import_position ccs checkCompleteness main_dcl_module_n import_position (Declaration {decl_ident, decl_index, decl_kind=STE_Imported (STE_FunctionOrMacro _) mod_index}) ccs = checkCompletenessOfMacro decl_ident decl_index main_dcl_module_n import_position ccs checkCompleteness main_dcl_module_n import_position (Declaration {decl_ident, decl_index, decl_kind=STE_Imported expl_imp_kind mod_index}) 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 where continuation :: !STE_Kind CommonDefs !{# FunType} !CheckCompletenessInputBox !*CheckCompletenessStateBox -> *CheckCompletenessStateBox continuation STE_Type dcl_common dcl_functions cci ccs = check_completeness dcl_common.com_type_defs.[decl_index] cci ccs continuation STE_Constructor dcl_common dcl_functions cci ccs = check_completeness dcl_common.com_cons_defs.[decl_index] cci ccs continuation (STE_Field _) dcl_common dcl_functions cci ccs = check_completeness dcl_common.com_selector_defs.[decl_index] cci ccs continuation STE_Class dcl_common dcl_functions cci ccs = check_completeness dcl_common.com_class_defs.[decl_index] cci ccs continuation STE_Member dcl_common dcl_functions cci ccs = check_completeness dcl_common.com_member_defs.[decl_index] cci ccs continuation (STE_Instance _) dcl_common dcl_functions cci ccs = check_completeness dcl_common.com_instance_defs.[decl_index] cci ccs continuation STE_DclFunction dcl_common dcl_functions cci ccs = check_completeness dcl_functions.[decl_index] cci ccs checkCompletenessOfMacro :: !Ident !Index !Int !Position !*CheckCompletenessStateBox -> *CheckCompletenessStateBox checkCompletenessOfMacro decl_ident decl_index main_dcl_module_n import_position ccs #! ({fun_body}, ccs) = ccs!box_ccs.ccs_icl_functions.[decl_index] ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[decl_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" toString STE_Constructor = "constructor" toString (STE_Field _) = "field" toString STE_Class = "class" toString STE_Generic = "generic" //AA toString STE_Member = "class member" toString (STE_Instance _) = "instance" check_whether_ident_is_imported :: !Ident !STE_Kind !CheckCompletenessInputBox !*CheckCompletenessStateBox -> *CheckCompletenessStateBox check_whether_ident_is_imported ident wanted_ste_kind cci ccs=:{box_ccs=box_ccs=:{ccs_symbol_table}} #! (ste=:{ste_kind}, ccs_symbol_table) = readPtr ident.id_info ccs_symbol_table ccs = { ccs & box_ccs = { box_ccs & ccs_symbol_table = ccs_symbol_table } } | is_imported ste_kind wanted_ste_kind = ccs #! (ccs=:{box_ccs=box_ccs=:{ccs_symbol_table, ccs_error, ccs_heap_changes_accu}}) = ccs {box_cci={cci_import_position}} = cci ccs_error = checkErrorWithIdentPos (newPosition { id_name="import", id_info=nilPtr } cci_import_position) (" "+++toString wanted_ste_kind+++" "+++toString ident.id_name+++" not imported") ccs_error // pretend that the unimported symbol was imported to prevent doubling error mesages ccs_symbol_table = writePtr ident.id_info { ste & ste_kind = wanted_ste_kind, ste_previous = ste } ccs_symbol_table = { ccs & box_ccs = { box_ccs & ccs_error = ccs_error, ccs_symbol_table = ccs_symbol_table, ccs_heap_changes_accu = [ident.id_info:ccs_heap_changes_accu] }} where is_imported (STE_Imported ste_kind _) wanted_ste_kind = ste_kind==wanted_ste_kind is_imported ste_kind wanted_ste_kind = ste_kind==wanted_ste_kind class check_completeness x :: !x !CheckCompletenessInputBox !*CheckCompletenessStateBox -> *CheckCompletenessStateBox instance check_completeness App where check_completeness {app_symb, app_args} cci ccs = check_completeness app_symb cci (check_completeness app_args cci ccs) instance check_completeness AlgebraicPattern where check_completeness {ap_symbol, ap_expr} cci ccs = check_completeness ap_expr cci (check_whether_ident_is_imported ap_symbol.glob_object.ds_ident STE_Constructor cci ccs) instance check_completeness AType where check_completeness {at_type} cci ccs = check_completeness at_type cci ccs instance check_completeness BasicPattern where check_completeness {bp_expr} cci ccs = check_completeness bp_expr cci ccs instance check_completeness LetBind where check_completeness {lb_src} cci ccs = check_completeness lb_src cci ccs instance check_completeness Case where check_completeness { case_expr, case_guards, case_default } cci ccs = ( (check_completeness case_expr cci) o (check_completeness case_guards cci) o (check_completeness case_default cci) ) ccs instance check_completeness CasePatterns where check_completeness (AlgebraicPatterns _ algebraicPatterns) cci ccs = check_completeness algebraicPatterns cci ccs check_completeness (BasicPatterns _ basicPatterns) cci ccs = check_completeness basicPatterns cci ccs check_completeness (DynamicPatterns dynamicPatterns) cci ccs = check_completeness dynamicPatterns cci ccs check_completeness NoPattern _ ccs = ccs instance check_completeness CheckedAlternative where check_completeness {ca_rhs} cci ccs = check_completeness ca_rhs cci ccs instance check_completeness CheckedBody where check_completeness {cb_rhs} cci ccs = check_completeness cb_rhs cci ccs instance check_completeness ClassDef where check_completeness {class_context} cci ccs = check_completeness class_context cci ccs instance check_completeness ClassInstance where 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 check_completeness {cons_type} cci ccs = check_completeness cons_type cci ccs instance check_completeness DynamicPattern where check_completeness { dp_rhs, dp_type } cci ccs = check_completeness dp_rhs cci (check_completeness_of_dyn_expr_ptr dp_type cci ccs) instance check_completeness DynamicExpr where check_completeness { dyn_expr, dyn_opt_type } cci ccs = check_completeness dyn_expr cci (check_completeness dyn_opt_type cci ccs) instance check_completeness DynamicType where check_completeness { dt_type } cci ccs = check_completeness dt_type cci ccs instance check_completeness Expression where check_completeness (Var _) cci ccs = ccs check_completeness (App app) cci ccs = check_completeness app cci ccs check_completeness (expression @ expressions) cci ccs = check_completeness expression cci (check_completeness expressions cci ccs) check_completeness (Let lad) cci ccs = check_completeness lad cci ccs check_completeness (Case keesje) cci ccs = check_completeness keesje cci ccs check_completeness (Selection _ expression selections) cci ccs = check_completeness expression cci (check_completeness selections cci ccs) check_completeness (TupleSelect _ _ expression) cci ccs = check_completeness expression cci ccs check_completeness (BasicExpr _ _) _ ccs = ccs check_completeness (AnyCodeExpr _ _ _) _ ccs = ccs check_completeness (ABCCodeExpr _ _) _ ccs = ccs check_completeness (MatchExpr _ constructor expression) cci ccs = check_completeness expression cci (check_whether_ident_is_imported constructor.glob_object.ds_ident STE_Constructor cci ccs) check_completeness (FreeVar _) _ ccs = ccs check_completeness (DynamicExpr dynamicExpr) cci ccs = check_completeness dynamicExpr cci ccs check_completeness EE _ ccs = ccs check_completeness (Update expr1 selections expr2) cci ccs = ( (check_completeness expr1 cci) o (check_completeness selections cci) o (check_completeness expr2) cci ) ccs check_completeness expr _ _ = abort "explicitimports:check_completeness (Expression) does not match" //<<- expr instance check_completeness FunctionBody where check_completeness (CheckedBody body) cci ccs = check_completeness body cci ccs check_completeness (TransformedBody body) cci ccs = check_completeness body cci ccs check_completeness (RhsMacroBody body) cci ccs = check_completeness body cci ccs instance check_completeness FunDef where check_completeness {fun_type, fun_body, fun_info} cci ccs = ( (check_completeness fun_type cci) o (check_completeness fun_body cci) o (foldSt (flipM check_completeness_of_dyn_expr_ptr cci) fun_info.fi_dynamics) ) ccs instance check_completeness FunType where check_completeness {ft_type} cci ccs = check_completeness ft_type cci ccs instance check_completeness (Global x) | check_completeness x where check_completeness { glob_object } cci ccs = check_completeness glob_object cci ccs instance check_completeness InstanceType where check_completeness {it_types, it_context} cci ccs = check_completeness it_types cci (check_completeness it_context cci ccs) instance check_completeness Let where check_completeness { let_strict_binds, let_lazy_binds, let_expr } cci ccs = ( (check_completeness let_expr cci) o (check_completeness let_strict_binds cci) o (check_completeness let_lazy_binds cci) ) ccs instance check_completeness MemberDef where check_completeness {me_type} cci ccs = check_completeness me_type cci ccs instance check_completeness (Optional x) | check_completeness x where check_completeness (Yes x) cci ccs = check_completeness x cci ccs check_completeness No _ ccs = ccs instance check_completeness Selection where check_completeness (RecordSelection {glob_object,glob_module} _) cci ccs #! ({dcl_common}, ccs) = ccs!box_ccs.ccs_dcl_modules.[glob_module] // the selector's filed has to be looked up ({sd_field}) = dcl_common.com_selector_defs.[glob_object.ds_index] = check_whether_ident_is_imported sd_field ste_field cci ccs check_completeness (ArraySelection _ _ index_expr) cci ccs = check_completeness index_expr cci ccs check_completeness (DictionarySelection _ selections _ index_expr) cci ccs = check_completeness selections cci (check_completeness index_expr cci ccs) instance check_completeness SelectorDef where check_completeness {sd_type} cci ccs = check_completeness sd_type cci ccs instance check_completeness SymbIdent where check_completeness {symb_name, symb_kind} cci ccs = case symb_kind of SK_Constructor _ -> check_whether_ident_is_imported symb_name STE_Constructor cci ccs SK_Function global_index -> check_completeness_for_function symb_name global_index ste_fun_or_macro cci ccs SK_LocalMacroFunction function_index -> check_completeness_for_local_macro_function symb_name function_index ste_fun_or_macro cci ccs SK_OverloadedFunction global_index -> check_completeness_for_function symb_name global_index STE_Member cci ccs SK_Macro global_index -> check_completeness_for_function symb_name global_index ste_fun_or_macro cci ccs where check_completeness_for_function symb_name {glob_object,glob_module} wanted_ste_kind cci ccs | glob_module<>cci.box_cci.cci_main_dcl_module_n // the function that is referred from within a macro is a DclFunction // -> must be global -> has to be imported = check_whether_ident_is_imported symb_name wanted_ste_kind cci ccs #! (fun_def, ccs) = ccs!box_ccs.ccs_icl_functions.[glob_object] // otherwise the function was defined locally in a macro // it is not a consequence, but it's type and body are consequences ! #! (already_visited, ccs) = ccs!box_ccs.ccs_set_of_visited_icl_funs.[glob_object] | already_visited = ccs #! ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[glob_object] = True } = check_completeness fun_def cci ccs check_completeness_for_local_macro_function symb_name glob_object wanted_ste_kind cci ccs #! (fun_def, ccs) = ccs!box_ccs.ccs_icl_functions.[glob_object] // otherwise the function was defined locally in a macro // it is not a consequence, but it's type and body are consequences ! #! (already_visited, ccs) = ccs!box_ccs.ccs_set_of_visited_icl_funs.[glob_object] | already_visited = ccs #! ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[glob_object] = True } = check_completeness fun_def cci ccs instance check_completeness SymbolType where check_completeness {st_args, st_result, st_context} cci ccs = ( (check_completeness st_args cci) o (check_completeness st_result cci) o (check_completeness st_context cci) ) ccs instance check_completeness TransformedBody where check_completeness {tb_rhs} cci ccs = check_completeness tb_rhs cci ccs instance check_completeness Type where check_completeness (TA {type_name} arguments) cci ccs = check_completeness arguments cci (check_whether_ident_is_imported type_name STE_Type cci ccs) check_completeness (l --> r) cci ccs = check_completeness l cci (check_completeness r cci ccs) check_completeness (_ :@: arguments) cci ccs = check_completeness arguments cci ccs check_completeness _ _ ccs = ccs instance check_completeness TypeContext where check_completeness {tc_class, tc_types} cci ccs = check_completeness tc_types cci (check_whether_ident_is_imported tc_class.glob_object.ds_ident STE_Class cci ccs) instance check_completeness (TypeDef TypeRhs) where check_completeness td=:{td_rhs, td_context} cci ccs = check_completeness td_rhs cci (check_completeness td_context cci ccs) instance check_completeness TypeRhs where check_completeness (SynType aType) cci ccs = check_completeness aType cci ccs check_completeness _ _ ccs = ccs instance check_completeness [a] | check_completeness a where check_completeness [] _ ccs = ccs check_completeness [h:t] cci ccs = check_completeness h cci (check_completeness t cci ccs) check_completeness_of_dyn_expr_ptr :: !ExprInfoPtr !CheckCompletenessInputBox !*CheckCompletenessStateBox -> *CheckCompletenessStateBox check_completeness_of_dyn_expr_ptr dyn_expr_ptr cci ccs=:{box_ccs=box_ccs=:{ccs_expr_heap}} #! (expr_info, ccs_expr_heap) = readPtr dyn_expr_ptr ccs_expr_heap ccs = { ccs & box_ccs = { box_ccs & ccs_expr_heap = ccs_expr_heap }} = case expr_info of (EI_Dynamic No) -> ccs (EI_Dynamic (Yes dynamic_type)) -> check_completeness dynamic_type cci ccs (EI_DynamicType dynamic_type further_dynamic_ptrs) -> check_completeness dynamic_type cci (foldSt (flipM check_completeness_of_dyn_expr_ptr cci) further_dynamic_ptrs ccs) (EI_DynamicTypeWithVars _ dynamic_type further_dynamic_ptrs) -> check_completeness dynamic_type cci (foldSt (flipM check_completeness_of_dyn_expr_ptr cci) further_dynamic_ptrs ccs) flipM f a b :== f b a // STE_Kinds just for comparision 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