Commit 7a3e3a39 authored by Artem Alimarine's avatar Artem Alimarine
Browse files

Generics are added, but are disabled.

Tested with compiling Object IO and butstrapping.
parent fe32f6bc
......@@ -4,4 +4,3 @@ import checksupport, typesupport
analTypeDefs :: !{#CommonDefs} !NumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
instance <<< TypeKind
......@@ -10,21 +10,6 @@ import syntax, checksupport, checktypes, check, typesupport, utilities, analunit
AS_NotChecked :== -1
instance <<< TypeKind
where
(<<<) file tk = file <<< toString (toKindInfo tk)
instance toString KindInfo
where
toString (KI_Var ptr) = "*" +++ toString (ptrToInt ptr)
toString (KI_Const) = "*"
toString (KI_Arrow kinds) = kind_list_to_string kinds
where
kind_list_to_string [] = " ?????? "
kind_list_to_string [k] = "* -> *"
kind_list_to_string [k:ks] = "* -> " +++ kind_list_to_string ks
kindError kind1 kind2 error
= checkError "conflicting kinds: " (toString kind1 +++ " and " +++ toString kind2) error
......@@ -70,8 +55,8 @@ where
= KI_Var info_ptr
toKindInfo KindConst
= KI_Const
toKindInfo (KindArrow arity)
= KI_Arrow [ KI_Const \\ i <- [1 .. arity]]
toKindInfo (KindArrow ks)
= KI_Arrow [ toKindInfo k \\ k <- ks]
// ---> ("toKindInfo", arity)
......@@ -373,7 +358,8 @@ where
determine_kind (KI_Indirection kind)
= determine_kind kind
determine_kind (KI_Arrow kinds)
= KindArrow (length kinds)
//AA: = KindArrow (length kinds)
= KindArrow [determine_kind k \\ k <- kinds]
determine_kind kind
= KindConst
......
......@@ -14,3 +14,5 @@ determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials
arrayFunOffsetToPD_IndexTable :: !w:{# MemberDef} !v:{# PredefinedSymbol} -> (!{# Index}, !x:{#MemberDef}, !v:{#PredefinedSymbol}) , [w<=x]
makeElemTypeOfArrayFunctionStrict :: !SymbolType !Index !{# Index} -> SymbolType
initializeContextVariables :: ![TypeContext] !*VarHeap -> (![TypeContext], !*VarHeap)
......@@ -13,7 +13,47 @@ isMainModule :: ModuleKind -> Bool
isMainModule MK_Main = True
isMainModule _ = False
// AA..
checkGenerics :: !Index !Index !*{#GenericDef} !*{#ClassDef} !*{#CheckedTypeDef} !*{#DclModule} !*TypeHeaps !*CheckState
-> (!*{#GenericDef}, !*{#ClassDef}, !*{#CheckedTypeDef}, !*{#DclModule}, !*TypeHeaps, !*CheckState)
checkGenerics
gen_index module_index generic_defs class_defs type_defs modules
type_heaps=:{th_vars}
cs=:{cs_symbol_table, cs_error}
| gen_index == size generic_defs
= (generic_defs, class_defs, type_defs, modules, type_heaps, cs)
// otherwise
# (gen_def=:{gen_name, gen_args, gen_type,gen_pos}, generic_defs) = generic_defs![gen_index]
# position = newPosition gen_name gen_pos
# cs_error = setErrorAdmin position cs_error
# (gen_args, cs_symbol_table, th_vars, cs_error)
= add_vars_to_symbol_table gen_args cs_symbol_table th_vars cs_error
# cs = {cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }
# type_heaps = {type_heaps & th_vars = th_vars}
# (gen_type, specials, type_defs, class_defs, modules, type_heaps, cs) =
checkSymbolType module_index gen_type SP_None type_defs class_defs modules type_heaps cs
# cs = {cs & cs_symbol_table = removeVariablesFromSymbolTable cGlobalScope gen_args cs.cs_symbol_table}
# generic_defs = {generic_defs & [gen_index] = {gen_def & gen_type = gen_type, gen_args = gen_args}}
= checkGenerics (inc gen_index) module_index generic_defs class_defs type_defs modules type_heaps cs
where
add_vars_to_symbol_table [] symbol_table th_vars error = ([], symbol_table, th_vars, error)
add_vars_to_symbol_table [var=:{tv_name={id_name,id_info}} : vars] symbol_table th_vars error
# (entry, symbol_table) = readPtr id_info symbol_table
| entry.ste_kind == STE_Empty || entry.ste_def_level < cGlobalScope
# (new_var_ptr, th_vars) = newPtr TVI_Empty th_vars
# symbol_table = NewEntry symbol_table id_info (STE_TypeVariable new_var_ptr) NoIndex cGlobalScope entry
# var = { var & tv_info_ptr = new_var_ptr}
# (vars, symbol_table, th_vars, error) = add_vars_to_symbol_table vars symbol_table th_vars error
= ([var:vars], symbol_table, th_vars, error)
// otherwise
= add_vars_to_symbol_table vars symbol_table th_vars (checkError id_name "(variable) already defined" error)
// ..AA
checkTypeClasses :: !Index !Index !*{#ClassDef} !*{#MemberDef} !*{#CheckedTypeDef} !*{#DclModule} !*TypeHeaps !*CheckState
-> (!*{#ClassDef}, !*{#MemberDef}, !*{#CheckedTypeDef}, !*{#DclModule}, !*TypeHeaps, !*CheckState)
......@@ -169,9 +209,124 @@ where
{ is_type_defs :: !.{# CheckedTypeDef}
, is_class_defs :: !.{# ClassDef}
, is_member_defs :: !.{# MemberDef}
, is_generic_defs :: !.{# GenericDef} // AA
, is_modules :: !.{# DclModule}
}
// AA..
checkInstanceDefs :: !Index !*{#ClassInstance} !u:{#CheckedTypeDef} !u:{#ClassDef} !u:{#MemberDef} /*AA*/!u:{#GenericDef} !u:{#DclModule} !*TypeHeaps !*CheckState
-> (!.{#ClassInstance},!u:{#CheckedTypeDef},!u:{#ClassDef},!u:{#MemberDef}, /*AA*/!u:{#GenericDef}, !u:{#DclModule},!.TypeHeaps,!.CheckState)
checkInstanceDefs mod_index instance_defs type_defs class_defs member_defs generic_defs modules type_heaps cs
# is = { is_type_defs = type_defs, is_class_defs = class_defs, is_member_defs = member_defs, /*AA*/is_generic_defs = generic_defs, is_modules = modules }
(instance_defs, is, type_heaps, cs) = check_instance_defs 0 mod_index instance_defs is type_heaps cs
= (instance_defs, is.is_type_defs, is.is_class_defs, is.is_member_defs, /*AA*/is.is_generic_defs, is.is_modules, type_heaps, cs)
where
check_instance_defs :: !Index !Index !*{# ClassInstance} !u:InstanceSymbols !*TypeHeaps !*CheckState
-> (!*{# ClassInstance},!u:InstanceSymbols,!*TypeHeaps,!*CheckState)
check_instance_defs inst_index mod_index instance_defs is type_heaps cs
| inst_index < size instance_defs
# (instance_def, instance_defs) = instance_defs![inst_index]
(instance_def, is, type_heaps, cs) = check_instance mod_index instance_def is type_heaps cs
= check_instance_defs (inc inst_index) mod_index { instance_defs & [inst_index] = instance_def } is type_heaps cs
= (instance_defs, is, type_heaps, cs)
check_instance :: !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState)
check_instance module_index
ins=:{ins_members,ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident}
is=:{is_class_defs,is_generic_defs, is_modules} type_heaps cs=:{cs_symbol_table}
# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table
# cs = pushErrorAdmin (newPosition ins_ident ins_pos) { cs & cs_symbol_table = cs_symbol_table }
# (ins, is, type_heaps, cs) = case entry.ste_kind of
STE_Class
# (class_def, is) = class_by_index entry.ste_index is
-> check_class_instance class_def module_index entry.ste_index module_index ins is type_heaps cs
STE_Imported STE_Class dcl_index
# (class_def, is) = class_by_module_index dcl_index entry.ste_index is
-> check_class_instance class_def module_index entry.ste_index dcl_index ins is type_heaps cs
STE_Generic
# (generic_def, is) = generic_by_index entry.ste_index is
-> check_generic_instance generic_def module_index entry.ste_index module_index ins is type_heaps cs
STE_Imported STE_Generic dcl_index
# (gen_def, is) = generic_by_module_index dcl_index entry.ste_index is
-> check_generic_instance gen_def module_index entry.ste_index dcl_index ins is type_heaps cs
ste -> (ins, is, type_heaps, { cs & cs_error = checkError id_name "class or generic undefined" cs.cs_error })
= (ins, is, type_heaps, popErrorAdmin cs)
where
class_by_index class_index is=:{is_class_defs}
# (class_def, is_class_defs) = is_class_defs![class_index]
= (class_def, {is & is_class_defs = is_class_defs})
class_by_module_index dcl_index class_index is=:{is_modules}
# (dcl_mod, is_modules) = is_modules![dcl_index]
class_def = dcl_mod.dcl_common.com_class_defs.[class_index]
= (class_def, {is & is_modules = is_modules })
generic_by_index gen_index is=:{is_generic_defs}
# (gen_def, is_generic_defs) = is_generic_defs![gen_index]
= (gen_def, {is & is_generic_defs = is_generic_defs})
generic_by_module_index dcl_index gen_index is=:{is_modules}
# (dcl_mod, is_modules) = is_modules![dcl_index]
gen_def = dcl_mod.dcl_common.com_generic_defs.[gen_index]
= (gen_def, {is & is_modules = is_modules })
check_class_instance :: ClassDef !Index !Index !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState
-> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState)
check_class_instance class_def module_index class_index class_mod_index
ins=:{ins_members,ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident,ins_generate}
is=:{is_class_defs,is_modules} type_heaps cs=:{cs_symbol_table}
| ins_generate
= ( ins
, is
, type_heaps
, { cs & cs_error = checkError id_name "cannot generate class instance" cs.cs_error }
)
| class_def.class_arity == ds_arity
# ins_class = { glob_object = { class_name & ds_index = class_index }, glob_module = class_mod_index}
(ins_type, ins_specials, is_type_defs, is_class_defs, is_modules, type_heaps, cs)
= checkInstanceType module_index ins_class ins_type ins_specials
is.is_type_defs is.is_class_defs is.is_modules type_heaps cs
is = { is & is_type_defs = is_type_defs, is_class_defs = is_class_defs, is_modules = is_modules }
= ({ins & ins_class = ins_class, ins_type = ins_type, ins_specials = ins_specials}, is, type_heaps, cs)
// otherwise
= ( ins
, is
, type_heaps
, { cs & cs_error = checkError id_name ("wrong arity: expected "+++toString class_def.class_arity+++" found "+++toString ds_arity) cs.cs_error }
)
check_generic_instance :: GenericDef !Index !Index !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState)
check_generic_instance
class_def module_index generic_index generic_module_index
ins=:{
ins_members,
ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity, ds_index} },
ins_type,
ins_specials,
ins_pos,
ins_ident,
ins_is_generic}
is=:{is_class_defs,is_modules}
type_heaps
cs=:{cs_symbol_table, cs_error}
# class_name = {class_name & ds_index = generic_index}
# ins_class = { glob_object = class_name, glob_module = generic_module_index}
| ds_arity == 1
# (ins_type, ins_specials, is_type_defs, is_class_defs, is_modules, type_heaps, cs)
= checkInstanceType module_index ins_class ins_type ins_specials
is.is_type_defs is.is_class_defs is.is_modules type_heaps cs
# is = { is & is_type_defs = is_type_defs, is_class_defs = is_class_defs, is_modules = is_modules }
# ins = { ins &
ins_is_generic = True,
ins_generic = {glob_module = module_index, glob_object = generic_index},
ins_class = ins_class,
ins_type = ins_type,
ins_specials = ins_specials
}
= (ins, is, type_heaps, cs)
// otherwise
# cs_error = checkError id_name "arity of generic instance must be 1" cs_error
# cs = {cs & cs_error = cs_error}
= (ins, is, type_heaps, cs)
/*
checkInstanceDefs :: !Index !*{#ClassInstance} !u:{#CheckedTypeDef} !u:{#ClassDef} !u:{#MemberDef} !u:{#DclModule} !*TypeHeaps !*CheckState
-> (!.{#ClassInstance},!u:{#CheckedTypeDef},!u:{#ClassDef},!u:{#MemberDef},!u:{#DclModule},!.TypeHeaps,!.CheckState)
checkInstanceDefs mod_index instance_defs type_defs class_defs member_defs modules type_heaps cs
......@@ -221,32 +376,70 @@ where
= (ste_index, dcl_index, class_def, class_defs, modules)
get_class_def _ mod_index class_defs modules
= (NotFound, -1/*cIclModIndex*/, abort "no class definition", class_defs, modules)
*/
checkInstances :: !Index !*CommonDefs !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
-> (![(Index,SymbolType)], !*CommonDefs, !u:{# DclModule}, !*VarHeap , !*TypeHeaps, !*CheckState)
checkInstances mod_index icl_common=:{com_instance_defs,com_class_defs,com_member_defs} modules var_heap type_heaps cs=:{cs_error}
checkInstances mod_index icl_common=:{com_instance_defs,com_class_defs,com_member_defs,/*AA*/com_generic_defs} modules var_heap type_heaps cs=:{cs_error}
| cs_error.ea_ok
# (instance_types, com_instance_defs, com_class_defs, com_member_defs, modules, var_heap, type_heaps, cs)
= check_instances 0 mod_index [] com_instance_defs com_class_defs com_member_defs modules var_heap type_heaps cs
= (instance_types, { icl_common & com_instance_defs = com_instance_defs,com_class_defs = com_class_defs,com_member_defs = com_member_defs },
# (instance_types, com_instance_defs, com_class_defs, com_member_defs, com_generic_defs, modules, var_heap, type_heaps, cs)
= check_instances 0 mod_index [] com_instance_defs com_class_defs com_member_defs /*AA*/com_generic_defs modules var_heap type_heaps cs
= (instance_types, { icl_common & com_instance_defs = com_instance_defs,com_class_defs = com_class_defs,com_member_defs = com_member_defs, /*AA*/com_generic_defs = com_generic_defs },
modules, var_heap, type_heaps, cs)
= ([], icl_common, modules, var_heap, type_heaps, cs)
where
check_instances :: !Index !Index ![(Index,SymbolType)] !x:{# ClassInstance} !w:{# ClassDef} !v:{# MemberDef} !u:{# DclModule}
check_instances :: !Index !Index ![(Index,SymbolType)] !x:{# ClassInstance} !w:{# ClassDef} !v:{# MemberDef} /*AA*/!w:{# GenericDef} !u:{# DclModule}
!*VarHeap !*TypeHeaps !*CheckState
-> (![(Index,SymbolType)], !x:{# ClassInstance}, !w:{# ClassDef}, !v:{# MemberDef}, !u:{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState)
check_instances inst_index mod_index instance_types instance_defs class_defs member_defs modules var_heap type_heaps cs
-> (![(Index,SymbolType)], !x:{# ClassInstance}, !w:{# ClassDef}, !v:{# MemberDef}, /*AA*/!w:{# GenericDef}, !u:{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState)
check_instances inst_index mod_index instance_types instance_defs class_defs member_defs generic_defs modules var_heap type_heaps cs
/*
| inst_index < size instance_defs
# ({ins_class,ins_members,ins_type}, instance_defs) = instance_defs![inst_index]
# ({ins_class,ins_members,ins_type, /*AA*/ins_generic}, instance_defs) = instance_defs![inst_index]
# ({class_members,class_name}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules
class_size = size class_members
| class_size == size ins_members
# (instance_types, member_defs, modules, var_heap, type_heaps, cs) = check_member_instances mod_index ins_class.glob_module
0 class_size ins_members class_members ins_type instance_types member_defs modules var_heap type_heaps cs
= check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs modules var_heap type_heaps cs
= check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs modules var_heap type_heaps
= check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs /*AA*/generic_defs modules var_heap type_heaps cs
= check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs /*AA*/generic_defs modules var_heap type_heaps
{ cs & cs_error = checkError class_name "different number of members specified" cs.cs_error }
= (instance_types, instance_defs, class_defs, member_defs, modules, var_heap, type_heaps, cs)
= (instance_types, instance_defs, class_defs, member_defs, /*AA*/generic_defs, modules, var_heap, type_heaps, cs)
*/
// AA..
| inst_index < size instance_defs
# (instance_def=:{ins_is_generic}, instance_defs) = instance_defs![inst_index]
# (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs) =
(if ins_is_generic check_generic_instance check_class_instance)
instance_def mod_index instance_types class_defs member_defs generic_defs modules var_heap type_heaps cs
= check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs generic_defs modules var_heap type_heaps cs
// otherwise
= (instance_types, instance_defs, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs)
check_class_instance {ins_class,ins_members,ins_type} mod_index instance_types class_defs member_defs generic_defs modules var_heap type_heaps cs
# ({class_members,class_name}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules
class_size = size class_members
| class_size == size ins_members
# (instance_types, member_defs, modules, var_heap, type_heaps, cs) = check_member_instances mod_index ins_class.glob_module
0 class_size ins_members class_members ins_type instance_types member_defs modules var_heap type_heaps cs
= (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs)
// otherwise
# cs = { cs & cs_error = checkError class_name "different number of members specified" cs.cs_error }
= (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs)
check_generic_instance {ins_class, ins_members, ins_generate} mod_index instance_types class_defs member_defs generic_defs modules var_heap type_heaps cs
# ({gen_name, gen_member_name}, generic_defs, modules) = getGenericDef ins_class mod_index generic_defs modules
| ins_generate
= (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs)
| size ins_members <> 1
# cs = { cs & cs_error = checkError gen_name "generic instance must have one memeber" cs.cs_error }
= (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs)
# member_name = ins_members.[0].ds_ident
| member_name <> gen_member_name
# cs = { cs & cs_error = checkError member_name "wrong member name" cs.cs_error }
= (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs)
// otherwise
= (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs)
// ..AA
check_member_instances :: !Index !Index !Int !Int !{#DefinedSymbol} !{#DefinedSymbol} !InstanceType ![(Index,SymbolType)]
!v:{# MemberDef} !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
......@@ -272,6 +465,7 @@ where
= check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members ins_type
[ (ins_member.ds_index, { instance_type & st_context = st_context }) : instance_types ] member_defs modules var_heap type_heaps cs
getClassDef :: !(Global DefinedSymbol) !Int !u:{#ClassDef} !v:{#DclModule} -> (!ClassDef,!u:{#ClassDef},!v:{#DclModule})
getClassDef {glob_module, glob_object={ds_ident, ds_index}} mod_index class_defs modules
| glob_module == mod_index
......@@ -288,6 +482,16 @@ getMemberDef mem_mod mem_index mod_index member_defs modules
# (dcl_mod,modules) = modules![mem_mod]
= (dcl_mod.dcl_common.com_member_defs.[mem_index], member_defs, modules)
// AA..
getGenericDef :: !(Global DefinedSymbol) !Int !u:{#GenericDef} !v:{#DclModule} -> (!GenericDef,!u:{#GenericDef},!v:{#DclModule})
getGenericDef {glob_module, glob_object={ds_ident, ds_index}} mod_index generic_defs modules
| glob_module == mod_index
# (generic_def, generic_defs) = generic_defs![ds_index]
= (generic_def, generic_defs, modules)
# (dcl_mod, modules) = modules![glob_module]
= (dcl_mod.dcl_common.com_generic_defs.[ds_index], generic_defs, modules)
// ..AA
instantiateTypes :: ![TypeVar] ![AttributeVar] !types ![TypeContext] ![AttrInequality] !SpecialSubstitution ![SpecialSubstitution] !*TypeHeaps
-> (![TypeVar], ![AttributeVar], !types , ![TypeContext], ![AttrInequality], ![SpecialSubstitution], !*TypeHeaps) | substitute types
instantiateTypes old_type_vars old_attr_vars types type_contexts attr_env {ss_environ, ss_vars, ss_attrs, ss_context} special_subst_list type_heaps=:{th_vars, th_attrs}
......@@ -563,13 +767,14 @@ instance < FunDef
where
(<) fd1 fd2 = fd1.fun_symb.id_name < fd2.fun_symb.id_name
createCommonDefinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances}
createCommonDefinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances, def_generics}
= { com_type_defs = { type \\ type <- def_types }
, com_cons_defs = { cons \\ cons <- def_constructors }
, com_selector_defs = { sel \\ sel <- def_selectors }
, com_class_defs = { class_def \\ class_def <- def_classes }
, com_member_defs = { member \\ member <- def_members }
, com_instance_defs = { next_instance \\ next_instance <- def_instances }
, com_generic_defs = { gen \\ gen <- def_generics }
}
array_plus_list a [] = a
......@@ -586,9 +791,13 @@ checkCommonDefinitions is_dcl module_index common modules type_heaps var_heap cs
= checkTypeClasses 0 module_index common.com_class_defs common.com_member_defs com_type_defs modules type_heaps cs
(com_member_defs, com_type_defs, com_class_defs, modules, type_heaps, var_heap, cs)
= checkMemberTypes module_index com_member_defs com_type_defs com_class_defs modules type_heaps var_heap cs
(com_instance_defs, com_type_defs, com_class_defs, com_member_defs, modules, type_heaps, cs)
= checkInstanceDefs module_index common.com_instance_defs com_type_defs com_class_defs com_member_defs modules type_heaps cs
// AA..
(com_generic_defs, com_class_defs, com_type_defs, modules, type_heaps, cs)
= checkGenerics 0 module_index common.com_generic_defs com_class_defs com_type_defs modules type_heaps cs
// ..AA
(com_instance_defs, com_type_defs, com_class_defs, com_member_defs, /*AA*/com_generic_defs, modules, type_heaps, cs)
= checkInstanceDefs module_index common.com_instance_defs com_type_defs com_class_defs com_member_defs /*AA*/com_generic_defs modules type_heaps cs
(size_com_type_defs,com_type_defs) = usize com_type_defs
(size_com_selector_defs,com_selector_defs) = usize com_selector_defs
(size_com_cons_defs,com_cons_defs) = usize com_cons_defs
......@@ -602,10 +811,10 @@ checkCommonDefinitions is_dcl module_index common modules type_heaps var_heap cs
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,
com_member_defs = com_member_defs, com_instance_defs = com_instance_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)
collectCommonfinitions :: !(CollectedDefinitions ClassInstance a) -> (!*{# Int}, ![Declaration])
collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances}
collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances, def_generics}
// MW: the order in which the declarations appear in the returned list is essential (explicit imports)
# sizes = createArray cConversionTableSize 0
(size, defs) = foldSt cons_def_to_dcl def_constructors (0, [])
......@@ -620,6 +829,10 @@ collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_
sizes = { sizes & [cClassDefs] = size }
(size, defs) = foldSt instance_def_to_dcl def_instances (0, defs)
sizes = { sizes & [cInstanceDefs] = size }
// AA..
(size, defs) = foldSt generic_def_to_dcl def_generics (0, defs)
sizes = { sizes & [cGenericDefs] = size }
// ..AA
= (sizes, defs)
where
type_def_to_dcl {td_name, td_pos} (dcl_index, decls)
......@@ -635,6 +848,13 @@ where
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])
// AA..
generic_def_to_dcl {gen_name, gen_member_name, gen_type, gen_pos} (dcl_index, decls)
# generic_decl = { dcl_ident = gen_name, dcl_pos = gen_pos, dcl_kind = STE_Generic, dcl_index = dcl_index }
# member_decl = { dcl_ident = gen_member_name, dcl_pos = gen_pos, dcl_kind = STE_Generic, dcl_index = dcl_index }
= (inc dcl_index, [generic_decl, member_decl : decls])
// ..AA
collectMacros {ir_from,ir_to} macro_defs sizes_defs
= collectGlobalFunctions cMacroDefs ir_from ir_to macro_defs sizes_defs
......@@ -720,17 +940,25 @@ renumber_icl_definitions_as_dcl_definitions _ icl_decl_symbols modules cdefs icl
# class_def = {class_def & class_members=class_members}
# cdefs = {cdefs & com_class_defs.[dcl_index] =class_def}
= ({icl_decl_symbol & dcl_index=icl_to_dcl_index_table.[cClassDefs,dcl_index]},cdefs)
// AA..
renumber_icl_decl_symbol icl_decl_symbol=:{dcl_kind = STE_Generic, dcl_index} cdefs
= ({icl_decl_symbol & dcl_index=icl_to_dcl_index_table.[cGenericDefs,dcl_index]},cdefs)
---> ("renumber_icl_decl_symbol: " +++ icl_decl_symbol.dcl_ident.id_name)
// ..AA
renumber_icl_decl_symbol icl_decl_symbol cdefs
= (icl_decl_symbol,cdefs)
# cdefs=reorder_common_definitions cdefs
with
reorder_common_definitions {com_type_defs,com_cons_defs,com_selector_defs,com_class_defs,com_member_defs,com_instance_defs}
reorder_common_definitions {com_type_defs,com_cons_defs,com_selector_defs,com_class_defs,com_member_defs,com_instance_defs, /* AA */ com_generic_defs}
# com_type_defs=reorder_array com_type_defs icl_to_dcl_index_table.[cTypeDefs]
# com_cons_defs=reorder_array com_cons_defs icl_to_dcl_index_table.[cConstructorDefs]
# com_selector_defs=reorder_array com_selector_defs icl_to_dcl_index_table.[cSelectorDefs]
# com_class_defs=reorder_array com_class_defs icl_to_dcl_index_table.[cClassDefs]
# com_member_defs=reorder_array com_member_defs icl_to_dcl_index_table.[cMemberDefs]
= {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}
# com_generic_defs=reorder_array com_generic_defs icl_to_dcl_index_table.[cGenericDefs] // AA
= { 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,
com_generic_defs = com_generic_defs/*AA*/}
where
reorder_array array index_array
# new_array={e\\e<-:array}
......@@ -753,8 +981,8 @@ combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs
(moved_dcl_defs, conversion_table, icl_sizes, icl_decl_symbols, cs)
= foldSt (add_to_conversion_table dcl_macros.ir_from dcl_common) dcls_local ([], { createArray size NoIndex \\ size <-: dcl_sizes }, icl_sizes, icl_decl_symbols, cs)
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs)
= foldSt (add_dcl_definition dcl_common) moved_dcl_defs ([], [], [], [], [], cs)
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, /*AA*/new_generic_defs, cs)
= foldSt (add_dcl_definition dcl_common) moved_dcl_defs ([], [], [], [], [], /*AA*/[],cs)
cs_symbol_table
= removeDeclarationsFromSymbolTable icl_decl_symbols cGlobalScope cs.cs_symbol_table
......@@ -766,6 +994,7 @@ combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs
, def_selectors = my_append icl_definitions.def_selectors new_selector_defs
, def_classes = my_append icl_definitions.def_classes new_class_defs
, def_members = my_append icl_definitions.def_members new_member_defs
, def_generics = my_append icl_definitions.def_generics new_generic_defs // AA
}
, icl_sizes
, { cs & cs_symbol_table = cs_symbol_table }
......@@ -799,7 +1028,7 @@ where
can_be_only_in_dcl def_kind
= def_kind == cTypeDefs || def_kind == cConstructorDefs || def_kind == cSelectorDefs
|| def_kind == cClassDefs || def_kind == cMemberDefs
|| def_kind == cClassDefs || def_kind == cMemberDefs /*AA*/ || def_kind == cGenericDefs
is_abstract_type com_type_defs dcl_index
= case com_type_defs.[dcl_index].td_rhs of (AbstractType _) -> True ; _ -> False
......@@ -819,10 +1048,10 @@ where
)
add_dcl_definition {com_type_defs} dcl=:{dcl_kind = STE_Type, dcl_index}
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs)
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, cs)
# type_def = com_type_defs.[dcl_index]
(new_type_defs, cs) = add_type_def type_def new_type_defs cs
= (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs)
= (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, cs)
where
add_type_def td=:{td_pos, td_rhs = AlgType conses} new_type_defs cs
# (conses, cs) = mapSt (redirect_defined_symbol STE_Constructor td_pos) conses cs
......@@ -855,27 +1084,34 @@ where
is_field _ = False
add_dcl_definition {com_cons_defs} dcl=:{dcl_kind = STE_Constructor, dcl_index}
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs)
= (new_type_defs, new_class_defs, [ com_cons_defs.[dcl_index] : new_cons_defs ], new_selector_defs, new_member_defs, cs)
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, cs)
= (new_type_defs, new_class_defs, [ com_cons_defs.[dcl_index] : new_cons_defs ], new_selector_defs, new_member_defs, new_generic_defs, cs)
add_dcl_definition {com_selector_defs} dcl=:{dcl_kind = STE_Field _, dcl_index}
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs)
= (new_type_defs, new_class_defs, new_cons_defs, [ com_selector_defs.[dcl_index] : new_selector_defs ], new_member_defs, cs)
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, cs)
= (new_type_defs, new_class_defs, new_cons_defs, [ com_selector_defs.[dcl_index] : new_selector_defs ], new_member_defs, new_generic_defs, cs)
add_dcl_definition {com_class_defs} dcl=:{dcl_kind = STE_Class, dcl_index, dcl_pos}
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs)
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, cs)
# class_def = com_class_defs.[dcl_index]
(new_class_defs, cs) = add_class_def dcl_pos class_def new_class_defs cs
= (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs)
= (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, cs)
where
add_class_def dcl_pos cd=:{class_members} new_class_defs cs
# (new_class_members, cs) = mapSt (redirect_defined_symbol STE_Member dcl_pos) [ cm \\ cm<-:class_members ] cs
= ([{cd & class_members={cm \\ cm<-new_class_members}}:new_class_defs], cs)
add_dcl_definition {com_member_defs} dcl=:{dcl_kind = STE_Member, dcl_index, dcl_pos}
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs)
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, cs)
# member_def = com_member_defs.[dcl_index]
= (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, [member_def:new_member_defs], cs)
= (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, [member_def:new_member_defs], new_generic_defs, cs)
// AA..
add_dcl_definition {com_generic_defs} dcl=:{dcl_kind = STE_Generic, dcl_index, dcl_pos}
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, cs)
# generic_def = com_generic_defs.[dcl_index]
= (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, [generic_def:new_generic_defs], cs)
// ..AA
add_dcl_definition _ _
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs)
= (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs)
(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, cs)
= (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, cs)
redirect_defined_symbol req_kind pos ds=:{ds_ident} cs
# ({ste_kind,ste_index}, cs_symbol_table) = readPtr ds_ident.id_info cs.cs_symbol_table
......@@ -1309,6 +1545,8 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde
<=< adjust_predefined_module_symbol PD_StdEnum
<=< adjust_predefined_module_symbol PD_StdBool
<=< adjust_predefined_module_symbol PD_StdDynamics
<=< adjust_predefined_module_symbol PD_StdGeneric // AA
<=< adjust_predefined_module_symbol PD_StdMisc // AA
<=< adjust_predefined_module_symbol PD_PredefinedModule
= ([], macro_and_fun_defs, { cs & cs_predef_symbols = cs_predef_symbols, cs_symbol_table = cs_symbol_table})
where
......@@ -1507,8 +1745,9 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func
heaps = { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap }
e_info = { ef_type_defs = icl_common.com_type_defs, ef_selector_defs = icl_common.com_selector_defs, ef_class_defs = icl_common.com_class_defs,
ef_cons_defs = icl_common.com_cons_defs, ef_member_defs = icl_common.com_member_defs, ef_modules = dcl_modules,
ef_is_macro_fun = False }
ef_cons_defs = icl_common.com_cons_defs, ef_member_defs = icl_common.com_member_defs,
ef_generic_defs = icl_common.com_generic_defs, //AA
ef_modules = dcl_modules, ef_is_macro_fun = False }