Skip to content
GitLab
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
Hide whitespace changes
Inline Side-by-side
frontend/analtypes.dcl
View file @ 7a3e3a39
......@@ -4,4 +4,3 @@ import checksupport, typesupport
analTypeDefs :: !{#CommonDefs} !NumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
instance <<< TypeKind
frontend/analtypes.icl
View file @ 7a3e3a39
......@@ -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
......
frontend/check.dcl
View file @ 7a3e3a39
......@@ -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)
frontend/check.icl
View file @ 7a3e3a39
......@@ -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 }