Skip to content
GitLab
Commit b7a59339 authored by Martin Wierich's avatar Martin Wierich
Browse files

lots of changes in module trans to make fusion work.

parent edc0429e
Hide whitespace changes
Inline Side-by-side
frontend/check.icl
View file @ b7a59339
......@@ -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 }
......
frontend/convertcases.icl
View file @ b7a59339
......@@ -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]
......
frontend/main.icl
View file @ b7a59339
......@@ -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
......
frontend/syntax.dcl
View file @ b7a59339
......@@ -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 =
......@@ -443,8 +444,9 @@ cIsAGlobalVar :== True
cIsALocalVar :== False
:: ConsClasses =
{ cc_size ::!Int
, cc_args ::![ConsClass]
{ cc_size ::!Int
, 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 }
......
frontend/syntax.icl
View file @ b7a59339
......@@ -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 =
......@@ -399,8 +400,9 @@ cIsAGlobalVar :== True
cIsALocalVar :== False
:: ConsClasses =
{ cc_size ::!Int
, cc_args ::![ConsClass]
{ cc_size ::!Int
, 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 }
......
frontend/trans.dcl
View file @ b7a59339
......@@ -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})
......
frontend/trans.icl
View file @ b7a59339
......@@ -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
......@@ -87,14 +88,17 @@ where
:: BitVector :== Int
:: *AnalyseInfo =
{ ai_heap :: !*VarHeap
, ai_cons_class :: !*{! ConsClasses}
, ai_class_subst :: !* ConsClassSubst
, ai_next_var :: !Int
{ 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