Commit e20ad282 authored by Sjaak Smetsers's avatar Sjaak Smetsers
Browse files

change: dynamics are now converted before 'fusion'

parent 04775aea
......@@ -2,6 +2,12 @@ definition module convertDynamics
import syntax, transform, convertcases
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
/*
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols
!*{#{# CheckedTypeDef}} !ImportedFunctions !*VarHeap !*TypeHeaps !*ExpressionHeap
!*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
*/
\ No newline at end of file
This diff is collapsed.
......@@ -18,10 +18,16 @@ convertIclModule :: !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructor
-> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps)
newFunction :: !(Optional Ident) !FunctionBody ![AType] !AType !Int !(!Int, ![FunctionInfoPtr],!*FunctionHeap)
newFunction :: !(Optional Ident) !FunctionBody ![FreeVar] ![AType] !AType !Int !(!Int, ![FunctionInfoPtr],!*FunctionHeap)
-> (! SymbIdent, !(!Int, ![FunctionInfoPtr],!*FunctionHeap))
copyExpression :: ![(FreeVar,AType)] !Expression !*VarHeap -> (![Expression], ![.(FreeVar,AType)], !Expression, !*VarHeap)
:: TypedVariable =
{ tv_free_var :: !FreeVar
, tv_type :: !AType
}
copyExpression :: ![TypedVariable] !Expression !*VarHeap -> (![Expression], ![TypedVariable], ![FreeVar], !Expression, !*VarHeap)
addNewFunctionsToGroups :: !{#.CommonDefs} FunctionHeap ![FunctionInfoPtr] !*{! Group} !*{#{# CheckedTypeDef}} !ImportedFunctions !*TypeHeaps !*VarHeap
-> (!*{! Group}, ![FunDef], !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
......
......@@ -89,9 +89,11 @@ where
= (TupleSelect tuple_symbol arg_nr expr, ci)
convertCases bound_vars group_index common_defs (Case case_expr) ci
= convertCasesInCaseExpression bound_vars group_index common_defs cHasNoDefault case_expr ci
/*
convertCases bound_vars group_index common_defs (DynamicExpr dynamik) ci
# (dynamik, ci) = convertCases bound_vars group_index common_defs dynamik ci
= (DynamicExpr dynamik, ci)
*/
convertCases bound_vars group_index common_defs expr ci
= (expr, ci)
......@@ -110,10 +112,25 @@ where
cHasNoDefault :== nilPtr
convertDefaultToExpression default_ptr (EI_Default expr type prev_default) bound_vars group_index common_defs ci=:{ci_var_heap}
# (act_args, free_typed_vars, expression, ci_var_heap) = copyExpression bound_vars expr ci_var_heap
(fun_symb, ci) = newDefaultFunction free_typed_vars expression type prev_default group_index common_defs { ci & ci_var_heap = ci_var_heap }
# ci_var_heap = foldSt (\({fv_info_ptr}, type) -> writePtr fv_info_ptr (VI_BoundVar type)) bound_vars ci_var_heap
(expression, {cp_free_vars, cp_var_heap, cp_local_vars}) = copy expr { cp_free_vars = [], cp_var_heap = ci_var_heap, cp_local_vars = [] }
(act_args, free_typed_vars, ci_var_heap) = foldSt retrieveVariable cp_free_vars ([], [], cp_var_heap)
(fun_symb, ci) = new_default_function free_typed_vars cp_local_vars expression type prev_default group_index common_defs { ci & ci_var_heap = ci_var_heap }
= (App { app_symb = fun_symb, app_args = act_args, app_info_ptr = nilPtr },
{ ci & ci_expr_heap = ci.ci_expr_heap <:= (default_ptr, EI_DefaultFunction fun_symb act_args)})
where
new_default_function free_vars local_vars rhs_expr result_type prev_default group_index common_defs ci
# (guarded_exprs, ci) = convertPatternExpression [] [free_vars] group_index common_defs prev_default rhs_expr ci
fun_bodies = map build_pattern guarded_exprs
arg_types = map (\(_,type) -> type) free_vars
(fun_symb, (ci_next_fun_nr, ci_new_functions, ci_fun_heap))
= newFunction No (BackendBody fun_bodies) local_vars arg_types result_type group_index
(ci.ci_next_fun_nr, ci.ci_new_functions, ci.ci_fun_heap)
= (fun_symb, { ci & ci_fun_heap = ci_fun_heap, ci_next_fun_nr = ci_next_fun_nr, ci_new_functions = ci_new_functions })
build_pattern ([ right_patterns : _ ], bb_rhs)
= { bb_args = right_patterns, bb_rhs = bb_rhs }
convertDefaultToExpression default_ptr (EI_DefaultFunction fun_symb act_args) bound_vars group_index common_defs ci
= (App { app_symb = fun_symb, app_args = act_args, app_info_ptr = nilPtr }, ci)
......@@ -144,40 +161,35 @@ combineDefaults default_ptr this_default bound_vars guards group_index common_de
= (this_default, ci)
:: TypedVariable =
{ tv_free_var :: !FreeVar
, tv_type :: !AType
}
copyExpression :: ![TypedVariable] !Expression !*VarHeap -> (![Expression], ![TypedVariable], ![FreeVar], !Expression, !*VarHeap)
copyExpression bound_vars expression var_heap
# var_heap = foldSt (\{tv_free_var={fv_info_ptr},tv_type} -> writePtr fv_info_ptr (VI_BoundVar tv_type)) bound_vars var_heap
(expression, {cp_free_vars, cp_var_heap, cp_local_vars}) = copy expression { cp_free_vars = [], cp_var_heap = var_heap, cp_local_vars = [] }
(bound_vars, free_typed_vars, var_heap) = foldSt retrieve_variable cp_free_vars ([], [], cp_var_heap)
= (bound_vars, free_typed_vars, cp_local_vars, expression, var_heap)
where
retrieve_variable (var_info_ptr, type) (bound_vars, free_typed_vars, var_heap)
# (VI_FreeVar name new_ptr count type, var_heap) = readPtr var_info_ptr var_heap
= ( [Var { var_name = name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} : bound_vars],
[{tv_free_var = { fv_def_level = NotALevel, fv_name = name, fv_info_ptr = new_ptr, fv_count = count }, tv_type = type} : free_typed_vars], var_heap)
retrieveVariable (var_info_ptr, type) (bound_vars, free_typed_vars, var_heap)
# (VI_FreeVar name new_ptr count type, var_heap) = readPtr var_info_ptr var_heap
= ( [Var { var_name = name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} : bound_vars],
[({ fv_def_level = NotALevel, fv_name = name, fv_info_ptr = new_ptr, fv_count = count }, type) : free_typed_vars], var_heap)
copyCaseExpression bound_vars opt_variable guards_and_default var_heap
# var_heap = foldSt (\({fv_name,fv_info_ptr},type) -> writePtr fv_info_ptr (VI_BoundVar type)) bound_vars var_heap
(opt_copied_var, var_heap) = copy_variable opt_variable var_heap
(expression, {cp_free_vars, cp_var_heap}) = copy guards_and_default ({ cp_free_vars = [], cp_var_heap = var_heap }
==> ("copyCaseExpression", bound_vars, guards_and_default))
(bound_vars, free_typed_vars, var_heap) = foldSt retrieveVariable cp_free_vars ([], [], cp_var_heap)
(opt_free_var, var_heap) = toOptionalFreeVar opt_copied_var var_heap
= (bound_vars, free_typed_vars, opt_free_var, expression, var_heap)
where
copy_variable (Yes (var=:{var_name,var_info_ptr}, var_type)) var_heap
# (new_info, var_heap) = newPtr VI_Empty var_heap
= (Yes (var_info_ptr, var_type), var_heap <:= (var_info_ptr, VI_FreeVar var_name new_info 0 var_type))
copy_variable No var_heap
= (No, var_heap)
copyExpression :: ![(FreeVar,AType)] !Expression !*VarHeap -> (![Expression], ![.(FreeVar,AType)], !Expression, !*VarHeap)
copyExpression bound_vars expression var_heap
# var_heap = foldSt (\({fv_name,fv_info_ptr},type) -> writePtr fv_info_ptr (VI_BoundVar type)) bound_vars var_heap
(expression, {cp_free_vars, cp_var_heap}) = copy expression { cp_free_vars = [], cp_var_heap = var_heap }
(bound_vars, free_typed_vars, var_heap) = foldSt retrieveVariable cp_free_vars ([], [], cp_var_heap)
= (bound_vars, free_typed_vars, expression, var_heap)
[({ fv_def_level = NotALevel, fv_name = name, fv_info_ptr = new_ptr, fv_count = count }, type) : free_typed_vars], var_heap)
convertCasesInCaseExpression bound_vars group_index common_defs default_ptr { case_expr, case_guards, case_default, case_ident, case_info_ptr} ci
# (case_default, ci) = combineDefaults default_ptr case_default bound_vars case_guards group_index common_defs ci
(case_expr, ci) = convertCases bound_vars group_index common_defs case_expr ci
(EI_CaseTypeAndRefCounts case_type ref_counts, ci_expr_heap) = readPtr case_info_ptr ci.ci_expr_heap
(act_vars, form_vars, opt_free_var, (case_guards, case_default), ci_var_heap)
= copyCaseExpression bound_vars (get_variable case_expr case_type.ct_pattern_type) (case_guards,case_default) ci.ci_var_heap
(fun_symb, ci) = newCaseFunction case_ident case_guards case_default case_type opt_free_var form_vars
(act_vars, form_vars, opt_free_var, local_vars, (case_guards, case_default), ci_var_heap)
= copy_case_expression bound_vars (get_variable case_expr case_type.ct_pattern_type) (case_guards,case_default) ci.ci_var_heap
(fun_symb, ci) = new_case_function case_ident case_guards case_default case_type opt_free_var form_vars local_vars
group_index common_defs default_ptr { ci & ci_var_heap = ci_var_heap, ci_expr_heap = ci_expr_heap }
= (App { app_symb = fun_symb, app_args = [ case_expr : act_vars ], app_info_ptr = nilPtr }, ci)
where
......@@ -185,6 +197,31 @@ where
= Yes (var, pattern_type)
get_variable _ _
= No
copy_case_expression bound_vars opt_variable guards_and_default var_heap
# var_heap = foldSt (\({fv_name,fv_info_ptr},type) -> writePtr fv_info_ptr (VI_BoundVar type)) bound_vars var_heap
(opt_copied_var, var_heap) = copy_variable opt_variable var_heap
(expression, {cp_free_vars, cp_var_heap, cp_local_vars}) = copy guards_and_default { cp_free_vars = [], cp_var_heap = var_heap, cp_local_vars = [] }
(bound_vars, free_typed_vars, var_heap) = foldSt retrieveVariable cp_free_vars ([], [], cp_var_heap)
(opt_free_var, var_heap) = toOptionalFreeVar opt_copied_var var_heap
= (bound_vars, free_typed_vars, opt_free_var, cp_local_vars, expression, var_heap)
copy_variable (Yes (var=:{var_name,var_info_ptr}, var_type)) var_heap
# (new_info, var_heap) = newPtr VI_Empty var_heap
= (Yes (var_info_ptr, var_type), var_heap <:= (var_info_ptr, VI_FreeVar var_name new_info 0 var_type))
copy_variable No var_heap
= (No, var_heap)
new_case_function opt_id patterns case_default {ct_result_type,ct_pattern_type,ct_cons_types} opt_var free_vars local_vars
group_index common_defs prev_default ci=:{ci_expr_heap}
# (default_ptr, ci_expr_heap) = makePtrToDefault case_default ct_result_type prev_default ci_expr_heap
(fun_bodies, ci) = convertPatterns patterns ct_cons_types opt_var [] free_vars default_ptr group_index common_defs { ci & ci_expr_heap = ci_expr_heap }
(fun_bodies, ci) = convertDefault default_ptr opt_var [] free_vars group_index common_defs (fun_bodies, ci)
(fun_symb, (ci_next_fun_nr, ci_new_functions, ci_fun_heap))
= newFunction opt_id (BackendBody fun_bodies) local_vars [ct_pattern_type : [ type \\ (_, type) <- free_vars]] ct_result_type group_index
(ci.ci_next_fun_nr, ci.ci_new_functions, ci.ci_fun_heap)
= (fun_symb, { ci & ci_fun_heap = ci_fun_heap, ci_next_fun_nr = ci_next_fun_nr, ci_new_functions = ci_new_functions })
makePtrToDefault (Yes default_expr) type prev_default_ptr expr_heap
......@@ -215,31 +252,10 @@ where
typed_free_var_to_pattern (free_var, type) = FP_Variable free_var
newDefaultFunction free_vars rhs_expr result_type prev_default group_index common_defs ci
# (guarded_exprs, ci) = convertPatternExpression [] [free_vars] group_index common_defs prev_default rhs_expr ci
fun_bodies = map build_pattern guarded_exprs
arg_types = map (\(_,type) -> type) free_vars
(fun_symb, (ci_next_fun_nr, ci_new_functions, ci_fun_heap))
= newFunction No (BackendBody fun_bodies) arg_types result_type group_index
(ci.ci_next_fun_nr, ci.ci_new_functions, ci.ci_fun_heap)
= (fun_symb, { ci & ci_fun_heap = ci_fun_heap, ci_next_fun_nr = ci_next_fun_nr, ci_new_functions = ci_new_functions })
where
build_pattern ([ right_patterns : _ ], bb_rhs)
= { bb_args = right_patterns, bb_rhs = bb_rhs }
newCaseFunction opt_id patterns case_default {ct_result_type,ct_pattern_type,ct_cons_types} opt_var free_vars
group_index common_defs prev_default ci=:{ci_expr_heap}
# (default_ptr, ci_expr_heap) = makePtrToDefault case_default ct_result_type prev_default ci_expr_heap
(fun_bodies, ci) = convertPatterns patterns ct_cons_types opt_var [] free_vars default_ptr group_index common_defs { ci & ci_expr_heap = ci_expr_heap }
(fun_bodies, ci) = convertDefault default_ptr opt_var [] free_vars group_index common_defs (fun_bodies, ci)
(fun_symb, (ci_next_fun_nr, ci_new_functions, ci_fun_heap))
= newFunction opt_id (BackendBody fun_bodies) [ct_pattern_type : map (\(_,type) -> type) free_vars] ct_result_type group_index
(ci.ci_next_fun_nr, ci.ci_new_functions, ci.ci_fun_heap)
= (fun_symb, { ci & ci_fun_heap = ci_fun_heap, ci_next_fun_nr = ci_next_fun_nr, ci_new_functions = ci_new_functions })
newFunction :: !(Optional Ident) !FunctionBody ![AType] !AType !Int !(!Int, ![FunctionInfoPtr],!*FunctionHeap)
newFunction :: !(Optional Ident) !FunctionBody ![FreeVar] ![AType] !AType !Int !(!Int, ![FunctionInfoPtr],!*FunctionHeap)
-> (! SymbIdent, !(!Int, ![FunctionInfoPtr],!*FunctionHeap))
newFunction opt_id fun_bodies arg_types result_type group_index (ci_next_fun_nr, ci_new_functions, ci_fun_heap)
newFunction opt_id fun_bodies local_vars arg_types result_type group_index (ci_next_fun_nr, ci_new_functions, ci_fun_heap)
# (fun_def_ptr, ci_fun_heap) = newPtr FI_Empty ci_fun_heap
fun_id = getIdent opt_id ci_next_fun_nr
arity = length arg_types
......@@ -263,7 +279,7 @@ newFunction opt_id fun_bodies arg_types result_type group_index (ci_next_fun_nr,
, fun_index = NoIndex
, fun_kind = FK_Function
, fun_lifted = 0
, fun_info = { EmptyFunInfo & fi_group_index = group_index }
, fun_info = { EmptyFunInfo & fi_group_index = group_index, fi_local_vars = local_vars }
}
= ({ 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],
......@@ -721,25 +737,27 @@ convertRootExpression bound_vars group_index common_defs _ expr ci
:: CopyInfo =
{ cp_free_vars :: ![(VarInfoPtr,AType)]
, cp_local_vars :: ![FreeVar]
, cp_var_heap :: !.VarHeap
}
class copy e :: !e !*CopyInfo -> (!e, !*CopyInfo)
instance copy BoundVar
where
copy var=:{var_name,var_info_ptr} cp_info=:{cp_free_vars, cp_var_heap}
#! var_info = sreadPtr var_info_ptr cp_var_heap
copy var=:{var_name,var_info_ptr} cp_info=:{cp_var_heap}
# (var_info, cp_var_heap) = readPtr var_info_ptr cp_var_heap
cp_info = { cp_info & cp_var_heap = cp_var_heap }
= case var_info of
VI_FreeVar name new_info_ptr count type
-> ({ var & var_info_ptr = new_info_ptr }, { cp_free_vars = cp_free_vars,
cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar name new_info_ptr (inc count) type)})
-> ({ var & var_info_ptr = new_info_ptr },
{ cp_info & cp_var_heap = cp_info.cp_var_heap <:= (var_info_ptr, VI_FreeVar name new_info_ptr (inc count) type)})
VI_LocalVar
-> (var, {cp_free_vars = cp_free_vars, cp_var_heap = cp_var_heap})
-> (var, cp_info)
VI_BoundVar type
# (new_info_ptr, cp_var_heap) = newPtr VI_Empty cp_var_heap
-> ({ var & var_info_ptr = new_info_ptr }, { cp_free_vars = [ (var_info_ptr, type) : cp_free_vars ],
# (new_info_ptr, cp_var_heap) = newPtr VI_Empty cp_info.cp_var_heap
-> ({ var & var_info_ptr = new_info_ptr },
{ cp_info & cp_free_vars = [ (var_info_ptr, type) : cp_info.cp_free_vars ],
cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar var_name new_info_ptr 1 type) })
_
-> abort "copy [BoundVar] (convertcases, 612)" <<- (var_info ---> (var_name, ptrToInt var_info_ptr))
......@@ -755,10 +773,13 @@ where
copy (fun_expr @ exprs) cp_info
# ((fun_expr, exprs), cp_info) = copy (fun_expr, exprs) cp_info
= (fun_expr @ exprs, cp_info)
copy (Let lad=:{let_binds,let_expr}) cp_info=:{cp_var_heap}
# ((let_binds,let_expr), cp_info) = copy (let_binds,let_expr)
{ cp_info & cp_var_heap = foldSt (\{bind_dst={fv_info_ptr}} -> writePtr fv_info_ptr VI_LocalVar) let_binds cp_var_heap }
copy (Let lad=:{let_binds,let_expr}) cp_info=:{cp_var_heap, cp_local_vars}
# (cp_local_vars, cp_var_heap) = foldSt bind_let_var let_binds (cp_local_vars, cp_var_heap)
# ((let_binds,let_expr), cp_info) = copy (let_binds,let_expr) {cp_info & cp_var_heap = cp_var_heap, cp_local_vars = cp_local_vars }
= (Let {lad & let_expr = let_expr, let_binds = let_binds }, cp_info)
where
bind_let_var {bind_dst} (local_vars, var_heap)
= ([bind_dst : local_vars], var_heap <:= (bind_dst.fv_info_ptr, VI_LocalVar))
copy (Case case_expr) cp_info
# (case_expr, cp_info) = copy case_expr cp_info
= (Case case_expr, cp_info)
......@@ -783,9 +804,11 @@ where
copy (TupleSelect tuple_symbol arg_nr expr) cp_info
# (expr, cp_info) = copy expr cp_info
= (TupleSelect tuple_symbol arg_nr expr, cp_info)
/*
copy (DynamicExpr dynamik) cp_info
# (dynamik, cp_info) = copy dynamik cp_info
= (DynamicExpr dynamik, cp_info)
*/
copy EE cp_info
= (EE, cp_info)
copy expr cp_info
......@@ -811,7 +834,7 @@ where
copy selector cp_info
= (selector, cp_info)
/*
instance copy DynamicExpr
where
copy dynamik=:{dyn_expr,dyn_uni_vars,dyn_type_code} cp_info=:{cp_var_heap}
......@@ -842,6 +865,9 @@ copyVarInfo var_info_ptr cp_info=:{cp_free_vars, cp_var_heap}
# (new_info_ptr, cp_var_heap) = newPtr VI_Empty cp_var_heap
-> (new_info_ptr, { cp_free_vars = [ (var_info_ptr, type) : cp_free_vars ],
cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar { id_name = "_t", id_info = nilPtr } new_info_ptr 1 type) })
*/
instance copy Case
where
copy this_case=:{case_expr, case_guards, case_default} cp_info
......@@ -856,9 +882,11 @@ where
copy (BasicPatterns type patterns) cp_info
# (patterns, cp_info) = copy patterns cp_info
= (BasicPatterns type patterns, cp_info)
/*
copy (DynamicPatterns patterns) cp_info
# (patterns, cp_info) = copy patterns cp_info
= (DynamicPatterns patterns, cp_info)
*/
instance copy AlgebraicPattern
where
......@@ -871,7 +899,7 @@ where
copy pattern=:{bp_expr} cp_info
# (bp_expr, cp_info) = copy bp_expr cp_info
= ({ pattern & bp_expr = bp_expr }, cp_info)
/*
instance copy DynamicPattern
where
copy pattern=:{dp_var={fv_info_ptr},dp_rhs,dp_type_patterns_vars, dp_type_code} cp_info=:{cp_var_heap}
......@@ -880,7 +908,7 @@ where
<:= (fv_info_ptr, VI_LocalVar) }
(dp_type_code, cp_info) = copy dp_type_code cp_info
= ({ pattern & dp_rhs = dp_rhs, dp_type_code = dp_type_code }, cp_info)
*/
instance copy [a] | copy a
where
copy l cp_info = mapSt copy l cp_info
......@@ -998,8 +1026,10 @@ where
= weightedRefCount dcl_functions common_defs depth (expression, expressions) rc_info
weightedRefCount dcl_functions common_defs depth (TupleSelect tuple_symbol arg_nr expr) rc_info
= weightedRefCount dcl_functions common_defs depth expr rc_info
/*
weightedRefCount dcl_functions common_defs depth (DynamicExpr {dyn_expr}) rc_info
= weightedRefCount dcl_functions common_defs depth dyn_expr rc_info
*/
weightedRefCount dcl_functions common_defs depth (AnyCodeExpr _ _ _) rc_info
= rc_info
weightedRefCount dcl_functions common_defs depth (ABCCodeExpr _ _) rc_info
......@@ -1132,17 +1162,17 @@ instance weightedRefCount App
where
weightedRefCount dcl_functions common_defs depth {app_symb,app_args} rc_info
# rc_info = weightedRefCount dcl_functions common_defs depth app_args rc_info
= check_import dcl_functions common_defs app_symb.symb_kind rc_info
= check_import dcl_functions common_defs app_symb rc_info
where
check_import dcl_functions common_defs symb_kind=:(SK_Function {glob_module,glob_object}) rc_info=:{rc_imports, rc_var_heap}
check_import dcl_functions common_defs {symb_kind=SK_Function {glob_module,glob_object}} rc_info=:{rc_imports, rc_var_heap}
= checkImportOfDclFunction dcl_functions common_defs glob_module glob_object rc_info
check_import dcl_functions common_defs symb_kind=:(SK_Constructor {glob_module,glob_object}) rc_info=:{rc_imports, rc_var_heap}
check_import dcl_functions common_defs {symb_name,symb_kind=symb_kind=:(SK_Constructor {glob_module,glob_object})} rc_info=:{rc_imports, rc_var_heap}
| glob_module <> cIclModIndex
# {cons_type_ptr} = common_defs.[glob_module].com_cons_defs.[glob_object]
(rc_imports, rc_var_heap) = checkImportedSymbol symb_kind cons_type_ptr (rc_imports, rc_var_heap)
= { rc_info & rc_imports = rc_imports, rc_var_heap = rc_var_heap }
= rc_info
check_import dcl_functions common_defs symb_kind rc_info
check_import dcl_functions common_defs _ rc_info
= rc_info
......@@ -1272,9 +1302,10 @@ where
is_moved LES_Moved = True
is_moved _ = False
distributeLets depth (DynamicExpr dynamik=:{dyn_expr}) dl_info
/* distributeLets depth (DynamicExpr dynamik=:{dyn_expr}) dl_info
# (dyn_expr, dl_info) = distributeLets depth dyn_expr dl_info
= (DynamicExpr { dynamik & dyn_expr = dyn_expr }, dl_info)
*/
distributeLets depth expr=:(TypeCodeExpression _) dl_info
= (expr, dl_info)
distributeLets depth (AnyCodeExpr in_params out_params code_expr) dl_info=:{di_var_heap}
......
......@@ -478,7 +478,7 @@ cIsALocalVar :== False
VI_ExpandedType !SymbolType | /* for storing the (expanded) type of an imported function */
VI_Record ![AuxiliaryPattern] |
VI_Pattern !AuxiliaryPattern |
VI_Default !Int | /* used during conversion of dynamics; the Int indiacted the refenrence count */
VI_Default !Int | VI_Indirection !Int | /* used during conversion of dynamics; the Int indiacted the refenrence count */
VI_Body !SymbIdent !TransformedBody ![FreeVar] | /* used during fusion */
VI_Dictionary !SymbIdent ![Expression] ![Type] | /* used during fusion */
VI_Extended !ExtendedVarInfo !VarInfo
......
......@@ -434,7 +434,7 @@ cIsALocalVar :== False
VI_ExpandedType !SymbolType | /* for storing the (expanded) type of an imported function */
VI_Record ![AuxiliaryPattern] |
VI_Pattern !AuxiliaryPattern |
VI_Default !Int | /* used during conversion of dynamics; the Int indiacted the refenrence count */
VI_Default !Int | VI_Indirection !Int | /* used during conversion of dynamics; the Int indiacted the refenrence count */
VI_Body !SymbIdent !TransformedBody ![FreeVar] | /* used during fusion */
VI_Dictionary !SymbIdent ![Expression] ![Type] | /* used during fusion */
VI_Extended !ExtendedVarInfo !VarInfo
......@@ -1332,7 +1332,7 @@ where
// was (<<<) file (App {app_symb, app_args})
// = file <<< app_symb <<< ' ' <<< app_args
(<<<) file (f_exp @ a_exp) = file <<< '(' <<< f_exp <<< " @ " <<< a_exp <<< ')'
(<<<) file (Let {let_binds, let_expr}) = write_binds (file <<< "let " <<< '\n') let_binds <<< "in\n" <<< let_expr
(<<<) file (Let {let_info_ptr, let_binds, let_expr}) = write_binds (file <<< "let " <<< ptrToInt let_info_ptr <<< '\n') let_binds <<< "in\n" <<< let_expr
where
write_binds file []
= file
......@@ -1516,7 +1516,7 @@ where
instance <<< FreeVar
where
(<<<) file {fv_name,fv_info_ptr} = file <<< fv_name <<< '<' <<< ptrToInt fv_info_ptr <<< '>'
(<<<) file {fv_name,fv_info_ptr,fv_count} = file <<< fv_name <<< '.' <<< fv_count <<< '<' <<< ptrToInt fv_info_ptr <<< '>'
instance <<< DynamicType
where
......
......@@ -13,8 +13,9 @@ cAccumulating :== -3
analyseGroups :: !{# CommonDefs} !*{! 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)
transformGroups :: !CleanupInfo !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} }
!*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
partitionateFunctions :: !*{# FunDef} ![IndexRange] -> (!*{! Group}, !*{# FunDef})
......
......@@ -224,16 +224,24 @@ instance consumerRequirements Expression where
{ ai & ai_next_var = new_next_var, ai_next_var_of_fun = new_ai_next_var_of_fun, ai_var_heap = ai_var_heap }
= consumerRequirements let_expr common_defs ai // XXX why not not_an_unsafe_pattern
where
init_variables [{bind_dst={fv_info_ptr}} : binds] ai_next_var ai_next_var_of_fun ai_var_heap
= init_variables binds (inc ai_next_var) (inc ai_next_var_of_fun)
(writePtr fv_info_ptr (VI_AccVar ai_next_var ai_next_var_of_fun) ai_var_heap)
init_variables [{bind_dst={fv_count, fv_info_ptr}} : binds] ai_next_var ai_next_var_of_fun ai_var_heap
/* Sjaak ... */
| fv_count > 0
= init_variables binds (inc ai_next_var) (inc ai_next_var_of_fun)
(writePtr fv_info_ptr (VI_AccVar ai_next_var ai_next_var_of_fun) ai_var_heap)
= init_variables binds ai_next_var ai_next_var_of_fun ai_var_heap
/* ... Sjaak */
init_variables [] ai_next_var ai_next_var_of_fun ai_var_heap
= (ai_next_var, ai_next_var_of_fun, ai_var_heap)
acc_requirements_of_let_binds [ {bind_src, bind_dst={fv_info_ptr}} : binds ] ai_next_var common_defs ai
# (bind_var, _, ai) = consumerRequirements bind_src common_defs ai
ai_class_subst = unifyClassifications ai_next_var bind_var ai.ai_class_subst
= acc_requirements_of_let_binds binds (inc ai_next_var) common_defs { ai & ai_class_subst = ai_class_subst }
acc_requirements_of_let_binds [ {bind_src, bind_dst} : binds ] ai_next_var common_defs ai
/* Sjaak ... */
| bind_dst.fv_count > 0
# (bind_var, _, ai) = consumerRequirements bind_src common_defs ai
ai_class_subst = unifyClassifications ai_next_var bind_var ai.ai_class_subst
= acc_requirements_of_let_binds binds (inc ai_next_var) common_defs { ai & ai_class_subst = ai_class_subst }
= acc_requirements_of_let_binds binds ai_next_var common_defs ai
/* ... Sjaak */
acc_requirements_of_let_binds [] ai_next_var _ ai
= ai
......@@ -412,9 +420,9 @@ instance consumerRequirements DynamicPattern where
= consumerRequirements dp_rhs common_defs ai
bindPatternVars [fv=:{fv_info_ptr,fv_count} : vars] next_var next_var_of_fun var_heap
// | fv_count > 0
| fv_count > 0
= bindPatternVars vars (inc next_var) (inc next_var_of_fun) (writePtr fv_info_ptr (VI_AccVar next_var next_var_of_fun) var_heap)
// = bindPatternVars vars next_var next_var_of_fun (writePtr fv_info_ptr (VI_Count 0 False) var_heap)
= bindPatternVars vars next_var next_var_of_fun (writePtr fv_info_ptr (VI_Count 0 False) var_heap)
bindPatternVars [] next_var next_var_of_fun var_heap
= (next_var, next_var_of_fun, var_heap)
......@@ -1743,13 +1751,21 @@ where
:: ImportedConstructors :== [Global Index]
transformGroups :: !CleanupInfo !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
transformGroups cleanup_info groups fun_defs cons_args common_defs imported_funs var_heap type_heaps symbol_heap
/* Sjaak ... */
// transformGroups :: !CleanupInfo !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } !*VarHeap !*TypeHeaps !*ExpressionHeap
// -> (!*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
transformGroups :: !CleanupInfo !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} }
!*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
/* ... Sjaak */
// transformGroups cleanup_info groups fun_defs cons_args common_defs imported_funs var_heap type_heaps symbol_heap
transformGroups cleanup_info groups fun_defs cons_args common_defs imported_funs imported_types collected_imports var_heap type_heaps symbol_heap
#! (nr_of_funs, fun_defs) = usize fun_defs
# imported_types = {com_type_defs \\ {com_type_defs} <-: common_defs }
// # imported_types = {com_type_defs \\ {com_type_defs} <-: common_defs }
# (groups, imported_types, collected_imports, ti)
= transform_groups 0 groups common_defs imported_funs imported_types []
= transform_groups 0 groups common_defs imported_funs imported_types collected_imports
{ti_fun_defs = fun_defs, ti_instances = createArray nr_of_funs II_Empty,
ti_cons_args = cons_args, ti_new_functions = [], ti_fun_heap = newHeap, ti_var_heap = var_heap,
ti_symbol_heap = symbol_heap, ti_type_heaps = type_heaps, ti_next_fun_nr = nr_of_funs, ti_cleanup_info = cleanup_info,
......
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