Commit b7a59339 authored by Martin Wierich's avatar Martin Wierich
Browse files

lots of changes in module trans to make fusion work.

parent edc0429e
......@@ -596,6 +596,7 @@ where
, ef_member_defs :: !.{# MemberDef}
, ef_class_defs :: !.{# ClassDef}
, ef_modules :: !.{# DclModule}
, ef_is_macro_fun :: !Bool
}
:: ExpressionState =
......@@ -2048,7 +2049,7 @@ where
checkFunction :: !Index !Index !Level !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef},!*ExpressionInfo, !*Heaps, !*CheckState);
checkFunction mod_index fun_index def_level fun_defs
e_info=:{ef_type_defs,ef_modules,ef_class_defs} heaps=:{hp_var_heap,hp_expression_heap,hp_type_heaps} cs=:{cs_error}
e_info=:{ef_type_defs,ef_modules,ef_class_defs,ef_is_macro_fun} heaps=:{hp_var_heap,hp_expression_heap,hp_type_heaps} cs=:{cs_error}
#! fun_def = fun_defs.[fun_index]
# {fun_symb,fun_pos,fun_body,fun_type} = fun_def
position = newPosition fun_symb fun_pos
......@@ -2065,7 +2066,8 @@ checkFunction mod_index fun_index def_level fun_defs
(ef_type_defs, ef_modules, es_type_heaps, es_expression_heap, cs) =
checkDynamicTypes mod_index es_dynamics fun_type e_info.ef_type_defs e_info.ef_modules es_type_heaps es_expression_heap cs
cs = { cs & cs_error = popErrorAdmin cs.cs_error }
fun_info = { fun_def.fun_info & fi_calls = es_calls, fi_def_level = def_level, fi_free_vars = free_vars, fi_dynamics = es_dynamics }
fun_info = { fun_def.fun_info & fi_calls = es_calls, fi_def_level = def_level, fi_free_vars = free_vars, fi_dynamics = es_dynamics,
fi_is_macro_fun = ef_is_macro_fun }
fun_defs = { es_fun_defs & [fun_index] = { fun_def & fun_body = fun_body, fun_index = fun_index, fun_info = fun_info, fun_type = fun_type}}
(fun_defs, cs_symbol_table) = remove_calls_from_symbol_table fun_index def_level es_calls fun_defs cs.cs_symbol_table
= (fun_defs,
......@@ -2106,9 +2108,10 @@ checkFunctions mod_index level from_index to_index fun_defs e_info heaps cs
checkMacros :: !Index !IndexRange !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
-> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState);
checkMacros mod_index range fun_defs e_info heaps cs
# (fun_defs, e_info=:{ef_modules}, heaps=:{hp_var_heap, hp_expression_heap}, cs=:{cs_symbol_table,cs_error})
= checkFunctions mod_index cGlobalScope range.ir_from range.ir_to fun_defs e_info heaps cs
checkMacros mod_index range fun_defs e_info=:{ef_is_macro_fun=ef_is_macro_fun_old} heaps cs
# (fun_defs, e_info, heaps=:{hp_var_heap, hp_expression_heap}, cs=:{cs_symbol_table,cs_error})
= checkFunctions mod_index cGlobalScope range.ir_from range.ir_to fun_defs { e_info & ef_is_macro_fun=True } heaps cs
(e_info=:{ef_modules}) = { e_info & ef_is_macro_fun=ef_is_macro_fun_old }
(fun_defs, ef_modules, hp_var_heap, hp_expression_heap, cs_symbol_table, cs_error)
= partitionateMacros range mod_index fun_defs ef_modules hp_var_heap hp_expression_heap cs_symbol_table cs_error
= (fun_defs, { e_info & ef_modules = ef_modules }, {heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap},
......@@ -2375,7 +2378,8 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
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_cons_defs = icl_common.com_cons_defs, ef_member_defs = icl_common.com_member_defs, ef_modules = dcl_modules,
ef_is_macro_fun = False }
(icl_functions, e_info, heaps, cs) = checkMacros cIclModIndex cdefs.def_macros icl_functions e_info heaps cs
(icl_functions, e_info, heaps, cs) = checkFunctions cIclModIndex cGlobalScope 0 nr_of_global_funs icl_functions e_info heaps cs
......@@ -2791,7 +2795,8 @@ checkDclModule {mod_name,mod_imports,mod_defs} mod_index modules icl_functions h
reverse rev_special_defs) }
e_info = { ef_type_defs = com_type_defs, ef_selector_defs = dcl_common.com_selector_defs, ef_class_defs = com_class_defs,
ef_cons_defs = dcl_common.com_cons_defs, ef_member_defs = dcl_common.com_member_defs, ef_modules = modules }
ef_cons_defs = dcl_common.com_cons_defs, ef_member_defs = dcl_common.com_member_defs, ef_modules = modules,
ef_is_macro_fun = False }
(icl_functions, e_info, heaps, cs)
= checkMacros mod_index dcl_macros icl_functions e_info heaps { cs & cs_error = cs_error }
......
......@@ -268,7 +268,7 @@ newFunction opt_id fun_bodies arg_types result_type group_index (ci_next_fun_nr,
= ({ symb_name = fun_id, symb_kind = SK_GeneratedFunction fun_def_ptr ci_next_fun_nr, symb_arity = arity },
(inc ci_next_fun_nr, [fun_def_ptr : ci_new_functions],
ci_fun_heap <:= (fun_def_ptr, FI_Function { gf_fun_def = fun_def, gf_instance_info = II_Empty,
gf_fun_index = ci_next_fun_nr, gf_cons_args = {cc_args = [], cc_size=0} })))
gf_fun_index = ci_next_fun_nr, gf_cons_args = {cc_size=0, cc_args = [], cc_linear_bits = []} })))
consOptional (Yes x) xs = [x : xs]
......
......@@ -3,6 +3,8 @@ module main
import scanner, parse, postparse, check, type, trans, convertcases, utilities, convertDynamics
import StdEnv
// XXX
import RWSDebug
Start world
# (std_io, world) = stdio world
......@@ -16,6 +18,15 @@ Start world
(ms.ms_out, ms.ms_files))) world
= fclose ms_out world
CommandLoop proj ms=:{ms_io}
# answer = "c Menu0"
(command, argument) = SplitAtLayoutChar (dropWhile isSpace (fromString answer))
| command == []
= CommandLoop proj { ms & ms_io = ms_io}
# (ready, proj, ms) = DoCommand command argument proj { ms & ms_io = ms_io}
= ms
/*
CommandLoop proj ms=:{ms_io}
# (answer, ms_io) = freadline (ms_io <<< "> ")
(command, argument) = SplitAtLayoutChar (dropWhile isSpace (fromString answer))
......@@ -25,6 +36,7 @@ CommandLoop proj ms=:{ms_io}
| ready
= ms
= CommandLoop proj ms
*/
:: MainStateDefs funs funtypes types conses classes instances members selectors =
{ msd_funs :: !funs
......@@ -165,9 +177,10 @@ loadModule mod_ident predef_symbols hash_table ms=:{ms_files,ms_error,ms_io,ms_o
# (components, fun_defs) = partitionateFunctions (fun_defs ---> "partitionateFunctions") [ { ir_from = 0, ir_to = nr_of_global_funs }, icl_instances, icl_specials]
(components, fun_defs, ms_io) = showTypes components 0 fun_defs ms_io
// (components, fun_defs, ms_out) = showComponents components 0 True fun_defs ms_out
(acc_args, components, fun_defs, var_heap) = analyseGroups (components ---> "Transform") fun_defs heaps.hp_var_heap
(components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
= transformGroups components fun_defs acc_args common_defs imported_funs var_heap heaps.hp_type_heaps heaps.hp_expression_heap
(cleanup_info, acc_args, components, fun_defs, var_heap, expression_heap)
= analyseGroups (components ---> "Transform") fun_defs heaps.hp_var_heap heaps.hp_expression_heap
# (components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
= transformGroups cleanup_info components fun_defs acc_args common_defs imported_funs var_heap heaps.hp_type_heaps expression_heap
// (components, fun_defs, ms_error) = showComponents components 0 True fun_defs ms_error
(dcl_types, used_conses, var_heap, type_heaps) = convertIclModule common_defs dcl_types used_conses var_heap type_heaps
(dcl_types, used_conses, var_heap, type_heaps) = convertDclModule dcl_mods common_defs dcl_types used_conses var_heap type_heaps
......
......@@ -392,6 +392,7 @@ cIsNonCoercible :== 2
, fi_free_vars :: ![FreeVar]
, fi_local_vars :: ![FreeVar]
, fi_dynamics :: ![ExprInfoPtr]
, fi_is_macro_fun :: !Bool // whether the function is a local function of a macro
}
:: ParsedBody =
......@@ -417,7 +418,7 @@ cIsNonCoercible :== 2
| RhsMacroBody !CheckedBody
/* macro expansion transforms a CheckedBody into a TransformedBody */
| TransformedBody !TransformedBody
| Expanding
| Expanding ![FreeVar] // the parameters of the newly generated function
| BackendBody ![BackendBody]
:: BackendBody =
......@@ -444,7 +445,8 @@ cIsALocalVar :== False
:: ConsClasses =
{ cc_size ::!Int
, cc_args ::![ConsClass]
, cc_args ::![ConsClass] // the lists have the
, cc_linear_bits ::![Bool] // same length
}
:: ConsClass :== Int
......@@ -462,10 +464,10 @@ cIsALocalVar :== False
:: AP_Kind = APK_Constructor !Index | APK_Macro
:: VarInfo = VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar (!Ident, ![Int]) |
:: VarInfo = VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar !Ident |
VI_Expression !Expression | VI_Variable !Ident !VarInfoPtr | VI_LiftedVariable !VarInfoPtr |
VI_Count !Int /* the reference count of a variable */ !Bool /* true if the variable is global, false otherwise */ |
VI_AccVar !ConsClass /* used during fusion to determine accumulating parameters of functions */ |
VI_AccVar !ConsClass !ArgumentPosition /* used during fusion to determine accumulating parameters of functions */ |
VI_Alias !BoundVar /* used for resolving aliases just before type checking (in transform) */ |
/* used during elimination and lifting of cases */
VI_FreeVar !Ident !VarInfoPtr !Int !AType | VI_BoundVar !AType | VI_LocalVar |
......@@ -478,6 +480,8 @@ cIsALocalVar :== False
VI_Pattern !AuxiliaryPattern |
VI_Default !Int /* used during conversion of dynamics; the Int indiacted the refenrence count */
:: ArgumentPosition :== Int
:: VarInfoPtr :== Ptr VarInfo
:: LetVarInfo =
......@@ -562,10 +566,10 @@ cNonRecursiveAppl :== False
:: FunctionInfo = FI_Empty | FI_Function !GeneratedFunction
:: Producer = PR_Empty
| PR_Function !SymbIdent !Index
| PR_Function !SymbIdent !Index !Int // Int: number of actual arguments in application
| PR_Class !App ![BoundVar] ![Type]
// | PR_Constructor !SymbIdent ![Expression]
| PR_GeneratedFunction !SymbIdent !Index
| PR_GeneratedFunction !SymbIdent !Index !Int // Int: number of actual arguments in application
:: InstanceInfo = II_Empty | II_Node !{! Producer} !FunctionInfoPtr !InstanceInfo !InstanceInfo
......@@ -634,6 +638,21 @@ cNonRecursiveAppl :== False
| EI_Default !Expression !AType !ExprInfoPtr
| EI_DefaultFunction !SymbIdent ![Expression]
| EI_Extended ![ExtendedExprInfo] !ExprInfo
:: ExtendedExprInfo
= EEI_ActiveCase !ActiveCaseInfo
:: ActiveCaseInfo =
{ aci_arg_pos :: !Int
, aci_opt_unfolder:: !(Optional SymbIdent)
, aci_free_vars :: !Optional [VarId]
}
:: VarId =
{ v_name :: !Ident
, v_info_ptr :: !VarInfoPtr
}
:: RefCountsInCase =
{ rcc_all_variables :: ![CountedVariable]
......@@ -786,6 +805,7 @@ cNonRecursiveAppl :== False
| TVI_Used /* to administer that this variable is encountered (in checkOpenTypes) */
// | TVI_Clean !Int /* to keep the unique number that has been assigned to this variable during 'clean_up' */
| TVI_TypeCode !TypeCodeExpression
| TVI_FreshTypeVar TypeVar /* auxiliary used during fusion */
:: TypeVarInfoPtr :== Ptr TypeVarInfo
:: TypeVarHeap :== Heap TypeVarInfo
......@@ -1146,7 +1166,7 @@ MakeAttributedType type :== { at_attribute = TA_None, at_annotation = AN_None, a
MakeAttributedTypeVar type_var :== { atv_attribute = TA_None, atv_annotation = AN_None, atv_variable = type_var }
EmptyFunInfo :== { fi_calls = [], fi_group_index = NoIndex, fi_def_level = NotALevel,
fi_free_vars = [], fi_local_vars = [], fi_dynamics = [] }
fi_free_vars = [], fi_local_vars = [], fi_dynamics = [], fi_is_macro_fun=False }
BottomSignClass :== { sc_pos_vect = 0, sc_neg_vect = 0 }
PostiveSignClass :== { sc_pos_vect = bitnot 0, sc_neg_vect = 0 }
......
......@@ -348,6 +348,7 @@ cMayBeNonCoercible :== 4
, fi_free_vars :: ![FreeVar]
, fi_local_vars :: ![FreeVar]
, fi_dynamics :: ![ExprInfoPtr]
, fi_is_macro_fun :: !Bool // whether the function is a local function of a macro
}
:: ParsedBody =
......@@ -373,7 +374,7 @@ cMayBeNonCoercible :== 4
| RhsMacroBody !CheckedBody
/* macro expansion the transforms a CheckedBody into a TransformedBody */
| TransformedBody !TransformedBody
| Expanding
| Expanding ![FreeVar] // the parameters of the newly generated function
| BackendBody ![BackendBody]
:: BackendBody =
......@@ -400,7 +401,8 @@ cIsALocalVar :== False
:: ConsClasses =
{ cc_size ::!Int
, cc_args ::![ConsClass]
, cc_args ::![ConsClass] // the lists have the
, cc_linear_bits ::![Bool] // same length
}
:: ConsClass :== Int
......@@ -418,10 +420,10 @@ cIsALocalVar :== False
:: AP_Kind = APK_Constructor !Index | APK_Macro
:: VarInfo = VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar (!Ident, ![Int]) |
:: VarInfo = VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar !Ident |
VI_Expression !Expression | VI_Variable !Ident !VarInfoPtr | VI_LiftedVariable !VarInfoPtr |
VI_Count !Int /* the reference count of a variable */ !Bool /* true if the variable is global, false otherwise */ |
VI_AccVar !ConsClass /* used during fusion to determine accumulating parameters of functions */ |
VI_AccVar !ConsClass !ArgumentPosition /* used during fusion to determine accumulating parameters of functions */ |
VI_Alias !BoundVar /* used for resolving aliases just before type checking (in transform) */ |
/* used during elimination and lifting of cases */
VI_FreeVar !Ident !VarInfoPtr !Int !AType | VI_BoundVar !AType | VI_LocalVar |
......@@ -434,6 +436,8 @@ cIsALocalVar :== False
VI_Pattern !AuxiliaryPattern |
VI_Default !Int /* used during conversion of dynamics; the Int indiacted the refenrence count */
:: ArgumentPosition :== Int
:: VarInfoPtr :== Ptr VarInfo
:: LetVarInfo =
......@@ -508,10 +512,10 @@ cNotVarNumber :== -1
:: FunctionInfo = FI_Empty | FI_Function !GeneratedFunction
:: Producer = PR_Empty
| PR_Function !SymbIdent !Index
| PR_Function !SymbIdent !Index !Int // Int: number of actual arguments in application
| PR_Class !App ![BoundVar] ![Type]
// | PR_Constructor !SymbIdent ![Expression]
| PR_GeneratedFunction !SymbIdent !Index
| PR_GeneratedFunction !SymbIdent !Index !Int // Int: number of actual arguments in application
:: InstanceInfo = II_Empty | II_Node !{! Producer} !FunctionInfoPtr !InstanceInfo !InstanceInfo
......@@ -581,6 +585,21 @@ cNotVarNumber :== -1
| EI_Default !Expression !AType !ExprInfoPtr
| EI_DefaultFunction !SymbIdent ![Expression]
| EI_Extended ![ExtendedExprInfo] !ExprInfo
:: ExtendedExprInfo
= EEI_ActiveCase !ActiveCaseInfo
:: ActiveCaseInfo =
{ aci_arg_pos :: !Int
, aci_opt_unfolder:: !(Optional SymbIdent)
, aci_free_vars :: !Optional [VarId]
}
:: VarId =
{ v_name :: !Ident
, v_info_ptr :: !VarInfoPtr
}
:: RefCountsInCase =
{ rcc_all_variables :: ![CountedVariable]
......@@ -725,6 +744,7 @@ cNotVarNumber :== -1
| TVI_CorrespondenceNumber !Int
| TVI_Used /* to adminster that this variable is encountered (in checkOpenTypes) */
| TVI_TypeCode !TypeCodeExpression
| TVI_FreshTypeVar TypeVar /* auxiliary used during fusion */
:: TypeVarInfoPtr :== Ptr TypeVarInfo
:: TypeVarHeap :== Heap TypeVarInfo
......@@ -1728,7 +1748,7 @@ MakeAttributedType type :== { at_attribute = TA_None, at_annotation = AN_None, a
MakeAttributedTypeVar type_var :== { atv_attribute = TA_None, atv_annotation = AN_None, atv_variable = type_var }
EmptyFunInfo :== { fi_calls = [], fi_group_index = NoIndex, fi_def_level = NotALevel,
fi_free_vars = [], fi_local_vars = [], fi_dynamics = [] }
fi_free_vars = [], fi_local_vars = [], fi_dynamics = [], fi_is_macro_fun=False }
BottomSignClass :== { sc_pos_vect = 0, sc_neg_vect = 0 }
PostiveSignClass :== { sc_pos_vect = bitnot 0, sc_neg_vect = 0 }
......
......@@ -8,9 +8,12 @@ cPassive :== -1
cActive :== -2
cAccumulating :== -3
analyseGroups :: !*{! Group} !*{#FunDef} !*VarHeap -> (!*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap)
:: CleanupInfo
transformGroups :: !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } !*VarHeap !*TypeHeaps !*ExpressionHeap
analyseGroups :: !*{! Group} !*{#FunDef} !*VarHeap !*ExpressionHeap
-> (!CleanupInfo, !*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap, !*ExpressionHeap)
transformGroups :: !CleanupInfo !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
partitionateFunctions :: !*{# FunDef} ![IndexRange] -> (!*{! Group}, !*{# FunDef})
......
......@@ -4,7 +4,7 @@ import StdEnv
import syntax, transform, checksupport, StdCompare, check, utilities
import RWSDebug
import RWSDebug, StdDebug
:: PartitioningInfo =
{ pi_marks :: !.{# Int}
......@@ -15,6 +15,7 @@ import RWSDebug
}
NotChecked :== -1
implies a b :== not a || b
partitionateFunctions :: !*{# FunDef} ![IndexRange] -> (!*{! Group}, !*{# FunDef})
partitionateFunctions fun_defs ranges
......@@ -89,12 +90,15 @@ where
:: *AnalyseInfo =
{ ai_heap :: !*VarHeap
, ai_cons_class :: !*{! ConsClasses}
, ai_cur_ref_counts :: !*{#Int} // for each variable 0,1 or 2
, ai_class_subst :: !* ConsClassSubst
, ai_next_var :: !Int
, ai_cases_of_vars_for_function :: ![(!ExprInfoPtr,!VarInfoPtr)]
}
:: ConsClassSubst :== {# ConsClass}
:: CleanupInfo :== [ExprInfoPtr]
/*
The argument classification (i.e. 'accumulating', 'active' or 'passive') of consumers
is represented by an negative integer value.
......@@ -102,6 +106,7 @@ where
Unification of classifications is done on-the-fly
*/
cNoFunArg :== -1
cPassive :== -1
cActive :== -2
......@@ -145,6 +150,7 @@ where
| IsAVariable cc2
#! cc_val2 = subst.[cc2]
= { subst & [cc2] = cc1, [cc1] = combine_cons_constants cc_val1 cc_val2 }
= { subst & [cc1] = combine_cons_constants cc_val1 cc2 }
| IsAVariable cc2
#! cc_val2 = subst.[cc2]
......@@ -165,11 +171,16 @@ instance consumerRequirements BoundVar
where
consumerRequirements {var_info_ptr} ai=:{ai_heap}
#! var_info = sreadPtr var_info_ptr ai_heap
= case var_info of
VI_AccVar temp_var
-> (temp_var, ai)
_
-> (cPassive, ai)
= continuation var_info ai
where
continuation (VI_AccVar temp_var arg_position) ai=:{ai_cur_ref_counts}
| arg_position<0
= (temp_var, ai)
#! ref_count = ai_cur_ref_counts.[arg_position]
ai_cur_ref_counts = { ai_cur_ref_counts & [arg_position]=min (ref_count+1) 2 }
= (temp_var, { ai & ai_cur_ref_counts=ai_cur_ref_counts })
// continuation vi ai
// = (cPassive, ai)
instance consumerRequirements Expression where
consumerRequirements (Var var) ai
......@@ -186,7 +197,8 @@ instance consumerRequirements Expression where
= consumerRequirements let_expr ai
where
init_variables [{bind_dst={fv_info_ptr}} : binds] ai_next_var ai_heap
= init_variables binds (inc ai_next_var) (write_ptr fv_info_ptr (VI_AccVar ai_next_var) ai_heap "init_variables")
= init_variables binds (inc ai_next_var)
(write_ptr fv_info_ptr (VI_AccVar ai_next_var cNoFunArg) ai_heap "init_variables")
init_variables [] ai_next_var ai_heap
= (ai_next_var, ai_heap)
......@@ -262,6 +274,7 @@ instance consumerRequirements App where
# (act_cc, ai) = consumerRequirements arg ai
ai_class_subst = unifyClassifications form_cc act_cc ai.ai_class_subst
= reqs_of_args ccs args (combineClasses act_cc cumm_arg_class) { ai & ai_class_subst = ai_class_subst }
/*
consumerRequirements {app_symb={symb_kind = SK_InternalFunction _}, app_args=[arg:_]} ai
# (cc, ai) = consumerRequirements arg ai
......@@ -271,12 +284,24 @@ instance consumerRequirements App where
consumerRequirements {app_args} ai
= consumerRequirements app_args ai
instance consumerRequirements Case where
consumerRequirements {case_expr,case_guards,case_default,case_info_ptr} ai
# ai = case case_expr of
(Var {var_info_ptr}) -> { ai & ai_cases_of_vars_for_function=[(case_info_ptr,var_info_ptr):ai.ai_cases_of_vars_for_function] }
_ -> ai
(cce, ai) = consumerRequirements case_expr ai
ai_class_subst = unifyClassifications cActive cce ai.ai_class_subst
(ccgs, ai) = consumerRequirements case_guards { ai & ai_class_subst = ai_class_subst }
(ccd, ai) = consumerRequirements case_default ai
= (combineClasses ccgs ccd, ai)
/* XXX was
instance consumerRequirements Case where
consumerRequirements {case_expr,case_guards,case_default} ai
# (cce, ai) = consumerRequirements case_expr ai
// ai_class_subst = unifyClassifications cActive cce ai.ai_class_subst
(ccgs, ai) = consumerRequirements (case_guards,case_default) ai //{ ai & ai_class_subst = ai_class_subst }
ai_class_subst = unifyClassifications cActive cce ai.ai_class_subst
(ccgs, ai) = consumerRequirements (case_guards,case_default) { ai & ai_class_subst = ai_class_subst }
= (ccgs, ai)
*/
instance consumerRequirements DynamicExpr where
consumerRequirements {dyn_expr} ai
......@@ -296,12 +321,25 @@ instance consumerRequirements DynamicPattern where
instance consumerRequirements CasePatterns where
consumerRequirements (AlgebraicPatterns type patterns) ai
= consumerRequirements patterns ai
# pattern_exprs = [ ap_expr \\ {ap_expr}<-patterns]
pattern_vars = flatten [ filter (\{fv_count}->fv_count>0) ap_vars \\ {ap_vars}<-patterns]
(ai_next_var, ai_heap) = bind_pattern_vars pattern_vars ai.ai_next_var ai.ai_heap
= independentConsumerRequirements pattern_exprs { ai & ai_heap=ai_heap, ai_next_var=ai_next_var }
where
bind_pattern_vars [{fv_info_ptr,fv_count} : vars] next_var var_heap
| fv_count > 0
= bind_pattern_vars vars (inc next_var) (write_ptr fv_info_ptr (VI_AccVar next_var cNoFunArg) var_heap "bind_pattern_vars")
= bind_pattern_vars vars (inc next_var) var_heap
bind_pattern_vars [] next_var var_heap
= (next_var, var_heap)
consumerRequirements (BasicPatterns type patterns) ai
= consumerRequirements patterns ai
# pattern_exprs = [ bp_expr \\ {bp_expr}<-patterns]
= independentConsumerRequirements pattern_exprs ai
consumerRequirements (DynamicPatterns dyn_patterns) ai
= consumerRequirements dyn_patterns ai
= abort "trans.icl: consumerRequirements CasePatterns case missing"
// XXX was before adding reference counting = consumerRequirements dyn_patterns ai
/*
instance consumerRequirements AlgebraicPattern where
consumerRequirements {ap_vars,ap_expr} ai=:{ai_heap}
# ai_heap = bind_pattern_vars ap_vars ai_heap
......@@ -309,10 +347,11 @@ instance consumerRequirements AlgebraicPattern where
where
bind_pattern_vars [{fv_info_ptr,fv_count} : vars] var_heap
| fv_count > 0
= bind_pattern_vars vars (write_ptr fv_info_ptr (VI_AccVar cPassive) var_heap "bind_pattern_vars")
= bind_pattern_vars vars (write_ptr fv_info_ptr (VI_AccVar cPassive cNoFunArg) var_heap "bind_pattern_vars") -!-> "NOT BINDING"
= bind_pattern_vars vars var_heap
bind_pattern_vars [] var_heap
= var_heap
*/
instance consumerRequirements BasicPattern where
consumerRequirements {bp_expr} ai
......@@ -342,60 +381,124 @@ instance consumerRequirements (Bind a b) | consumerRequirements a where
consumerRequirements {bind_src} ai
= consumerRequirements bind_src ai
analyseGroups :: !*{! Group} !*{#FunDef} !*VarHeap -> (!*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap)
analyseGroups groups fun_defs var_heap
independentConsumerRequirements exprs ai=:{ai_cur_ref_counts}
// reference counting happens independently for each pattern expression
#! s = size ai_cur_ref_counts
zero_array = createArray s 0
(_, cc, ai) = foldSt independent_consumer_requirements exprs (zero_array, cPassive, ai)
= (cc, ai)
where
independent_consumer_requirements :: Expression (*{#Int}, ConsClass, AnalyseInfo) -> (*{#Int}, ConsClass, AnalyseInfo)
independent_consumer_requirements expr (zero_array, cc, ai=:{ai_cur_ref_counts})
#! s = size ai_cur_ref_counts
ai = { ai & ai_cur_ref_counts=zero_array }
(cce, ai) = consumerRequirements expr ai
(unused, unified_ref_counts) = unify_ref_count_arrays s ai_cur_ref_counts ai.ai_cur_ref_counts
ai = { ai & ai_cur_ref_counts=unified_ref_counts }
= ({ unused & [i]=0 \\ i<-[0..s-1]}, combineClasses cce cc, ai)
unify_ref_count_arrays 0 src1 src2_dest
= (src1, src2_dest)
unify_ref_count_arrays i src1 src2_dest
#! i1 = dec i
rc1 = src1.[i1]
rc2 = src2_dest.[i1]
= unify_ref_count_arrays i1 src1 { src2_dest & [i1]= unify_ref_counts rc1 rc2}
// unify_ref_counts outer_ref_count ref_count_in_pattern
unify_ref_counts 0 x = if (x==2) 2 0
unify_ref_counts 1 x = if (x==0) 1 2
unify_ref_counts 2 _ = 2
analyseGroups :: !*{! Group} !*{#FunDef} !*VarHeap !*ExpressionHeap
-> (!CleanupInfo, !*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap, !*ExpressionHeap)
analyseGroups groups fun_defs var_heap expr_heap
#! nr_of_funs = size fun_defs
= analyse_groups 0 groups var_heap (createArray nr_of_funs { cc_size = 0, cc_args = [] }) fun_defs
nr_of_groups = size groups
= iFoldSt analyse_group 0 nr_of_groups
([], createArray nr_of_funs { cc_size = 0, cc_args = [], cc_linear_bits = []}, groups, fun_defs, var_heap, expr_heap)
// = analyse_groups 0 groups (createArray nr_of_funs { cc_size = 0, cc_args = [], cc_linear_bits = []})
// fun_defs var_heap expr_heap
where
analyse_groups group_nr groups var_heap class_env fun_defs
/* analyse_groups group_nr groups class_env fun_defs var_heap expr_heap
| group_nr == size groups
= (class_env, groups, fun_defs, var_heap)
= (class_env, groups, fun_defs, var_heap, expr_heap)
#! fun_indexes = groups.[group_nr]
# (class_env, fun_defs, var_heap) = analyse_group fun_indexes.group_members var_heap class_env fun_defs
= analyse_groups (inc group_nr) groups var_heap class_env fun_defs
# (class_env, fun_defs, var_heap, expr_heap)
= analyse_group fun_indexes.group_members class_env fun_defs var_heap expr_heap
= analyse_groups (inc group_nr) groups class_env fun_defs var_heap expr_heap
analyse_group group var_heap class_env fun_defs
# (nr_of_vars, nr_of_local_vars, var_heap, class_env, fun_defs) = initial_cons_class group 0 0 var_heap class_env fun_defs
*/
analyse_group group_nr (cleanup_info, class_env, groups, fun_defs, var_heap, expr_heap)
#! {group_members} = groups.[group_nr]
# (nr_of_vars, nr_of_local_vars, var_heap, class_env, fun_defs) = initial_cons_class group_members 0 0 var_heap class_env fun_defs
initial_subst = createArray (nr_of_vars + nr_of_local_vars) cPassive
(ai, fun_defs) = analyse_functions group { ai_heap = var_heap, ai_cons_class = class_env,
ai_class_subst = initial_subst, ai_next_var = nr_of_vars } fun_defs
class_env = collect_classifications group ai.ai_cons_class ai.ai_class_subst
= (class_env, fun_defs, ai.ai_heap)
(ai_cases_of_vars_for_group, ai, fun_defs)
= analyse_functions group_members []
{ ai_heap = var_heap,
ai_cons_class = class_env,
ai_cur_ref_counts = {}, ai_class_subst = initial_subst,
ai_next_var = nr_of_vars,
ai_cases_of_vars_for_function = [] } fun_defs
class_env = collect_classifications group_members ai.ai_cons_class ai.ai_class_subst
(cleanup_info, class_env, fun_defs, var_heap, expr_heap)
= foldSt set_case_expr_info (flatten ai_cases_of_vars_for_group) (cleanup_info,class_env, fun_defs, ai.ai_heap, expr_heap)
= (cleanup_info, class_env, groups, fun_defs, var_heap, expr_heap)
where
set_case_expr_info ((expr_info_ptr,var_info_ptr),fun_index) (cleanup_acc, class_env, fun_defs, var_heap, expr_heap)
# (VI_AccVar _ arg_position, var_heap) = readPtr var_info_ptr var_heap
({cc_args, cc_linear_bits},class_env) = class_env![fun_index]
| arg_position<>cNoFunArg && cc_args!!arg_position==cActive && cc_linear_bits!!arg_position
// mark cases whose case_expr is an active linear function argument
# aci = { aci_arg_pos = arg_position, aci_opt_unfolder = No, aci_free_vars=No }
= ([expr_info_ptr:cleanup_acc], class_env, fun_defs, var_heap, add_extended_expr_info expr_info_ptr (EEI_ActiveCase aci) expr_heap)
= (cleanup_acc, class_env, fun_defs, var_heap, expr_heap)