Commit 4b6ccbe7 authored by John van Groningen's avatar John van Groningen

refactor, move some code to (new) functions

parent 4aa1883e
......@@ -433,17 +433,8 @@ where
# (instance_type,type_defs,modules,var_heap,type_heaps,cs)
= make_class_member_instance_type ins_type me_type me_class_vars type_defs modules var_heap type_heaps cs
(new_instance_member_ds,new_instance_member,ins_member_types_and_functions,cs)
= case me_default_implementation of
MacroMemberDefault {mm_ident}
# (new_instance_member_ds,new_instance_member,cs)
= make_default_instance instance_type.st_arity mm_ident me_priority ins_pos class_member function_n cs
-> (new_instance_member_ds,new_instance_member,ins_member_types_and_functions,cs)
DeriveDefault generic_ident generic_index optional_member_ident_global_index
# ins_member_types_and_functions = GenerateInstanceMember instance_member_n function_n ins_member_types_and_functions
# fun_body = GenerateInstanceBodyChecked generic_ident generic_index optional_member_ident_global_index
# (new_instance_member_ds,new_instance_member,cs)
= make_derived_default_instance instance_type.st_arity fun_body me_priority ins_pos class_member function_n cs
-> (new_instance_member_ds,new_instance_member,ins_member_types_and_functions,cs)
= make_default_implementation me_default_implementation me_priority ins_pos class_member function_n instance_type.st_arity
instance_member_n ins_member_types_and_functions cs
icl_functions & [function_n] = new_instance_member
ins_members = { if (i<>instance_member_n) ins_members.[i] new_instance_member_ds \\ i<-[0..size ins_members-1] }
instance_types = [(function_n,instance_type) : instance_types]
......@@ -459,17 +450,8 @@ where
# (instance_type,type_defs,modules,var_heap,type_heaps,cs)
= make_class_member_instance_type ins_type me_type me_class_vars type_defs modules var_heap type_heaps cs
(new_instance_member_ds,new_instance_member,ins_member_types_and_functions,cs)
= case me_default_implementation of
MacroMemberDefault {mm_ident}
# (new_instance_member_ds,new_instance_member,cs)
= make_default_instance instance_type.st_arity mm_ident me_priority ins_pos class_member n_icl_functions cs
-> (new_instance_member_ds,new_instance_member,ins_member_types_and_functions,cs)
DeriveDefault generic_ident generic_index optional_member_ident_global_index
# ins_member_types_and_functions = GenerateInstanceMember instance_member_n n_icl_functions ins_member_types_and_functions
# fun_body = GenerateInstanceBodyChecked generic_ident generic_index optional_member_ident_global_index
# (new_instance_member_ds,new_instance_member,cs)
= make_derived_default_instance instance_type.st_arity fun_body me_priority ins_pos class_member n_icl_functions cs
-> (new_instance_member_ds,new_instance_member,ins_member_types_and_functions,cs)
= make_default_implementation me_default_implementation me_priority ins_pos class_member n_icl_functions instance_type.st_arity
instance_member_n ins_member_types_and_functions cs
new_instance_members = [! new_instance_member : new_instance_members !]
ins_members
= { if (i<instance_member_n) ins_members.[i] (if (i==instance_member_n) new_instance_member_ds ins_members.[i-1])
......@@ -479,6 +461,21 @@ where
# cs & cs_error = checkErrorWithPosition class_member.ds_ident ins_pos "instance of class member expected" cs.cs_error
= (instance_member_n,ins_members,ins_member_types_and_functions,n_icl_functions,new_instance_members,instance_types,member_defs,type_defs,modules,var_heap,type_heaps,cs)
make_default_implementation (MacroMemberDefault {mm_ident}) me_priority ins_pos class_member function_n arity instance_member_n ins_member_types_and_functions cs
# (new_instance_member_ds,new_instance_body,cs)
= make_default_instance_body arity mm_ident me_priority ins_pos class_member function_n cs
new_instance_member
= { fun_ident = new_instance_member_ds.cim_ident, fun_arity = arity, fun_priority = me_priority,
fun_body = new_instance_body, fun_type = No, fun_pos = ins_pos,
fun_kind = FK_Function False, fun_lifted = 0, fun_info = EmptyFunInfo }
= (new_instance_member_ds,new_instance_member,ins_member_types_and_functions,cs)
make_default_implementation (DeriveDefault generic_ident generic_index optional_member_ident_global_index) me_priority ins_pos class_member function_n arity instance_member_n ins_member_types_and_functions cs
# ins_member_types_and_functions = GenerateInstanceMember instance_member_n function_n ins_member_types_and_functions
# fun_body = GenerateInstanceBodyChecked generic_ident generic_index optional_member_ident_global_index
# (new_instance_member_ds,new_instance_member,cs)
= make_derived_default_instance arity fun_body me_priority ins_pos class_member function_n cs
= (new_instance_member_ds,new_instance_member,ins_member_types_and_functions,cs)
add_generated_instance ins_member_index class_member member_mod_index ins_type instance_types icl_functions member_defs type_defs modules var_heap type_heaps cs=:{cs_x={x_main_dcl_module_n}}
# ({me_type,me_class_vars,me_priority}, member_defs, modules)
= getMemberDef member_mod_index class_member.ds_index x_main_dcl_module_n member_defs modules
......@@ -513,9 +510,9 @@ where
= (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 :: !Int Ident Priority Position DefinedSymbol Int !*CheckState
-> (!ClassInstanceMember,!FunDef,!*CheckState)
make_default_instance arity default_class_member_ident me_priority ins_pos class_member function_n cs
make_default_instance_body :: !Int Ident Priority Position DefinedSymbol Int !*CheckState
-> (!ClassInstanceMember,FunctionBody,!*CheckState)
make_default_instance_body arity default_class_member_ident me_priority ins_pos class_member function_n cs
# new_instance_ident = {id_name=class_member.ds_ident.id_name,id_info=nilPtr}
new_instance_member_ds = {cim_ident = new_instance_ident, cim_arity = arity, cim_index = function_n}
......@@ -523,14 +520,14 @@ where
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]]
default_class_member_expr = PE_Ident default_class_member_ident
rhs = case me_priority of
NoPrio -> if (arity==0)
(PE_Ident default_class_member_ident)
(PE_List [PE_Ident default_class_member_ident:arguments])
default_class_member_expr
(PE_List [default_class_member_expr:arguments])
_ -> if (arity==0)
(PE_List [PE_Ident default_class_member_ident])
(PE_List [hd arguments,PE_Ident default_class_member_ident:tl arguments])
(PE_List [default_class_member_expr])
(PE_List [hd arguments,default_class_member_expr:tl arguments])
new_instance_body = ParsedBody
[{ pb_args = arguments,
pb_rhs = { rhs_alts=UnGuardedExpr
......@@ -540,10 +537,7 @@ where
rhs_locals=NoCollectedLocalDefs},
pb_position = ins_pos
}]
new_instance_member = { fun_ident = new_instance_ident, fun_arity = arity, fun_priority = me_priority,
fun_body = new_instance_body, fun_type = No, fun_pos = ins_pos,
fun_kind = FK_Function False, fun_lifted = 0, fun_info = EmptyFunInfo }
= (new_instance_member_ds,new_instance_member,cs)
= (new_instance_member_ds,new_instance_body,cs)
make_derived_default_instance :: !Int FunctionBody Priority Position DefinedSymbol Int !*CheckState
-> (!ClassInstanceMember,!FunDef,!*CheckState)
......
......@@ -371,27 +371,29 @@ checkFunctionBodies GeneratedBody function_ident_for_errors e_input e_state e_in
checkFunctionBodies (GenerateInstanceBodyChecked generic_ident generic_index optional_member_ident_global_index) function_ident_for_errors e_input e_state e_info cs
# (optional_member_ident_global_index,cs)
= case optional_member_ident_global_index of
No
-> (No,cs)
Yes member_ident_global_index=:{igi_ident={id_info}}
# (entry, cs_symbol_table) = readPtr id_info cs.cs_symbol_table
cs & cs_symbol_table=cs_symbol_table
-> case entry of
{ste_kind=STE_Member,ste_index}
# member_ident_global_index & igi_g_index = {gi_module=e_input.ei_mod_index,gi_index=ste_index}
-> (Yes member_ident_global_index,cs)
{ste_kind=STE_Imported STE_Member mod_index,ste_index}
# member_ident_global_index & igi_g_index = {gi_module=mod_index,gi_index=ste_index}
-> (Yes member_ident_global_index,cs)
_
# cs & cs_error = checkError member_ident_global_index.igi_ident "undefined class member" cs.cs_error
-> (Yes member_ident_global_index,cs)
No -> (No,cs)
Yes {igi_ident} -> get_optional_member_ident_index igi_ident e_input.ei_mod_index cs
= (GenerateInstanceBodyChecked generic_ident generic_index optional_member_ident_global_index, [], e_state, e_info, cs)
checkFunctionBodies (GenerateInstanceBody generic_ident optional_member_ident) function_ident_for_errors e_input e_state e_info cs
= (GenerateInstanceBody generic_ident optional_member_ident, [], e_state, e_info, cs)
checkFunctionBodies _ function_ident_for_errors e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_var_heap, es_fun_defs} e_info cs
= abort ("checkFunctionBodies " +++ toString function_ident_for_errors +++ "\n")
get_optional_member_ident_index member_ident=:{id_info} ei_mod_index cs
# (entry, cs_symbol_table) = readPtr id_info cs.cs_symbol_table
cs & cs_symbol_table=cs_symbol_table
= case entry of
{ste_kind=STE_Member,ste_index}
# member_ident_global_index = {igi_ident = member_ident, igi_g_index = {gi_module=ei_mod_index,gi_index=ste_index}}
-> (Yes member_ident_global_index,cs)
{ste_kind=STE_Imported STE_Member mod_index,ste_index}
# member_ident_global_index = {igi_ident = member_ident, igi_g_index = {gi_module=mod_index,gi_index=ste_index}}
-> (Yes member_ident_global_index,cs)
_
# cs & cs_error = checkError member_ident "undefined class member" cs.cs_error
# member_ident_global_index = {igi_ident = member_ident, igi_g_index = {gi_module=0,gi_index=0}}
-> (Yes member_ident_global_index,cs)
removeLocalsFromSymbolTable :: !Index !Level ![Ident] !LocalDefs !Int !*{#FunDef} !*{#*{#FunDef}} !*(Heap SymbolTableEntry)
-> (!.{#FunDef},!.{#.{#FunDef}},!.Heap SymbolTableEntry)
removeLocalsFromSymbolTable module_index level loc_vars NoCollectedLocalDefs local_functions_index_offset fun_defs macro_defs symbol_table
......
......@@ -2096,7 +2096,7 @@ generate_derived_instances instance_i instance_defs main_module_n predefs ss
| instance_i<size instance_defs
| instance_defs.[instance_i].ins_member_types_and_functions=:NoDclInstanceMemberTypes
= generate_derived_instances (instance_i+1) instance_defs main_module_n predefs ss
# {ins_member_types_and_functions,ins_members,ins_type,ins_class_ident,ins_pos,ins_class_index} = instance_defs.[instance_i]
# {ins_member_types_and_functions,ins_members,ins_type,ins_pos,ins_class_index} = instance_defs.[instance_i]
# ss = generate_derived_instance ins_member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
= generate_derived_instances (instance_i+1) instance_defs main_module_n predefs ss
= ss
......@@ -2117,18 +2117,10 @@ generate_derived_instance (GenerateInstanceMember member_i member_fun_i member_t
= make_member_symb_ident optional_member gen_type.st_arity generic_ident member_i ins_class_index ins_pos ss
= case opt_member_symb_ident of
Yes member_symb_ident
# type_index = case ins_type.it_types of
[TA {type_index} _] -> type_index
[TAS {type_index} _ _] -> type_index
_ -> {glob_module= -1,glob_object= -1}
# type_index = type_index_of_type_constructor ins_type.it_types
| type_index.glob_module>=0
# ({tdi_gen_rep},ss) = ss!ss_td_infos.[type_index.glob_module, type_index.glob_object]
# gen_type_rep = getGenericTypeRep tdi_gen_rep
# gen_type_rep & gtr_type = add_instance_calls_to_GenTypeStruct gen_type_rep.gtr_type member_symb_ident
# (TransformedBody {tb_args, tb_rhs}, ss)
= buildDerivedInstanceCaseBody gen_type_rep main_module_n ins_pos type_index generic_ident generic_index predefs ss
# (tb_args,tb_rhs,ss)
= build_derived_instance_body type_index ins_pos generic_ident generic_index member_symb_ident main_module_n predefs ss
#! (arg_vars, local_vars, free_vars) = collectVars tb_rhs tb_args
| not free_vars=:[]
......@@ -2153,22 +2145,36 @@ generate_derived_instance (GenerateInstanceMember member_i member_fun_i member_t
-> generate_derived_instance member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
No
-> generate_derived_instance member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
where
make_member_symb_ident :: !(Optional IdentGlobalIndex) !Int !Ident !Int !GlobalIndex !Position !*SpecializeState -> *(!Optional SymbIdent,!*SpecializeState)
make_member_symb_ident No gen_arity generic_ident member_i ins_class_index ins_pos ss
# ({class_ident,class_members},ss) = ss!ss_modules.[ins_class_index.gi_module].com_class_defs.[ins_class_index.gi_index]
# {ds_ident,ds_index} = class_members.[member_i]
# member_symb_ident = {symb_ident=ds_ident,
symb_kind=SK_OverloadedFunction {glob_module=ins_class_index.gi_module,glob_object=ds_index}}
= (Yes member_symb_ident,ss)
make_member_symb_ident (Yes {igi_g_index}) gen_arity generic_ident member_i ins_class_index ins_pos ss
# ({me_type,me_ident},ss) = ss!ss_modules.[igi_g_index.gi_module].com_member_defs.[igi_g_index.gi_index]
| me_type.st_arity<>gen_arity
# ss & ss_error = reportError generic_ident.id_name ins_pos "arity of generic function and member not equal" ss.ss_error
= (No,ss)
# member_symb_ident = {symb_ident=me_ident,
symb_kind=SK_OverloadedFunction {glob_module=igi_g_index.gi_module,glob_object=igi_g_index.gi_index}}
= (Yes member_symb_ident,ss)
type_index_of_type_constructor [TA {type_index} _] = type_index
type_index_of_type_constructor [TAS {type_index} _ _] = type_index
type_index_of_type_constructor _ = {glob_module= -1,glob_object= -1}
make_member_symb_ident :: !(Optional IdentGlobalIndex) !Int !Ident !Int !GlobalIndex !Position !*SpecializeState -> *(!Optional SymbIdent,!*SpecializeState)
make_member_symb_ident No gen_arity generic_ident member_i ins_class_index ins_pos ss
# ({class_ident,class_members},ss) = ss!ss_modules.[ins_class_index.gi_module].com_class_defs.[ins_class_index.gi_index]
# {ds_ident,ds_index} = class_members.[member_i]
# member_symb_ident = {symb_ident=ds_ident,
symb_kind=SK_OverloadedFunction {glob_module=ins_class_index.gi_module,glob_object=ds_index}}
= (Yes member_symb_ident,ss)
make_member_symb_ident (Yes {igi_g_index}) gen_arity generic_ident member_i ins_class_index ins_pos ss
# ({me_type,me_ident},ss) = ss!ss_modules.[igi_g_index.gi_module].com_member_defs.[igi_g_index.gi_index]
| me_type.st_arity<>gen_arity
# ss & ss_error = reportError generic_ident.id_name ins_pos "arity of generic function and member not equal" ss.ss_error
= (No,ss)
# member_symb_ident = {symb_ident=me_ident,
symb_kind=SK_OverloadedFunction {glob_module=igi_g_index.gi_module,glob_object=igi_g_index.gi_index}}
= (Yes member_symb_ident,ss)
build_derived_instance_body type_index ins_pos generic_ident generic_index member_symb_ident main_module_n predefs ss
# ({tdi_gen_rep},ss) = ss!ss_td_infos.[type_index.glob_module, type_index.glob_object]
# gen_type_rep = getGenericTypeRep tdi_gen_rep
# gen_type_rep & gtr_type = add_instance_calls_to_GenTypeStruct gen_type_rep.gtr_type member_symb_ident
# (TransformedBody {tb_args, tb_rhs}, ss)
= buildDerivedInstanceCaseBody gen_type_rep main_module_n ins_pos type_index generic_ident generic_index predefs ss
= (tb_args,tb_rhs,ss)
add_instance_calls_to_GenTypeStruct :: !GenTypeStruct SymbIdent -> GenTypeStruct
add_instance_calls_to_GenTypeStruct (GTSPair gts1 gts2) member_symb_ident
......
......@@ -850,6 +850,8 @@ remove_dynamic_expr_info_ptr_copies [dyn_ptr:dyn_ptrs] expr_heap
remove_dynamic_expr_info_ptr_copies [] expr_heap
= expr_heap
:: ExpandInfo :== (![FunCall], !.ExpandState)
unfoldMacro :: !FunDef ![Expression] !*ExpandInfo -> (!Expression, !*ExpandInfo)
unfoldMacro {fun_body =fun_body=: TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls},fun_kind,fun_ident} args (calls, es=:{es_var_heap,es_expression_heap,es_fun_defs})
# (let_binds, var_heap) = bind_expressions tb_args args [] es_var_heap
......@@ -1412,9 +1414,8 @@ try_to_close_group max_fun_nr macro_module_index fun_index fun_number min_dep pi
where
close_group macro_module_index fun_index [index=:FunctionOrIclMacroIndex d:ds] functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs
# (fun_def, fun_defs) = fun_defs![d]
| case fun_def.fun_kind of FK_Macro->True; _ -> False
| fun_def.fun_kind=:FK_Macro
# fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = -2-group_number }}
// # fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = group_number }}
# macros_in_group = [index : macros_in_group]
| d == fun_index && macro_module_index==(-1)
= (ds, functions_in_group, macros_in_group, fun_defs,macro_defs)
......@@ -1426,7 +1427,7 @@ where
= close_group macro_module_index fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs
close_group macro_module_index fun_index [index=:DclMacroIndex module_index d:ds] functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs
# (fun_def, macro_defs) = macro_defs![module_index,d]
| case fun_def.fun_kind of FK_Macro->True; _ -> False
| fun_def.fun_kind=:FK_Macro
# macro_defs = { macro_defs & [module_index,d] = { fun_def & fun_info.fi_group_index = -2-group_number }}
# macros_in_group = [index : macros_in_group]
| d == fun_index && macro_module_index==module_index
......@@ -1559,8 +1560,6 @@ expandCheckedAlternative {ca_rhs, ca_position} ei
# (ca_rhs, ei) = expand ca_rhs ei
= ((ca_rhs, ca_position), ei)
:: ExpandInfo :== (![FunCall], !.ExpandState)
add_new_fun_defs new_functions new_function_index last_function_index es=:{es_fun_defs,es_new_fun_def_numbers}
# new_fun_defs = new_fun_defs
with
......
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