Skip to content
GitLab
Commit 9effc288 authored by Martin Wierich's avatar Martin Wierich
Browse files

refactoring

parent 5d14453b
Hide whitespace changes
Inline Side-by-side
frontend/StdCompare.dcl
View file @ 9effc288
......@@ -14,7 +14,7 @@ instance =< Int, Expression, {# Char}, Ident, [a] | =< a, BasicType //, (Global
instance =< Type, SymbIdent
instance == BasicType, TypeVar, TypeSymbIdent, DefinedSymbol, TypeContext , BasicValue,
FunKind, (Global a) | == a, Priority, Assoc, Type, ConsVariable
FunKind, (Global a) | == a, Priority, Assoc, Type, ConsVariable, SignClassification
instance < MemberDef
......
frontend/StdCompare.icl
View file @ 9effc288
......@@ -94,6 +94,9 @@ instance == Assoc
where
(==) a1 a2 = equal_constructor a1 a2
instance == SignClassification where
(==) sc1 sc2 = sc1.sc_pos_vect == sc2.sc_pos_vect && sc1.sc_neg_vect == sc2.sc_neg_vect
:: CompareValue :== Int
Smaller :== -1
Greater :== 1
......
frontend/checksupport.dcl
View file @ 9effc288
......@@ -150,8 +150,10 @@ retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Inde
// -> (!Int, ![Declaration], !.ExplImpInfos, !.Heap SymbolTableEntry);
addLocalFunctionDefsToSymbolTable :: !Level !Index !Index !Bool !*{#FunDef} !*SymbolTable !*ErrorAdmin -> (!*{# FunDef}, !*SymbolTable, !*ErrorAdmin)
addDefToSymbolTable :: !Level !Index !Ident !STE_Kind !*SymbolTable !*ErrorAdmin -> (!* SymbolTable, !*ErrorAdmin)
addDeclaredSymbolsToSymbolTable2 :: .Bool .Int !{!Declaration} !{!Declaration} !*CheckState -> .CheckState;
addDeclarationsOfDclModToSymbolTable :: .Int !{!Declaration} !{!Declaration} !*CheckState -> .CheckState;
addGlobalDefinitionsToSymbolTable :: ![Declaration] !*CheckState -> .CheckState;
addSymbol :: !(Optional a) !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !Int !*CheckState -> (!Bool, !.CheckState)
addImportedFunctionOrMacro :: !(Optional IndexRange) !Ident !Int !*CheckState -> (!Bool, !.CheckState)
removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *SymbolTable
removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
......@@ -167,20 +169,16 @@ local_declaration_for_import :: !u:Declaration .Index -> v:Declaration, [u <= v]
get_ident :: !ImportDeclaration -> Ident
getBelongingSymbolsFromID :: !ImportDeclaration -> Optional [ImportedIdent]
mw_addIndirectlyImportedSymbol :: !(Optional a) !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !Int !*CheckState -> (!Bool, !.CheckState)
updateExplImpForMarkedSymbol :: !Index Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable
-> (!u:{#DclModule}, !{!{!.ExplImpInfo}},!.SymbolTable)
:: BelongingSymbols
= BS_Constructors ![DefinedSymbol]
| BS_Fields !{#FieldSymbol}
| BS_Members !{#DefinedSymbol}
| BS_Nothing
getBelongingSymbols :: !Declaration !{#x:DclModule} -> (!.BelongingSymbols, !{#x:DclModule})
getBelongingSymbols :: !Declaration !v:{#DclModule} -> (!BelongingSymbols, !v:{#DclModule})
nrOfBelongingSymbols :: !BelongingSymbols -> Int
import_ident :: Ident
restoreHeap :: !Ident !*SymbolTable -> .SymbolTable
temp_try_a_new_thing_XXX yes no :== no
expand_syn_types_late_XXX yes no :== no
frontend/checksupport.icl
View file @ 9effc288
......@@ -9,6 +9,7 @@ import RWSDebug
:: VarHeap :== Heap VarInfo
cUndef :== -1
CS_NotChecked :== -1
NotFound :== -1
......@@ -235,60 +236,7 @@ retrieveGlobalDefinition {ste_kind,ste_def_level,ste_index} requ_kind mod_index
= (NotFound, mod_index)
updateExplImpForMarkedSymbol :: !Index Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable
-> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !.SymbolTable)
updateExplImpForMarkedSymbol mod_index decl {ste_kind=STE_ExplImpComponentNrs component_numbers inst_indices}
dcl_modules expl_imp_infos cs_symbol_table
= foldSt (addExplImpInfo mod_index decl inst_indices) component_numbers
(dcl_modules, expl_imp_infos, cs_symbol_table)
updateExplImpForMarkedSymbol _ decl {ste_kind=STE_Instance class_ident} dcl_modules expl_imp_infos cs_symbol_table
// this alternative is only for old syntax (cs_symbol_table argument is not necessary for new syntax)
# cs_symbol_table
= checkExplImpForInstance decl class_ident cs_symbol_table
= (dcl_modules, expl_imp_infos, cs_symbol_table)
updateExplImpForMarkedSymbol _ decl {ste_kind=STE_Imported (STE_Instance class_ident) _} dcl_modules expl_imp_infos cs_symbol_table
// this alternative is only for old syntax (cs_symbol_table argument is not necessary for new syntax)
# cs_symbol_table
= checkExplImpForInstance decl class_ident cs_symbol_table
= (dcl_modules, expl_imp_infos, cs_symbol_table)
updateExplImpForMarkedSymbol _ _ entry dcl_modules expl_imp_infos cs_symbol_table
= (dcl_modules, expl_imp_infos, cs_symbol_table)
addExplImpInfo :: !Index Declaration ![Declaration] !ComponentNrAndIndex !(!u:{#DclModule}, !{!{!*ExplImpInfo}}, !v:SymbolTable)
-> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !v:SymbolTable)
addExplImpInfo mod_index decl instances { cai_component_nr, cai_index } (dcl_modules, expl_imp_infos, cs_symbol_table)
# (ExplImpInfo eii_ident eii_declaring_modules, expl_imp_infos)
= replaceTwoDimArrElt cai_component_nr cai_index TemporarilyFetchedAway expl_imp_infos
(di_belonging, dcl_modules, cs_symbol_table)
= get_belonging_symbol_nrs decl dcl_modules cs_symbol_table
di
= { di_decl = decl, di_instances = instances, di_belonging = di_belonging }
new_expl_imp_info
= ExplImpInfo eii_ident (ikhInsert` False mod_index di eii_declaring_modules)
= (dcl_modules, { expl_imp_infos & [cai_component_nr,cai_index] = new_expl_imp_info }, cs_symbol_table)
where
get_belonging_symbol_nrs :: !Declaration !{#x:DclModule} !u:(Heap SymbolTableEntry)
-> (!.NumberSet,!{#x:DclModule},!u:Heap SymbolTableEntry)
get_belonging_symbol_nrs decl dcl_modules cs_symbol_table
# (all_belonging_symbols, dcl_modules)
= getBelongingSymbols decl dcl_modules
nr_of_belongs
= nrOfBelongingSymbols all_belonging_symbols
(_, belonging_bitvect, cs_symbol_table)
= foldlBelongingSymbols set_bit all_belonging_symbols (0, bitvectCreate nr_of_belongs, cs_symbol_table)
= (bitvectToNumberSet belonging_bitvect, dcl_modules, cs_symbol_table)
set_bit {id_info} (bit_nr, bitvect, cs_symbol_table)
# ({ste_kind}, cs_symbol_table)
= readPtr id_info cs_symbol_table
= ( bit_nr+1
, case ste_kind of
STE_Empty -> bitvect
_ -> bitvectSet bit_nr bitvect
, cs_symbol_table
)
getBelongingSymbols :: !Declaration !{#x:DclModule} -> (!.BelongingSymbols, !{#x:DclModule})
getBelongingSymbols :: !Declaration !v:{#DclModule} -> (!BelongingSymbols, !v:{#DclModule})
getBelongingSymbols {dcl_kind=STE_Imported STE_Type def_mod_index, dcl_index} dcl_modules
# ({td_rhs}, dcl_modules)
= dcl_modules![def_mod_index].dcl_common.com_type_defs.[dcl_index]
......@@ -322,55 +270,12 @@ nrOfBelongingSymbols BS_Nothing
| BS_Members !{#DefinedSymbol}
| BS_Nothing
foldlBelongingSymbols f bs st
:== case bs of
BS_Constructors constructors
-> foldSt (\{ds_ident} st -> f ds_ident st) constructors st
BS_Fields fields
-> foldlArraySt (\{fs_name} st -> f fs_name st) fields st
BS_Members members
-> foldlArraySt (\{ds_ident} st -> f ds_ident st) members st
BS_Nothing
-> st
checkExplImpForInstance decl class_ident cs_symbol_table
// this function is only for old syntax
| switch_import_syntax False True
= cs_symbol_table
# (class_ste, cs_symbol_table)
= readPtr class_ident.id_info cs_symbol_table
= case class_ste.ste_kind of
STE_ExplImpComponentNrs component_numbers inst_indices_accu
-> writePtr class_ident.id_info
{ class_ste & ste_kind = STE_ExplImpComponentNrs component_numbers [decl:inst_indices_accu]}
cs_symbol_table
_
-> cs_symbol_table
removeImportsAndLocalsOfModuleFromSymbolTable :: !Declarations !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry
removeImportsAndLocalsOfModuleFromSymbolTable {dcls_import,dcls_local} symbol_table
removeImportsAndLocalsOfModuleFromSymbolTable {dcls_import,dcls_local_for_import} symbol_table
# symbol_table = remove_declared_symbols_in_array 0 dcls_import symbol_table
= remove_declared_symbols dcls_local symbol_table
= remove_declared_symbols_in_array 0 dcls_local_for_import symbol_table
where
remove_declared_symbols :: ![Declaration] !*SymbolTable -> !*SymbolTable
remove_declared_symbols [symbol=:{dcl_ident={id_info},dcl_index}:symbols] symbol_table
#! entry = sreadPtr id_info symbol_table
# {ste_kind,ste_def_level} = entry
| ste_kind == STE_Empty || ste_def_level > cModuleScope
= remove_declared_symbols symbols symbol_table
# symbol_table = symbol_table <:= (id_info, entry.ste_previous)
= case ste_kind of
STE_Field selector_id
-> remove_declared_symbols symbols (removeFieldFromSelectorDefinition selector_id NoIndex dcl_index symbol_table)
STE_Imported (STE_Field selector_id) def_mod
-> remove_declared_symbols symbols (removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table)
_
-> remove_declared_symbols symbols symbol_table
remove_declared_symbols [] symbol_table
= symbol_table
remove_declared_symbols_in_array :: !Int !{!Declaration} !*SymbolTable -> !*SymbolTable
remove_declared_symbols_in_array symbol_index symbols symbol_table
| symbol_index<size symbols
......@@ -414,49 +319,62 @@ addDefToSymbolTable level def_index def_ident=:{id_info} def_kind symbol_table e
= (symbol_table <:= (id_info,entry), error)
= (symbol_table, checkError def_ident " already defined" error)
addDeclaredSymbolsToSymbolTable2 :: .Bool .Int !{!Declaration} !{!Declaration} !*CheckState -> .CheckState;
addDeclaredSymbolsToSymbolTable2 is_dcl_mod ste_index locals imported cs
# cs=add_imports_in_array_to_symbol_table 0 is_dcl_mod imported cs
addDeclarationsOfDclModToSymbolTable :: .Int !{!Declaration} !{!Declaration} !*CheckState -> .CheckState;
addDeclarationsOfDclModToSymbolTable ste_index locals imported cs
# cs=add_imports_in_array_to_symbol_table 0 imported cs
= addLocalSymbolsForImportToSymbolTable 0 locals ste_index cs
add_imports_in_array_to_symbol_table symbol_index is_dcl_mod symbols cs=:{cs_x}
| symbol_index<size symbols
#! ({dcl_ident,dcl_pos,dcl_kind},symbols) = symbols![symbol_index]
= case dcl_kind of
STE_Imported def_kind def_mod
| is_dcl_mod || def_mod <> cs_x.x_main_dcl_module_n
where
add_imports_in_array_to_symbol_table symbol_index symbols cs=:{cs_x}
| symbol_index<size symbols
#! ({dcl_ident,dcl_pos,dcl_kind},symbols) = symbols![symbol_index]
= case dcl_kind of
STE_Imported def_kind def_mod
#! dcl_index= symbols.[symbol_index].dcl_index
-> add_imports_in_array_to_symbol_table (symbol_index+1) is_dcl_mod symbols (addIndirectlyImportedSymbolOld dcl_ident dcl_pos dcl_kind def_kind dcl_index def_mod cs)
-> add_imports_in_array_to_symbol_table (symbol_index+1) is_dcl_mod symbols cs
STE_FunctionOrMacro _
(_, cs)
= addSymbol No dcl_ident dcl_pos dcl_kind
def_kind dcl_index def_mod cUndef cs
-> add_imports_in_array_to_symbol_table (symbol_index+1) symbols cs
STE_FunctionOrMacro _
#! dcl_index= symbols.[symbol_index].dcl_index
-> add_imports_in_array_to_symbol_table (symbol_index+1) is_dcl_mod symbols (addImportedFunctionOrMacro dcl_ident dcl_index cs)
= cs
addLocalSymbolsForImportToSymbolTable :: !Int !{!Declaration} Int !*CheckState -> .CheckState;
addLocalSymbolsForImportToSymbolTable symbol_index symbols mod_index cs
| symbol_index<size symbols
# ({dcl_ident,dcl_pos,dcl_kind,dcl_index},symbols) = symbols![symbol_index]
= case dcl_kind of
STE_FunctionOrMacro _
-> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index
(addImportedFunctionOrMacro dcl_ident dcl_index cs)
STE_Imported def_kind def_mod
-> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index
(addIndirectlyImportedSymbolOld dcl_ident dcl_pos dcl_kind def_kind dcl_index mod_index cs)
= cs
addImportedFunctionOrMacro :: !Ident .Int !*CheckState -> .CheckState;
addImportedFunctionOrMacro ident=:{id_info} def_index cs=:{cs_symbol_table}
(_, cs)
= addImportedFunctionOrMacro No dcl_ident dcl_index cs
-> add_imports_in_array_to_symbol_table (symbol_index+1) symbols cs
= cs
addLocalSymbolsForImportToSymbolTable :: !Int !{!Declaration} Int !*CheckState -> .CheckState;
addLocalSymbolsForImportToSymbolTable symbol_index symbols mod_index cs
| symbol_index<size symbols
# ({dcl_ident,dcl_pos,dcl_kind,dcl_index},symbols) = symbols![symbol_index]
= case dcl_kind of
STE_FunctionOrMacro _
# (_, cs)
= addImportedFunctionOrMacro No dcl_ident dcl_index cs
-> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index cs
STE_Imported def_kind def_mod
# (_, cs)
= addSymbol No dcl_ident dcl_pos dcl_kind
def_kind dcl_index mod_index cUndef cs
-> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index cs
= cs
addImportedFunctionOrMacro :: !(Optional IndexRange) !Ident !Int !*CheckState -> (!Bool, !.CheckState)
addImportedFunctionOrMacro opt_dcl_macro_range ident=:{id_info} def_index cs=:{cs_symbol_table}
#! entry = sreadPtr id_info cs_symbol_table
= case entry.ste_kind of
STE_Empty
-> { cs & cs_symbol_table = NewEntry cs.cs_symbol_table id_info (STE_FunctionOrMacro []) def_index cModuleScope entry}
-> (True, { cs & cs_symbol_table = NewEntry cs.cs_symbol_table id_info (STE_FunctionOrMacro [])
def_index cModuleScope entry})
STE_FunctionOrMacro _
| entry.ste_index == def_index
-> cs
| entry.ste_index == def_index || within_opt_range opt_dcl_macro_range def_index
-> (False, cs)
_
-> { cs & cs_error = checkError ident " multiply imported" cs.cs_error}
-> (False, { cs & cs_error = checkError ident "multiply defined" cs.cs_error})
where
within_opt_range (Yes {ir_from, ir_to}) i
= ir_from<=i && i<ir_to
within_opt_range No _
= False
addFieldToSelectorDefinition :: !Ident (Global .Int) !*CheckState -> .CheckState;
addFieldToSelectorDefinition {id_info} glob_field_index cs=:{cs_symbol_table}
......@@ -468,28 +386,8 @@ addFieldToSelectorDefinition {id_info} glob_field_index cs=:{cs_symbol_table}
_
-> { cs & cs_symbol_table = NewEntry cs.cs_symbol_table id_info (STE_Selector [glob_field_index]) NoIndex cModuleScope entry }
addIndirectlyImportedSymbolOld :: !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !*CheckState -> .CheckState;
addIndirectlyImportedSymbolOld ident pos dcl_kind def_kind def_index def_mod cs=:{cs_symbol_table}
# (entry, cs_symbol_table) = readPtr ident.id_info cs_symbol_table
= add_indirectly_imported_symbol entry ident pos def_kind def_index def_mod { cs & cs_symbol_table = cs_symbol_table }
where
add_indirectly_imported_symbol /*entry=:*/{ste_kind = STE_Empty} {id_name,id_info} _ def_kind def_index def_mod cs=:{cs_symbol_table}
// JVG: read the entry again, because it is boxed
# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table
# cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info dcl_kind def_index cModuleScope entry}
= case def_kind of
STE_Field selector_id
-> addFieldToSelectorDefinition selector_id { glob_module = def_mod, glob_object = def_index } cs
_
-> cs
add_indirectly_imported_symbol /*entry=:*/{ste_kind = STE_Imported kind mod_index, ste_index} ident=:{id_info} _ def_kind def_index def_mod cs
| kind == def_kind && mod_index == def_mod && ste_index == def_index
= cs
add_indirectly_imported_symbol entry ident pos def_kind def_index def_mod cs=:{cs_error}
= { cs & cs_error = checkErrorWithIdentPos (newPosition ident pos) " multiply imported" cs_error}
mw_addIndirectlyImportedSymbol :: !(Optional a) !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !Int !*CheckState -> (!Bool, !.CheckState)
mw_addIndirectlyImportedSymbol yes_for_icl_module ident pos dcl_kind def_kind def_index def_mod importing_mod cs=:{cs_symbol_table}
addSymbol :: !(Optional a) !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !Int !*CheckState -> (!Bool, !.CheckState)
addSymbol yes_for_icl_module ident pos dcl_kind def_kind def_index def_mod importing_mod cs=:{cs_symbol_table}
# (entry, cs_symbol_table) = readPtr ident.id_info cs_symbol_table
= add_indirectly_imported_symbol yes_for_icl_module entry ident pos def_kind def_index def_mod
importing_mod { cs & cs_symbol_table = cs_symbol_table }
......@@ -547,9 +445,9 @@ where
removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *SymbolTable
removeDeclarationsFromSymbolTable decls scope symbol_table
= unsafeFold2St (remove_declaration scope) decls [1..] symbol_table
= foldSt (remove_declaration scope) decls symbol_table
where
remove_declaration scope decl=:{dcl_ident={id_info}, dcl_index} decl_nr symbol_table
remove_declaration scope decl=:{dcl_ident={id_info}, dcl_index} symbol_table
# ({ste_kind,ste_previous}, symbol_table)
= readPtr id_info symbol_table
= case ste_kind of
......@@ -723,4 +621,4 @@ restoreHeap {id_info} cs_symbol_table
= readPtr id_info cs_symbol_table
= writePtr id_info ste_previous cs_symbol_table
temp_try_a_new_thing_XXX yes no :== no
expand_syn_types_late_XXX yes no :== no
frontend/checktypes.icl
View file @ 9effc288
......@@ -418,7 +418,7 @@ where
| type_index == nr_of_types
| cs.cs_error.ea_ok && not is_main_dcl
# marks = createArray nr_of_types CS_NotChecked
{exp_type_defs,exp_modules,exp_type_heaps,exp_error} = (temp_try_a_new_thing_XXX id (expand_syn_types module_index 0 nr_of_types))
{exp_type_defs,exp_modules,exp_type_heaps,exp_error} = (expand_syn_types_late_XXX id (expand_syn_types module_index 0 nr_of_types))
{ exp_type_defs = ts.ts_type_defs, exp_modules = ts.ts_modules, exp_marks = marks,
exp_type_heaps = ti_type_heaps, exp_error = cs.cs_error }
= (exp_type_defs, ts.ts_cons_defs, ts.ts_selector_defs, exp_modules, ti_var_heap, exp_type_heaps, { cs & cs_error = exp_error })
......@@ -437,7 +437,7 @@ expand_syn_types module_index type_index nr_of_types expst
expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin
-> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin)
expandSynonymTypes module_index exp_type_defs exp_modules exp_type_heaps exp_error
| temp_try_a_new_thing_XXX False True
| expand_syn_types_late_XXX False True
= abort "expandSynonymTypes"
#! nr_of_types
= size exp_type_defs
......
frontend/comparedefimp.dcl
View file @ 9effc288
......@@ -4,6 +4,6 @@ import syntax, checksupport
// compare definition and implementation module
compareDefImp :: !{#Int} !{!FunctionBody} !Int !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin
compareDefImp :: !{#Int} !{!FunctionBody} !Int {#CheckedTypeDef} !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin
-> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin)
frontend/comparedefimp.icl
View file @ 9effc288
......@@ -29,10 +29,11 @@ import syntax, checksupport, compare_constructor, utilities, StdCompare
, tc_dcl_modules
:: !.{#DclModule}
, tc_icl_type_defs
:: !{CheckedTypeDef}
:: !{#CheckedTypeDef}
, tc_type_conversions
:: !Conversions
, tc_visited_syn_types // to detect cycles in type synonyms
// only for no in expand_syn_types_late_XXX
:: !.{#Bool}
, tc_main_dcl_module_n
:: !Int
......@@ -73,7 +74,8 @@ import syntax, checksupport, compare_constructor, utilities, StdCompare
}
:: OptionalCorrespondenceNumber = CorrespondenceNumber !Int | Bound | Unbound
// Bound is only used for no case in expand_syn_types_late_XXX
class t_corresponds a :: !a !a -> *TypesCorrespondMonad
// whether two types correspond
class e_corresponds a :: !a !a -> ExpressionsCorrespondMonad
......@@ -87,26 +89,30 @@ class CorrespondenceNumber a where
initial_hwn hwn_heap = { hwn_heap = hwn_heap, hwn_number = 0 }
compareDefImp :: !{#Int} !{!FunctionBody} !Int !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin
compareDefImp :: !{#Int} !{!FunctionBody} !Int {#CheckedTypeDef} !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin
-> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin)
compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n dcl_modules icl_module heaps error_admin
compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n type_defs_of_icl_mod dcl_modules
icl_module heaps error_admin
// icl definitions with indices >= size_uncopied_icl_defs.[def_type] don't have to be compared,
// because they are copies of definitions that appear exclusively in the dcl module
// # (main_dcl_module, dcl_modules) = dcl_modules![cIclModIndex]
# (main_dcl_module, dcl_modules) = dcl_modules![main_dcl_module_n]
= case main_dcl_module.dcl_conversions of
No -> (dcl_modules, icl_module, heaps, error_admin)
Yes conversion_table
# {dcl_functions, dcl_macros, dcl_common, dcl_instances} = main_dcl_module
# {dcl_functions, dcl_macros, dcl_common} = main_dcl_module
{icl_common, icl_functions}
= icl_module
{hp_var_heap, hp_expression_heap, hp_type_heaps={th_vars, th_attrs}}
= heaps
{ com_type_defs=icl_com_type_defs, com_cons_defs=icl_com_cons_defs,
{ com_type_defs, com_cons_defs=icl_com_cons_defs,
com_selector_defs=icl_com_selector_defs, com_class_defs=icl_com_class_defs,
com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs }
= icl_common
(icl_type_defs, icl_com_type_defs) = memcpy icl_com_type_defs
icl_com_type_defs
= expand_syn_types_late_XXX type_defs_of_icl_mod com_type_defs
(icl_type_defs, icl_com_type_defs)
= expand_syn_types_late_XXX (icl_com_type_defs, icl_com_type_defs)
(memcpy icl_com_type_defs)
tc_state
= { tc_type_vars = initial_hwn th_vars
, tc_attr_vars = initial_hwn th_attrs
......@@ -150,7 +156,8 @@ compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n dcl_modules
{ tc_type_vars, tc_attr_vars, tc_dcl_modules }
= tc_state
icl_common
= { icl_common & com_type_defs=icl_com_type_defs, com_cons_defs=icl_com_cons_defs,
= { icl_common & com_type_defs=expand_syn_types_late_XXX com_type_defs icl_com_type_defs,
com_cons_defs=icl_com_cons_defs,
com_selector_defs=icl_com_selector_defs, com_class_defs=icl_com_class_defs,
com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs }
heaps
......@@ -159,10 +166,16 @@ compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n dcl_modules
-> ( tc_dcl_modules, { icl_module & icl_common = icl_common, icl_functions = icl_functions },
heaps, error_admin )
where
memcpy :: !*{#CheckedTypeDef} -> (!.{CheckedTypeDef}, !.{#CheckedTypeDef})
memcpy :: !u:{#CheckedTypeDef} -> (!.{#CheckedTypeDef}, !u:{#CheckedTypeDef})
memcpy original
| expand_syn_types_late_XXX True False
= abort "memcpy not used"
#! size = size original
# new = createArray size (abort "don't make that array strict !")
| size==0
= ({}, original)
# (el0, original)
= original![0]
# new = createArray size el0
= iFoldSt (\i (dst, src=:{[i]=src_i}) -> ({ dst & [i] = src_i }, src)) 0 size (new, original)
compareWithConversions size_uncopied_icl_defs conversions dclDefs iclDefs tc_state error_admin
......@@ -314,7 +327,7 @@ instance CorrespondenceNumber TypeVarInfo where
toCorrespondenceNumber TVI_Empty
= Unbound
toCorrespondenceNumber (TVI_AType _)
= Bound
= expand_syn_types_late_XXX (abort "not used!!!") Bound
fromCorrespondenceNumber number
= TVI_CorrespondenceNumber number
......@@ -355,6 +368,11 @@ instance t_corresponds [a] | t_corresponds a where
t_corresponds _ _
= return False
instance t_corresponds (a, b) | t_corresponds a & t_corresponds b where
t_corresponds (a1, b1) (a2, b2)
= t_corresponds a1 a2
&&& t_corresponds b1 b2
/*2.0
instance t_corresponds {# a} | t_corresponds a & Array {#} a
......@@ -397,7 +415,7 @@ instance t_corresponds (Global DefinedSymbol) where
instance t_corresponds (TypeDef TypeRhs) where
t_corresponds dclDef iclDef
= t_corresponds_TypeDef dclDef iclDef
= (expand_syn_types_late_XXX t_corresponds_TypeDef` t_corresponds_TypeDef) dclDef iclDef
where
t_corresponds_TypeDef dclDef iclDef tc_state
// | False--->("comparing:", dclDef, iclDef)
......@@ -424,20 +442,30 @@ instance t_corresponds (TypeDef TypeRhs) where
= (corresponds, tc_state)
# attributes_correspond = (is_TA_Unique dclDef.td_attribute)==(is_TA_Unique iclDef.td_attribute)
= (attributes_correspond, tc_state)
root_has_anonymous_attr (TA_Var lhs_attr_var) syn_type=:(SynType a_type=:{at_attribute=TA_Var rhs_attr_var})
= rhs_attr_var.av_info_ptr==lhs_attr_var.av_info_ptr
root_has_anonymous_attr _ _
= False
coerce (SynType atype)
= SynType { atype & at_attribute = TA_Anonymous }
isnt_abstract (AbstractType _) = False
isnt_abstract _ = True
where
root_has_anonymous_attr (TA_Var lhs_attr_var) syn_type=:(SynType a_type=:{at_attribute=TA_Var rhs_attr_var})
= rhs_attr_var.av_info_ptr==lhs_attr_var.av_info_ptr
root_has_anonymous_attr _ _
= False
coerce (SynType atype)
= SynType { atype & at_attribute = TA_Anonymous }
isnt_abstract (AbstractType _) = False
isnt_abstract _ = True
is_TA_Unique TA_Unique = True
is_TA_Unique _ = False
is_TA_Unique TA_Unique = True
is_TA_Unique _ = False
t_corresponds_TypeDef` dclDef iclDef tc_state
// | False--->("comparing:", dclDef, iclDef)
// = undef
# tc_state = init_attr_vars dclDef.td_attrs tc_state
tc_state = init_attr_vars iclDef.td_attrs tc_state
tc_state = init_atype_vars dclDef.td_args tc_state
tc_state = init_atype_vars iclDef.td_args tc_state
= t_corresponds (dclDef.td_args, (dclDef.td_rhs, (dclDef.td_context, dclDef.td_attribute)))
(iclDef.td_args, (iclDef.td_rhs, (iclDef.td_context, iclDef.td_attribute))) tc_state
instance t_corresponds TypeContext where
t_corresponds dclDef iclDef
......@@ -456,8 +484,14 @@ instance t_corresponds ATypeVar where
instance t_corresponds AType where
t_corresponds dclDef iclDef
= t_corresponds_at_type dclDef iclDef
= (expand_syn_types_late_XXX t_corresponds_at_type` t_corresponds_at_type) dclDef iclDef
where
t_corresponds_at_type` dclDef iclDef
| dclDef.at_annotation<>iclDef.at_annotation
= return False
= t_corresponds dclDef.at_attribute iclDef.at_attribute
&&& t_corresponds dclDef.at_type iclDef.at_type
t_corresponds_at_type dclDef iclDef tc_state
| dclDef.at_annotation<>iclDef.at_annotation
= (False, tc_state)
......@@ -561,7 +595,8 @@ instance t_corresponds TypeAttribute where
t_corresponds (TA_RootVar dclDef) (TA_RootVar iclDef)
= PA_BUG (return True) (t_corresponds dclDef iclDef)
t_corresponds _ TA_Anonymous
= return True
| expand_syn_types_late_XXX False True
= return True
t_corresponds TA_None icl
= case icl of
TA_Multi-> return True
......@@ -745,8 +780,6 @@ instance e_corresponds DefinedSymbol where
instance e_corresponds FunctionBody where
// both bodies are either CheckedBodies or TransformedBodies
e_corresponds dclDef iclDef
// | False--->("e_corresponds", from_body dclDef, from_body iclDef)
// = undef
= e_corresponds (from_body dclDef) (from_body iclDef)
where
from_body (TransformedBody {tb_args, tb_rhs}) = (tb_args, [tb_rhs])
......
frontend/explicitimports.dcl
View file @ 9effc288
......@@ -13,9 +13,16 @@ import syntax, checksupport
}
markExplImpSymbols :: !Int !*(!*{!*{!u:ExplImpInfo}}, !*SymbolTable)
-> (!.[Ident],!(!{!{!u:ExplImpInfo}},!.SymbolTable))
updateExplImpForMarkedSymbol :: !Index Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable
-> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !.SymbolTable)
solveExplicitImports :: !(IntKeyHashtable [(Int,Position,[ImportNrAndIdents])]) !{#Int} !Index
!*(!{#x:DclModule},!*{#Int},!{!*ExplImpInfo},!*CheckState)
-> (!.SolvedImports,!(!{#x:DclModule},!.{#Int},!{!.ExplImpInfo},!.CheckState))
checkExplicitImportCompleteness :: ![(Declaration, Position)] !*{#DclModule} !*{#FunDef}