Commit dcf06742 authored by John van Groningen's avatar John van Groningen

refactor, add type MemberDefault, use it for field me_default_implementation...

refactor, add type MemberDefault, use it for field me_default_implementation instead of Optional MacroMember
parent 5b864e69
......@@ -362,28 +362,12 @@ where
instance_types n_icl_functions new_instance_members member_defs type_defs icl_functions modules var_heap type_heaps cs
= (ins_members,instance_types,n_icl_functions,new_instance_members,member_defs,type_defs,icl_functions,modules,var_heap,type_heaps,cs)
make_class_member_instance_type :: InstanceType SymbolType [TypeVar] z:{#CheckedTypeDef} u:{#DclModule} *VarHeap *TypeHeaps *CheckState
-> *(!SymbolType,!z:{#CheckedTypeDef},!u:{#DclModule},!*VarHeap,!*TypeHeaps,!*CheckState)
make_class_member_instance_type ins_type me_type me_class_vars type_defs modules var_heap type_heaps cs
# (instance_type, _, type_heaps, Yes (modules, type_defs), cs_error)
= determineTypeOfMemberInstance me_type me_class_vars ins_type SP_None type_heaps (Yes (modules, type_defs, cs.cs_x.x_main_dcl_module_n)) cs.cs_error
cs = {cs & cs_error = cs_error }
(st_context, var_heap) = initializeContextVariables instance_type.st_context var_heap
instance_type = { instance_type & st_context = st_context }
= (instance_type,type_defs,modules,var_heap,type_heaps,cs)
not_a_member_of_this_class_error ins_member=:{cim_index} icl_functions cs
| cim_index>=0 && cim_index<size icl_functions
# ({fun_ident,fun_pos},icl_functions) = icl_functions![ins_member.cim_index]
= (icl_functions,{cs & cs_error = checkErrorWithPosition fun_ident fun_pos (ins_member.cim_ident.id_name+++" is not a member of this class") cs.cs_error})
= (icl_functions,{cs & cs_error = checkError ins_member.cim_ident "not a member of this class" cs.cs_error})
add_default_instance_or_report_error_for_exported_instance class_member member_mod_index ins_type ins_pos
instance_member_n ins_members function_n instance_types member_defs type_defs icl_functions modules var_heap type_heaps cs=:{cs_x={x_main_dcl_module_n}}
# ({me_default_implementation,me_class_vars,me_type,me_priority,me_pos},member_defs,modules)
= getMemberDef member_mod_index class_member.ds_index x_main_dcl_module_n member_defs modules
= case me_default_implementation of
Yes {mm_ident}
MacroMemberDefault {mm_ident}
# (new_instance_member_ds,new_instance_member,instance_types,type_defs,modules,var_heap,type_heaps,cs)
= make_default_instance mm_ident me_type me_class_vars me_priority ins_pos
class_member ins_type function_n instance_types type_defs modules var_heap type_heaps cs
......@@ -393,7 +377,7 @@ where
new_instance_member_ds
\\ i<-[0..size ins_members-1] }
= (instance_member_n+1,ins_members,instance_types,member_defs,type_defs,icl_functions,modules,var_heap,type_heaps,cs)
No
NoMemberDefault
# cs = { cs & cs_error = checkError class_member.ds_ident "instance of class member expected" cs.cs_error}
= (instance_member_n+1,ins_members,instance_types,member_defs,type_defs,icl_functions,modules,var_heap,type_heaps,cs)
......@@ -402,7 +386,7 @@ where
# ({me_default_implementation,me_class_vars,me_type,me_priority,me_pos},member_defs,modules)
= getMemberDef member_mod_index class_member.ds_index x_main_dcl_module_n member_defs modules
= case me_default_implementation of
Yes {mm_ident}
MacroMemberDefault {mm_ident}
# (new_instance_member_ds,new_instance_member,instance_types,type_defs,modules,var_heap,type_heaps,cs)
= make_default_instance mm_ident me_type me_class_vars me_priority ins_pos
class_member ins_type n_icl_functions instance_types type_defs modules var_heap type_heaps cs
......@@ -415,10 +399,26 @@ where
)
\\ i<-[0..size ins_members] }
= (instance_member_n+1,ins_members,n_icl_functions+1,new_instance_members,instance_types,member_defs,type_defs,modules,var_heap,type_heaps,cs)
No
NoMemberDefault
# cs = { cs & cs_error = checkErrorWithPosition class_member.ds_ident ins_pos "instance of class member expected" cs.cs_error}
= (instance_member_n,ins_members,n_icl_functions,new_instance_members,instance_types,member_defs,type_defs,modules,var_heap,type_heaps,cs)
make_class_member_instance_type :: InstanceType SymbolType [TypeVar] z:{#CheckedTypeDef} u:{#DclModule} *VarHeap *TypeHeaps *CheckState
-> *(!SymbolType,!z:{#CheckedTypeDef},!u:{#DclModule},!*VarHeap,!*TypeHeaps,!*CheckState)
make_class_member_instance_type ins_type me_type me_class_vars type_defs modules var_heap type_heaps cs
# (instance_type, _, type_heaps, Yes (modules, type_defs), cs_error)
= determineTypeOfMemberInstance me_type me_class_vars ins_type SP_None type_heaps (Yes (modules, type_defs, cs.cs_x.x_main_dcl_module_n)) cs.cs_error
cs = {cs & cs_error = cs_error }
(st_context, var_heap) = initializeContextVariables instance_type.st_context var_heap
instance_type = { instance_type & st_context = st_context }
= (instance_type,type_defs,modules,var_heap,type_heaps,cs)
not_a_member_of_this_class_error ins_member=:{cim_index} icl_functions cs
| cim_index>=0 && cim_index<size icl_functions
# ({fun_ident,fun_pos},icl_functions) = icl_functions![ins_member.cim_index]
= (icl_functions,{cs & cs_error = checkErrorWithPosition fun_ident fun_pos (ins_member.cim_ident.id_name+++" is not a member of this class") cs.cs_error})
= (icl_functions,{cs & cs_error = checkError ins_member.cim_ident "not a member of this class" cs.cs_error})
make_default_instance :: Ident SymbolType [TypeVar] Priority Position DefinedSymbol InstanceType Int
![(Int,SymbolType)] !z:{#CheckedTypeDef} !u:{#DclModule} !*VarHeap !*TypeHeaps !*CheckState
-> (!ClassInstanceMember,!FunDef,![(Int,SymbolType)],!z:{#CheckedTypeDef},!u:{#DclModule},!*VarHeap,!*TypeHeaps,!*CheckState)
......@@ -431,14 +431,7 @@ where
new_instance_member_ds = {cim_ident = new_instance_ident, cim_arity = arity, cim_index = function_n}
(argument_pointers,symbol_table) = make_argument_pointers arity [] cs.cs_symbol_table
with
make_argument_pointers n argument_pointers symbol_table
| n==0
= (argument_pointers,symbol_table)
# ste = { ste_kind = STE_Empty, ste_index = -1, ste_def_level = -1, ste_previous = abort "ste_previous" }
# (argument_pointer,symbol_table) = newPtr ste symbol_table
= make_argument_pointers (n-1) [argument_pointer:argument_pointers] symbol_table
cs = { cs & cs_symbol_table=symbol_table }
cs & cs_symbol_table=symbol_table
arguments = [PE_Ident {id_name="_a"+++toString arg_n,id_info=argument_pointer}\\argument_pointer<-argument_pointers & arg_n<-[1..arity]]
empty_CollectedLocalDefs = CollectedLocalDefs {loc_functions={ir_from=0,ir_to=0},loc_nodes=[],loc_in_icl_module=True}
......@@ -466,6 +459,14 @@ where
instance_types = [(function_n,instance_type) : instance_types]
= (new_instance_member_ds,new_instance_member,instance_types,type_defs,modules,var_heap,type_heaps,cs)
make_argument_pointers :: !Int ![SymbolPtr] !*SymbolTable -> (![SymbolPtr],!*SymbolTable)
make_argument_pointers n argument_pointers symbol_table
| n==0
= (argument_pointers,symbol_table)
# ste = {ste_kind = STE_Empty, ste_index = -1, ste_def_level = -1, ste_previous = abort "ste_previous"}
# (argument_pointer,symbol_table) = newPtr ste symbol_table
= make_argument_pointers (n-1) [argument_pointer:argument_pointers] symbol_table
getClassDef :: !GlobalIndex !Int !u:{#ClassDef} !v:{#DclModule} -> (!ClassDef,!u:{#ClassDef},!v:{#DclModule})
getClassDef {gi_module,gi_index} mod_index class_defs modules
| gi_module == mod_index
......
......@@ -155,12 +155,11 @@ getBelongingSymbols (Declaration {decl_kind=STE_Imported STE_Class def_mod_index
add_default_class_member_macros class_member_n dcl_modules
| class_member_n<size class_members
# member_index=class_members.[class_member_n].ds_index
({me_default_implementation},dcl_modules)
= dcl_modules![def_mod_index].dcl_common.com_member_defs.[member_index]
({me_default_implementation},dcl_modules) = dcl_modules![def_mod_index].dcl_common.com_member_defs.[member_index]
= case me_default_implementation of
No
NoMemberDefault
-> add_default_class_member_macros (class_member_n+1) dcl_modules
Yes default_class_member_macro_ident_and_index
MacroMemberDefault default_class_member_macro_ident_and_index
#! n_members = size class_members
# default_member_indexes = createArray n_members -1
default_member_indexes & [class_member_n] = 0
......@@ -172,12 +171,11 @@ getBelongingSymbols (Declaration {decl_kind=STE_Imported STE_Class def_mod_index
add_more_default_class_member_macros class_member_n default_class_members default_member_n default_member_indexes dcl_modules
| class_member_n<size class_members
# member_index=class_members.[class_member_n].ds_index
({me_default_implementation}, dcl_modules)
= dcl_modules![def_mod_index].dcl_common.com_member_defs.[member_index]
({me_default_implementation}, dcl_modules) = dcl_modules![def_mod_index].dcl_common.com_member_defs.[member_index]
= case me_default_implementation of
No
NoMemberDefault
-> add_more_default_class_member_macros (class_member_n+1) default_class_members default_member_n default_member_indexes dcl_modules
Yes default_class_member_macro_ident_and_index
MacroMemberDefault default_class_member_macro_ident_and_index
# default_class_members = [|default_class_member_macro_ident_and_index:default_class_members]
default_member_indexes & [class_member_n] = default_member_n
-> add_more_default_class_member_macros (class_member_n+1) default_class_members (default_member_n+1) default_member_indexes dcl_modules
......
......@@ -231,8 +231,8 @@ where
= (False, icl_member_defs, comp_st)
= (False, icl_member_defs, comp_st)
compare_default_implementations No No = True
compare_default_implementations (Yes _) (Yes _) = True
compare_default_implementations NoMemberDefault NoMemberDefault = True
compare_default_implementations (MacroMemberDefault _) (MacroMemberDefault _) = True
compare_default_implementations _ _ = False
sort_clas_macro_members class_macro_members
......@@ -538,7 +538,7 @@ FirstHasMoreStrictness:==2;
CompareGenericCaseMacro:==4; // only used from ec_tc_state
:: TypesCorrespondMonad
:== *TypesCorrespondState -> *(!Bool, !*TypesCorrespondState)
:== *TypesCorrespondState -> *(Bool, *TypesCorrespondState)
:: ExpressionsCorrespondState =
{ ec_icl_correspondences :: !.{# Int },
......
......@@ -2029,7 +2029,7 @@ where
me_class_vars = [class_var], // the same variable as in the class
me_pos = gen_pos,
me_priority = NoPrio,
me_default_implementation = No
me_default_implementation = NoMemberDefault
}
= (member_def, gs)
......
......@@ -1541,9 +1541,9 @@ where
-> (![MemberDef],![FunDef],![(Ident,MacroMember,Position)],[!MacroMember!],!Int,!*CollectAdmin)
check_symbols_of_class_members [PD_TypeSpec pos name prio opt_type=:(Yes type=:{st_context,st_arity}) specials : defs] type_context macro_count ca
# (bodies, fun_kind, defs, ca) = collectFunctionBodies name st_arity prio FK_Unknown defs ca
| isEmpty bodies
| bodies=:[]
# mem_def = { me_ident = name, me_type = { type & st_context = [type_context : st_context ]}, me_pos = pos, me_priority = prio,
me_default_implementation = No,
me_default_implementation = NoMemberDefault,
me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr }
(mem_defs,mem_macros,default_members_without_type,macro_members,new_macro_count,ca)
= check_symbols_of_class_members defs type_context macro_count ca
......@@ -1562,7 +1562,7 @@ where
# macro = MakeNewImpOrDefFunction macro_ident st_arity bodies FK_Macro prio opt_type pos
# mem_def = { me_ident = name, me_type = { type & st_context = [type_context : st_context ]}, me_pos = pos, me_priority = prio,
me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex},
me_default_implementation = Yes {mm_ident=macro_ident,mm_index=macro_count}, me_type_ptr = nilPtr }
me_default_implementation = MacroMemberDefault {mm_ident=macro_ident,mm_index=macro_count}, me_type_ptr = nilPtr }
(mem_defs,mem_macros,default_members_without_type,macro_members,macro_count,ca)
= check_symbols_of_class_members defs type_context (macro_count+1) ca
= ([mem_def : mem_defs],[macro : mem_macros],default_members_without_type,macro_members,macro_count,ca)
......@@ -1609,8 +1609,8 @@ where
= add_default_members_without_type default_members_without_type mem_defs ca
where
add_default_member [mem_def:mem_defs] name ca
| mem_def.me_ident==name && case mem_def.me_default_implementation of No -> True; _ -> False
# mem_def = {mem_def & me_default_implementation = Yes macro_member}
| mem_def.me_ident==name && mem_def.me_default_implementation=:NoMemberDefault
# mem_def & me_default_implementation = MacroMemberDefault macro_member
= ([mem_def:mem_defs],ca)
# (mem_defs,ca) = add_default_member mem_defs name ca
= ([mem_def:mem_defs],ca)
......@@ -1662,7 +1662,7 @@ where
-> collect_member_instances defs (postParseError fun_pos "function body expected" ca)
collect_member_instances [PD_DeriveInstanceMember pos member_ident generic_ident : defs] ca
# fun_body = GenerateInstanceBody generic_ident
fun_def = {fun_ident = member_ident, fun_arity = 0, fun_priority = NoPrio, fun_type = No, fun_kind = (FK_Function False),
fun_def = {fun_ident = member_ident, fun_arity = 0, fun_priority = NoPrio, fun_type = No, fun_kind = FK_Function False,
fun_body = fun_body, fun_pos = pos, fun_lifted = 0, fun_info = EmptyFunInfo }
(fun_defs, ca) = collect_member_instances defs ca
= ([fun_def : fun_defs], ca)
......
......@@ -582,7 +582,7 @@ where
tc_types = [ TV class_var ], tc_var = nilPtr}],
st_attr_vars = [], st_attr_env = [] }
tc_member_def = { me_ident = tc_member_name, me_type = me_type, me_pos = NoPos, me_priority = NoPrio, me_default_implementation = No,
tc_member_def = { me_ident = tc_member_name, me_type = me_type, me_pos = NoPos, me_priority = NoPrio, me_default_implementation = NoMemberDefault,
me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr }
tc_class_def = { class_ident = tc_class_name, class_arity = 1, class_args = [class_var], class_context = [],
......
......@@ -401,6 +401,8 @@ cNameLocationDependent :== True
:: ClassDefInfos :== {# .{! [TypeKind]}}
:: MemberDefault = NoMemberDefault | MacroMemberDefault !MacroMember
:: MemberDef =
{ me_ident :: !Ident
, me_class :: !Global Index
......@@ -408,7 +410,7 @@ cNameLocationDependent :== True
, me_type :: !SymbolType
, me_type_ptr :: !VarInfoPtr
, me_class_vars :: ![TypeVar]
, me_default_implementation :: !Optional MacroMember
, me_default_implementation :: !MemberDefault
, me_pos :: !Position
, me_priority :: !Priority
}
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment