Commit 6ffa3db4 authored by John van Groningen's avatar John van Groningen

add deriving a local function in the top level where of a default class...

 add deriving a local function in the top level where of a default class instance member definition using derive
parent 4b6ccbe7
......@@ -475,6 +475,16 @@ where
# (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)
make_default_implementation (MacroMemberDefaultWithDerive {mm_ident}) me_priority ins_pos class_member function_n arity instance_member_n ins_member_types_and_functions cs
# ins_member_types_and_functions = GenerateInstanceMemberFunction instance_member_n ins_member_types_and_functions
(new_instance_member_ds,new_instance_body,cs)
= make_default_instance_body arity mm_ident me_priority ins_pos class_member function_n cs
fun_info = {EmptyFunInfo & fi_properties=FI_DefaultMemberWithDerive}
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 = fun_info }
= (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)
......
......@@ -4,6 +4,7 @@ import StdEnv, compare_types
import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef
import explicitimports, comparedefimp
from check import checkFunctions,checkDclMacros
from checkgenerics import get_generic_index
cIsInExpressionList :== True
cIsNotInExpressionList :== False
......@@ -375,7 +376,13 @@ checkFunctionBodies (GenerateInstanceBodyChecked generic_ident generic_index opt
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)
// derive local function in where of default class member
# (generic_index,cs) = get_generic_index generic_ident e_input.ei_mod_index cs
# (optional_member_ident_global_index,cs)
= case optional_member_ident of
No -> (No,cs)
Yes member_ident -> get_optional_member_ident_index member_ident e_input.ei_mod_index cs
= (GenerateInstanceBodyLocalMacro generic_ident generic_index optional_member_ident_global_index, [], 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")
......
......@@ -166,6 +166,11 @@ getBelongingSymbols (Declaration {decl_kind=STE_Imported STE_Class def_mod_index
-> add_more_default_class_member_macros (class_member_n+1) [|default_class_member_macro_ident_and_index] 1 default_member_indexes dcl_modules
DeriveDefault generic_ident generic_index _
-> add_default_class_member_macros (class_member_n+1) dcl_modules
MacroMemberDefaultWithDerive 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
-> add_more_default_class_member_macros (class_member_n+1) [|default_class_member_macro_ident_and_index] 1 default_member_indexes dcl_modules
| size class_macro_members==0
= (BS_Members class_members,dcl_modules)
= (BS_MembersAndMacros class_members class_macro_members {} {},dcl_modules)
......@@ -179,10 +184,14 @@ getBelongingSymbols (Declaration {decl_kind=STE_Imported STE_Class def_mod_index
-> add_more_default_class_member_macros (class_member_n+1) default_class_members default_member_n default_member_indexes dcl_modules
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
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
DeriveDefault generic_ident generic_index _
-> add_more_default_class_member_macros (class_member_n+1) default_class_members default_member_n default_member_indexes dcl_modules
MacroMemberDefaultWithDerive 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
# default_class_members = {default_class_member\\default_class_member<-reverse default_class_members}
= (BS_MembersAndMacros class_members class_macro_members default_member_indexes default_class_members,dcl_modules)
= (members,dcl_modules)
......
......@@ -235,6 +235,7 @@ where
compare_default_implementations (MacroMemberDefault _) (MacroMemberDefault _) = True
compare_default_implementations (DeriveDefault generic_ident1 generic_index1 optional_member_ident1) (DeriveDefault generic_ident2 generic_index2 optional_member_ident2)
= generic_index1==generic_index2 && generic_ident1==generic_ident2 && compare_optional_member_ident optional_member_ident1 optional_member_ident2
compare_default_implementations (MacroMemberDefaultWithDerive _) (MacroMemberDefaultWithDerive _) = True
compare_default_implementations _ _ = False
compare_optional_member_ident No No = True
......
......@@ -2145,6 +2145,60 @@ 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
generate_derived_instance (GenerateInstanceMemberFunction member_i member_types_and_functions) ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
# {cim_index} = ins_members.[member_i]
| cim_index<0
= generate_derived_instance member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
# ({fun_kind},ss) = ss!ss_funs.[cim_index]
| not fun_kind=:FK_FunctionWithDerive _ _
= generate_derived_instance member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
# (FK_FunctionWithDerive first_new_function_n end_new_function_n) = fun_kind
# ss = generate_instance_member_functions first_new_function_n end_new_function_n member_i member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
= generate_derived_instance member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
generate_instance_member_functions fun_index end_fun_index member_i member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
| fun_index<end_fun_index
| ss.ss_funs.[fun_index].fun_body=:PartitioningGenerateInstanceBodyLocalMacro _ _ _ _
# (PartitioningGenerateInstanceBodyLocalMacro generic_ident generic_index optional_member _,ss) = ss!ss_funs.[fun_index].fun_body
# ({gen_type,gen_deps},ss) = ss!ss_modules.[generic_index.gi_module].com_generic_defs.[generic_index.gi_index]
| ss.ss_funs.[fun_index].fun_arity<>gen_type.st_arity
# ss & ss_error = reportError generic_ident.id_name ins_pos "arity of generic function and member not equal" ss.ss_error
= generate_instance_member_functions (fun_index+1) end_fun_index member_i member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
| not gen_deps=:[]
# ss & ss_error = reportError generic_ident.id_name ins_pos "deriving instances from generic with dependencies not implemented" ss.ss_error
= generate_instance_member_functions (fun_index+1) end_fun_index member_i member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
# (opt_member_symb_ident,ss)
= 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 = type_index_of_type_constructor ins_type.it_types
| type_index.glob_module>=0
# (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=:[]
-> abort "generate_instance_member_functions: free_vars is not empty\n"
# (fun=:{fun_info},ss) = ss!ss_funs.[fun_index]
fun &
fun_arity = length arg_vars,
fun_body = TransformedBody {tb_args=arg_vars, tb_rhs=tb_rhs},
fun_info = {fun_info &
fi_calls = collectCalls main_module_n tb_rhs,
fi_free_vars = [], fi_local_vars = local_vars,
fi_properties = fun_info.fi_properties bitor FI_GenericFun}
ss & ss_funs.[fun_index] = fun
-> generate_instance_member_functions (fun_index+1) end_fun_index member_i member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
-> generate_instance_member_functions (fun_index+1) end_fun_index member_i member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
No
-> generate_instance_member_functions (fun_index+1) end_fun_index member_i member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
= generate_instance_member_functions (fun_index+1) end_fun_index member_i member_types_and_functions ins_members ins_type ins_pos ins_class_index main_module_n predefs ss
= ss
type_index_of_type_constructor [TA {type_index} _] = type_index
type_index_of_type_constructor [TAS {type_index} _ _] = type_index
......
......@@ -1647,7 +1647,7 @@ wantClassDefinition parseContext pos pState
# (begin_members, pState) = begin_member_group token pState
| begin_members
# (class_id, pState) = stringToIdent class_or_member_name IC_Class pState
(members, pState) = wantDefinitions (SetClassDefsContext parseContext) pState
(members, pState) = wantMemberDefinitions (SetClassDefsContext parseContext) pState
class_def = { class_ident = class_id, class_arity = class_arity, class_args = class_args,
class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars,
class_macro_members = {},
......@@ -1777,7 +1777,7 @@ wantInstanceDeclaration parseContext pi_pos pState
# (member_ident, pState) = stringToIdent class_name IC_Expression pState
# (generic_ident, pState) = stringToIdent generic_function_name IC_Generic pState
# pState = wantEndOfDefinition "derive instance" pState
-> (PD_Instance {pim_pi = pi, pim_members = [PD_DeriveInstanceMember pi_pos member_ident generic_ident No]}, pState)
-> (PD_Instance {pim_pi = pi, pim_members = [PD_DeriveInstanceMember pi_pos member_ident generic_ident 0 No]}, pState)
_
# pState = parseError "derive instance member" (Yes token) "generic function name" pState
-> (PD_Instance {pim_pi = pi, pim_members = []}, pState)
......@@ -2302,10 +2302,10 @@ wantDeriveInstanceDefinition parseContext pos pState
IdentToken member_name2
# (member_ident2, pState) = stringToIdent member_name2 IC_Expression pState
# pState = wantEndOfDefinition "derive instance" pState
-> (PD_DeriveInstanceMember pos member_ident generic_ident (Yes member_ident2),pState)
-> (PD_DeriveInstanceMember pos member_ident generic_ident 0 (Yes member_ident2),pState)
token
# pState = wantEndOfDefinition "derive instance" (tokenBack pState)
-> (PD_DeriveInstanceMember pos member_ident generic_ident No,pState)
-> (PD_DeriveInstanceMember pos member_ident generic_ident 0 No,pState)
_
# pState = parseError "derive instance member" (Yes token) "generic function name" pState
-> (PD_Erroneous,pState)
......
......@@ -327,9 +327,9 @@ where
where
arity (Yes {st_arity}) = st_arity
arity No = 2 // it was specified as infix
reorganiseLocalDefinitions [PD_DeriveInstanceMember pos member_ident generic_ident optional_member_ident : defs] ca
reorganiseLocalDefinitions [PD_DeriveInstanceMember pos member_ident generic_ident arity optional_member_ident : defs] ca
# fun_body = GenerateInstanceBody generic_ident optional_member_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 = arity, 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, node_defs, ca) = reorganiseLocalDefinitions defs ca
= ([fun_def:fun_defs], node_defs, ca)
......@@ -1548,7 +1548,7 @@ where
| bodies=:[]
# type & st_context = [type_context : st_context]
= case defs of
[PD_DeriveInstanceMember pos member_ident generic_ident optional_member_ident:defs]
[PD_DeriveInstanceMember pos member_ident generic_ident _ optional_member_ident:defs]
| member_ident.id_name==name.id_name
# default_implementation
= case optional_member_ident of
......@@ -1579,15 +1579,53 @@ where
= (mem_defs,[macro : mem_macros],default_members_without_type,[|macro_member : macro_members],new_macro_count,ca)
FK_Function _
# macro_name = class_ident.id_name+++"_"+++name.id_name
# ({boxed_ident=macro_ident}, ca_hash_table) = putIdentInHashTable macro_name IC_Expression ca.ca_hash_table
# ca = { ca & ca_hash_table = ca_hash_table }
# 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 = 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)
({boxed_ident=macro_ident}, ca_hash_table) = putIdentInHashTable macro_name IC_Expression ca.ca_hash_table
ca & ca_hash_table = ca_hash_table
macro_member = {mm_ident=macro_ident,mm_index=macro_count}
type & st_context = [type_context : st_context]
| not (has_PD_DeriveInstanceMember_in_where bodies)
# macro = MakeNewImpOrDefFunction macro_ident st_arity bodies FK_Macro prio opt_type pos
mem_def = { me_ident = name, me_type = type, me_pos = pos, me_priority = prio, me_offset = NoIndex,
me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex},
me_default_implementation = MacroMemberDefault macro_member, 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)
# bodies = set_PD_DeriveInstanceMember_arity_in_where st_arity bodies
macro = MakeNewImpOrDefFunction macro_ident st_arity bodies FK_Macro prio opt_type pos
mem_def = { me_ident = name, me_type = type, me_pos = pos, me_priority = prio, me_offset = NoIndex,
me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex},
me_default_implementation = MacroMemberDefaultWithDerive macro_member, 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)
where
has_PD_DeriveInstanceMember_in_where [{pb_rhs={rhs_locals=LocalParsedDefs local_parsed_defs}}:parsed_bodies]
= has_PD_DeriveInstanceMember local_parsed_defs || has_PD_DeriveInstanceMember_in_where parsed_bodies
where
has_PD_DeriveInstanceMember [PD_DeriveInstanceMember _ _ _ _ _:local_parsed_defs] = True
has_PD_DeriveInstanceMember [_:local_parsed_defs] = has_PD_DeriveInstanceMember local_parsed_defs
has_PD_DeriveInstanceMember [] = False
has_PD_DeriveInstanceMember_in_where []
= False
set_PD_DeriveInstanceMember_arity_in_where arity [rhs=:{pb_rhs={rhs_locals=LocalParsedDefs local_parsed_defs}}:bodies]
# local_parsed_defs = set_PD_DeriveInstanceMember_arity arity local_parsed_defs
# bodies = set_PD_DeriveInstanceMember_arity_in_where arity bodies
= [{rhs & pb_rhs.rhs_locals=LocalParsedDefs local_parsed_defs}:bodies]
where
set_PD_DeriveInstanceMember_arity arity [PD_DeriveInstanceMember pos member_ident generic_ident _ optional_member_ident:local_parsed_defs]
= [PD_DeriveInstanceMember pos member_ident generic_ident arity optional_member_ident:set_PD_DeriveInstanceMember_arity arity local_parsed_defs]
set_PD_DeriveInstanceMember_arity arity [local_parsed_def:local_parsed_defs]
= [local_parsed_def:set_PD_DeriveInstanceMember_arity arity local_parsed_defs]
set_PD_DeriveInstanceMember_arity arity []
= []
set_PD_DeriveInstanceMember_arity_in_where arity []
= []
check_symbols_of_class_members [PD_TypeSpec fun_pos fun_name prio No specials : defs] type_context macro_count ca
= case defs of
[PD_Function pos name is_infix args rhs fun_kind : defs]
......@@ -1620,7 +1658,7 @@ where
macro = MakeNewImpOrDefFunction macro_ident fun_arity bodies FK_Macro prio No fun_pos
macro_member = {mm_ident=macro_ident,mm_index=macro_count}
-> (mem_defs,[macro : mem_macros],[(name,macro_member,fun_pos) : default_members_without_type],macro_members,new_macro_count,ca)
check_symbols_of_class_members [PD_DeriveInstanceMember pos _ _ _ : defs] type_context macro_count ca
check_symbols_of_class_members [PD_DeriveInstanceMember pos _ _ _ _ : defs] type_context macro_count ca
= check_symbols_of_class_members defs type_context macro_count (postParseError pos "member type missing" ca)
check_symbols_of_class_members [def : _] type_context macro_count ca
= abort "postparse.check_symbols_of_class_members: unknown def" // <<- def
......@@ -1684,9 +1722,9 @@ where
-> ([ fun : fun_defs ], ca)
_
-> collect_member_instances defs (postParseError fun_pos "function body expected" ca)
collect_member_instances [PD_DeriveInstanceMember pos member_ident generic_ident optional_member_ident : defs] ca
collect_member_instances [PD_DeriveInstanceMember pos member_ident generic_ident arity optional_member_ident : defs] ca
# fun_body = GenerateInstanceBody generic_ident optional_member_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 = arity, 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)
......
......@@ -27,7 +27,11 @@ instance toString Ident
, ste_previous :: SymbolTableEntry
}
:: FunctionOrMacroIndex = FunctionOrIclMacroIndex !Int | DclMacroIndex /*module_n*/ !Int /*macro_n_in_module*/ !Int;
:: FunctionOrMacroIndex
= FunctionOrIclMacroIndex !Int
| DclMacroIndex /*module_n*/ !Int /*macro_n_in_module*/ !Int
| DeriveInstanceMacroIndex !Int
| DeriveInstanceDclMacroIndex !Int !Int
instance == FunctionOrMacroIndex
......@@ -272,10 +276,11 @@ cIsNotAFunction :== False
| PD_Generic GenericDef
| PD_GenericCase GenericCaseDef Ident
| PD_Derive [GenericCaseDef]
| PD_DeriveInstanceMember Position Ident Ident (Optional Ident)
| PD_DeriveInstanceMember Position Ident Ident !Int !(Optional Ident)
| PD_Erroneous
:: FunKind = FK_Function !Bool | FK_Macro | FK_Caf | FK_NodeDefOrFunction | FK_Unknown
| FK_FunctionWithDerive !Int !Int
:: StrictnessList = NotStrict | Strict !Int | StrictList !Int StrictnessList
......@@ -326,6 +331,7 @@ cNameLocationDependent :== True
= DclInstanceMemberTypes !FunType !DclInstanceMemberTypeAndFunctions
| NoDclInstanceMemberTypes
| GenerateInstanceMember !Int !Int !DclInstanceMemberTypeAndFunctions // member_n function_n
| GenerateInstanceMemberFunction !Int !DclInstanceMemberTypeAndFunctions // member_n
:: IdentOrQualifiedIdent
= Ident !Ident
......@@ -406,6 +412,7 @@ cNameLocationDependent :== True
= NoMemberDefault
| MacroMemberDefault !MacroMember
| DeriveDefault !Ident !GlobalIndex !(Optional IdentGlobalIndex)
| MacroMemberDefaultWithDerive !MacroMember
:: MemberDef =
{ me_ident :: !Ident
......@@ -683,6 +690,7 @@ FI_Unused :== 64 // used in module trans
FI_UnusedUsed :== 128 // used in module trans
FI_HasTypeCodes :== 256
FI_FusedMember :== 512 // used in module trans to mark fused versions of instance members
FI_DefaultMemberWithDerive :== 1024
:: FunInfo =
{ fi_calls :: ![FunCall]
......@@ -728,6 +736,8 @@ FI_FusedMember :== 512 // used in module trans to mark fused versions of insta
| GeneratedBody // the body will be generated automatically - for generics
| GenerateInstanceBody !Ident !(Optional Ident)
| GenerateInstanceBodyChecked !Ident !GlobalIndex !(Optional IdentGlobalIndex)
| GenerateInstanceBodyLocalMacro !Ident !GlobalIndex !(Optional IdentGlobalIndex)
| PartitioningGenerateInstanceBodyLocalMacro !Ident !GlobalIndex !(Optional IdentGlobalIndex) !Int
| NoBody
:: IdentGlobalIndex = { igi_ident :: !Ident, igi_g_index :: !GlobalIndex }
......
......@@ -231,6 +231,10 @@ where
= add_free_vars_of_non_recursive_calls fi_def_level group_index fi_calls lifted_function_called fi_free_vars fun_defs macro_defs
= (contains_free_vars || not (isEmpty fi_free_vars), lifted_function_called,
fun_defs,{ macro_defs & [macro_module_index,macro_index] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}})
add_free_vars_of_non_recursive_calls_to_function group_index (DeriveInstanceMacroIndex _) (contains_free_vars, lifted_function_called, fun_defs,macro_defs)
= (contains_free_vars, lifted_function_called, fun_defs,macro_defs)
add_free_vars_of_non_recursive_calls_to_function group_index (DeriveInstanceDclMacroIndex _ _) (contains_free_vars, lifted_function_called, fun_defs,macro_defs)
= (contains_free_vars, lifted_function_called, fun_defs,macro_defs)
add_free_vars_of_non_recursive_calls fi_def_level group_index fi_calls lifted_function_called fi_free_vars fun_defs macro_defs
= foldSt (add_free_vars_of_non_recursive_call fi_def_level group_index) fi_calls (lifted_function_called, fi_free_vars, fun_defs,macro_defs)
......@@ -324,6 +328,10 @@ where
macro_defs = ls_x.x_macro_defs
macro_defs = { macro_defs & [module_index].[fun] = { fun_def & fun_lifted = fun_lifted, fun_body = PartitioningFunction {cb_args = cb_args, cb_rhs = cb_rhs} fun_number}}
= {ls_x={ls_x & x_macro_defs=macro_defs}, ls_var_heap=ls_var_heap, ls_expr_heap= ls_expr_heap}
lift_function (DeriveInstanceMacroIndex _) ls
= ls
lift_function (DeriveInstanceDclMacroIndex _ _) ls
= ls
remove_lifted_args vars var_heap
= foldl (\var_heap {fv_ident,fv_info_ptr} -> writePtr fv_info_ptr VI_Empty var_heap) var_heap vars
......@@ -831,6 +839,8 @@ copy_macro_or_local_macro_function macro=:{fun_body = TransformedBody {tb_args,t
# us_symbol_heap = remove_dynamic_expr_info_ptr_copies fi_dynamics us_symbol_heap
= ({macro & fun_body = TransformedBody {tb_args=tb_args,tb_rhs=result_expr},fun_info.fi_local_vars=fi_local_vars,fun_info.fi_calls=fi_calls,fun_info.fi_dynamics=new_dynamics},us_local_macro_functions,
us_var_heap, us_symbol_heap)
copy_macro_or_local_macro_function macro=:{fun_body = PartitioningGenerateInstanceBodyLocalMacro _ _ _ _} local_macro_functions var_heap expr_heap
= (macro,local_macro_functions,var_heap,expr_heap)
copy_dynamic_expr_info_ptrs :: ![ExprInfoPtr] !*ExpressionHeap -> (![ExprInfoPtr],!*ExpressionHeap)
copy_dynamic_expr_info_ptrs [dyn_ptr:dyn_ptrs] expr_heap
......@@ -1343,6 +1353,16 @@ partitionate_called_function mod_index max_fun_nr fun_index pi ps
GenerateInstanceBodyChecked _ _ _
// do not allocate a group, it will be allocated during the generic phase
-> (max_fun_nr, ps)
GenerateInstanceBodyLocalMacro generic_ident generic_index optional_member_ident_global_index
# fun_number = ps.ps_next_num
fun_body = PartitioningGenerateInstanceBodyLocalMacro generic_ident generic_index optional_member_ident_global_index fun_number
ps & ps_fun_defs.[fun_index].fun_body = fun_body,
ps_next_num = inc fun_number,
ps_deps = [DeriveInstanceMacroIndex fun_index : ps.ps_deps]
min_dep = max_fun_nr
-> try_to_close_group max_fun_nr (-1) fun_index fun_number min_dep pi ps
PartitioningGenerateInstanceBodyLocalMacro _ _ _ fun_number
-> (fun_number, ps)
index_in_ranges index [!{ir_from, ir_to}:ranges!]
= (index>=ir_from && index < ir_to) || index_in_ranges index ranges;
......@@ -1371,6 +1391,14 @@ partitionate_macro mod_index max_fun_nr macro_module_index macro_index pi ps
ps_next_group = inc ps.ps_next_group, ps_groups = [ [DclMacroIndex macro_module_index macro_index] : ps.ps_groups]}
)
-> (max_fun_nr, ps)
GenerateInstanceBodyLocalMacro generic_ident generic_index optional_member_ident_global_index
# fun_number = ps.ps_next_num
fun_body = PartitioningGenerateInstanceBodyLocalMacro generic_ident generic_index optional_member_ident_global_index fun_number
ps & ps_unexpanded_dcl_macros=[(macro_module_index,macro_index,fun_def):ps.ps_unexpanded_dcl_macros],
ps_macro_defs.[macro_module_index,macro_index] = {fun_def & fun_body=fun_body},
ps_next_num = inc fun_number, ps_deps = [DeriveInstanceDclMacroIndex macro_module_index macro_index : ps.ps_deps]
min_dep = max_fun_nr
-> try_to_close_group max_fun_nr macro_module_index macro_index fun_number min_dep pi ps
visit_functions :: Int Int ![FunCall] PartitioningInfo !*(Int,*PartitioningState) -> *(Int,*PartitioningState)
visit_functions mod_index max_fun_nr calls pi min_dep_ps
......@@ -1438,20 +1466,48 @@ where
| d == fun_index && macro_module_index==module_index
= (ds, functions_in_group, macros_in_group, fun_defs,macro_defs)
= 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=:DeriveInstanceMacroIndex d:ds] functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs
# fun_defs & [d].fun_info.fi_group_index = -2-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)
= 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=:DeriveInstanceDclMacroIndex 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]
# 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
= (ds, functions_in_group, macros_in_group, fun_defs,macro_defs)
= close_group macro_module_index fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs
expand_macros_in_group group es
= foldSt expand_macros group es
where
expand_macros (FunctionOrIclMacroIndex fun_index) es
# (fun_def,es) = es!es_fun_defs.[fun_index]
{fun_ident,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = fun_def
identPos = newPosition fun_ident fun_pos
# es={ es & es_error = setErrorAdmin identPos es.es_error }
# (tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es)
= expandMacrosInBody fun_info.fi_calls body pi.pi_predef_symbols_for_transform pi.pi_reset_body_of_rhs_macros es
fun_def = { fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = fi_local_vars,fi_dynamics=fi_dynamics }}
= {es & es_fun_defs.[fun_index] = fun_def }
| es.es_fun_defs.[fun_index].fun_info.fi_properties bitand FI_DefaultMemberWithDerive==0
# (fun_def,es) = es!es_fun_defs.[fun_index]
{fun_ident,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = fun_def
identPos = newPosition fun_ident fun_pos
es & es_error = setErrorAdmin identPos es.es_error
(tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es)
= expandMacrosInBody fun_info.fi_calls body pi.pi_predef_symbols_for_transform pi.pi_reset_body_of_rhs_macros es
fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = fi_local_vars,fi_dynamics=fi_dynamics }
= {es & es_fun_defs.[fun_index] = fun_def}
# (fun_def,es) = es!es_fun_defs.[fun_index]
{fun_ident,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = fun_def
identPos = newPosition fun_ident fun_pos
es & es_error = setErrorAdmin identPos es.es_error
#! n_fun_defs_0 = size es.es_fun_defs
# (tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es)
= expandMacrosInBody fun_info.fi_calls body pi.pi_predef_symbols_for_transform pi.pi_reset_body_of_rhs_macros es
#! n_fun_defs_1 = size es.es_fun_defs
# fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = fi_local_vars,fi_dynamics=fi_dynamics }
| n_fun_defs_0==n_fun_defs_1
= {es & es_fun_defs.[fun_index] = fun_def}
# fun_def & fun_kind = FK_FunctionWithDerive n_fun_defs_0 n_fun_defs_1
= {es & es_fun_defs.[fun_index] = fun_def}
expand_macros (DclMacroIndex macro_module_index fun_index) es
# (old_fun_def,es) = es!es_macro_defs.[macro_module_index,fun_index]
{fun_ident,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = old_fun_def
......@@ -1462,6 +1518,10 @@ where
fun_def = { old_fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = fi_local_vars,fi_dynamics=fi_dynamics }}
= {es & es_macro_defs.[macro_module_index,fun_index] = fun_def }
expand_macros (DeriveInstanceMacroIndex _) es
= es
expand_macros (DeriveInstanceDclMacroIndex _ _) es
= es
add_called_macros :: ![FunCall] !*PartitioningState -> *PartitioningState
add_called_macros calls ps
......@@ -1496,6 +1556,10 @@ where
= ([fun:funs],fun_defs)
remove_macros_from_group [DclMacroIndex macro_module_index macro_index:funs] fun_defs
= remove_macros_from_group funs fun_defs
remove_macros_from_group [DeriveInstanceMacroIndex _:funs] fun_defs
= remove_macros_from_group funs fun_defs
remove_macros_from_group [DeriveInstanceDclMacroIndex _ _:funs] fun_defs
= remove_macros_from_group funs fun_defs
remove_macros_from_group [] fun_defs
= ([],fun_defs);
remove_macros_from_groups_and_reverse [] fun_defs result_groups
......
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