Skip to content
GitLab
Commit e28bc780 authored by Diederik van Arkel's avatar Diederik van Arkel
Browse files

Add producer class for fusion

parent b94e5f7b
Hide whitespace changes
Inline Side-by-side
frontend/convertcases.icl
View file @ e28bc780
......@@ -736,7 +736,7 @@ newFunctionWithType opt_id fun_bodies local_vars fun_type group_index (cs_next_f
= ({ symb_name = fun_id, symb_kind = SK_GeneratedFunction fun_def_ptr cs_next_fun_nr, symb_arity = arity },
(inc cs_next_fun_nr, [fun_def_ptr : cs_new_functions],
cs_fun_heap <:= (fun_def_ptr, FI_Function { gf_fun_def = fun_def, gf_instance_info = II_Empty,
gf_fun_index = cs_next_fun_nr, gf_cons_args = {cc_size=0, cc_args = [], cc_linear_bits = []} })))
gf_fun_index = cs_next_fun_nr, gf_cons_args = {cc_size=0, cc_args = [], cc_linear_bits = [], cc_producer = False} })))
addNewFunctionsToGroups :: !{#.CommonDefs} FunctionHeap ![FunctionInfoPtr] !Int !*{! Group} !*{#{# CheckedTypeDef}} !ImportedFunctions !*TypeHeaps !*VarHeap
-> (!*{! Group}, ![FunDef], !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
......
frontend/syntax.dcl
View file @ e28bc780
......@@ -507,10 +507,15 @@ cIsALocalVar :== False
{ cc_size ::!Int
, cc_args ::![ConsClass]
, cc_linear_bits ::![Bool]
, cc_producer ::!ProdClass
}
:: ConsClass :== Int
:: ProdClass :== Bool
pIsSafe :== True
:: OptionalVariable :== Optional (Bind Ident VarInfoPtr)
:: AuxiliaryPattern
......@@ -639,7 +644,7 @@ cNonRecursiveAppl :== False
:: Producer = PR_Empty
| PR_Function !SymbIdent !Index
| PR_Class !App ![(BoundVar, Type)] !Type
// | PR_Constructor !SymbIdent ![Expression]
| PR_Constructor !SymbIdent ![Expression]
| PR_GeneratedFunction !SymbIdent !Index
| PR_Curried !SymbIdent
......
frontend/syntax.icl
View file @ e28bc780
......@@ -500,10 +500,15 @@ cIsALocalVar :== False
{ cc_size ::!Int
, cc_args ::![ConsClass]
, cc_linear_bits ::![Bool]
, cc_producer ::!ProdClass
}
:: ConsClass :== Int
:: ProdClass :== Bool
pIsSafe :== True
:: OptionalVariable :== Optional (Bind Ident VarInfoPtr)
:: AuxiliaryPattern
......@@ -627,7 +632,7 @@ cNotVarNumber :== -1
:: Producer = PR_Empty
| PR_Function !SymbIdent !Index
| PR_Class !App ![(BoundVar, Type)] !Type
// | PR_Constructor !SymbIdent ![Expression]
| PR_Constructor !SymbIdent ![Expression]
| PR_GeneratedFunction !SymbIdent !Index
| PR_Curried !SymbIdent
......@@ -1735,6 +1740,7 @@ where
(<<<) file (CheckedBody {cb_args,cb_rhs}) = file <<< "C " <<< cb_args <<< " = " <<< cb_rhs <<< '\n'
(<<<) file (TransformedBody {tb_args,tb_rhs}) = file <<< "T " <<< tb_args <<< " = " <<< tb_rhs <<< '\n'
(<<<) file (BackendBody body) = file <<< body <<< '\n'
(<<<) file (Expanding vars) = file <<< "E " <<< vars
(<<<) file NoBody = file <<< "Array function\n"
instance <<< FunCall
......
frontend/trans.icl
View file @ e28bc780
......@@ -548,7 +548,7 @@ analyseGroups common_defs imported_funs {ir_from, ir_to} main_dcl_module_n stdSt
nr_of_groups = size groups
# consumerAnalysisRO=ConsumerAnalysisRO {common_defs=common_defs,imported_funs=imported_funs,main_dcl_module_n=main_dcl_module_n,stdStrictLists_module_n=stdStrictLists_module_n}
= iFoldSt (analyse_group consumerAnalysisRO) 0 nr_of_groups
([], createArray nr_of_funs { cc_size = 0, cc_args = [], cc_linear_bits = []}, groups, fun_defs, var_heap, expr_heap)
([], createArray nr_of_funs { cc_size = 0, cc_args = [], cc_linear_bits = [], cc_producer=False}, groups, fun_defs, var_heap, expr_heap)
where
analyse_group common_defs group_nr (cleanup_info, class_env, groups, fun_defs, var_heap, expr_heap)
# ({group_members}, groups) = groups![group_nr]
......@@ -602,7 +602,7 @@ where
# (TransformedBody {tb_args}) = fun_def.fun_body
(fresh_vars, next_var_number, var_heap) = fresh_variables tb_args 0 next_var_number var_heap
= initial_cons_class funs next_var_number (length fun_def.fun_info.fi_local_vars + nr_of_local_vars) var_heap
{ class_env & [fun] = { cc_size = 0, cc_args = fresh_vars, cc_linear_bits=[]}} fun_defs
{ class_env & [fun] = { cc_size = 0, cc_args = fresh_vars, cc_linear_bits=[], cc_producer=False}} fun_defs
initial_cons_class [] next_var_number nr_of_local_vars var_heap class_env fun_defs
= (next_var_number, nr_of_local_vars, var_heap, class_env, fun_defs)
......@@ -1143,7 +1143,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti
# cc_args_from_outer_fun = [ cons_arg \\ cons_arg <- outer_cons_args.cc_args & used <- used_mask | used ]
cc_linear_bits_from_outer_fun = [ cons_arg \\ cons_arg <- outer_cons_args.cc_linear_bits & used <- used_mask | used ]
new_cons_args = { cc_size = fun_arity, cc_args = repeatn nr_of_lifted_vars cPassive++cc_args_from_outer_fun,
cc_linear_bits = repeatn nr_of_lifted_vars False++cc_linear_bits_from_outer_fun }
cc_linear_bits = repeatn nr_of_lifted_vars False++cc_linear_bits_from_outer_fun, cc_producer = False}
gf = { gf_fun_def = fun_def, gf_instance_info = II_Empty, gf_cons_args = new_cons_args, gf_fun_index = fun_index}
ti_fun_heap = writePtr fun_info_ptr (FI_Function gf) ti.ti_fun_heap
ti = { ti & ti_new_functions = [fun_info_ptr:ti.ti_new_functions], ti_var_heap = ti_var_heap, ti_fun_heap = ti_fun_heap,
......@@ -1537,9 +1537,11 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi
new_fd_expanding
= { fd & fun_body = Expanding new_fun_args, fun_arity = fun_arity,fun_type=new_fun_type,
fun_info.fi_group_index = fi_group_index}
new_fd_cons_args
= {cc_args = new_cons_args, cc_size = length new_cons_args, cc_linear_bits=new_linear_bits, cc_producer = False}
new_gen_fd
= { gf_fun_def = new_fd_expanding, gf_instance_info = II_Empty, gf_fun_index = ti_next_fun_nr,
gf_cons_args = {cc_args = new_cons_args, cc_size = length new_cons_args, cc_linear_bits=new_linear_bits} }
gf_cons_args = new_fd_cons_args }
ti_fun_heap
= writePtr fun_def_ptr (FI_Function new_gen_fd) ti_fun_heap
(subst, _)
......@@ -1573,7 +1575,7 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi
}
ti_trace
=False
| ti_trace && (False--->("transforming new function:",tb_rhs))
| False -!-> ("transforming new function:",tb_rhs)
= undef
# ti
= { ti & ti_var_heap = us_var_heap, ti_fun_heap = ti_fun_heap, ti_symbol_heap = us_symbol_heap,
......@@ -1584,9 +1586,27 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi
= transform tb_rhs ro ti
new_fd
= { new_fd_expanding & fun_body = TransformedBody {tb_args = new_fun_args, tb_rhs = new_fun_rhs} }
// | (False--->("generated function", new_fd, new_cons_args))
// = undef
= (ti_next_fun_nr, fun_arity, { ti & ti_fun_heap = ti.ti_fun_heap <:= (fun_def_ptr, FI_Function { new_gen_fd & gf_fun_def = new_fd })})
| False -!-> ("generated function", new_fd, new_cons_args)
= undef
// DvA...
# fun_heap = ti.ti_fun_heap
// producer requirements for generated function here...
#! prs =
{ prs_group = [dec ti_next_fun_nr]
, prs_cons_args = ti.ti_cons_args
, prs_main_dcl_module_n = ro.ro_main_dcl_module_n
, prs_fun_heap = fun_heap
}
# (safe,prs) = producerRequirements new_fun_rhs prs
# fun_heap = prs.prs_fun_heap
// put back prs info into ti?
// ...DvA
# new_gen_fd = { new_gen_fd & gf_fun_def = new_fd, gf_cons_args = {new_fd_cons_args & cc_producer = safe}}
# ti =
{ ti
& ti_fun_heap = fun_heap <:= (fun_def_ptr, FI_Function new_gen_fd)
}
= (ti_next_fun_nr, fun_arity, ti)
where
is_dictionary {at_type=TA {type_index} _} es_td_infos
= type_index.glob_object>=size es_td_infos.[type_index.glob_module]
......@@ -1764,11 +1784,13 @@ where
Yes cons_classes
-> ({ cc_size = symb_arity, cc_args = take symb_arity cons_classes.cc_args,
cc_linear_bits = if curried (repeatn symb_arity linear_bit)
(take symb_arity cons_classes.cc_linear_bits)}
(take symb_arity cons_classes.cc_linear_bits),
cc_producer = False}
, fun_heap)
No
-> ({cc_size = symb_arity, cc_args = repeatn symb_arity cPassive,
cc_linear_bits = repeatn symb_arity linear_bit}, fun_heap)
cc_linear_bits = repeatn symb_arity linear_bit,
cc_producer = False}, fun_heap)
get_fun_def (SK_Function {glob_module, glob_object}) main_dcl_module_n fun_defs fun_heap
......@@ -2448,11 +2470,53 @@ transformGroups cleanup_info main_dcl_module_n stdStrictLists_module_n groups fu
# (ti_fun_defs, imported_types, collected_imports, ti_type_heaps, ti_var_heap)
= foldSt (convert_function_type common_defs) group_members
(ti.ti_fun_defs, imported_types, collected_imports, ti.ti_type_heaps, ti.ti_var_heap)
= transform_groups (inc group_nr) groups common_defs imported_funs imported_types collected_imports
(foldSt (transform_function common_defs imported_funs) group_members
{ ti & ti_fun_defs = ti_fun_defs, ti_type_heaps = ti_type_heaps, ti_var_heap = ti_var_heap })
# ti = { ti & ti_fun_defs = ti_fun_defs, ti_type_heaps = ti_type_heaps, ti_var_heap = ti_var_heap }
# ti = foldSt (transform_function common_defs imported_funs) group_members ti
# ti = reannotate_producers (group_members -!-> ("reannotate_producers",group_nr)) ti
= transform_groups (inc group_nr) groups common_defs imported_funs imported_types collected_imports ti
= (groups, imported_types, collected_imports, ti)
// DvA ...
reannotate_producers group_members ti
// determine if safe group
# (safe,ti) = safe_producers group_members group_members ti
| safe
// if safe mark all members as safe
= foldSt mark_producer_safe group_members ti
= ti
safe_producers group_members [] ti
= (True,ti)
safe_producers group_members [fun:funs] ti
// look for occurrence of group_members in safe argument position of fun RHS
// i.e. linearity ok && ...
#! prs =
{ prs_group = group_members
, prs_cons_args = ti.ti_cons_args
, prs_main_dcl_module_n = main_dcl_module_n
, prs_fun_heap = ti.ti_fun_heap
}
# (fun_def, ti) = ti!ti_fun_defs.[fun]
{fun_body = TransformedBody tb} = fun_def
fun_body = tb.tb_rhs
# (safe,prs) = producerRequirements fun_body prs
// put back prs info into ti?
| safe -!-> ("producerRequirements",fun_def.fun_symb,safe)
= safe_producers group_members funs ti
= (safe,ti)
mark_producer_safe fun ti
// update cc_prod for fun
// doesn't work with array update since that requires unique array?!
#! ti_cons_args = {safe x fun tca \\ tca <-: ti.ti_cons_args & x <- [0..]}
ti = {ti & ti_cons_args = ti_cons_args}
= ti
where
safe x f t
| x ==f = {t & cc_producer = pIsSafe}
= t
// ... DvA
transform_function common_defs imported_funs fun ti=:{ti_fun_defs, ti_var_heap}
# (fun_def, ti_fun_defs) = ti_fun_defs![fun]
(Yes {st_args}) = fun_def.fun_type
......@@ -2965,3 +3029,199 @@ foldrExprSt f expr st :== foldr_expr_st expr st
= f lad st
foldr_expr_st sel=:(Selection a expr b) st
= f sel (foldr_expr_st expr st)
:: *PRState =
{ prs_group :: ![Int]
, prs_cons_args :: !{!ConsClasses}
, prs_main_dcl_module_n :: !Int
, prs_fun_heap :: !*FunctionHeap
}
class producerRequirements a
:: !a !PRState -> (!Bool,!PRState)
instance producerRequirements [a] | producerRequirements a where
producerRequirements [] prs
= (True,prs)
producerRequirements [x:xs] prs
# (safe,prs) = producerRequirements x prs
| safe = producerRequirements xs prs
= (safe,prs)
instance producerRequirements Expression where
producerRequirements (Var var) prs
= (True,prs)
producerRequirements (App {app_symb={symb_kind=(SK_Constructor _)},app_args}) prs
= producerRequirements app_args prs
producerRequirements (App {app_symb,app_args}) prs
// look up consumer class for app_symb args
#! (maybe_ca,prs) = retrieve_consumer_args app_symb prs
// need to check for recursive call in safe arg...
= case maybe_ca of
No // assuming that for functions that have no consumer info no unfolding will occur
// note that this means that generated functions must be visible this way...
-> (True,prs)
Yes ca // for each arg:
// if safe && top of arg is App of group member...
// else recurse into arg
-> check_app_arguments ca.cc_args ca.cc_linear_bits app_args prs
where
check_app_arguments [cc_arg:cc_args] [cc_linear_bit:cc_bits] [app_arg:app_args] prs
| cc_arg == cActive && cc_linear_bit
# (rec,prs) = is_recursive_app app_arg prs
| rec = (False,prs)
# (safe,prs)= producerRequirements app_arg prs
| safe = check_app_arguments cc_args cc_bits app_args prs
= (safe,prs)
# (safe,prs) = producerRequirements app_arg prs
| safe = check_app_arguments cc_args cc_bits app_args prs
= (safe,prs)
check_app_arguments _ _ _ prs
= (True,prs)
is_recursive_app (App {app_symb}) prs
// check if app_symb member of prs_group
# {symb_kind} = app_symb
| is_SK_Function_or_SK_LocalMacroFunction symb_kind
#! main_dcl_module_n = prs.prs_main_dcl_module_n
# { glob_module, glob_object }
= case symb_kind of
SK_Function global_index -> global_index
SK_LocalMacroFunction index -> { glob_module = main_dcl_module_n, glob_object = index }
| glob_module <> main_dcl_module_n
= (False,prs)
#! rec = isMember glob_object prs.prs_group
= (rec,prs)
is_recursive_app _ prs
= (False,prs)
producerRequirements (fun_expr @ exprs) prs
// recurse
# (safe,prs) = producerRequirements fun_expr prs
| safe = producerRequirements exprs prs
= (safe,prs)
producerRequirements (Let {let_strict_binds,let_lazy_binds,let_expr}) prs
// watch out for function shadowing by 'let' binds
// recurse into binding exprs
// continue with 'in' body
= (False,prs)
producerRequirements (Case {case_expr,case_guards,case_default,case_ident}) prs
// watch out for function shadowing by guards or case ident
// check case_expr
# (safe,prs) = producerRequirements case_expr prs
| not safe = (safe,prs)
// check case_guards
# (safe,prs) = producerRequirements case_guards prs
| not safe = (safe,prs)
// check case_default
# (safe,prs) = producerRequirements case_default prs
| not safe = (safe,prs)
= (True,prs)
producerRequirements (Selection _ _ _) prs
// ...
= (False,prs)
producerRequirements (Update _ _ _) prs
// ...
= (False,prs)
producerRequirements (RecordUpdate _ expr exprs) prs
// ...
# (safe,prs) = producerRequirements expr prs
| safe = producerFieldRequirements exprs prs
= (safe,prs)
where
producerFieldRequirements [] prs
= (True,prs)
producerFieldRequirements [{bind_src}:fields] prs
# (safe,prs) = producerRequirements bind_src prs
| safe = producerFieldRequirements fields prs
= (safe,prs)
producerRequirements (TupleSelect _ _ expr) prs
= producerRequirements expr prs
producerRequirements (BasicExpr _ _) prs
= (True,prs)
producerRequirements (AnyCodeExpr _ _ _) prs
= (False,prs)
producerRequirements (ABCCodeExpr _ _) prs
= (False,prs)
producerRequirements (MatchExpr _ _ _) prs
// what's this?
= (False,prs)
producerRequirements (DynamicExpr _) prs
// what's this?
= (False,prs)
producerRequirements (TypeCodeExpression _) prs
// what's this?
= (False,prs)
producerRequirements (EE) prs
// what's this?
= (False,prs)
producerRequirements (NoBind var) prs
// what's this?
= (False,prs)
producerRequirements expr prs
= abort ("producerRequirements " ---> expr)
instance producerRequirements (Optional a) | producerRequirements a where
producerRequirements (Yes x) prs
= producerRequirements x prs
producerRequirements No prs
= (True,prs)
instance producerRequirements CasePatterns where
producerRequirements (AlgebraicPatterns index patterns) prs
// name shadowing...
# (safe,prs) = producerRequirements patterns prs
= (safe,prs)
producerRequirements (BasicPatterns type patterns) prs
// name shadowing...
# (safe,prs) = producerRequirements patterns prs
= (safe,prs)
producerRequirements (DynamicPatterns patterns) prs
//...disallow for now...
= (False,prs)
producerRequirements NoPattern prs
= (True,prs)
instance producerRequirements AlgebraicPattern where
producerRequirements {ap_expr} prs
// name shadowing...
= producerRequirements ap_expr prs
instance producerRequirements BasicPattern where
producerRequirements {bp_expr} prs
// name shadowing...
= producerRequirements bp_expr prs
// compare with 'get_fun_def_and_cons_args'
retrieve_consumer_args si=:{symb_kind, symb_arity} prs=:{prs_cons_args, prs_main_dcl_module_n}
= case symb_kind of
SK_Function {glob_module, glob_object}
| glob_module == prs_main_dcl_module_n && glob_object < size prs_cons_args
-> (Yes prs_cons_args.[glob_object],prs)
-> (No,prs) -!-> ("r_c_a",si)
SK_LocalMacroFunction glob_object
| glob_object < size prs_cons_args
-> (Yes prs_cons_args.[glob_object],prs)
-> (No,prs) -!-> ("r_c_a",si)
SK_GeneratedFunction fun_ptr fun_index
| fun_index < size prs_cons_args
-> (Yes prs_cons_args.[fun_index],prs)
# (FI_Function {gf_cons_args}, fun_heap) = readPtr fun_ptr prs.prs_fun_heap
# prs = {prs & prs_fun_heap = fun_heap}
-> (Yes gf_cons_args,prs)
// SK_Constructor cons_index
sk -> (No -!-> ("Unexpected symbol kind: ", si, sk),prs)
instance <<< SymbIdent
where
(<<<) file symb=:{symb_kind = SK_Function symb_index }
= file <<< symb.symb_name <<< '@' <<< symb_index
(<<<) file symb=:{symb_kind = SK_LocalMacroFunction symb_index }
= file <<< symb.symb_name <<< '@' <<< symb_index
(<<<) file symb=:{symb_kind = SK_GeneratedFunction _ symb_index }
= file <<< symb.symb_name <<< '@' <<< symb_index
(<<<) file symb=:{symb_kind = SK_OverloadedFunction symb_index }
= file <<< symb.symb_name <<< "[o]@" <<< symb_index
(<<<) file symb
= file <<< symb.symb_name
Supports Markdown
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