Commit 42496f31 authored by Sjaak Smetsers's avatar Sjaak Smetsers
Browse files

removed kind correctness checking module

parent 2218df38
...@@ -7,4 +7,14 @@ partionateAndExpandTypes :: !NumberSet !Index !*CommonDefs !*{#DclModule} !*Type ...@@ -7,4 +7,14 @@ partionateAndExpandTypes :: !NumberSet !Index !*CommonDefs !*{#DclModule} !*Type
:: TypeGroups :== [[GlobalIndex]] :: TypeGroups :== [[GlobalIndex]]
analyseTypeDefs :: !{#CommonDefs} !TypeGroups !*TypeDefInfos !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin) analyseTypeDefs :: !{#CommonDefs} !TypeGroups !*TypeDefInfos !*TypeVarHeap !*ErrorAdmin -> (!*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin)
determineKindsOfClasses :: !NumberSet !{#CommonDefs} !*TypeDefInfos !*TypeVarHeap !*ErrorAdmin
-> (!*ClassDefInfos, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin)
checkKindsOfCommonDefsAndFunctions :: !Index !Index !NumberSet !IndexRange !{#CommonDefs} !u:{# FunDef} !v:{#DclModule} !*TypeDefInfos !*ClassDefInfos
!*TypeVarHeap !*ErrorAdmin -> (!u:{# FunDef}, !v:{#DclModule}, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin)
isATopConsVar cv :== cv < 0
encodeTopConsVar cv :== dec (~cv)
decodeTopConsVar cv :== ~(inc cv)
This diff is collapsed.
...@@ -903,16 +903,17 @@ checkCommonDefinitions is_dcl module_index common modules type_heaps var_heap cs ...@@ -903,16 +903,17 @@ checkCommonDefinitions is_dcl module_index common modules type_heaps var_heap cs
(size_com_selector_defs,com_selector_defs) = usize com_selector_defs (size_com_selector_defs,com_selector_defs) = usize com_selector_defs
(size_com_cons_defs,com_cons_defs) = usize com_cons_defs (size_com_cons_defs,com_cons_defs) = usize com_cons_defs
(com_class_defs, modules, new_type_defs, new_selector_defs, new_cons_defs, th_vars, var_heap, cs) (com_class_defs, modules, new_type_defs, new_selector_defs, new_cons_defs, th_vars, var_heap, cs_symbol_table)
= createClassDictionaries module_index com_class_defs modules size_com_type_defs size_com_selector_defs size_com_cons_defs = createClassDictionaries module_index com_class_defs modules size_com_type_defs size_com_selector_defs size_com_cons_defs
type_heaps.th_vars var_heap cs type_heaps.th_vars var_heap cs.cs_symbol_table
com_type_defs = array_plus_list com_type_defs new_type_defs com_type_defs = array_plus_list com_type_defs new_type_defs
com_selector_defs = array_plus_list com_selector_defs new_selector_defs com_selector_defs = array_plus_list com_selector_defs new_selector_defs
com_cons_defs = array_plus_list com_cons_defs new_cons_defs com_cons_defs = array_plus_list com_cons_defs new_cons_defs
= ({common & com_type_defs = com_type_defs, com_cons_defs = com_cons_defs, com_selector_defs = com_selector_defs, com_class_defs = com_class_defs, = ({common & com_type_defs = com_type_defs, com_cons_defs = com_cons_defs, com_selector_defs = com_selector_defs, com_class_defs = com_class_defs,
com_member_defs = com_member_defs, com_instance_defs = com_instance_defs, /* AA */ com_generic_defs = com_generic_defs }, modules, { type_heaps & th_vars = th_vars }, var_heap, cs) com_member_defs = com_member_defs, com_instance_defs = com_instance_defs, /* AA */ com_generic_defs = com_generic_defs }, modules,
{ type_heaps & th_vars = th_vars }, var_heap, { cs & cs_symbol_table = cs_symbol_table })
collectCommonfinitions :: !(CollectedDefinitions ClassInstance a) -> (!*{# Int}, ![Declaration]) collectCommonfinitions :: !(CollectedDefinitions ClassInstance a) -> (!*{# Int}, ![Declaration])
collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances, def_generics} collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances, def_generics}
......
...@@ -20,17 +20,7 @@ checkSuperClasses :: ![TypeVar] ![TypeContext] !Index !u:{# CheckedTypeDef} !v:{ ...@@ -20,17 +20,7 @@ checkSuperClasses :: ![TypeVar] ![TypeContext] !Index !u:{# CheckedTypeDef} !v:{
checkDynamicTypes :: !Index ![ExprInfoPtr] !(Optional SymbolType) !u:{# CheckedTypeDef} !u:{# DclModule} !*TypeHeaps !*ExpressionHeap !*CheckState checkDynamicTypes :: !Index ![ExprInfoPtr] !(Optional SymbolType) !u:{# CheckedTypeDef} !u:{# DclModule} !*TypeHeaps !*ExpressionHeap !*CheckState
-> (!u:{# CheckedTypeDef}, !u:{# DclModule}, !*TypeHeaps, !*ExpressionHeap, !*CheckState) -> (!u:{# CheckedTypeDef}, !u:{# DclModule}, !*TypeHeaps, !*ExpressionHeap, !*CheckState)
createClassDictionaries :: !Index !*{#ClassDef} !u:{#.DclModule} !Index !Index !Index !*TypeVarHeap !*VarHeap !*CheckState createClassDictionaries :: !Index !*{#ClassDef} !u:{#.DclModule} !Index !Index !Index !*TypeVarHeap !*VarHeap !*SymbolTable
-> (!*{#ClassDef}, !u:{#DclModule}, ![CheckedTypeDef], ![SelectorDef], ![ConsDef], !*TypeVarHeap, !*VarHeap, !*CheckState) -> (!*{#ClassDef}, !u:{#DclModule}, ![CheckedTypeDef], ![SelectorDef], ![ConsDef], !*TypeVarHeap, !*VarHeap, !*SymbolTable)
/*
bindTypeVarsAndAttributes :: !TypeAttribute !TypeAttribute ![ATypeVar] ![AType] !*TypeHeaps -> *TypeHeaps;
clearBindingsOfTypeVarsAndAttributes :: !TypeAttribute ![ATypeVar] !*TypeHeaps -> *TypeHeaps;
*/
isATopConsVar cv :== cv < 0
encodeTopConsVar cv :== dec (~cv)
decodeTopConsVar cv :== ~(inc cv)
/*
expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin
-> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin)
*/
removeVariablesFromSymbolTable :: !Int ![TypeVar] !*SymbolTable -> *SymbolTable removeVariablesFromSymbolTable :: !Int ![TypeVar] !*SymbolTable -> *SymbolTable
...@@ -174,10 +174,6 @@ addToAttributeEnviron _ _ attr_env error ...@@ -174,10 +174,6 @@ addToAttributeEnviron _ _ attr_env error
emptyIdent name :== { id_name = name, id_info = nilPtr } emptyIdent name :== { id_name = name, id_info = nilPtr }
isATopConsVar cv :== cv < 0
encodeTopConsVar cv :== dec (~cv)
decodeTopConsVar cv :== ~(inc cv)
checkTypeDef :: !Index !Index !*TypeSymbols !*TypeInfo !*CheckState -> (!*TypeSymbols, !*TypeInfo, !*CheckState); checkTypeDef :: !Index !Index !*TypeSymbols !*TypeInfo !*CheckState -> (!*TypeSymbols, !*TypeInfo, !*CheckState);
checkTypeDef type_index module_index ts=:{ts_type_defs} ti=:{ti_type_heaps} cs=:{cs_error} checkTypeDef type_index module_index ts=:{ts_type_defs} ti=:{ti_type_heaps} cs=:{cs_error}
# (type_def, ts_type_defs) = ts_type_defs![type_index] # (type_def, ts_type_defs) = ts_type_defs![type_index]
...@@ -1161,18 +1157,15 @@ removeVariablesFromSymbolTable scope vars symbol_table ...@@ -1161,18 +1157,15 @@ removeVariablesFromSymbolTable scope vars symbol_table
makeAttributedType attr annot type :== { at_attribute = attr, at_annotation = annot, at_type = type } makeAttributedType attr annot type :== { at_attribute = attr, at_annotation = annot, at_type = type }
createClassDictionaries :: !Index !*{#ClassDef} !u:{#.DclModule} !Index !Index !Index !*TypeVarHeap !*VarHeap !*CheckState createClassDictionaries :: !Index !*{#ClassDef} !u:{#.DclModule} !Index !Index !Index !*TypeVarHeap !*VarHeap !*SymbolTable
-> (!*{#ClassDef}, !u:{#DclModule}, ![CheckedTypeDef], ![SelectorDef], ![ConsDef], !*TypeVarHeap, !*VarHeap, !*CheckState) -> (!*{#ClassDef}, !u:{#DclModule}, ![CheckedTypeDef], ![SelectorDef], ![ConsDef], !*TypeVarHeap, !*VarHeap, !*SymbolTable)
createClassDictionaries mod_index class_defs modules first_type_index first_selector_index first_cons_index type_var_heap var_heap cs createClassDictionaries mod_index class_defs modules first_type_index first_selector_index first_cons_index type_var_heap var_heap symbol_table
| cs.cs_error.ea_ok # (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, symbol_table)
= create_class_dictionaries mod_index 0 class_defs modules []
# (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs) = create_class_dictionaries mod_index 0 class_defs modules [] { index_type = first_type_index, index_cons= first_cons_index, index_selector = first_selector_index } type_var_heap var_heap symbol_table
{ index_type = first_type_index, index_cons= first_cons_index, index_selector = first_selector_index } type_var_heap var_heap cs (type_defs, sel_defs, cons_defs, symbol_table) = foldSt collect_type_def rev_dictionary_list ([], [], [], symbol_table)
(type_defs, sel_defs, cons_defs, cs_symbol_table) = foldSt collect_type_def rev_dictionary_list ([], [], [], cs.cs_symbol_table) = (class_defs, modules, type_defs, sel_defs, cons_defs, type_var_heap, var_heap, symbol_table)
= (class_defs, modules, type_defs, sel_defs, cons_defs, type_var_heap, var_heap, {cs & cs_symbol_table = cs_symbol_table }) where
= (class_defs, modules, [], [], [], type_var_heap, var_heap, cs)
where
collect_type_def type_ptr (type_defs, sel_defs, cons_defs, symbol_table) collect_type_def type_ptr (type_defs, sel_defs, cons_defs, symbol_table)
# ({ ste_kind = STE_DictType type_def }, symbol_table) = readPtr type_ptr symbol_table # ({ ste_kind = STE_DictType type_def }, symbol_table) = readPtr type_ptr symbol_table
(RecordType {rt_constructor, rt_fields}) = type_def.td_rhs (RecordType {rt_constructor, rt_fields}) = type_def.td_rhs
...@@ -1194,91 +1187,71 @@ where ...@@ -1194,91 +1187,71 @@ where
= create_class_dictionaries mod_index (inc class_index) class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs = create_class_dictionaries mod_index (inc class_index) class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
= (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs) = (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs)
create_class_dictionary :: !Index !Index !*{#ClassDef} !w:{#DclModule} !v:[SymbolPtr] !u:Indexes !*TypeVarHeap !*VarHeap !*CheckState create_class_dictionary :: !Index !Index !*{#ClassDef} !w:{#DclModule} !v:[SymbolPtr] !u:Indexes !*TypeVarHeap !*VarHeap !*SymbolTable
-> (!*{#ClassDef}, !w:{#DclModule}, !v:[SymbolPtr], !u:Indexes, !*TypeVarHeap, !*VarHeap, !*CheckState) -> (!*{#ClassDef}, !w:{#DclModule}, !v:[SymbolPtr], !u:Indexes, !*TypeVarHeap, !*VarHeap, !*SymbolTable)
create_class_dictionary mod_index class_index class_defs =:{[class_index] = class_def } modules rev_dictionary_list create_class_dictionary mod_index class_index class_defs =:{[class_index] = class_def } modules rev_dictionary_list
indexes type_var_heap var_heap cs=:{cs_symbol_table,cs_error} indexes type_var_heap var_heap symbol_table
# {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_name,id_info}}} = class_def # {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_name,id_info}}} = class_def
| isNilPtr id_info # (type_id_info, symbol_table) = newPtr EmptySymbolTableEntry symbol_table
# (type_id_info, cs_symbol_table) = newPtr EmptySymbolTableEntry cs_symbol_table nr_of_members = size class_members
nr_of_members = size class_members nr_of_fields = nr_of_members + length class_context
nr_of_fields = nr_of_members + length class_context rec_type_id = { class_name & id_info = type_id_info}
rec_type_id = { class_name & id_info = type_id_info} class_dictionary = { ds & ds_ident = rec_type_id }
class_dictionary = { ds & ds_ident = rec_type_id }
class_defs = { class_defs & [class_index] = { class_def & class_dictionary = class_dictionary}} { index_type, index_cons, index_selector } = indexes
(class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs)
= create_class_dictionaries_of_contexts mod_index class_context class_defs modules type_symb = MakeTypeSymbIdent { glob_object = index_type, glob_module = mod_index } rec_type_id class_arity
rev_dictionary_list indexes type_var_heap var_heap { cs & cs_symbol_table = cs_symbol_table }
rec_type = makeAttributedType TA_Multi AN_Strict (TA type_symb [makeAttributedType TA_Multi AN_None TE \\ i <- [1..class_arity]])
{ index_type, index_cons, index_selector } = indexes field_type = makeAttributedType TA_Multi AN_None TE
type_symb = MakeTypeSymbIdent { glob_object = index_type, glob_module = mod_index } rec_type_id class_arity (rev_fields, var_heap, symbol_table)
= build_fields 0 nr_of_members class_members rec_type field_type index_type index_selector [] var_heap symbol_table
rec_type = makeAttributedType TA_Multi AN_Strict (TA type_symb [makeAttributedType TA_Multi AN_None TE \\ i <- [1..class_arity]]) (index_selector, rev_fields, rev_field_types, class_defs, modules, var_heap, symbol_table)
field_type = makeAttributedType TA_Multi AN_None TE = build_context_fields mod_index nr_of_members class_context rec_type index_type (index_selector + nr_of_members) rev_fields
[ { field_type & at_annotation = AN_Strict } \\ i <- [1..nr_of_members] ] class_defs modules var_heap symbol_table
(rev_fields, var_heap, cs_symbol_table)
= build_fields 0 nr_of_members class_members rec_type field_type index_type index_selector [] var_heap cs.cs_symbol_table (cons_id_info, symbol_table) = newPtr EmptySymbolTableEntry symbol_table
(index_selector, rev_fields, rev_field_types, class_defs, modules, var_heap, cs_symbol_table) rec_cons_id = { class_name & id_info = cons_id_info}
= build_context_fields mod_index nr_of_members class_context rec_type index_type (index_selector + nr_of_members) rev_fields cons_symbol = { ds_ident = rec_cons_id, ds_arity = nr_of_fields, ds_index = index_cons }
[ { field_type & at_annotation = AN_Strict } \\ i <- [1..nr_of_members] ] class_defs modules var_heap cs_symbol_table (cons_type_ptr, var_heap) = newPtr VI_Empty var_heap
(cons_id_info, cs_symbol_table) = newPtr EmptySymbolTableEntry cs_symbol_table (td_args, type_var_heap) = mapSt new_attributed_type_variable class_args type_var_heap
rec_cons_id = { class_name & id_info = cons_id_info}
cons_symbol = { ds_ident = rec_cons_id, ds_arity = nr_of_fields, ds_index = index_cons }
(cons_type_ptr, var_heap) = newPtr VI_Empty var_heap type_def =
{ td_name = rec_type_id
(td_args, type_var_heap) = mapSt new_attributed_type_variable class_args type_var_heap , td_index = index_type
, td_arity = 0
, td_args = td_args
type_def = , td_attrs = []
{ td_name = rec_type_id , td_context = []
, td_index = index_type , td_rhs = RecordType {rt_constructor = cons_symbol, rt_fields = { field \\ field <- reverse rev_fields }}
, td_arity = 0 , td_attribute = TA_None
, td_args = td_args , td_pos = NoPos
, td_attrs = [] , td_used_types = []
, td_context = [] }
, td_rhs = RecordType {rt_constructor = cons_symbol, rt_fields = { field \\ field <- reverse rev_fields }}
, td_attribute = TA_None cons_def =
, td_pos = NoPos { cons_symb = rec_cons_id
, td_used_types = [] , cons_type = { st_vars = [], st_args = reverse rev_field_types, st_result = rec_type,
} st_arity = nr_of_fields, st_context = [], st_attr_vars = [], st_attr_env = [] }
, cons_priority = NoPrio
cons_def = , cons_index = 0
{ cons_symb = rec_cons_id , cons_type_index = index_type
, cons_type = { st_vars = [], st_args = reverse rev_field_types, st_result = rec_type, , cons_exi_vars = []
st_arity = nr_of_fields, st_context = [], st_attr_vars = [], st_attr_env = [] } , cons_arg_vars = []
, cons_priority = NoPrio , cons_type_ptr = cons_type_ptr
, cons_index = 0 , cons_pos = NoPos
, cons_type_index = index_type }
, cons_exi_vars = []
, cons_arg_vars = [] = ({ class_defs & [class_index] = { class_def & class_dictionary = { class_dictionary & ds_index = index_type }}}, modules,
, cons_type_ptr = cons_type_ptr [ type_id_info : rev_dictionary_list ], { index_type = inc index_type, index_cons = inc index_cons, index_selector = index_selector },
, cons_pos = NoPos type_var_heap, var_heap,
} symbol_table <:= (type_id_info, { ste_kind = STE_DictType type_def, ste_index = index_type,
= ({ class_defs & [class_index] = { class_def & class_dictionary = { class_dictionary & ds_index = index_type }}}, modules, ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })
[ type_id_info : rev_dictionary_list ], { index_type = inc index_type, index_cons = inc index_cons, index_selector = index_selector }, <:= (cons_id_info, { ste_kind = STE_DictCons cons_def, ste_index = index_cons,
type_var_heap, var_heap, { cs & cs_symbol_table = cs_symbol_table ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" }))
<:= (type_id_info, { ste_kind = STE_DictType type_def, ste_index = index_type,
ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })
<:= (cons_id_info, { ste_kind = STE_DictCons cons_def, ste_index = index_cons,
ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })})
# ({ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table
| ste_kind == STE_Empty
= (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap,
{ cs & cs_symbol_table = cs_symbol_table, cs_error = checkError class_name "cyclic dependencies between type classes" cs_error})
= (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, { cs & cs_symbol_table = cs_symbol_table })
create_class_dictionaries_of_contexts mod_index [{tc_class = {glob_module, glob_object={ds_index}}}:tcs] class_defs modules
rev_dictionary_list indexes type_var_heap var_heap cs
| mod_index == glob_module
# (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs)
= create_class_dictionary mod_index ds_index class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
= create_class_dictionaries_of_contexts mod_index tcs class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
= create_class_dictionaries_of_contexts mod_index tcs class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
create_class_dictionaries_of_contexts mod_index [] class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
= (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs)
new_attributed_type_variable tv type_var_heap new_attributed_type_variable tv type_var_heap
# (new_tv_ptr, type_var_heap) = newPtr TVI_Empty type_var_heap # (new_tv_ptr, type_var_heap) = newPtr TVI_Empty type_var_heap
...@@ -1313,7 +1286,6 @@ where ...@@ -1313,7 +1286,6 @@ where
, sd_type = { st_vars = [], st_args = [ rec_type ], st_result = field_type, st_arity = 1, , sd_type = { st_vars = [], st_args = [ rec_type ], st_result = field_type, st_arity = 1,
st_context = [], st_attr_vars = [], st_attr_env = [] } st_context = [], st_attr_vars = [], st_attr_env = [] }
, sd_exi_vars = [] , sd_exi_vars = []
// , sd_exi_attrs = []
, sd_field_nr = field_nr , sd_field_nr = field_nr
, sd_type_index = rec_type_index , sd_type_index = rec_type_index
, sd_type_ptr = sd_type_ptr , sd_type_ptr = sd_type_ptr
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
implementation module frontend implementation module frontend
import scanner, parse, postparse, check, type, trans, convertcases, overloading, utilities, convertDynamics, import scanner, parse, postparse, check, type, trans, convertcases, overloading, utilities, convertDynamics,
convertimportedtypes, checkKindCorrectness, compilerSwitches, analtypes, generics convertimportedtypes, /*checkKindCorrectness, */ compilerSwitches, analtypes, generics
SwitchGenerics on off :== off SwitchGenerics on off :== off
...@@ -80,12 +80,12 @@ frontSyntaxTree cached_functions_and_macros cached_dcl_mods n_functions_and_macr ...@@ -80,12 +80,12 @@ frontSyntaxTree cached_functions_and_macros cached_dcl_mods n_functions_and_macr
},cached_functions_and_macros,cached_dcl_mods,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,tcl_file,heaps },cached_functions_and_macros,cached_dcl_mods,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,tcl_file,heaps
) )
//import StdDebug // import StdDebug
frontEndInterface :: !FrontEndOptions !Ident !SearchPaths !{#DclModule} !{#FunDef} !(Optional Bool) !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File (!Optional !*File) !*Heaps frontEndInterface :: !FrontEndOptions !Ident !SearchPaths !{#DclModule} !{#FunDef} !(Optional Bool) !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File (!Optional !*File) !*Heaps
-> ( !Optional *FrontEndSyntaxTree,!*{# FunDef },!{#DclModule},!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional !*File, !*Heaps) -> ( !Optional *FrontEndSyntaxTree,!*{# FunDef },!{#DclModule},!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional !*File, !*Heaps)
frontEndInterface options mod_ident search_paths cached_dcl_modules functions_and_macros list_inferred_types predef_symbols hash_table files error io out tcl_file heaps frontEndInterface options mod_ident search_paths cached_dcl_modules functions_and_macros list_inferred_types predef_symbols hash_table files error io out tcl_file heaps
// # files = trace_n ("Compiling "+++mod_ident.id_name) files // # files = trace_n ("Compiling "+++mod_ident.id_name) files
# (ok, mod, hash_table, error, predef_symbols, files) # (ok, mod, hash_table, error, predef_symbols, files)
= wantModule cWantIclFile mod_ident NoPos options.feo_generics(hash_table /* ---> ("Parsing:", mod_ident)*/) error search_paths predef_symbols files = wantModule cWantIclFile mod_ident NoPos options.feo_generics(hash_table /* ---> ("Parsing:", mod_ident)*/) error search_paths predef_symbols files
...@@ -147,9 +147,18 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an ...@@ -147,9 +147,18 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an
# (type_groups, ti_common_defs, td_infos, icl_common, dcl_mods, type_heaps, error_admin) # (type_groups, ti_common_defs, td_infos, icl_common, dcl_mods, type_heaps, error_admin)
= partionateAndExpandTypes icl_used_module_numbers main_dcl_module_n icl_common dcl_mods type_heaps error_admin = partionateAndExpandTypes icl_used_module_numbers main_dcl_module_n icl_common dcl_mods type_heaps error_admin
ti_common_defs = { ti_common_defs & [main_dcl_module_n] = icl_common } ti_common_defs = { ti_common_defs & [main_dcl_module_n] = icl_common }
# (td_infos, type_heaps, error_admin) = analyseTypeDefs ti_common_defs type_groups td_infos type_heaps error_admin # (td_infos, th_vars, error_admin) = analyseTypeDefs ti_common_defs type_groups td_infos type_heaps.th_vars error_admin
/*
(fun_defs, dcl_mods, th_vars, td_infos, error_admin) (fun_defs, dcl_mods, th_vars, td_infos, error_admin)
= checkKindCorrectness main_dcl_module_n nr_of_chached_functions_and_macros icl_instances ti_common_defs n_cached_dcl_modules fun_defs dcl_mods type_heaps.th_vars td_infos error_admin = checkKindCorrectness main_dcl_module_n nr_of_chached_functions_and_macros icl_instances ti_common_defs n_cached_dcl_modules fun_defs dcl_mods type_heaps.th_vars td_infos error_admin
*/
(class_infos, td_infos, th_vars, error_admin)
= determineKindsOfClasses icl_used_module_numbers ti_common_defs td_infos th_vars error_admin
#! nr_of_icl_functions = icl_mod.icl_instances.ir_from
# (fun_defs, dcl_mods, td_infos, th_vars, error_admin)
= checkKindsOfCommonDefsAndFunctions n_cached_dcl_modules main_dcl_module_n icl_used_module_numbers global_fun_range
ti_common_defs fun_defs dcl_mods td_infos class_infos th_vars error_admin
type_heaps = { type_heaps & th_vars = th_vars } type_heaps = { type_heaps & th_vars = th_vars }
# heaps = { heaps & hp_type_heaps = type_heaps } # heaps = { heaps & hp_type_heaps = type_heaps }
# (saved_main_dcl_common, ti_common_defs) = replace (dcl_common_defs dcl_mods) main_dcl_module_n icl_common # (saved_main_dcl_common, ti_common_defs) = replace (dcl_common_defs dcl_mods) main_dcl_module_n icl_common
......
...@@ -232,18 +232,17 @@ convertGenerics ...@@ -232,18 +232,17 @@ convertGenerics
} }
} }
#! (gs_dcl_modules, gs_modules, gs_heaps, cs) = #! (gs_dcl_modules, gs_modules, gs_heaps, cs_symbol_table) =
create_class_dictionaries 0 gs_dcl_modules gs_modules gs_heaps cs create_class_dictionaries 0 gs_dcl_modules gs_modules gs_heaps cs.cs_symbol_table
// create_class_dictionaries1 main_dcl_module_n dcl_modules gs_modules gs_heaps cs // create_class_dictionaries1 main_dcl_module_n dcl_modules gs_modules gs_heaps cs
//---> "*** create class dictionaries" //---> "*** create class dictionaries"
# {cs_symbol_table, cs_predef_symbols, cs_error} = cs
# hash_table = { hash_table & hte_symbol_heap = cs_symbol_table } # hash_table = { hash_table & hte_symbol_heap = cs_symbol_table }
#! index_range = {ir_from = gs.gs_first_fun, ir_to = gs.gs_last_fun} #! index_range = {ir_from = gs.gs_first_fun, ir_to = gs.gs_last_fun}
= ( gs_groups, gs_modules, gs_fun_defs, index_range, gs_td_infos, gs_heaps, hash_table, = ( gs_groups, gs_modules, gs_fun_defs, index_range, gs_td_infos, gs_heaps, hash_table,
cs_predef_symbols, gs_dcl_modules, gs_opt_dcl_icl_conversions, cs_error) cs.cs_predef_symbols, gs_dcl_modules, gs_opt_dcl_icl_conversions, cs.cs_error)
where where
return { gs_modules, gs_groups, gs_fun_defs, gs_td_infos, gs_gtd_infos, return { gs_modules, gs_groups, gs_fun_defs, gs_td_infos, gs_gtd_infos,
gs_heaps, gs_main_dcl_module_n, gs_dcl_modules, gs_opt_dcl_icl_conversions, gs_error} gs_heaps, gs_main_dcl_module_n, gs_dcl_modules, gs_opt_dcl_icl_conversions, gs_error}
...@@ -252,21 +251,21 @@ where ...@@ -252,21 +251,21 @@ where
gs_td_infos, gs_heaps, hash_table, predefs, gs_dcl_modules, gs_td_infos, gs_heaps, hash_table, predefs, gs_dcl_modules,
gs_opt_dcl_icl_conversions, gs_error) gs_opt_dcl_icl_conversions, gs_error)
create_class_dictionaries module_index dcl_modules modules heaps cs create_class_dictionaries module_index dcl_modules modules heaps symbol_table
#! size_of_modules = size modules #! size_of_modules = size modules
| module_index == size_of_modules | module_index == size_of_modules
= (dcl_modules, modules, heaps, cs) = (dcl_modules, modules, heaps, symbol_table)
#! (dcl_modules, modules, heaps, cs) = #! (dcl_modules, modules, heaps, symbol_table) =
create_class_dictionaries1 module_index dcl_modules modules heaps cs create_class_dictionaries1 module_index dcl_modules modules heaps symbol_table
= create_class_dictionaries (inc module_index) dcl_modules modules heaps cs = create_class_dictionaries (inc module_index) dcl_modules modules heaps symbol_table
create_class_dictionaries1 create_class_dictionaries1
module_index dcl_modules modules module_index dcl_modules modules
heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}, hp_var_heap} heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}, hp_var_heap}
cs symbol_table
#! (common_defs, modules) = modules![module_index] #! (common_defs, modules) = modules![module_index]
#! class_defs = { x \\ x <-: common_defs.com_class_defs } // make unique copy #! class_defs = { x \\ x <-: common_defs.com_class_defs } // make unique copy
#! (class_defs, dcl_modules, new_type_defs, new_selector_defs, new_cons_defs, th_vars, hp_var_heap, cs) = #! (class_defs, dcl_modules, new_type_defs, new_selector_defs, new_cons_defs, th_vars, hp_var_heap, symbol_table) =
createClassDictionaries createClassDictionaries
module_index module_index
class_defs class_defs
...@@ -274,7 +273,7 @@ where ...@@ -274,7 +273,7 @@ where
(size common_defs.com_type_defs) (size common_defs.com_type_defs)
(size common_defs.com_selector_defs) (size common_defs.com_selector_defs)
(size common_defs.com_cons_defs) (size common_defs.com_cons_defs)
th_vars hp_var_heap cs th_vars hp_var_heap symbol_table
#! common_defs = { common_defs & #! common_defs = { common_defs &
com_class_defs = class_defs, com_class_defs = class_defs,
...@@ -284,7 +283,7 @@ where ...@@ -284,7 +283,7 @@ where
#! heaps = {heaps & hp_var_heap = hp_var_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}} #! heaps = {heaps & hp_var_heap = hp_var_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}}
#! modules = { modules & [module_index] = common_defs } #! modules = { modules & [module_index] = common_defs }
= (dcl_modules, modules, heaps, cs) = (dcl_modules, modules, heaps, symbol_table)
convertInstances :: !*GenericState convertInstances :: !*GenericState
-> (![Global Index], !*GenericState) -> (![Global Index], !*GenericState)
......
...@@ -255,6 +255,8 @@ cNameLocationDependent :== True ...@@ -255,6 +255,8 @@ cNameLocationDependent :== True
, class_arg_kinds :: ![TypeKind] // filled in in checkKindCorrectness phase , class_arg_kinds :: ![TypeKind] // filled in in checkKindCorrectness phase
} }
:: ClassDefInfos :== {# .{! [TypeKind]}}
:: MemberDef = :: MemberDef =
{ me_symb :: !Ident { me_symb :: !Ident
, me_class :: !Global Index , me_class :: !Global Index
...@@ -858,7 +860,7 @@ cNonRecursiveAppl :== False ...@@ -858,7 +860,7 @@ cNonRecursiveAppl :== False
:: KindInfoPtr :== Ptr KindInfo :: KindInfoPtr :== Ptr KindInfo
:: KindInfo = KI_Var !KindInfoPtr :: KindInfo = KI_Var !KindInfoPtr
| KI_Arrow ![KindInfo] | KI_Arrow !KindInfo !KindInfo
| KI_Const | KI_Const
| KI_ConsVar | KI_ConsVar
...@@ -932,7 +934,7 @@ cNonRecursiveAppl :== False ...@@ -932,7 +934,7 @@ cNonRecursiveAppl :== False
:: BasicValue = BVI !String | BVC !String | BVB !Bool | BVR !String | BVS !String :: BasicValue = BVI !String | BVC !String | BVB !Bool | BVR !String | BVS !String
:: TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow ![TypeKind] :: TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow ![TypeKind] | KindCycle
instance toString TypeKind instance toString TypeKind
instance <<< TypeKind instance <<< TypeKind
......
...@@ -247,6 +247,8 @@ cNameLocationDependent :== True ...@@ -247,6 +247,8 @@ cNameLocationDependent :== True
, class_arg_kinds :: ![TypeKind] // filled in in checkKindCorrectness phase , class_arg_kinds :: ![TypeKind] // filled in in checkKindCorrectness phase
} }
:: ClassDefInfos :== {# .{! [TypeKind]}}
:: MemberDef = :: MemberDef =
{ me_symb :: !Ident { me_symb :: !Ident
, me_class :: !Global Index , me_class :: !Global Index
...@@ -839,7 +841,7 @@ cNotVarNumber :== -1 ...@@ -839,7 +841,7 @@ cNotVarNumber :== -1
:: KindInfoPtr :== Ptr KindInfo :: KindInfoPtr :== Ptr KindInfo
:: KindInfo = KI_Var !KindInfoPtr :: KindInfo = KI_Var !KindInfoPtr
| KI_Arrow ![KindInfo] | KI_Arrow !KindInfo !KindInfo
| KI_Const | KI_Const
| KI_ConsVar | KI_ConsVar
...@@ -917,8 +919,7 @@ cNotVarNumber :== -1 ...@@ -917,8 +919,7 @@ cNotVarNumber :== -1
:: BasicValue = BVI !String | BVC !String | BVB !Bool | BVR !String | BVS !String :: BasicValue = BVI !String | BVC !String | BVB !Bool | BVR !String | BVS !String
//:: TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow !Int :: TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow ![TypeKind] | KindCycle
:: TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow ![TypeKind]
:: Occurrence = :: Occurrence =
{ occ_ref_count :: !ReferenceCount { occ_ref_count :: !ReferenceCount
...@@ -935,7 +936,6 @@ cNotVarNumber :== -1 ...@@ -935,7 +936,6 @@ cNotVarNumber :== -1
:: OccurrenceBinding = OB_Empty | OB_OpenLet !Expression | OB_LockedLet !Expression :: OccurrenceBinding = OB_Empty | OB_OpenLet !Expression | OB_LockedLet !Expression
| OB_Pattern ![(FreeVar, Int)] !OccurrenceBinding | OB_Pattern ![(FreeVar, Int)] !OccurrenceBinding
// | OB_Closed !LetOccurrences | OB_Marked !LetOccurrences
:: TypeDefInfo = :: TypeDefInfo =
{ tdi_kinds :: ![TypeKind] { tdi_kinds :: ![TypeKind]
...@@ -1798,14 +1798,12 @@ where ...@@ -1798,14 +1798,12 @@ where