Commit 9effc288 authored by Martin Wierich's avatar Martin Wierich
Browse files

refactoring

parent 5d14453b
...@@ -14,7 +14,7 @@ instance =< Int, Expression, {# Char}, Ident, [a] | =< a, BasicType //, (Global ...@@ -14,7 +14,7 @@ instance =< Int, Expression, {# Char}, Ident, [a] | =< a, BasicType //, (Global
instance =< Type, SymbIdent instance =< Type, SymbIdent
instance == BasicType, TypeVar, TypeSymbIdent, DefinedSymbol, TypeContext , BasicValue, 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 instance < MemberDef
......
...@@ -94,6 +94,9 @@ instance == Assoc ...@@ -94,6 +94,9 @@ instance == Assoc
where where
(==) a1 a2 = equal_constructor a1 a2 (==) 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 :: CompareValue :== Int
Smaller :== -1 Smaller :== -1
Greater :== 1 Greater :== 1
......
...@@ -150,8 +150,10 @@ retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Inde ...@@ -150,8 +150,10 @@ retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Inde
// -> (!Int, ![Declaration], !.ExplImpInfos, !.Heap SymbolTableEntry); // -> (!Int, ![Declaration], !.ExplImpInfos, !.Heap SymbolTableEntry);
addLocalFunctionDefsToSymbolTable :: !Level !Index !Index !Bool !*{#FunDef} !*SymbolTable !*ErrorAdmin -> (!*{# FunDef}, !*SymbolTable, !*ErrorAdmin) addLocalFunctionDefsToSymbolTable :: !Level !Index !Index !Bool !*{#FunDef} !*SymbolTable !*ErrorAdmin -> (!*{# FunDef}, !*SymbolTable, !*ErrorAdmin)
addDefToSymbolTable :: !Level !Index !Ident !STE_Kind !*SymbolTable !*ErrorAdmin -> (!* 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; 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; removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *SymbolTable removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *SymbolTable
removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
...@@ -167,20 +169,16 @@ local_declaration_for_import :: !u:Declaration .Index -> v:Declaration, [u <= v] ...@@ -167,20 +169,16 @@ local_declaration_for_import :: !u:Declaration .Index -> v:Declaration, [u <= v]
get_ident :: !ImportDeclaration -> Ident get_ident :: !ImportDeclaration -> Ident
getBelongingSymbolsFromID :: !ImportDeclaration -> Optional [ImportedIdent] 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 :: BelongingSymbols
= BS_Constructors ![DefinedSymbol] = BS_Constructors ![DefinedSymbol]
| BS_Fields !{#FieldSymbol} | BS_Fields !{#FieldSymbol}
| BS_Members !{#DefinedSymbol} | BS_Members !{#DefinedSymbol}
| BS_Nothing | BS_Nothing
getBelongingSymbols :: !Declaration !{#x:DclModule} -> (!.BelongingSymbols, !{#x:DclModule}) getBelongingSymbols :: !Declaration !v:{#DclModule} -> (!BelongingSymbols, !v:{#DclModule})
nrOfBelongingSymbols :: !BelongingSymbols -> Int nrOfBelongingSymbols :: !BelongingSymbols -> Int
import_ident :: Ident import_ident :: Ident
restoreHeap :: !Ident !*SymbolTable -> .SymbolTable restoreHeap :: !Ident !*SymbolTable -> .SymbolTable
temp_try_a_new_thing_XXX yes no :== no expand_syn_types_late_XXX yes no :== no
...@@ -9,6 +9,7 @@ import RWSDebug ...@@ -9,6 +9,7 @@ import RWSDebug
:: VarHeap :== Heap VarInfo :: VarHeap :== Heap VarInfo
cUndef :== -1
CS_NotChecked :== -1 CS_NotChecked :== -1
NotFound :== -1 NotFound :== -1
...@@ -235,60 +236,7 @@ retrieveGlobalDefinition {ste_kind,ste_def_level,ste_index} requ_kind mod_index ...@@ -235,60 +236,7 @@ retrieveGlobalDefinition {ste_kind,ste_def_level,ste_index} requ_kind mod_index
= (NotFound, mod_index) = (NotFound, mod_index)
updateExplImpForMarkedSymbol :: !Index Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable getBelongingSymbols :: !Declaration !v:{#DclModule} -> (!BelongingSymbols, !v:{#DclModule})
-> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !.SymbolTable)
updateExplImpForMarkedSymbol mod_index decl {ste_kind=STE_ExplImpComponentNrs component_numbers inst_indices}
dcl_modules expl_imp_infos cs_symbol_table
= foldSt (addExplImpInfo mod_index decl inst_indices) component_numbers
(dcl_modules, expl_imp_infos, cs_symbol_table)
updateExplImpForMarkedSymbol _ decl {ste_kind=STE_Instance class_ident} dcl_modules expl_imp_infos cs_symbol_table
// this alternative is only for old syntax (cs_symbol_table argument is not necessary for new syntax)
# cs_symbol_table
= checkExplImpForInstance decl class_ident cs_symbol_table
= (dcl_modules, expl_imp_infos, cs_symbol_table)
updateExplImpForMarkedSymbol _ decl {ste_kind=STE_Imported (STE_Instance class_ident) _} dcl_modules expl_imp_infos cs_symbol_table
// this alternative is only for old syntax (cs_symbol_table argument is not necessary for new syntax)
# cs_symbol_table
= checkExplImpForInstance decl class_ident cs_symbol_table
= (dcl_modules, expl_imp_infos, cs_symbol_table)
updateExplImpForMarkedSymbol _ _ entry dcl_modules expl_imp_infos cs_symbol_table
= (dcl_modules, expl_imp_infos, cs_symbol_table)
addExplImpInfo :: !Index Declaration ![Declaration] !ComponentNrAndIndex !(!u:{#DclModule}, !{!{!*ExplImpInfo}}, !v:SymbolTable)
-> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !v:SymbolTable)
addExplImpInfo mod_index decl instances { cai_component_nr, cai_index } (dcl_modules, expl_imp_infos, cs_symbol_table)
# (ExplImpInfo eii_ident eii_declaring_modules, expl_imp_infos)
= replaceTwoDimArrElt cai_component_nr cai_index TemporarilyFetchedAway expl_imp_infos
(di_belonging, dcl_modules, cs_symbol_table)
= get_belonging_symbol_nrs decl dcl_modules cs_symbol_table
di
= { di_decl = decl, di_instances = instances, di_belonging = di_belonging }
new_expl_imp_info
= ExplImpInfo eii_ident (ikhInsert` False mod_index di eii_declaring_modules)
= (dcl_modules, { expl_imp_infos & [cai_component_nr,cai_index] = new_expl_imp_info }, cs_symbol_table)
where
get_belonging_symbol_nrs :: !Declaration !{#x:DclModule} !u:(Heap SymbolTableEntry)
-> (!.NumberSet,!{#x:DclModule},!u:Heap SymbolTableEntry)
get_belonging_symbol_nrs decl dcl_modules cs_symbol_table
# (all_belonging_symbols, dcl_modules)
= getBelongingSymbols decl dcl_modules
nr_of_belongs
= nrOfBelongingSymbols all_belonging_symbols
(_, belonging_bitvect, cs_symbol_table)
= foldlBelongingSymbols set_bit all_belonging_symbols (0, bitvectCreate nr_of_belongs, cs_symbol_table)
= (bitvectToNumberSet belonging_bitvect, dcl_modules, cs_symbol_table)
set_bit {id_info} (bit_nr, bitvect, cs_symbol_table)
# ({ste_kind}, cs_symbol_table)
= readPtr id_info cs_symbol_table
= ( bit_nr+1
, case ste_kind of
STE_Empty -> bitvect
_ -> bitvectSet bit_nr bitvect
, cs_symbol_table
)
getBelongingSymbols :: !Declaration !{#x:DclModule} -> (!.BelongingSymbols, !{#x:DclModule})
getBelongingSymbols {dcl_kind=STE_Imported STE_Type def_mod_index, dcl_index} dcl_modules getBelongingSymbols {dcl_kind=STE_Imported STE_Type def_mod_index, dcl_index} dcl_modules
# ({td_rhs}, dcl_modules) # ({td_rhs}, dcl_modules)
= dcl_modules![def_mod_index].dcl_common.com_type_defs.[dcl_index] = dcl_modules![def_mod_index].dcl_common.com_type_defs.[dcl_index]
...@@ -322,55 +270,12 @@ nrOfBelongingSymbols BS_Nothing ...@@ -322,55 +270,12 @@ nrOfBelongingSymbols BS_Nothing
| BS_Members !{#DefinedSymbol} | BS_Members !{#DefinedSymbol}
| BS_Nothing | 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 :: !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 # 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 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 :: !Int !{!Declaration} !*SymbolTable -> !*SymbolTable
remove_declared_symbols_in_array symbol_index symbols symbol_table remove_declared_symbols_in_array symbol_index symbols symbol_table
| symbol_index<size symbols | symbol_index<size symbols
...@@ -414,49 +319,62 @@ addDefToSymbolTable level def_index def_ident=:{id_info} def_kind symbol_table e ...@@ -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 <:= (id_info,entry), error)
= (symbol_table, checkError def_ident " already defined" error) = (symbol_table, checkError def_ident " already defined" error)
addDeclaredSymbolsToSymbolTable2 :: .Bool .Int !{!Declaration} !{!Declaration} !*CheckState -> .CheckState; addDeclarationsOfDclModToSymbolTable :: .Int !{!Declaration} !{!Declaration} !*CheckState -> .CheckState;
addDeclaredSymbolsToSymbolTable2 is_dcl_mod ste_index locals imported cs addDeclarationsOfDclModToSymbolTable ste_index locals imported cs
# cs=add_imports_in_array_to_symbol_table 0 is_dcl_mod imported cs # cs=add_imports_in_array_to_symbol_table 0 imported cs
= addLocalSymbolsForImportToSymbolTable 0 locals ste_index cs = addLocalSymbolsForImportToSymbolTable 0 locals ste_index cs
where
add_imports_in_array_to_symbol_table symbol_index is_dcl_mod symbols cs=:{cs_x} add_imports_in_array_to_symbol_table symbol_index symbols cs=:{cs_x}
| symbol_index<size symbols | symbol_index<size symbols
#! ({dcl_ident,dcl_pos,dcl_kind},symbols) = symbols![symbol_index] #! ({dcl_ident,dcl_pos,dcl_kind},symbols) = symbols![symbol_index]
= case dcl_kind of = case dcl_kind of
STE_Imported def_kind def_mod STE_Imported def_kind def_mod
| is_dcl_mod || def_mod <> cs_x.x_main_dcl_module_n
#! dcl_index= symbols.[symbol_index].dcl_index #! 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) (_, cs)
-> add_imports_in_array_to_symbol_table (symbol_index+1) is_dcl_mod symbols cs = addSymbol No dcl_ident dcl_pos dcl_kind
STE_FunctionOrMacro _ 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 #! 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)
= cs = addImportedFunctionOrMacro No dcl_ident dcl_index cs
-> add_imports_in_array_to_symbol_table (symbol_index+1) symbols cs
addLocalSymbolsForImportToSymbolTable :: !Int !{!Declaration} Int !*CheckState -> .CheckState; = cs
addLocalSymbolsForImportToSymbolTable symbol_index symbols mod_index cs
| symbol_index<size symbols addLocalSymbolsForImportToSymbolTable :: !Int !{!Declaration} Int !*CheckState -> .CheckState;
# ({dcl_ident,dcl_pos,dcl_kind,dcl_index},symbols) = symbols![symbol_index] addLocalSymbolsForImportToSymbolTable symbol_index symbols mod_index cs
= case dcl_kind of | symbol_index<size symbols
STE_FunctionOrMacro _ # ({dcl_ident,dcl_pos,dcl_kind,dcl_index},symbols) = symbols![symbol_index]
-> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index = case dcl_kind of
(addImportedFunctionOrMacro dcl_ident dcl_index cs) STE_FunctionOrMacro _
STE_Imported def_kind def_mod # (_, cs)
-> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index = addImportedFunctionOrMacro No dcl_ident dcl_index cs
(addIndirectlyImportedSymbolOld dcl_ident dcl_pos dcl_kind def_kind dcl_index mod_index cs) -> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index cs
= cs STE_Imported def_kind def_mod
# (_, cs)
addImportedFunctionOrMacro :: !Ident .Int !*CheckState -> .CheckState; = addSymbol No dcl_ident dcl_pos dcl_kind
addImportedFunctionOrMacro ident=:{id_info} def_index cs=:{cs_symbol_table} 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 #! entry = sreadPtr id_info cs_symbol_table
= case entry.ste_kind of = case entry.ste_kind of
STE_Empty 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 _ STE_FunctionOrMacro _
| entry.ste_index == def_index | entry.ste_index == def_index || within_opt_range opt_dcl_macro_range def_index
-> cs -> (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 :: !Ident (Global .Int) !*CheckState -> .CheckState;
addFieldToSelectorDefinition {id_info} glob_field_index cs=:{cs_symbol_table} addFieldToSelectorDefinition {id_info} glob_field_index cs=:{cs_symbol_table}
...@@ -468,28 +386,8 @@ 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 } -> { 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; addSymbol :: !(Optional a) !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !Int !*CheckState -> (!Bool, !.CheckState)
addIndirectlyImportedSymbolOld ident pos dcl_kind def_kind def_index def_mod cs=:{cs_symbol_table} 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 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}
# (entry, cs_symbol_table) = readPtr ident.id_info 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 = 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 } importing_mod { cs & cs_symbol_table = cs_symbol_table }
...@@ -547,9 +445,9 @@ where ...@@ -547,9 +445,9 @@ where
removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *SymbolTable removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *SymbolTable
removeDeclarationsFromSymbolTable decls scope symbol_table removeDeclarationsFromSymbolTable decls scope symbol_table
= unsafeFold2St (remove_declaration scope) decls [1..] symbol_table = foldSt (remove_declaration scope) decls symbol_table
where 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) # ({ste_kind,ste_previous}, symbol_table)
= readPtr id_info symbol_table = readPtr id_info symbol_table
= case ste_kind of = case ste_kind of
...@@ -723,4 +621,4 @@ restoreHeap {id_info} cs_symbol_table ...@@ -723,4 +621,4 @@ restoreHeap {id_info} cs_symbol_table
= readPtr id_info cs_symbol_table = readPtr id_info cs_symbol_table
= writePtr id_info ste_previous 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
...@@ -418,7 +418,7 @@ where ...@@ -418,7 +418,7 @@ where
| type_index == nr_of_types | type_index == nr_of_types
| cs.cs_error.ea_ok && not is_main_dcl | cs.cs_error.ea_ok && not is_main_dcl
# marks = createArray nr_of_types CS_NotChecked # 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_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_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 }) = (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 ...@@ -437,7 +437,7 @@ expand_syn_types module_index type_index nr_of_types expst
expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin
-> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin) -> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin)
expandSynonymTypes module_index exp_type_defs exp_modules exp_type_heaps exp_error 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" = abort "expandSynonymTypes"
#! nr_of_types #! nr_of_types
= size exp_type_defs = size exp_type_defs
......
...@@ -4,6 +4,6 @@ import syntax, checksupport ...@@ -4,6 +4,6 @@ import syntax, checksupport
// compare definition and implementation module // 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) -> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin)
...@@ -29,10 +29,11 @@ import syntax, checksupport, compare_constructor, utilities, StdCompare ...@@ -29,10 +29,11 @@ import syntax, checksupport, compare_constructor, utilities, StdCompare
, tc_dcl_modules , tc_dcl_modules
:: !.{#DclModule} :: !.{#DclModule}
, tc_icl_type_defs , tc_icl_type_defs
:: !{CheckedTypeDef} :: !{#CheckedTypeDef}
, tc_type_conversions , tc_type_conversions
:: !Conversions :: !Conversions
, tc_visited_syn_types // to detect cycles in type synonyms , tc_visited_syn_types // to detect cycles in type synonyms
// only for no in expand_syn_types_late_XXX
:: !.{#Bool} :: !.{#Bool}
, tc_main_dcl_module_n , tc_main_dcl_module_n
:: !Int :: !Int
...@@ -73,7 +74,8 @@ import syntax, checksupport, compare_constructor, utilities, StdCompare ...@@ -73,7 +74,8 @@ import syntax, checksupport, compare_constructor, utilities, StdCompare
} }
:: OptionalCorrespondenceNumber = CorrespondenceNumber !Int | Bound | Unbound :: 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 class t_corresponds a :: !a !a -> *TypesCorrespondMonad
// whether two types correspond // whether two types correspond
class e_corresponds a :: !a !a -> ExpressionsCorrespondMonad class e_corresponds a :: !a !a -> ExpressionsCorrespondMonad
...@@ -87,26 +89,30 @@ class CorrespondenceNumber a where ...@@ -87,26 +89,30 @@ class CorrespondenceNumber a where
initial_hwn hwn_heap = { hwn_heap = hwn_heap, hwn_number = 0 } 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) -> (!.{# 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, // 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 // 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] # (main_dcl_module, dcl_modules) = dcl_modules![main_dcl_module_n]
= case main_dcl_module.dcl_conversions of = case main_dcl_module.dcl_conversions of
No -> (dcl_modules, icl_module, heaps, error_admin) No -> (dcl_modules, icl_module, heaps, error_admin)
Yes conversion_table 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_common, icl_functions}
= icl_module = icl_module
{hp_var_heap, hp_expression_heap, hp_type_heaps={th_vars, th_attrs}} {hp_var_heap, hp_expression_heap, hp_type_heaps={th_vars, th_attrs}}
= heaps = 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_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 } com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs }
= icl_common = 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_state
= { tc_type_vars = initial_hwn th_vars = { tc_type_vars = initial_hwn th_vars
, tc_attr_vars = initial_hwn th_attrs , tc_attr_vars = initial_hwn th_attrs
...@@ -150,7 +156,8 @@ compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n dcl_modules ...@@ -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_type_vars, tc_attr_vars, tc_dcl_modules }
= tc_state = tc_state
icl_common 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_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 } com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs }
heaps heaps
...@@ -159,10 +166,16 @@ compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n dcl_modules ...@@ -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 }, -> ( tc_dcl_modules, { icl_module & icl_common = icl_common, icl_functions = icl_functions },
heaps, error_admin ) heaps, error_admin )
where where
memcpy :: !*{#CheckedTypeDef} -> (!.{CheckedTypeDef}, !.{#CheckedTypeDef}) memcpy :: !u:{#CheckedTypeDef} -> (!.{#CheckedTypeDef}, !u:{#CheckedTypeDef})
memcpy original memcpy original
| expand_syn_types_late_XXX True False
= abort "memcpy not used"
#! size = size original #! 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) = 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 compareWithConversions size_uncopied_icl_defs conversions dclDefs iclDefs tc_state error_admin
...@@ -314,7 +327,7 @@ instance CorrespondenceNumber TypeVarInfo where ...@@ -314,7 +327,7 @@ instance CorrespondenceNumber TypeVarInfo where