diff options
author | martinw | 2000-11-01 15:42:13 +0000 |
---|---|---|
committer | martinw | 2000-11-01 15:42:13 +0000 |
commit | 82bd65297bb04bdd2b144e2c426b6a548024ff6e (patch) | |
tree | 84d139b61c5b908fc66df5af7027f215814b0c87 /frontend | |
parent | changes were necessary due to different numberings due to caching of dcl (diff) |
improved code for explicit imports,
moved all switches to syntax module
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@277 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
Diffstat (limited to 'frontend')
-rw-r--r-- | frontend/check.icl | 41 | ||||
-rw-r--r-- | frontend/checksupport.dcl | 4 | ||||
-rw-r--r-- | frontend/checksupport.icl | 40 | ||||
-rw-r--r-- | frontend/explicitimports.dcl | 24 | ||||
-rw-r--r-- | frontend/explicitimports.icl | 903 | ||||
-rw-r--r-- | frontend/parse.icl | 18 | ||||
-rw-r--r-- | frontend/syntax.dcl | 17 | ||||
-rw-r--r-- | frontend/syntax.icl | 6 | ||||
-rw-r--r-- | frontend/type.icl | 2 | ||||
-rw-r--r-- | frontend/typesupport.dcl | 3 | ||||
-rw-r--r-- | frontend/typesupport.icl | 3 | ||||
-rw-r--r-- | frontend/utilities.dcl | 26 | ||||
-rw-r--r-- | frontend/utilities.icl | 32 |
13 files changed, 490 insertions, 629 deletions
diff --git a/frontend/check.icl b/frontend/check.icl index f806379..e8b6302 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -614,12 +614,12 @@ collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_ sizes = { sizes & [cSelectorDefs] = size } (size, defs) = foldSt type_def_to_dcl def_types (0, defs) sizes = { sizes & [cTypeDefs] = size } + (size, defs) = foldSt member_def_to_dcl def_members (0, defs) + sizes = { sizes & [cMemberDefs] = size } (size, defs) = foldSt class_def_to_dcl def_classes (0, defs) sizes = { sizes & [cClassDefs] = size } (size, defs) = foldSt instance_def_to_dcl def_instances (0, defs) sizes = { sizes & [cInstanceDefs] = size } - (size, defs) = foldSt member_def_to_dcl def_members (0, defs) - sizes = { sizes & [cMemberDefs] = size } = (sizes, defs) where type_def_to_dcl {td_name, td_pos} (dcl_index, decls) @@ -632,8 +632,8 @@ where = (inc dcl_index, [{ dcl_ident = class_name, dcl_pos = class_pos, dcl_kind = STE_Class, dcl_index = dcl_index } : decls]) member_def_to_dcl {me_symb, me_pos} (dcl_index, decls) = (inc dcl_index, [{ dcl_ident = me_symb, dcl_pos = me_pos, dcl_kind = STE_Member, dcl_index = dcl_index } : decls]) - instance_def_to_dcl {ins_ident, ins_pos} (dcl_index, decls) - = (inc dcl_index, [{ dcl_ident = ins_ident, dcl_pos = ins_pos, dcl_kind = STE_Instance, dcl_index = dcl_index } : decls]) + instance_def_to_dcl {ins_class, ins_ident, ins_pos} (dcl_index, decls) + = (inc dcl_index, [{ dcl_ident = ins_ident, dcl_pos = ins_pos, dcl_kind = STE_Instance ins_class.glob_object.ds_ident, dcl_index = dcl_index } : decls]) collectMacros {ir_from,ir_to} macro_defs sizes_defs = collectGlobalFunctions cMacroDefs ir_from ir_to macro_defs sizes_defs @@ -1108,7 +1108,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func cs = addGlobalDefinitionsToSymbolTable local_defs cs (dcl_modules, icl_functions, hp_expression_heap, cs) - = checkExplicitImportCompleteness (mod_name.id_name+++".icl") main_dcl_module_n dcls_explicit dcl_modules icl_functions hp_expression_heap cs + = checkExplicitImportCompleteness main_dcl_module_n dcls_explicit dcl_modules icl_functions hp_expression_heap cs heaps = { heaps & hp_expression_heap=hp_expression_heap } @@ -1238,8 +1238,8 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func where build_conversion_table_for_instances_of_dcl_mod {ir_from,ir_to} first_free_index dcl_functions dcl_instances conversion_table icl_instances #! nr_of_dcl_functions = size dcl_functions - # dcl_instances_table = conversion_table.[toInt STE_Instance] - dcl_function_table = conversion_table.[toInt STE_DclFunction] + # dcl_instances_table = conversion_table.[cInstanceDefs] + dcl_function_table = conversion_table.[cFunctionDefs] new_table = { createArray nr_of_dcl_functions NoIndex & [i] = icl_index \\ icl_index <-: dcl_function_table & i <- [0..] } index_diff = first_free_index - ir_from new_table = { new_table & [i] = i + index_diff \\ i <- [ir_from .. ir_to - 1] } @@ -1521,12 +1521,12 @@ checkImport module_id_info entry=:{ste_kind = STE_Module mod, ste_index} iinfo=: = 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_name, dcl_declared}, modules) = modules![mod_index] + # ({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 (dcl_name.id_name+++".dcl") cs_x.x_main_dcl_module_n dcls_explicit modules macro_and_fun_defs hp_expression_heap cs + = 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 }) @@ -1555,13 +1555,6 @@ initialDclModule ({mod_name, mod_defs=mod_defs=:{def_funtypes,def_macros}, mod_t , dcl_imported_module_numbers = EndModuleNumbers } -local_declaration_for_import decl=:{dcl_kind=STE_FunctionOrMacro _} module_n - = decl -local_declaration_for_import decl=:{dcl_kind=STE_Imported _ _} module_n - = abort "local_declaration_for_import" -local_declaration_for_import decl=:{dcl_kind} module_n - = {decl & dcl_kind = STE_Imported dcl_kind module_n} - 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 @@ -1575,8 +1568,6 @@ checkDclModule is_on_cycle {mod_name,mod_imports,mod_defs} mod_index modules icl cs = { cs & cs_x.x_needed_modules = 0 } nr_of_dcl_functions = size dcl_mod.dcl_functions - dcls_explicit = flatten [[dcls_explicit\\dcls_explicit<-:dcls_explicit] \\ (_,{dcls_explicit})<-imports] - #! main_dcl_module_n = cs.cs_x.x_main_dcl_module_n # (dcl_common, modules, hp_type_heaps, hp_var_heap, cs) @@ -1621,7 +1612,7 @@ checkDclModule is_on_cycle {mod_name,mod_imports,mod_defs} mod_index modules icl 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 (mod_name.id_name+++".dcl") main_dcl_module_n dcls_explicit modules icl_functions hp_expression_heap cs + False -> checkExplicitImportCompleteness main_dcl_module_n dcls_explicit modules icl_functions hp_expression_heap cs True -> (modules, icl_functions, hp_expression_heap, cs) heaps = { heaps & hp_expression_heap = hp_expression_heap } @@ -1632,7 +1623,7 @@ checkDclModule is_on_cycle {mod_name,mod_imports,mod_defs} mod_index modules icl 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 @@ -1647,11 +1638,11 @@ checkDclModule is_on_cycle {mod_name,mod_imports,mod_defs} mod_index modules icl 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 }) where - collect_imported_symbols [{import_module={id_info},import_symbols,import_file_position=LinePos filename line_nr} : mods ] all_decls modules cs=:{cs_symbol_table} + 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) = possibly_filter_decls - import_symbols decls_of_imported_module (filename, line_nr) modules cs + (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) @@ -1774,11 +1765,11 @@ NewEntry symbol_table symb_ptr def_kind def_index level previous :== // -> (![(!Declaration, !LineNr)], !*{# DclModule}, !*CheckState) addImportsToSymbolTable :: ![ParsedImport] ![ExplicitImport] !*{# DclModule} !*CheckState -> (![ExplicitImport], !*{# DclModule}, !*CheckState) -addImportsToSymbolTable [{import_module={id_info},import_symbols, import_file_position=LinePos filename line_nr} : mods ] explicit_akku modules cs=:{cs_symbol_table} +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) - = possibly_filter_decls import_symbols [(ste_index, decls_of_imported_module)] (filename,line_nr) modules { cs & cs_symbol_table = cs_symbol_table } + = 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 diff --git a/frontend/checksupport.dcl b/frontend/checksupport.dcl index 9955409..01bd14d 100644 --- a/frontend/checksupport.dcl +++ b/frontend/checksupport.dcl @@ -75,7 +75,7 @@ cConversionTableSize :== 8 , dcls_explicit ::!{!ExplicitImport} } -:: ExplicitImport = ExplicitImport !Declaration !LineNr; +:: ExplicitImport = ExplicitImport !Declaration !Position :: IclModule = { icl_name :: !Ident @@ -167,3 +167,5 @@ removeLocalsFromSymbolTable :: !Level ![Ident] !LocalDefs !u:{# FunDef} !*(Heap -> (!u:{# FunDef}, !.Heap SymbolTableEntry) newFreeVariable :: !FreeVar ![FreeVar] ->(!Bool, ![FreeVar]) + +local_declaration_for_import :: !u:Declaration .Index -> v:Declaration, [u <= v] diff --git a/frontend/checksupport.icl b/frontend/checksupport.icl index 069f924..1377fa2 100644 --- a/frontend/checksupport.icl +++ b/frontend/checksupport.icl @@ -18,11 +18,9 @@ cGlobalScope :== 1 cIsNotADclModule :== False cIsADclModule :== True -// MW.. cNeedStdArray :== 1 cNeedStdEnum :== 2 cNeedStdDynamics:== 4 -// ..MW :: Heaps = { hp_var_heap ::!.VarHeap @@ -56,7 +54,7 @@ where toInt (STE_Field _) = cSelectorDefs toInt STE_Class = cClassDefs toInt STE_Member = cMemberDefs - toInt STE_Instance = cInstanceDefs + toInt (STE_Instance _) = cInstanceDefs toInt STE_DclFunction = cFunctionDefs toInt (STE_FunctionOrMacro _) = cMacroDefs toInt _ = NoIndex @@ -84,7 +82,7 @@ where , dcls_explicit ::!{!ExplicitImport} } -:: ExplicitImport = ExplicitImport !Declaration !LineNr; +:: ExplicitImport = ExplicitImport !Declaration !Position :: IclModule = { icl_name :: !Ident @@ -252,12 +250,12 @@ retrieveAndRemoveImportsFromSymbolTable [] 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 0 imports all_decls symbol_table - = retrieve_declared_symbols_in_array 0 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 0 imports 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) @@ -292,13 +290,13 @@ where retrieve_declared_symbols_in_array :: !Int !{!Declaration} ![Declaration] !*SymbolTable -> (![Declaration], !*SymbolTable) retrieve_declared_symbols_in_array symbol_index symbols decls symbol_table - | symbol_index<size symbols + | 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 + = 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 @@ -307,29 +305,29 @@ retrieve_declared_symbols_in_array symbol_index symbols decls symbol_table _ -> 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) + -> 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) + -> 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) + -> 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) + -> 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 + -> 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 + -> 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 @@ -338,7 +336,7 @@ 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_Instance _) (STE_Instance _) = True same_STE_Kind STE_Member STE_Member = True same_STE_Kind STE_Class STE_Class = True same_STE_Kind _ _ = False @@ -631,6 +629,14 @@ newFreeVariable new_var [] = (True, [new_var]) +local_declaration_for_import :: !u:Declaration .Index -> v:Declaration, [u <= v] +local_declaration_for_import decl=:{dcl_kind=STE_FunctionOrMacro _} module_n + = decl +local_declaration_for_import decl=:{dcl_kind=STE_Imported _ _} module_n + = abort "local_declaration_for_import" +local_declaration_for_import decl=:{dcl_kind} module_n + = {decl & dcl_kind = STE_Imported dcl_kind module_n} + class toIdent a :: !a -> Ident @@ -728,7 +734,7 @@ where STE_Member = file <<< "STE_Member" (<<<) file - STE_Instance + (STE_Instance _) = file <<< "STE_Instance" (<<<) file (STE_Variable _) diff --git a/frontend/explicitimports.dcl b/frontend/explicitimports.dcl index 5d0f037..a227d77 100644 --- a/frontend/explicitimports.dcl +++ b/frontend/explicitimports.dcl @@ -2,25 +2,9 @@ definition module explicitimports import syntax, checksupport -temporary_import_solution_XXX yes no :== yes -// to switch between importing modes. -// iff this is yes, then explicit imports happen in the old Clean 1.3 fashion. -// This feature will be removed, when all programs are ported to Clean 2.0. The last Constructors of AtomType -// and StructureType should then be removed also +possiblyFilterExplImportedDecls :: ![ImportDeclaration] u:[w:(.Index,y:Declarations)] Position u0:{#DclModule} !*CheckState + -> (!v:[x:(Index,z:Declarations)],!u0:{#DclModule},!.CheckState), [y <= z, w <= x, u <= v] -//:: FunctionConsequence - -possibly_filter_decls :: .[ImportDeclaration] u:[w:(.Index,y:Declarations)] (.FileName,.LineNr) *{#.DclModule} *CheckState -> (v:[x:(Index,z:Declarations)],.{#DclModule},.CheckState), [y <= z, w <= x, u <= v]; -//possibly_filter_decls :: ![ImportDeclaration] ![(Index,Declarations)] !(!FileName,!LineNr) !*{#DclModule} !*CheckState -> (![(Index,Declarations)],!.{#DclModule},!.CheckState) - -//check_completeness_of_module :: .Index !Int [(.Declaration,.Int)] .String *(*{!.FunctionConsequence},*{#.DclModule},*{#FunDef},*ExpressionHeap,*CheckState) -> (.{!FunctionConsequence},.{#DclModule},.{#FunDef},.ExpressionHeap,.CheckState); -/* -check_completeness_of_module :: .Index !Int [ExplicitImport] .String *(*{!.FunctionConsequence},*{#.DclModule},*{#FunDef},*ExpressionHeap,*CheckState) -> (.{!FunctionConsequence},.{#DclModule},.{#FunDef},.ExpressionHeap,.CheckState); -check_completeness_of_all_dcl_modules :: !Int !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState - -> (!Int, !(!*{!FunctionConsequence}, !*{#DclModule}, !*{#FunDef}, !*ExpressionHeap, !*CheckState)) - -create_empty_consequences_array :: !Int -> *{!FunctionConsequence} -*/ -//checkExplicitImportCompleteness :: !String ![(!Declaration,!Int)] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState -> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState) -checkExplicitImportCompleteness :: !String !Int ![ExplicitImport] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState -> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState) +checkExplicitImportCompleteness :: !Int ![ExplicitImport] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState + -> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState) diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl index 822de3e..f5331ef 100644 --- a/frontend/explicitimports.icl +++ b/frontend/explicitimports.icl @@ -1,532 +1,345 @@ implementation module explicitimports -// compile using the "reuse unique nodes" option import StdEnv import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef, RWSDebug -temporary_import_solution_XXX yes no :== yes -// to switch between importing modes. -// iff this is yes, then explicit imports happen in the old Clean 1.3 fashion. -// This feature will be removed, when all programs are ported to Clean 2.0. The last Constructors of AtomType -// and StructureType should then be removed also -do_temporary_import_solution_XXX :== temporary_import_solution_XXX True False - -:: ExplicitImports :== (![AtomicImport], ![StructureImport]) -:: AtomicImport :== (!Ident, !AtomType) -:: StructureImport :== (!Ident, !StructureInfo, !StructureType, !OptimizeInfo) - -:: AtomType = AT_Function | AT_Class | AT_Instance | AT_RecordType | AT_AlgType | AT_Type - | AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen Bool // XXX -:: StructureInfo = SI_DotDot - // The .. notation was used for the structure - // (currently nothing is known about the elements) - | SI_Elements ![Ident] !Bool - // list of elements, that were not imported yet. - // Bool: the elements were listed explicitly in the structure -:: StructureType = ST_AlgType | ST_RecordType | ST_Class - | ST_stomm_stomm_stomm String -:: IdentWithKind :== (!Ident, !STE_Kind) - -:: OptimizeInfo :== Optional Index - -possibly_filter_decls :: .[ImportDeclaration] u:[w:(.Index,y:Declarations)] (.FileName,.LineNr) *{#.DclModule} *CheckState -> (v:[x:(Index,z:Declarations)],.{#DclModule},.CheckState), [y <= z, w <= x, u <= v]; -possibly_filter_decls [] decls_of_imported_module _ modules cs // implicit import can't go wrong +possiblyFilterExplImportedDecls :: ![ImportDeclaration] u:[w:(.Index,y:Declarations)] Position u0:{#DclModule} !*CheckState + -> (!v:[x:(Index,z:Declarations)],!u0:{#DclModule},!.CheckState), [y <= z, w <= x, u <= v] +possiblyFilterExplImportedDecls [] decls_of_imported_module _ modules cs // implicit import = (decls_of_imported_module, modules, cs) -possibly_filter_decls listed_symbols decls_of_imported_module (file_name, line_nr) modules cs +possiblyFilterExplImportedDecls import_declarations decls_of_imported_module import_statement_pos modules cs=:{cs_error, cs_symbol_table} // explicit import - #! ident_pos = { ip_ident= { id_name="", id_info=nilPtr } - , ip_line = line_nr - , ip_file = file_name - } - cs = { cs & cs_error = pushErrorAdmin ident_pos cs.cs_error } - (result, modules, cs) = filter_explicitly_imported_decl listed_symbols decls_of_imported_module [] line_nr modules cs - cs = { cs & cs_error = popErrorAdmin cs.cs_error } - = (result, modules, cs) - -filter_explicitly_imported_decl _ [] akku _ modules cs - = (akku, modules, cs) -filter_explicitly_imported_decl import_symbols [(index,{dcls_import,dcls_local,dcls_explicit}):new_decls] akku - line_nr modules cs - # undefined = -1 - atoms = flatten (map toAtom import_symbols) - structures = flatten (map toStructure import_symbols) - (checked_atoms, cs) = checkAtoms atoms cs - unimported = (checked_atoms, structures) - - (dcls_import,unimported, modules, cs) = filter_decl_array 0 dcls_import unimported undefined modules cs - - ((dcls_local,unimported), modules, cs) - = filter_decl dcls_local unimported index modules cs - cs_error = foldSt checkAtomError (fst unimported) cs.cs_error - cs_error = foldSt checkStructureError (snd unimported) cs_error - cs = { cs & cs_error=cs_error } - | isEmpty dcls_import && isEmpty dcls_local && size dcls_explicit==0 - = filter_explicitly_imported_decl import_symbols new_decls akku line_nr modules cs - # local_imports = [ { declaration & dcl_kind = STE_Imported declaration.dcl_kind index } \\ declaration <- dcls_local] - new_dcls_explicit = [ ExplicitImport dcls line_nr \\ dcls<-dcls_import++local_imports ] - - dcls_import = {dcls_import\\dcls_import<-dcls_import} - - newAkku = [(index, { dcls_import=dcls_import, dcls_local=dcls_local , - dcls_local_for_import = {local_declaration_for_import decl index \\ decl<-dcls_local}, -// dcls_explicit=new_dcls_explicit}) : akku] - dcls_explicit={new_dcls_explicit\\new_dcls_explicit<-new_dcls_explicit}}) : akku] - = filter_explicitly_imported_decl import_symbols new_decls newAkku line_nr modules cs + # 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) + (imported_decls, wanted_symbols, modules, cs=:{cs_error, cs_symbol_table}) + = foldSt (filter_decls_per_module import_statement_pos) decls_of_imported_module + ([], wanted_symbols, modules, { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }) + cs = { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table } + cs = foldSt (switch_import_syntax restore_symbol_table_old_syntax restore_symbol_table) wanted_symbols cs + cs = { cs & cs_error = popErrorAdmin cs.cs_error } + = (imported_decls, modules, cs) where - local_declaration_for_import decl=:{dcl_kind=STE_FunctionOrMacro _} module_n - = decl - local_declaration_for_import decl=:{dcl_kind=STE_Imported _ _} module_n - = abort "local_declaration_for_import" - local_declaration_for_import decl=:{dcl_kind} module_n - = {decl & dcl_kind = STE_Imported dcl_kind module_n} - - toAtom (ID_Function {ii_ident}) - = [(ii_ident, temporary_import_solution_XXX - (AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen False) - AT_Function)] - toAtom (ID_Class {ii_ident} _) - = [(ii_ident, AT_Class)] - toAtom (ID_Type {ii_ident} (Yes _)) - = [(ii_ident, AT_AlgType)] - toAtom (ID_Type {ii_ident} No) - = [(ii_ident, AT_Type)] - toAtom (ID_Record {ii_ident} yesOrNo) - = [(ii_ident, AT_RecordType)] - toAtom (ID_Instance _ ident _) - = [(ident, AT_Instance)] - toAtom _ - = [] - - atomTypeString AT_Function = "function" - atomTypeString AT_Class = "class" - atomTypeString AT_Instance = "instance" - atomTypeString _ = "type" - - toStructure (ID_Class {ii_ident} yesOrNo) - = to_structure ii_ident yesOrNo ST_Class - toStructure (ID_Type {ii_ident} yesOrNo) - = to_structure ii_ident yesOrNo ST_AlgType - toStructure (ID_Record {ii_ident} yesOrNo) - = to_structure ii_ident yesOrNo ST_RecordType -// MW added - toStructure (ID_Function {ii_ident}) - | do_temporary_import_solution_XXX - = [(ii_ident, SI_DotDot, ST_stomm_stomm_stomm ii_ident.id_name, No)] -// ..MW - toStructure _ - = [] + 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 - to_structure _ No _ - = [] - to_structure ident (Yes []) structureType - = [(ident, SI_DotDot, structureType, No)] - to_structure ident (Yes elements) structureType - # element_idents = removeDup [ ii_ident \\ {ii_ident}<-elements] - = [(ident, (SI_Elements element_idents True),structureType, No)] - - checkAtoms l cs - # groups = grouped l - wrong = filter isErroneous groups - unique = map hd groups - | isEmpty wrong - = (unique, cs) - = (unique, foldSt error wrong cs) + 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 } + + 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 - isErroneous l=:[(_,AT_Type),_:_] = True - isErroneous l=:[(_,AT_AlgType),_:_] = True - isErroneous l=:[(_,AT_RecordType),_:_] = True - isErroneous _ = False + 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, wanted_symbols, modules, cs) + # (dcls_import, (wanted_symbols, modules, cs)) + = iMapFilterYesSt (i_filter_possibly_imported_decl mod_index dcls_import) + 0 (size dcls_import) (wanted_symbols, modules, cs) + (dcls_local, (wanted_symbols, modules, cs)) + = mapFilterYesSt (filter_possibly_imported_decl mod_index) dcls_local (wanted_symbols, modules, cs) + 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 + ], + wanted_symbols, modules, cs) + + i_filter_possibly_imported_decl mod_index dcls_import i state + = filter_possibly_imported_decl mod_index dcls_import.[i] state - error [(ident, atomType):_] cs - = { cs & cs_error = checkError ("type "+++ident.id_name) "imported more than once in one from statement" - cs.cs_error } - - checkAtomError (id, AT_Instance) cs_error - = checkError ("specified instance of class "+++id.id_name) "not exported by the specified module" cs_error - checkAtomError (id, AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen was_imported_at_least_once) cs_error - | do_temporary_import_solution_XXX - = case was_imported_at_least_once of - True -> cs_error - _ -> checkError id ("not exported by the specified module") cs_error - checkAtomError (id, atomType) cs_error - = checkError id ("not exported as a "+++atomTypeString atomType+++" by the specified module") cs_error - -// MW remove this later.. - checkStructureError (_,_, ST_stomm_stomm_stomm _, _) cs_error - | do_temporary_import_solution_XXX - = cs_error - // further with next alternative -// ..MW - checkStructureError (struct_id, (SI_Elements wrong_elements _), st, _) cs_error - = foldSt err wrong_elements cs_error + 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 !(!v:[Ident],!u:{#DclModule},!*CheckState) +// -> (!Optional Declaration,!(!w:[Ident],!u:{#DclModule},!.CheckState)), [v<=w] + filter_decl mod_index decl (STE_Instance class_ident) state + // this alternative is only for old syntax + | switch_import_syntax True False + = filter_instance_decl mod_index decl class_ident state + filter_decl mod_index decl=:{dcl_ident={id_info}} dcl_kind (wanted_symbols_accu, modules, cs=:{cs_symbol_table}) + # (ste=:{ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table + cs = { cs & cs_symbol_table = cs_symbol_table } + = case ste_kind of + STE_ExplImp _ opt_import_declaration ste_kind_2 _ + // the symbol is wanted (see above). + # cs_symbol_table + = writePtr id_info { ste & ste_kind = STE_ExplImp True opt_import_declaration ste_kind_2 False} + cs.cs_symbol_table //--->("setting True", decl.dcl_ident) + // mark this symbol as being succesfully imported + cs = { cs & cs_symbol_table = cs_symbol_table} + -> case opt_import_declaration of + No -> (Yes decl, (wanted_symbols_accu, modules, cs)) + Yes import_declaration + # cs = switch_import_syntax (mark_partners import_declaration cs) cs + -> (Yes decl, add_bracketed_symbols_to_symbol_table import_declaration decl dcl_kind mod_index + (wanted_symbols_accu, modules, cs)) + _ -> (No, (wanted_symbols_accu, modules, cs)) + + // only for old syntax + filter_instance_decl mod_index decl=:{dcl_index} class_ident + (wanted_symbols_accu, modules, cs=:{cs_symbol_table}) + # (ste=:{ste_kind}, cs_symbol_table) = readPtr class_ident.id_info cs_symbol_table + cs = { cs & cs_symbol_table = cs_symbol_table } + = case ste_kind of + STE_ExplImp _ _ _ _ + -> (Yes decl, (wanted_symbols_accu, modules, cs)) + _ -> (No, (wanted_symbols_accu, modules, cs)) + + // only for old syntax + mark_partners (ID_OldSyntax partners) cs=:{cs_symbol_table} + # cs_symbol_table = foldSt mark_partner partners cs_symbol_table + = { cs & cs_symbol_table = cs_symbol_table } where - err element_id cs_error - # (element_type, structure_type) = case st of - ST_AlgType -> ("constructor", "algebraic type") - ST_RecordType -> ("field", "record type") - ST_Class -> ("member", "class") - = checkError element_id ( "not a "+++element_type+++" of "+++structure_type - +++" "+++struct_id.id_name) cs_error - checkStructureError _ cs_error - = cs_error - - // collect groups, e.g. grouped [3,5,1,3,1] = [[1,1],[3,3],[5]] - grouped [] - = [] - grouped l - # sorted = qsort l - = grouped_ [hd sorted] (tl sorted) [] + mark_partner {id_info} cs_symbol_table + # (ste=:{ste_kind=STE_ExplImp _ a b c}, cs_symbol_table) = readPtr id_info cs_symbol_table + = writePtr id_info { ste & ste_kind = STE_ExplImp True a b c } cs_symbol_table + + add_bracketed_symbols_to_symbol_table import_declaration decl dcl_kind mod_index + (wanted_symbols_accu, modules, cs) + # (opt_bracket_info, modules, cs=:{cs_symbol_table}) + = (switch_import_syntax get_opt_bracket_info_old_syntax get_opt_bracket_info) + import_declaration decl dcl_kind mod_index modules cs + | isNo opt_bracket_info + = (wanted_symbols_accu, modules, { cs & cs_symbol_table = cs_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 + cs_symbol_table + = foldSt (add_bracket_symbol_to_symbol_table ste_kind all_bracket_ids_are_wanted) all_bracket_ids + cs_symbol_table + cs = { cs & cs_symbol_table = cs_symbol_table } + | all_bracket_ids_are_wanted + // "import class C (..)" or "import :: T (..)" or "import :: T {..}" + = (all_bracket_ids++wanted_symbols_accu, modules, cs) + // "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 + # cs = foldSt (check_wanted_idents structure_name) wanted_bracket_ids cs + cs_symbol_table = foldSt overwrite_wanted_idents wanted_bracket_ids cs.cs_symbol_table + (wanted_symbols_accu, cs_symbol_table) + = foldSt remove_and_collect all_bracket_ids (wanted_symbols_accu, cs_symbol_table) + = (wanted_symbols_accu, modules, { cs & cs_symbol_table = cs_symbol_table }) where - grouped_ group [] akku - = [group:akku] - grouped_ group=:[x:_] [h:t] akku - | x==h = grouped_ [h:group] t akku - = grouped_ [h] t [group:akku] + isNo No = True + isNo _ = False + + add_bracketed_symbols_to_symbol_table _ _ _ mod_index states + = states - qsort [] = [] - qsort [h:t] = qsort left++[h: qsort right] + get_opt_bracket_info (ID_Class _ (Yes wanted_members)) {dcl_kind, dcl_index} mod_index modules cs=:{cs_symbol_table} + # (dcl_module, module_entry, modules, cs_symbol_table) + = get_module_and_entry dcl_kind mod_index modules cs_symbol_table + 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), + modules, { cs & cs_symbol_table = cs_symbol_table }) + get_opt_bracket_info (ID_Type ii (Yes wanted_constructors)) {dcl_kind, dcl_index} mod_index modules cs=:{cs_symbol_table} + # (dcl_module, module_entry, modules, cs_symbol_table) + = get_module_and_entry dcl_kind mod_index modules cs_symbol_table + 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) + # cs = { cs & cs_error = checkError ii.ii_ident "is not an algebraic type" cs.cs_error, + cs_symbol_table = cs_symbol_table } + = (No, modules, cs) + # (AlgType constructors) = type_def.td_rhs + all_constructor_idents = [ ds_ident \\ {ds_ident} <- constructors ] + cs = { cs & cs_symbol_table = cs_symbol_table } + = (Yes (all_constructor_idents, wanted_constructors, type_def.td_name, STE_Constructor), modules, cs) where - left = [x \\ x<-t | greater x h] - right = [x \\ x<-t | not (greater x h) || x==h] - greater ({id_name=id_name_l}, atomType_l) ({id_name=id_name_r}, atomType_r) - | id_name_l >id_name_r = True - | id_name_l==id_name_r = toInt atomType_l > toInt atomType_r - = False - -instance == AtomType - where - (==) l r = toInt l==toInt r - -instance toInt AtomType - where - toInt AT_Function = 0 - toInt AT_Class = 1 - toInt AT_Instance = 2 - toInt AT_RecordType = 3 - toInt AT_AlgType = 3 - toInt AT_Type = 3 // AT_RecordType, AT_AlgType & AT_Type are in one class !!! - toInt (AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen _) - = 0 - -NoPosition :== -1 - -filter_decl :: [.Declaration] ([(Ident,AtomType)],[(Ident,StructureInfo,StructureType,Optional Int)]) Int *{#DclModule} *CheckState -> (!(!.[Declaration],!([(Ident,AtomType)],![(Ident,StructureInfo,StructureType,Optional Int)])),!.{#DclModule},!.CheckState); -filter_decl [] unimported _ modules cs - = (([], unimported), modules, cs) -filter_decl [decl:decls] unimported index modules cs - # ((appears,unimported), modules, cs) = decl_appears decl unimported index modules cs - | appears - # ((recurs, unimported), modules, cs) = filter_decl decls unimported index modules cs - - = (([decl:recurs],unimported), modules, cs) - = filter_decl decls unimported index modules cs - -filter_decl_array :: !Int {!.Declaration} ([(Ident,AtomType)],[(Ident,StructureInfo,StructureType,Optional Int)]) Int *{#DclModule} *CheckState -> (!.[Declaration],!([(Ident,AtomType)],![(Ident,StructureInfo,StructureType,Optional Int)]),!.{#DclModule},!.CheckState); -filter_decl_array decl_index decls unimported index modules cs - | decl_index<size decls - # (decl,decls) = decls![decl_index] - # ((appears,unimported), modules, cs) = decl_appears decl unimported index modules cs - | appears - # (recurs, unimported, modules, cs) = filter_decl_array (decl_index+1) decls unimported index modules cs - = ([decl:recurs],unimported, modules, cs) - = filter_decl_array (decl_index+1) decls unimported index modules cs - = ([], unimported, modules, cs) + isAlgType (AlgType _) = True + isAlgType _ = False + get_opt_bracket_info (ID_Record ii (Yes wanted_fields)) {dcl_kind, dcl_index} mod_index modules cs=:{cs_symbol_table} + # (dcl_module, module_entry, modules, cs_symbol_table) + = get_module_and_entry dcl_kind mod_index modules cs_symbol_table + 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) + # cs = { cs & cs_error = checkError ii.ii_ident "is not a record type" cs.cs_error, + cs_symbol_table = cs_symbol_table } + = (No, modules, cs) + # (RecordType {rt_fields}) = type_def.td_rhs + all_field_idents = [ fs_name \\ {fs_name} <-: rt_fields ] + cs = { cs & cs_symbol_table = cs_symbol_table } + = (Yes (all_field_idents, wanted_fields, type_def.td_name, STE_Field (hd all_field_idents)), modules, cs) + where + isRecordType (RecordType _) = True + isRecordType _ = False + get_opt_bracket_info _ _ _ modules cs + = (No, modules, cs) + + // this function is only for old syntax + get_opt_bracket_info_old_syntax _ {dcl_index} STE_Class mod_index modules cs=:{cs_symbol_table} + # (dcl_module, module_entry, modules, cs_symbol_table) + = get_module_and_entry STE_Class mod_index modules cs_symbol_table + 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, cs_symbol_table) + = foldSt filter_member all_member_idents ([], cs_symbol_table) + = (Yes (all_member_idents_2, [], class_def.class_name, STE_Member), + modules, { cs & cs_symbol_table = cs_symbol_table }) + get_opt_bracket_info_old_syntax _ {dcl_index} STE_Type mod_index modules cs=:{cs_symbol_table} + # (dcl_module, module_entry, modules, cs_symbol_table) + = get_module_and_entry STE_Type mod_index modules cs_symbol_table + 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] + cs = { cs & cs_symbol_table = cs_symbol_table } + = 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)), modules, cs) + _ -> (No, modules, cs) + get_opt_bracket_info_old_syntax _ _ _ _ modules cs + = (No, modules, cs) -decl_appears :: !Declaration !ExplicitImports !Index !*{#DclModule} !*CheckState - -> (!(!Bool, !ExplicitImports), !*{#DclModule}, !*CheckState) -decl_appears dec=:{dcl_kind=STE_Imported ste_Kind def_index} unimported _ modules cs - = decl_appears {dec & dcl_kind=ste_Kind} unimported def_index modules cs -/* MW2 was: -decl_appears {dcl_ident,dcl_kind=STE_Constructor,dcl_index} unimported index modules cs - = elementAppears ST_AlgType dcl_ident dcl_index unimported index modules cs -*/ -decl_appears {dcl_ident,dcl_kind=STE_Constructor,dcl_index} unimported index modules cs - # (result=:((appears, unimported), modules, cs)) - = elementAppears ST_AlgType dcl_ident dcl_index unimported index modules cs - | appears || not do_temporary_import_solution_XXX - = result - = atomAppears dcl_ident dcl_index unimported index modules cs -/* MW2 was -decl_appears { dcl_ident,dcl_kind=(STE_Field _),dcl_index} unimported index modules cs - = elementAppears ST_RecordType dcl_ident dcl_index unimported index modules cs -*/ -decl_appears { dcl_ident,dcl_kind=(STE_Field _),dcl_index} unimported index modules cs - # (result=:((appears, unimported), modules, cs)) - = elementAppears ST_RecordType dcl_ident dcl_index unimported index modules cs - | appears || not do_temporary_import_solution_XXX - = result - = atomAppears dcl_ident dcl_index unimported index modules cs -/* MW2 was -decl_appears { dcl_ident,dcl_kind=STE_Member,dcl_index} unimported index modules cs - = elementAppears ST_Class dcl_ident dcl_index unimported index modules cs -*/ -decl_appears { dcl_ident,dcl_kind=STE_Member,dcl_index} unimported index modules cs - # (result=:((appears, unimported), modules, cs)) - = elementAppears ST_Class dcl_ident dcl_index unimported index modules cs - | appears || not do_temporary_import_solution_XXX - = result - = atomAppears dcl_ident dcl_index unimported index modules cs -decl_appears {dcl_ident, dcl_kind, dcl_index} unimported index modules cs - | isAtom dcl_kind - = atomAppears dcl_ident dcl_index unimported index modules cs - where - isAtom STE_DclFunction = True - isAtom (STE_FunctionOrMacro _) = True - isAtom STE_Class = True - isAtom STE_Type = True - isAtom STE_Instance = True - -elementAppears :: .StructureType Ident !.Int !(.a,![(Ident,.StructureInfo,.StructureType,Optional .Int)]) !.Int !*{#.DclModule} !*CheckState -> (!(!Bool,(!.a,![(Ident,StructureInfo,StructureType,Optional Int)])),!.{#DclModule},!.CheckState); -elementAppears imported_st dcl_ident dcl_index (atomicImports, structureImports) index modules cs - # ((result, structureImports), modules, cs) - = element_appears imported_st dcl_ident dcl_index structureImports structureImports 0 index modules cs - = ((result, (atomicImports, structureImports)), modules, cs) - -atomAppears dcl_ident dcl_index (atomicImports, structureImports) index modules cs - # ((result, atomicImports), modules, cs) - = atom_appears dcl_ident dcl_index atomicImports atomicImports 0 index modules cs - = ((result, (atomicImports, structureImports)), modules, cs) - -atom_appears :: Ident !.Int [(Ident,.AtomType)] w:[y:(Ident,u1:AtomType)] !Int !.Int !u:{#u3:DclModule} !*CheckState -> (!(.Bool,x:[z:(Ident,u2:AtomType)]),!v:{#DclModule},!.CheckState) , [u <= v, u1 <= u2, y <= z, w <= x, u <= u3]; -atom_appears _ _ [] atomic_imports _ _ modules cs - = ((False, atomic_imports), modules, cs) -atom_appears ident dcl_index [h=:(import_ident, atomType):t] atomic_imports unimp_index index modules cs -// MW2.. - | do_temporary_import_solution_XXX - && ident.id_name==import_ident.id_name - && atomType==(AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen True) // True or False doesn't matter in this line - # new_h = (import_ident, AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen True) - = ((True, [new_h: removeAt unimp_index atomic_imports]), modules, cs) -// ..MW2 - | ident==import_ident - # (modules, cs) = checkRecordError atomType import_ident dcl_index index modules cs - = ((True, removeAt unimp_index atomic_imports), modules, cs) - // goes further with next alternative - where - checkRecordError atomType import_ident dcl_index index modules cs - # (td_rhs, modules, cs) = lookup_type dcl_index index modules cs - cs_error = cs.cs_error - cs_error = case atomType of - AT_RecordType - -> case td_rhs of - RecordType _ -> cs_error - _ -> checkError import_ident "imported as a record type" cs_error - AT_AlgType - -> case td_rhs of - AlgType _ -> cs_error - _ -> checkError import_ident "imported as an algebraic type" cs_error - _ -> cs_error - = (modules, { cs & cs_error=cs_error }) -atom_appears ident dcl_index [h:t] atomic_imports unimp_index index modules cs - = atom_appears ident dcl_index t atomic_imports (inc unimp_index) index modules cs - -instance == StructureType - where - (==) ST_AlgType ST_AlgType = True - (==) ST_RecordType ST_RecordType = True - (==) ST_Class ST_Class = True - (==) _ _ = False - -element_appears :: StructureType Ident !Int [(Ident,.StructureInfo,u2:StructureType,z:Optional .Int)] u:[w:(Ident,u5:StructureInfo,u3:StructureType,y:Optional Int)] !Int !Int !*{#DclModule} !*CheckState -> (!(!Bool,!v:[x:(Ident,u6:StructureInfo,u4:StructureType,u1:Optional Int)]),!.{#DclModule},!.CheckState), [y z <= u1, u3 <= u4, u5 <= u6, w <= x, u <= v, u2 <= u3]; -element_appears _ _ _ [] atomic_imports _ _ modules cs - = ((False, atomic_imports), modules, cs) -// MW2 remove this later .. -element_appears imported_st element_ident dcl_index - [(_, SI_DotDot, ST_stomm_stomm_stomm type_name_string, optInfo):t] atomic_imports unimp_index - index modules cs - | do_temporary_import_solution_XXX - # (appears, modules, cs) - = element_appears_in_stomm_struct imported_st element_ident dcl_index index type_name_string modules cs - | appears - = ((appears, atomic_imports), modules, cs) - = element_appears imported_st element_ident dcl_index t atomic_imports (inc unimp_index) index modules cs - // otherwise go further with next alternative -// ..MW2 -element_appears imported_st element_ident dcl_index - [(_, _, st, _):t] atomic_imports unimp_index - index modules cs - | imported_st<>st - = element_appears imported_st element_ident dcl_index t atomic_imports (inc unimp_index) index modules cs - // goes further with next alternative -element_appears imported_st element_ident dcl_index - [(_, _, _, (Yes notDefinedHere)):t] atomic_imports unimp_index - index modules cs - | notDefinedHere==dcl_index - = element_appears imported_st element_ident dcl_index t atomic_imports (inc unimp_index) index modules cs - // goes further with next alternative -element_appears imported_st element_ident dcl_index - [(struct_id, (SI_Elements elements explicit), st, optInfo):t] atomic_imports unimp_index - index modules cs - | not (isMember element_ident elements) - = element_appears imported_st element_ident dcl_index t atomic_imports (inc unimp_index) index modules cs - # (l,r) = span ((<>) element_ident) elements - oneLess = l++(tl r) - newStructure = (struct_id, (SI_Elements oneLess explicit), st, optInfo) - atomic_imports_1 = removeAt unimp_index atomic_imports - | not explicit - = ((True, [newStructure: atomic_imports_1]), modules, cs) - // the found element was explicitly specified by the programmer: check it - # (appears, _, _, modules, cs) - = element_appears_in_struct imported_st element_ident dcl_index struct_id index modules cs - | appears - = ((True, [newStructure: atomic_imports_1]), modules, cs) - # message = "does not belong to specified "+++(case st of - ST_Class -> "class." - _ -> "type.") - cs = { cs & cs_error= checkError element_ident message cs.cs_error} - = ((False, atomic_imports_1), modules, cs) -element_appears imported_st element_ident dcl_index - [(struct_id, SI_DotDot, st, optInfo):t] atomic_imports unimp_index - index modules cs - | (case st of - ST_stomm_stomm_stomm _ - -> True - _ -> False) && (False->>"element_appears weird case") - = undef - # (appears, defined, opt_element_idents, modules, cs) - = element_appears_in_struct imported_st element_ident dcl_index struct_id index modules cs - | not appears - # structureInfo = case opt_element_idents of - No -> SI_DotDot - Yes element_idents -> (SI_Elements element_idents False) - newStructure = (struct_id, structureInfo, st, (if defined No (Yes dcl_index))) - new_atomic_imports = [newStructure : removeAt unimp_index atomic_imports] - = element_appears imported_st element_ident dcl_index t new_atomic_imports (inc unimp_index) index modules cs - # (Yes element_idents) = opt_element_idents - oneLess = filter ((<>) element_ident) element_idents - newStructure = (struct_id, (SI_Elements oneLess False), st, No) - new_atomic_imports = [newStructure : removeAt unimp_index atomic_imports] - = ((True,new_atomic_imports), modules, cs) -element_appears imported_st element_ident dcl_index [h:t] atomic_imports unimp_index index modules cs - = element_appears imported_st element_ident dcl_index t atomic_imports (inc unimp_index) index modules cs - -lookup_type dcl_index index modules cs - # (dcl_module=:{dcl_name=dcl_name=:{id_info}}, modules) = modules ! [index] - (module_entry, cs_symbol_table) = readPtr id_info cs.cs_symbol_table - cs = { cs & cs_symbol_table=cs_symbol_table } - = continuation module_entry.ste_kind dcl_module modules cs - where - continuation (STE_OpenModule _ modul) _ modules cs - # allTypes = modul.mod_defs.def_types - = ((allTypes !! dcl_index).td_rhs, modules, cs) - continuation STE_ClosedModule dcl_module modules cs - # com_type_def = dcl_module.dcl_common.com_type_defs.[dcl_index] - = (com_type_def.td_rhs, modules, cs) - -element_appears_in_stomm_struct :: .StructureType Ident .Int .Int .String *{#DclModule} !*CheckState -> (!Bool,!.{#DclModule},!.CheckState) -// MW remove this later CCC -element_appears_in_stomm_struct imported_st element_ident dcl_index index type_name_string modules cs - | not do_temporary_import_solution_XXX - = abort "element_appears_in_stomm_struct will be never called, when the above guard holds. This statement is only to remind people to remove this function." - # (dcl_module=:{dcl_name=dcl_name=:{id_info}}, modules) = modules ! [index] - (module_entry, cs_symbol_table) = readPtr id_info cs.cs_symbol_table - #! cs = { cs & cs_symbol_table=cs_symbol_table } -// = continuation imported_st module_entry.ste_kind dcl_module modules cs - = (appears imported_st module_entry.ste_kind dcl_module.dcl_common,modules,cs); - where - appears ST_RecordType (STE_OpenModule _ modul) _ - // lookup the constructors/fields for the algebraic type/record - # allTypes = modul.mod_defs.def_types - search = dropWhile (\{td_name} -> td_name.id_name<>type_name_string) allTypes - | isEmpty search - = False - # {td_rhs} = hd search - | not (isRecordType td_rhs) - = False - # element_idents = getElements td_rhs - = isMember element_ident element_idents - appears ST_RecordType STE_ClosedModule dcl_common - // lookup the type of the constructor and compare - # type_index = dcl_common.com_selector_defs.[dcl_index].sd_type_index - com_type_def = dcl_common.com_type_defs.[type_index] - appears = com_type_def.td_name.id_name==type_name_string - = appears - appears ST_Class (STE_OpenModule _ modul) _ - // lookup the members for the class - # allClasses = modul.mod_defs.def_classes - search = dropWhile (\{class_name} -> class_name.id_name<>type_name_string) allClasses - | isEmpty search - = False - # {class_members} = hd search - element_idents = [ ds_ident \\ {ds_ident} <-:class_members ] - = isMember element_ident element_idents - appears ST_Class STE_ClosedModule dcl_common - // lookup the class and compare - # com_member_def = dcl_common.com_member_defs.[dcl_index] - {glob_object} = com_member_def.me_class - com_class_def = dcl_common.com_class_defs.[glob_object] - appears = com_class_def.class_name.id_name==type_name_string - = appears - appears _ _ _ - = False - - getElements (RecordType {rt_fields}) - = [ fs_name \\ {fs_name}<-:rt_fields ] - getElements _ - = [] - isRecordType (RecordType _) = True - isRecordType _ = False -// ..MW - -/* 1st result: whether the element appears in the structure - 2nd result: whether the structure is defined at all in the module - 3rd result: Yes: a list of all idents of the elements of the structure -the first bool implies the second -*/ -element_appears_in_struct imported_st element_ident dcl_index struct_ident index modules cs - # (dcl_module=:{dcl_name=dcl_name=:{id_info}}, modules) = modules ! [index] - (module_entry, cs_symbol_table) = readPtr id_info cs.cs_symbol_table - cs = { cs & cs_symbol_table=cs_symbol_table } - = continuation imported_st module_entry.ste_kind dcl_module modules cs - where - continuation ST_Class (STE_OpenModule _ modul) _ modules cs - // lookup the members for the class - # allClasses = modul.mod_defs.def_classes - search = dropWhile (\{class_name} -> class_name<>struct_ident) allClasses - | isEmpty search - = (False, False, No, modules, cs) - # {class_members} = hd search - element_idents = [ ds_ident \\ {ds_ident} <-:class_members ] - = (isMember element_ident element_idents, True, Yes element_idents, modules, cs) - continuation imported_st (STE_OpenModule _ modul) _ modules cs - // lookup the constructors/fields for the algebraic type/record - # allTypes = modul.mod_defs.def_types - search = dropWhile (\{td_name} -> td_name<>struct_ident) allTypes - | isEmpty search - = (False, False, No, modules, cs) - # {td_rhs} = hd search - | not (isAlgOrRecordType td_rhs) - = (False, True, No, modules, cs) - # element_idents = getElements td_rhs - = (isMember element_ident element_idents, True, Yes element_idents, modules, cs) - continuation ST_Class STE_ClosedModule dcl_module modules cs - // lookup the class and compare - # com_member_def = dcl_module.dcl_common.com_member_defs.[dcl_index] - {glob_object} = com_member_def.me_class - com_class_def = dcl_module.dcl_common.com_class_defs.[glob_object] - allMembers = com_class_def.class_members - member_idents = [ ds_ident \\ {ds_ident} <-: allMembers] - appears = com_class_def.class_name==struct_ident - = (appears, True, if appears (Yes member_idents) No, modules, cs) - continuation imported_st STE_ClosedModule dcl_module modules cs - // lookup the type of the constructor and compare - # type_index = if (imported_st==ST_AlgType) - dcl_module.dcl_common.com_cons_defs.[dcl_index].cons_type_index - dcl_module.dcl_common.com_selector_defs.[dcl_index].sd_type_index - com_type_def = dcl_module.dcl_common.com_type_defs.[type_index] - element_idents = getElements com_type_def.td_rhs - appears = com_type_def.td_name==struct_ident - = (appears, True, if appears (Yes element_idents) No, modules, cs) - isAlgOrRecordType (AlgType _) = True - isAlgOrRecordType (RecordType _) = True - isAlgOrRecordType _ = False - getElements (AlgType constructor_symbols) - = [ds_ident \\ {ds_ident} <- constructor_symbols] - getElements (RecordType {rt_fields}) - = [ fs_name \\ {fs_name}<-:rt_fields ] - getElements _ - = [] + // only for old syntax + filter_member member_id=:{id_info} (accu, cs_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}, cs_symbol_table) = readPtr id_info cs_symbol_table + = case ste_kind of + STE_ExplImp _ _ _ _ + -> (accu, cs_symbol_table) + _ -> ([member_id:accu], cs_symbol_table) + + get_module_and_entry dcl_kind mod_index modules cs_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}}, modules) = modules![index_mod_with_def] + (module_entry, cs_symbol_table) = readPtr id_info cs_symbol_table + = (dcl_module, module_entry, modules, cs_symbol_table) + + check_wanted_idents structure_name {ii_ident=ii_ident=:{id_info}} cs=:{cs_symbol_table} + # (ste=:{ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table + cs = { cs & cs_symbol_table = cs_symbol_table } + = case ste_kind of + STE_ExplImp a b _ True + -> cs + _ -> { cs & cs_error = checkError ii_ident ("does not belong to "+++toString structure_name) cs.cs_error} + + overwrite_wanted_idents {ii_ident={id_info}} cs_symbol_table + # (ste=:{ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table + = case ste_kind of + STE_ExplImp a b c _ + -> writePtr id_info { ste & ste_kind = STE_ExplImp a b c False } cs_symbol_table + STE_Empty + -> cs_symbol_table + + remove_and_collect ident=:{id_info} (wanted_symbols_accu, cs_symbol_table) + # (ste=:{ste_kind=STE_ExplImp _ _ _ is_unwanted}, cs_symbol_table) = readPtr id_info cs_symbol_table + | is_unwanted + = (wanted_symbols_accu, writePtr id_info { ste & ste_kind = STE_Empty } cs_symbol_table) + = ([ident:wanted_symbols_accu], cs_symbol_table) + :: CheckCompletenessState = { ccs_dcl_modules :: !.{#DclModule} @@ -541,24 +354,22 @@ element_appears_in_struct imported_st element_ident dcl_index struct_ident index :: *CheckCompletenessStateBox = { box_ccs :: !*CheckCompletenessState } :: CheckCompletenessInput = - { cci_line_nr :: !Int - , cci_filename :: !String - , cci_expl_imported_ident :: !Ident - , cci_main_dcl_module_n::!Int + { cci_import_position :: !Position + , cci_main_dcl_module_n :: !Int } :: CheckCompletenessInputBox = { box_cci :: !CheckCompletenessInput } -checkExplicitImportCompleteness :: !String !Int ![ExplicitImport] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState +checkExplicitImportCompleteness :: !Int ![ExplicitImport] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState -> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState) -checkExplicitImportCompleteness filename main_dcl_module_n dcls_explicit dcl_modules icl_functions expr_heap +checkExplicitImportCompleteness main_dcl_module_n 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 filename) dcls_explicit { box_ccs = box_ccs } + ccs = foldSt checkCompleteness 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 @@ -566,48 +377,28 @@ checkExplicitImportCompleteness filename main_dcl_module_n dcls_explicit dcl_mod cs = { cs & cs_symbol_table = ccs_symbol_table, cs_error = ccs_error } = (ccs_dcl_modules, ccs_icl_functions, ccs_expr_heap, cs) where - checkCompleteness :: !String !ExplicitImport *CheckCompletenessStateBox -> *CheckCompletenessStateBox - checkCompleteness filename (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_FunctionOrMacro _} line_nr) ccs - = checkCompletenessOfMacro filename dcl_ident dcl_index main_dcl_module_n line_nr ccs - checkCompleteness filename (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_Imported (STE_FunctionOrMacro _) mod_index} line_nr) ccs - = checkCompletenessOfMacro filename dcl_ident dcl_index main_dcl_module_n line_nr ccs - checkCompleteness filename (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_Imported expl_imp_kind mod_index} line_nr) ccs + checkCompleteness :: !ExplicitImport *CheckCompletenessStateBox -> *CheckCompletenessStateBox + checkCompleteness (ExplicitImport {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 + = 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 #! ({dcl_common,dcl_functions}, ccs) = ccs!box_ccs.ccs_dcl_modules.[mod_index] - cci = { box_cci = { cci_line_nr = line_nr, cci_filename = filename, cci_expl_imported_ident = dcl_ident,cci_main_dcl_module_n=main_dcl_module_n }} - /* XXX - this case expression causes the compiler to be not self compilable anymore (12.7.2000). The bug is probably - in module refmark. The corresponding continuation function can be compiled + cci = { box_cci = { cci_import_position = import_position, cci_main_dcl_module_n=main_dcl_module_n }} = case expl_imp_kind of STE_Type -> check_completeness dcl_common.com_type_defs.[dcl_index] cci ccs STE_Constructor -> check_completeness dcl_common.com_cons_defs.[dcl_index] cci ccs (STE_Field _) -> check_completeness dcl_common.com_selector_defs.[dcl_index] cci ccs STE_Class -> check_completeness dcl_common.com_class_defs.[dcl_index] cci ccs STE_Member -> check_completeness dcl_common.com_member_defs.[dcl_index] cci ccs - STE_Instance -> check_completeness dcl_common.com_instance_defs.[dcl_index] cci ccs + (STE_Instance _) -> check_completeness dcl_common.com_instance_defs.[dcl_index] cci ccs STE_DclFunction -> check_completeness dcl_functions.[dcl_index] cci ccs - */ - = continuation expl_imp_kind dcl_common dcl_functions cci ccs - where - continuation STE_Type dcl_common dcl_functions cci ccs - = check_completeness dcl_common.com_type_defs.[dcl_index] cci ccs - continuation STE_Constructor dcl_common dcl_functions cci ccs - = check_completeness dcl_common.com_cons_defs.[dcl_index] cci ccs - continuation (STE_Field _) dcl_common dcl_functions cci ccs - = check_completeness dcl_common.com_selector_defs.[dcl_index] cci ccs - continuation STE_Class dcl_common dcl_functions cci ccs - = check_completeness dcl_common.com_class_defs.[dcl_index] cci ccs - continuation STE_Member dcl_common dcl_functions cci ccs - = check_completeness dcl_common.com_member_defs.[dcl_index] cci ccs - continuation STE_Instance dcl_common dcl_functions cci ccs - = 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 :: !String !Ident !Index !Int !Int *CheckCompletenessStateBox -> *CheckCompletenessStateBox - checkCompletenessOfMacro filename dcl_ident dcl_index main_dcl_module_n line_nr 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_line_nr = line_nr, cci_filename = filename, cci_expl_imported_ident = dcl_ident,cci_main_dcl_module_n=main_dcl_module_n }} + 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 @@ -622,6 +413,7 @@ instance toString STE_Kind where toString (STE_Field _) = "field" toString STE_Class = "class" toString STE_Member = "class member" + toString (STE_Instance _) = "instance" check_whether_ident_is_imported :: !Ident !STE_Kind !CheckCompletenessInputBox !*CheckCompletenessStateBox -> *CheckCompletenessStateBox @@ -631,12 +423,9 @@ check_whether_ident_is_imported ident wanted_ste_kind cci ccs=:{box_ccs=box_ccs= | 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_line_nr, cci_filename, cci_expl_imported_ident}} = cci - ident_pos = {ip_ident= { id_name="import", id_info=nilPtr }, ip_line=cci_line_nr, ip_file=cci_filename} - ccs_error = checkErrorWithIdentPos ident_pos - (cci_expl_imported_ident.id_name+++" explicitly imported without importing " - +++toString wanted_ste_kind+++" "+++ident.id_name) - ccs_error + {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, diff --git a/frontend/parse.icl b/frontend/parse.icl index 12706f0..11960d8 100644 --- a/frontend/parse.icl +++ b/frontend/parse.icl @@ -856,6 +856,24 @@ instance want ImportDeclaration where want pState # (token, pState) = nextToken GeneralContext pState +// MW5.. + = (switch_import_syntax want_1_3_import_declaration want_2_0_import_declaration) token pState + +want_1_3_import_declaration token pState + = case token of + IdentToken name + # (fun_id, pState) = stringToIdent name IC_Expression pState + (type_id, pState) = stringToIdent name IC_Type pState + (class_id, pState) = stringToIdent name IC_Class pState + -> (ID_OldSyntax [fun_id, type_id, class_id], pState) + token + # (fun_id, pState) = stringToIdent "dummy" IC_Expression pState + -> ( ID_Function { ii_ident = fun_id, ii_extended = False } + , parseError "from import" (Yes token) "imported item" pState + ) + +want_2_0_import_declaration token pState +// ..MW5 = case token of DoubleColonToken # (name, pState) = wantUpperCaseName "import type" pState diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 3cbb47a..07e55e5 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -6,6 +6,11 @@ import scanner, general, typeproperties, Heap PA_BUG on off :== on +switch_import_syntax one_point_three two_point_zero :== one_point_three + /* when finally removing this switch also remove the argument of STE_Instance and ID_OldSyntax */ + +SwitchFusion fuse dont_fuse :== dont_fuse + :: Ident = { id_name :: !String , id_info :: !SymbolPtr @@ -37,7 +42,7 @@ instance toString Ident | STE_Field !Ident | STE_Class | STE_Member - | STE_Instance + | STE_Instance !Ident // argument: the class (used in explicitimports (1.3 syntax only)) | STE_Variable !VarInfoPtr | STE_TypeVariable !TypeVarInfoPtr | STE_TypeAttribute !AttrVarInfoPtr @@ -55,6 +60,15 @@ instance toString Ident | 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. */ + /* 1st arg: initialized with False and set to True when the searched symbol has been found to indicate. + 2nd arg: Yes: the ImportDeclaration with which it was intended to import the symbol. + No: for symbols within a bracket (fields, constructors, members) + 3rd arg: for error messages: the expected namespace of the intended imported symbol + 4th arg: at first the idents for _all_ fields, constructors & members are added to the symbol table. In + 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. + */ :: Global object = { glob_object :: !object @@ -277,6 +291,7 @@ instance toString (Import from_symbol), AttributeVar, TypeAttribute, Annotation | ID_Type !ImportedIdent !(Optional [ImportedIdent]) | ID_Record !ImportedIdent !(Optional [ImportedIdent]) | ID_Instance !ImportedIdent !Ident !(![Type],![TypeContext]) + | ID_OldSyntax ![Ident] cIsImportedLibrary :== True cIsImportedObject :== False diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 0738d89..7e40d3c 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -5,6 +5,8 @@ import StdEnv, compare_constructor // ,RWSDebug import scanner, general, Heap, typeproperties, utilities PA_BUG on off :== on +switch_import_syntax one_point_three two_point_zero :== one_point_three +SwitchFusion fuse dont_fuse :== dont_fuse :: Ident = { id_name :: !String @@ -41,7 +43,7 @@ where toString {import_module} = toString import_module | STE_Field !Ident | STE_Class | STE_Member - | STE_Instance + | STE_Instance !Ident // the class (for explicit imports (1.3 syntax only)) | STE_Variable !VarInfoPtr | STE_TypeVariable !TypeVarInfoPtr | STE_TypeAttribute !AttrVarInfoPtr @@ -57,6 +59,7 @@ where toString {import_module} = toString import_module | 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. */ :: Global object = { glob_object :: !object @@ -267,6 +270,7 @@ cNameLocationDependent :== True | ID_Type !ImportedIdent !(Optional [ImportedIdent]) | ID_Record !ImportedIdent !(Optional [ImportedIdent]) | ID_Instance !ImportedIdent !Ident !(![Type],![TypeContext]) + | ID_OldSyntax ![Ident] cIsImportedLibrary :== True cIsImportedObject :== False diff --git a/frontend/type.icl b/frontend/type.icl index e72d55d..bfe7033 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -1986,7 +1986,7 @@ where collect_imported_instances imports common_defs dummy error class_instances type_var_heap td_infos = foldSt (collect_imported_instance common_defs) imports (dummy, error, class_instances, type_var_heap, td_infos) - collect_imported_instance common_defs {dcl_ident, dcl_kind = STE_Imported STE_Instance mod_index, dcl_index } state + collect_imported_instance common_defs {dcl_ident, dcl_kind = STE_Imported (STE_Instance _) mod_index, dcl_index } state = update_instances_of_class common_defs mod_index dcl_index state collect_imported_instance common_defs _ state = state diff --git a/frontend/typesupport.dcl b/frontend/typesupport.dcl index 0b3c4d1..8151d91 100644 --- a/frontend/typesupport.dcl +++ b/frontend/typesupport.dcl @@ -4,9 +4,6 @@ import checksupport, StdCompare from unitype import Coercions, CoercionTree, AttributePartition, CT_Empty -// MW: this switch is used to en(dis)able the fusion algorithm -SwitchFusion fuse dont_fuse :== dont_fuse - errorHeading :: !String !*ErrorAdmin -> *ErrorAdmin // MW4 was:class (<::) infixl a :: !*File (!Format, !a) -> *File diff --git a/frontend/typesupport.icl b/frontend/typesupport.icl index b9ee9b9..4f17359 100644 --- a/frontend/typesupport.icl +++ b/frontend/typesupport.icl @@ -3,9 +3,6 @@ implementation module typesupport import StdEnv, StdCompare import syntax, parse, check, unitype, utilities, checktypes, RWSDebug -// MW: this switch is used to en(dis)able the fusion algorithm -SwitchFusion fuse dont_fuse :== dont_fuse - :: Store :== Int :: AttrCoercion = diff --git a/frontend/utilities.dcl b/frontend/utilities.dcl index a513a36..e6fa88d 100644 --- a/frontend/utilities.dcl +++ b/frontend/utilities.dcl @@ -120,6 +120,32 @@ iterateSt op st :== iterate_st op st = iterate_st op st = st +mapFilterYesSt f l st + :== map_filter_yes_st l st + where + map_filter_yes_st [] st + = ([], st) + map_filter_yes_st [h:t] st + #! (opt_f_h , st) = f h st + (t2, st) = map_filter_yes_st t st + f_h_t2 = optCons opt_f_h t2 + st = st + = (f_h_t2, st) + +iMapFilterYesSt f fr to st + :== i_map_filter_yes_st fr to st + where + i_map_filter_yes_st fr to st + | fr >= to + = ([], st) + #! (opt_f_fr, st) = f fr st + (t, st) = i_map_filter_yes_st (inc fr) to st + f_fr_t2 = optCons opt_f_fr t + st = st + = (f_fr_t2, st) + +optCons :: !(Optional .a) !u:[.a] -> v:[.a] ,[u <= v] + revAppend :: ![a] ![a] -> [a] // Reverse the list using the second argument as accumulator. revMap :: !(.a -> .b) ![.a] !u:[.b] -> u:[.b] diff --git a/frontend/utilities.icl b/frontend/utilities.icl index 39f9a62..51f2c9d 100644 --- a/frontend/utilities.icl +++ b/frontend/utilities.icl @@ -205,6 +205,38 @@ iterateSt op st :== iterate_st op st = iterate_st op st = st +mapFilterYesSt f l st + :== map_filter_yes_st l st + where + map_filter_yes_st [] st + = ([], st) + map_filter_yes_st [h:t] st + #! (opt_f_h , st) = f h st + (t2, st) = map_filter_yes_st t st + f_h_t2 = optCons opt_f_h t2 + st = st + = (f_h_t2, st) + + +iMapFilterYesSt f fr to st + :== i_map_filter_yes_st fr to st + where + i_map_filter_yes_st fr to st + | fr >= to + = ([], st) + #! (opt_f_fr, st) = f fr st + (t, st) = i_map_filter_yes_st (inc fr) to st + f_fr_t2 = optCons opt_f_fr t + st = st + = (f_fr_t2, st) + +optCons :: !(Optional .a) !u:[.a] -> v:[.a] ,[u <= v] +optCons No l + = l +optCons (Yes x) l + = [x:l] + + eqMerge :: ![a] ![a] -> [a] | Eq a eqMerge [a : x] y | isMember a y |