Commit 8addc7be authored by Diederik van Arkel's avatar Diederik van Arkel
Browse files

add 'safe' to active case info for casefun generation

parent b6956fd3
......@@ -104,7 +104,7 @@ where
, ai_class_subst :: !*ConsClassSubst
, ai_next_var :: !Int
, ai_next_var_of_fun :: !Int
, ai_cases_of_vars_for_function :: ![Case]
, ai_cases_of_vars_for_function :: ![(!Bool,!Case)]
, ai_fun_heap :: !*FunctionHeap
, ai_def_ref_counts :: !RefCounts
}
......@@ -251,6 +251,8 @@ instance consumerRequirements Expression where
= (CPassive, False, ai)
consumerRequirements (NoBind _) _ ai
= (CPassive, False, ai)
consumerRequirements (FailExpr _) _ ai
= (CPassive, False, ai)
consumerRequirements expr _ ai
= abort ("consumerRequirements [Expression]" ---> expr)
......@@ -393,10 +395,16 @@ instance consumerRequirements Case where
cce ai
ai = case case_expr of
Var {var_info_ptr}
| may_be_active
-> { ai & ai_cases_of_vars_for_function=[kees:ai.ai_cases_of_vars_for_function] }
| SwitchMultimatchClassification may_be_active True
-> { ai & ai_cases_of_vars_for_function=[(safe,kees):ai.ai_cases_of_vars_for_function] }
-> ai
// N-WAY...
// _ -> ai
_
| SwitchMultimatchClassification may_be_active True
-> { ai & ai_cases_of_vars_for_function=[(safe,kees):ai.ai_cases_of_vars_for_function] }
-> ai
_ -> ai
// ...N-WAY
# ai = case case_guards of
OverloadedListPatterns (OverloadedList _ _ _ _) decons_expr=:(App {app_symb={symb_kind=SK_Function _},app_args=[app_arg]}) patterns
// decons_expr will be optimized to a decons_u Selector in transform
......@@ -768,7 +776,7 @@ where
class_env
= foldSt (collect_classifications ai.ai_class_subst) group_members class_env
(cleanup_info, class_env, fun_defs, var_heap, expr_heap)
= foldSt set_case_expr_info (flatten ai_cases_of_vars_for_group)
= foldSt (set_case_expr_info ai.ai_class_subst) (flatten ai_cases_of_vars_for_group)
(cleanup_info, class_env, fun_defs, ai.ai_var_heap, expr_heap)
= (cleanup_info, class_env, groups, fun_defs, var_heap, expr_heap)
where
......@@ -824,23 +832,63 @@ where
fun_class = determine_classification fun_class class_subst
= { class_env & [fun] = fun_class }
set_case_expr_info ({case_expr=(Var {var_info_ptr}), case_guards, case_info_ptr},fun_index)
set_case_expr_info class_subst ((safe,{case_expr=(Var {var_info_ptr}), case_guards, case_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
# (VI_AccVar cc arg_position, var_heap) = readPtr var_info_ptr var_heap
({cc_size, cc_args, cc_linear_bits},class_env) = class_env![fun_index]
(aci_linearity_of_patterns, var_heap) = get_linearity_info cc_linear_bits case_guards var_heap
| arg_position<cc_size && (arg_position>=cc_size || cc_args!!arg_position==CActive) && cc_linear_bits!!arg_position
//* Try always marking
// | arg_position<cc_size && (arg_position>=cc_size || cc_args!!arg_position==CActive) && cc_linear_bits!!arg_position
// mark non multimatch cases whose case_expr is an active linear function argument
| ((arg_position>=cc_size && CActive==skip_indirections class_subst cc) || (arg_position<cc_size && cc_args!!arg_position==CActive)) && cc_linear_bits!!arg_position
//*/
// | True
# aci =
{ aci_params = []
, aci_opt_unfolder = No
, aci_free_vars = No
, aci_linearity_of_patterns = aci_linearity_of_patterns
, aci_safe = safe
}
= ([case_info_ptr:cleanup_acc], class_env, fun_defs, var_heap,
setExtendedExprInfo case_info_ptr (EEI_ActiveCase aci) expr_heap)
= (cleanup_acc, class_env, fun_defs, var_heap, expr_heap)
where
skip_indirections subst cc
| IsAVariable cc
= skip_indirections subst subst.[cc]
= cc
// N-WAY...
set_case_expr_info class_subst ((safe,{case_expr=(App _), case_guards, case_info_ptr}),fun_index)
(cleanup_acc, class_env, fun_defs, var_heap, expr_heap)
# ({cc_size, cc_args, cc_linear_bits},class_env) = class_env![fun_index]
(aci_linearity_of_patterns, var_heap) = get_linearity_info cc_linear_bits case_guards var_heap
# aci =
{ aci_params = []
, aci_opt_unfolder = No
, aci_free_vars = No
, aci_linearity_of_patterns = aci_linearity_of_patterns
, aci_safe = safe
}
= ([case_info_ptr:cleanup_acc], class_env, fun_defs, var_heap,
setExtendedExprInfo case_info_ptr (EEI_ActiveCase aci) expr_heap)
set_case_expr_info class_subst ((safe,{case_expr=(_ @ _), case_guards, case_info_ptr}),fun_index)
(cleanup_acc, class_env, fun_defs, var_heap, expr_heap)
# ({cc_size, cc_args, cc_linear_bits},class_env) = class_env![fun_index]
(aci_linearity_of_patterns, var_heap) = get_linearity_info cc_linear_bits case_guards var_heap
# aci =
{ aci_params = []
, aci_opt_unfolder = No
, aci_free_vars = No
, aci_linearity_of_patterns = aci_linearity_of_patterns
, aci_safe = safe
}
= ([case_info_ptr:cleanup_acc], class_env, fun_defs, var_heap,
setExtendedExprInfo case_info_ptr (EEI_ActiveCase aci) expr_heap)
set_case_expr_info _ _ s = s
// ...N-WAY
get_linearity_info cc_linear_bits (AlgebraicPatterns _ algebraic_patterns) var_heap
= mapSt (get_linearity_info_of_pattern cc_linear_bits) algebraic_patterns var_heap
get_linearity_info cc_linear_bits (OverloadedListPatterns _ _ algebraic_patterns) var_heap
......@@ -863,7 +911,7 @@ reanalyseGroups :: !{# CommonDefs} !{#{#FunType}} !Int !Int ![FunctionInfoPtr]
-> (!CleanupInfo, !*{#FunDef}, !*VarHeap, !*ExpressionHeap, !*FunctionHeap, !*{!ConsClasses}, !Bool)
reanalyseGroups common_defs imported_funs main_dcl_module_n stdStrictLists_module_n new_functions
groups fun_defs var_heap expr_heap fun_heap class_env
#! nr_of_groups = size groups
// #! nr_of_groups = size groups
# consumerAnalysisRO=ConsumerAnalysisRO
{ common_defs = common_defs
, imported_funs = imported_funs
......@@ -1014,22 +1062,42 @@ where
equalCCBits 0 _ _ = True
equalCCBits n [l:ls] [r:rs] = l == r && equalCCBits (dec n) ls rs
set_case_expr_info ({case_expr=case_expr=:(Var {var_info_ptr}), case_guards, case_info_ptr},fun_index)
set_case_expr_info ((safe,{case_expr=case_expr=:(Var {var_info_ptr}), case_guards, case_info_ptr}),fun_index)
(cleanup_acc, class_env, fun_defs, var_heap, expr_heap, fun_heap)
# (VI_AccVar _ arg_position, var_heap) = readPtr var_info_ptr var_heap
({cc_size, cc_args, cc_linear_bits},fun_heap,class_env) = get_fun_class fun_index fun_heap class_env
(aci_linearity_of_patterns, var_heap) = get_linearity_info cc_linear_bits case_guards var_heap
//* Try always marking...
| arg_position<cc_size && (arg_position>=cc_size || cc_args!!arg_position==CActive) && cc_linear_bits!!arg_position
// mark non multimatch cases whose case_expr is an active linear function argument
//*/
| True
# aci =
{ aci_params = []
, aci_opt_unfolder = No
, aci_free_vars = No
, aci_linearity_of_patterns = aci_linearity_of_patterns
, aci_safe = safe
}
= ([case_info_ptr:cleanup_acc], class_env, fun_defs, var_heap,
setExtendedExprInfo case_info_ptr (EEI_ActiveCase aci) expr_heap, fun_heap)
= (cleanup_acc, class_env, fun_defs, var_heap, expr_heap, fun_heap)
// N-WAY...
set_case_expr_info ((safe,{case_expr=(App _), case_guards, case_info_ptr}),fun_index)
(cleanup_acc, class_env, fun_defs, var_heap, expr_heap, fun_heap)
# ({cc_size, cc_args, cc_linear_bits},fun_heap,class_env) = get_fun_class fun_index fun_heap class_env
(aci_linearity_of_patterns, var_heap) = get_linearity_info cc_linear_bits case_guards var_heap
# aci =
{ aci_params = []
, aci_opt_unfolder = No
, aci_free_vars = No
, aci_linearity_of_patterns = aci_linearity_of_patterns
, aci_safe = safe
}
= ([case_info_ptr:cleanup_acc], class_env, fun_defs, var_heap,
setExtendedExprInfo case_info_ptr (EEI_ActiveCase aci) expr_heap, fun_heap)
set_case_expr_info _ s = s
// ...N-WAY
get_fun_class fun fun_heap class_env
| fun < size class_env
......@@ -1189,6 +1257,7 @@ count_locals (TypeCodeExpression _) n
= n
count_locals EE n
= n
count_locals (FailExpr _) n = n
count_locals (NoBind _) n
= n
......
......@@ -4,10 +4,12 @@ import syntax, transform
partitionateFunctions :: !*{# FunDef} ![IndexRange] -> (!*{! Group}, !*{# FunDef})
//partitionateFunctions` :: !*{# FunDef} ![IndexRange] !Index !Int !Int -> (!*{! Group}, !*{# FunDef})
partitionateFunctions` :: !*{# FunDef} ![IndexRange] !Index !Int !Int !*PredefinedSymbols !*VarHeap !*ExpressionHeap !*ErrorAdmin -> (!*{! Group}, !*{# FunDef}, !*PredefinedSymbols, !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
partitionateFunctions`
:: !*{# FunDef} ![IndexRange] !Index !Int !Int !*PredefinedSymbols !*VarHeap !*ExpressionHeap !*ErrorAdmin
-> (!*{! Group}, !*{# FunDef}, !*PredefinedSymbols, !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
stripStrictLets :: !*{# FunDef} !*PredefinedSymbols !*VarHeap !*ExpressionHeap !*ErrorAdmin -> (!*{# FunDef}, !*PredefinedSymbols, !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
partitionateFunctions`` :: !Int !Int ![FunctionInfoPtr] !*{# FunDef} ![Int] !Index !Int !Int !*FunctionHeap
-> (!Int, ![Group], !*{# FunDef}, !*FunctionHeap)
partitionateFunctions``
:: !Int !Int ![FunctionInfoPtr] !*{# FunDef} ![Int] !Index !Int !Int !*FunctionHeap !*PredefinedSymbols !*VarHeap !*ExpressionHeap !*ErrorAdmin
-> (!Int, ![Group], !*{# FunDef}, !*FunctionHeap, !*PredefinedSymbols, !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
......@@ -54,6 +54,9 @@ where
visit_functions [MacroCall module_index fc_index _:funs] min_dep max_fun_nr fun_defs pi
= abort ("visit_functions "+++toString fd.fun_symb+++" "+++toString module_index+++" "+++toString fc_index)
visit_functions [DclFunCall module_index fc_index:funs] min_dep max_fun_nr fun_defs pi
= visit_functions funs min_dep max_fun_nr fun_defs pi
visit_functions [] min_dep max_fun_nr fun_defs pi
= (min_dep, fun_defs, pi)
= try_to_close_group fun_index pi_next_num min_dep max_fun_nr fun_defs pi
......@@ -77,19 +80,25 @@ where
try_to_close_group fun_index fun_nr min_dep max_fun_nr fun_defs pi=:{pi_marks, pi_deps, pi_groups, pi_next_group}
| fun_nr <= min_dep
# (pi_deps, pi_marks, group, fun_defs)
= close_group fun_index pi_deps pi_marks [] max_fun_nr pi_next_group fun_defs
= close_group False False fun_index pi_deps pi_marks [] max_fun_nr pi_next_group fun_defs
pi = { pi & pi_deps = pi_deps, pi_marks = pi_marks, pi_next_group = inc pi_next_group, pi_groups = [group : pi_groups] }
= (max_fun_nr, fun_defs, pi)
= (min_dep, fun_defs, pi)
where
close_group :: !Int ![Int] !*{# Int} ![Int] !Int !Int !*{# FunDef} -> (![Int], !*{# Int}, ![Int], !*{# FunDef})
close_group fun_index [d:ds] marks group max_fun_nr group_number fun_defs
close_group :: !Bool !Bool !Int ![Int] !*{# Int} ![Int] !Int !Int !*{# FunDef} -> (![Int], !*{# Int}, ![Int], !*{# FunDef})
close_group n_r_known non_recursive fun_index [d:ds] marks group max_fun_nr group_number fun_defs
# marks = { marks & [d] = max_fun_nr }
# (fd,fun_defs) = fun_defs![d]
# fun_defs = { fun_defs & [d] = { fd & fun_info.fi_group_index = group_number }}
# non_recursive = case n_r_known of
True -> non_recursive
_ -> case fun_index == d of
True -> isEmpty [fc \\ fc <- fd.fun_info.fi_calls | case fc of FunCall idx _ -> idx == d; _ -> False]
_ -> False
# fd = { fd & fun_info.fi_group_index = group_number, fun_info.fi_properties = set_rec_prop non_recursive fd.fun_info.fi_properties}
# fun_defs = { fun_defs & [d] = fd}
| d == fun_index
= (ds, marks, [d : group], fun_defs)
= close_group fun_index ds marks [d : group] max_fun_nr group_number fun_defs
= close_group True non_recursive fun_index ds marks [d : group] max_fun_nr group_number fun_defs
:: PartitioningInfo` =
......@@ -164,6 +173,7 @@ where
, fun_index=fun_index
} fd.fun_body {fun_calls = []}
fi_calls = fc_state.fun_calls
fd = {fd & fun_info.fi_calls = fi_calls}
# fun_defs = {fun_defs & [fun_index] = fd}
pi = push_on_dep_stack fun_index pi
......@@ -180,6 +190,9 @@ where
visit_functions [MacroCall module_index fc_index _:funs] min_dep max_fun_nr fun_defs pi
= abort ("visit_functions "+++toString fd.fun_symb+++" "+++toString module_index+++" "+++toString fc_index)
visit_functions [DclFunCall module_index fc_index:funs] min_dep max_fun_nr fun_defs pi
= visit_functions funs min_dep max_fun_nr fun_defs pi
visit_functions [] min_dep max_fun_nr fun_defs pi
= (min_dep, fun_defs, pi)
= try_to_close_group fun_index pi_next_num` min_dep max_fun_nr fun_defs pi
......@@ -203,19 +216,25 @@ where
try_to_close_group fun_index fun_nr min_dep max_fun_nr fun_defs pi=:{pi_marks`, pi_deps`, pi_groups`, pi_next_group`}
| fun_nr <= min_dep
# (pi_deps`, pi_marks`, group, fun_defs)
= close_group fun_index pi_deps` pi_marks` [] max_fun_nr pi_next_group` fun_defs
= close_group False False fun_index pi_deps` pi_marks` [] max_fun_nr pi_next_group` fun_defs
pi = { pi & pi_deps` = pi_deps`, pi_marks` = pi_marks`, pi_next_group` = inc pi_next_group`, pi_groups` = [group : pi_groups`] }
= (max_fun_nr, fun_defs, pi)
= (min_dep, fun_defs, pi)
where
close_group :: !Int ![Int] !*{# Int} ![Int] !Int !Int !*{# FunDef} -> (![Int], !*{# Int}, ![Int], !*{# FunDef})
close_group fun_index [d:ds] marks group max_fun_nr group_number fun_defs
close_group :: !Bool !Bool !Int ![Int] !*{# Int} ![Int] !Int !Int !*{# FunDef} -> (![Int], !*{# Int}, ![Int], !*{# FunDef})
close_group n_r_known non_recursive fun_index [d:ds] marks group max_fun_nr group_number fun_defs
# marks = { marks & [d] = max_fun_nr }
# (fd,fun_defs) = fun_defs![d]
# fun_defs = { fun_defs & [d] = { fd & fun_info.fi_group_index = group_number }}
# non_recursive = case n_r_known of
True -> non_recursive
_ -> case fun_index == d of
True -> isEmpty [fc \\ fc <- fd.fun_info.fi_calls | case fc of FunCall idx _ -> idx == d; _ -> False]
_ -> False
# fd = { fd & fun_info.fi_group_index = group_number, fun_info.fi_properties = set_rec_prop non_recursive fd.fun_info.fi_properties}
# fun_defs = { fun_defs & [d] = fd}
| d == fun_index
= (ds, marks, [d : group], fun_defs)
= close_group fun_index ds marks [d : group] max_fun_nr group_number fun_defs
= close_group True non_recursive fun_index ds marks [d : group] max_fun_nr group_number fun_defs
:: PartitioningInfo`` =
{ pi_marks`` :: !.Marks
......@@ -223,6 +242,7 @@ where
, pi_next_group`` :: !Int
, pi_groups`` :: ![[Int]]
, pi_deps`` :: ![Int]
, pi_collect`` :: !.CollectState
}
//:: Marks :== {# Int}
......@@ -244,21 +264,29 @@ set_mark marks fun val
// :== { if (m_fun==fun) {m & m_mark = val} m \\ m=:{m_fun=m_fun} <-: marks}
:== { if (m.m_fun==fun) {m & m_mark = val} m \\ m <-: marks}
partitionateFunctions`` :: !Int !Int ![FunctionInfoPtr] !*{# FunDef} ![Int] !Index !Int !Int !*FunctionHeap
-> (!Int, ![Group], !*{# FunDef}, !*FunctionHeap)
partitionateFunctions`` max_fun_nr next_group new_functions fun_defs functions main_dcl_module_n def_min def_max fun_heap
partitionateFunctions`` :: !Int !Int ![FunctionInfoPtr] !*{# FunDef} ![Int] !Index !Int !Int !*FunctionHeap !*PredefinedSymbols !*VarHeap !*ExpressionHeap !*ErrorAdmin
-> (!Int, ![Group], !*{# FunDef}, !*FunctionHeap, !*PredefinedSymbols, !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
partitionateFunctions`` max_fun_nr next_group new_functions fun_defs functions main_dcl_module_n def_min def_max fun_heap predef_symbols var_heap sym_heap error_admin
# marks = create_marks max_fun_nr functions
# (cs_predef,predef_symbols) = get_predef_symbols_for_transform predef_symbols
# collect_state =
{ cos_predef_symbols_for_transform = cs_predef
, cos_var_heap = var_heap
, cos_symbol_heap = sym_heap
, cos_error = error_admin
}
# partitioning_info =
{ pi_marks`` = marks
, pi_deps`` = []
, pi_next_num`` = 0
, pi_next_group`` = next_group
, pi_groups`` = []
, pi_collect`` = collect_state
}
(fun_defs, fun_heap, {pi_groups``,pi_next_group``}) =
(fun_defs, fun_heap, {pi_groups``,pi_next_group``,pi_collect``}) =
foldSt (partitionate_functions max_fun_nr) functions (fun_defs, fun_heap, partitioning_info)
groups = [ {group_members = group} \\ group <- reverse pi_groups`` ]
= (pi_next_group``,groups, fun_defs, fun_heap)
= (pi_next_group``,groups, fun_defs, fun_heap, predef_symbols, pi_collect``.cos_var_heap, pi_collect``.cos_symbol_heap, pi_collect``.cos_error)
where
partitionate_functions :: !Index !Int !(!*{# FunDef}, !*FunctionHeap, !*PartitioningInfo``) -> (!*{# FunDef}, !*FunctionHeap, !*PartitioningInfo``)
partitionate_functions max_fun_nr fun (fun_defs, fun_heap, pi=:{pi_marks``})
......@@ -268,9 +296,11 @@ where
= (fun_defs, fun_heap, pi)
partitionate_function :: !Int !Int !*{# FunDef} !*FunctionHeap !*PartitioningInfo`` -> *(!Int, !*{# FunDef}, !*FunctionHeap, !*PartitioningInfo``)
partitionate_function fun_index max_fun_nr fun_defs fun_heap pi=:{pi_next_num``}
partitionate_function fun_index max_fun_nr fun_defs fun_heap pi=:{pi_next_num``,pi_collect``}
// # (fd, fun_defs) = fun_defs![fun_index]
# (fd, fun_defs, fun_heap) = get_fun_def fun_index new_functions fun_defs fun_heap
# (fd,pi_collect``) = ref_null fd pi_collect``
# pi = {pi & pi_collect`` = pi_collect``}
# fc_state = find_calls
{ main_dcl_module_n=main_dcl_module_n
, def_min=def_min
......@@ -278,6 +308,8 @@ where
, fun_index=fun_index
} fd.fun_body {fun_calls = []}
fi_calls = fc_state.fun_calls
fd = {fd & fun_info.fi_calls = fi_calls}
# (fun_defs, fun_heap) = set_fun_def fun_index fd new_functions fun_defs fun_heap
pi = push_on_dep_stack fun_index pi
(min_dep, fun_defs, fun_heap, pi) = visit_functions fi_calls max_fun_nr max_fun_nr fun_defs fun_heap pi
with
......@@ -292,6 +324,9 @@ where
visit_functions [MacroCall module_index fc_index _:funs] min_dep max_fun_nr fun_defs fun_heap pi
= abort ("visit_functions "+++toString fd.fun_symb+++" "+++toString module_index+++" "+++toString fc_index)
visit_functions [DclFunCall module_index fc_index:funs] min_dep max_fun_nr fun_defs fun_heap pi
= visit_functions funs min_dep max_fun_nr fun_defs fun_heap pi
visit_functions [] min_dep max_fun_nr fun_defs fun_heap pi
= (min_dep, fun_defs, fun_heap, pi)
= try_to_close_group fun_index pi_next_num`` min_dep max_fun_nr fun_defs fun_heap pi
......@@ -309,22 +344,25 @@ where
try_to_close_group fun_index fun_nr min_dep max_fun_nr fun_defs fun_heap pi=:{pi_marks``, pi_deps``, pi_groups``, pi_next_group``}
| fun_nr <= min_dep
# (pi_deps``, pi_marks``, group, fun_defs, fun_heap)
= close_group fun_index pi_deps`` pi_marks`` [] max_fun_nr pi_next_group`` fun_defs fun_heap
= close_group False False fun_index pi_deps`` pi_marks`` [] max_fun_nr pi_next_group`` fun_defs fun_heap
pi = { pi & pi_deps`` = pi_deps``, pi_marks`` = pi_marks``, pi_next_group`` = inc pi_next_group``, pi_groups`` = [group : pi_groups``] }
= (max_fun_nr, fun_defs, fun_heap, pi)
= (min_dep, fun_defs, fun_heap, pi)
where
close_group :: !Int ![Int] !*Marks ![Int] !Int !Int !*{# FunDef} !*FunctionHeap -> (![Int], !*Marks, ![Int], !*{# FunDef}, !*FunctionHeap)
close_group fun_index [d:ds] marks group max_fun_nr group_number fun_defs fun_heap
close_group :: !Bool !Bool !Int ![Int] !*Marks ![Int] !Int !Int !*{# FunDef} !*FunctionHeap -> (![Int], !*Marks, ![Int], !*{# FunDef}, !*FunctionHeap)
close_group n_r_known non_recursive fun_index [d:ds] marks group max_fun_nr group_number fun_defs fun_heap
# marks = set_mark marks d max_fun_nr
// # (fd,fun_defs) = fun_defs![d]
# (fd, fun_defs, fun_heap) = get_fun_def d new_functions fun_defs fun_heap
// # fun_defs = { fun_defs & [d] = { fd & fun_info.fi_group_index = group_number }}
# fd = { fd & fun_info.fi_group_index = group_number }
# non_recursive = case n_r_known of
True -> non_recursive
_ -> case fun_index == d of
True -> isEmpty [fc \\ fc <- fd.fun_info.fi_calls | case fc of FunCall idx _ -> idx == d; _ -> False]
_ -> False
# fd = { fd & fun_info.fi_group_index = group_number, fun_info.fi_properties = set_rec_prop non_recursive fd.fun_info.fi_properties}
# (fun_defs, fun_heap) = set_fun_def d fd new_functions fun_defs fun_heap
| d == fun_index
= (ds, marks, [d : group], fun_defs, fun_heap)
= close_group fun_index ds marks [d : group] max_fun_nr group_number fun_defs fun_heap
= close_group True non_recursive fun_index ds marks [d : group] max_fun_nr group_number fun_defs fun_heap
get_fun_def fun new_functions fun_defs fun_heap
| fun < size fun_defs
......@@ -440,6 +478,8 @@ where
= fc_state //abort "EE"
find_calls fc_info (NoBind _) fc_state
= fc_state
find_calls fc_info (FailExpr _) fc_state
= fc_state
find_calls _ u _ = abort ("Undefined pattern in Expression\n")
instance find_calls App
......@@ -451,7 +491,7 @@ where
get_index (SK_Function {glob_object,glob_module}) fc_state
| fc_info.main_dcl_module_n == glob_module && (glob_object < fc_info.def_max || glob_object >= fc_info.def_min)
= {fc_state & fun_calls = [FunCall glob_object 0: fc_state.fun_calls]}
= fc_state
= {fc_state & fun_calls = [DclFunCall glob_module glob_object: fc_state.fun_calls]}
get_index (SK_Constructor idx) fc_state
= fc_state
get_index (SK_Unknown) fc_state
......@@ -470,6 +510,8 @@ where
get_index (SK_GeneratedFunction _ idx) fc_state
= {fc_state & fun_calls = [FunCall idx 0: fc_state.fun_calls]}
// = fc_state
// get_index (SK_GeneratedCaseFunction _ idx) fc_state
// = {fc_state & fun_calls = [FunCall idx 0: fc_state.fun_calls]}
get_index (SK_Generic _ _) fc_state
= abort "SK_Generic"
get_index (SK_TypeCode) fc_state
......@@ -538,7 +580,7 @@ import StdDebug
ref_null fd=:{fun_body=TransformedBody {tb_args,tb_rhs}} pi_collect
// | not (fst (ferror (stderr <<< fd)))
// # tb_args = tb_args ---> ("ref_null",tb_args)
// # tb_args = tb_args ---> ("ref_null",fd.fun_symb,tb_args,tb_rhs)
# (new_rhs, new_args, _, _, pi_collect) = determineVariablesAndRefCounts tb_args tb_rhs pi_collect
# fd = {fd & fun_body=TransformedBody {tb_args=new_args,tb_rhs=new_rhs}}
= (fd,pi_collect)
......@@ -566,3 +608,12 @@ dummy_predef_symbols =
, predef_and = dummy_predef_symbol
, predef_or = dummy_predef_symbol
}
///// FI_IsNonRecursive
FI_IsNonRecursive :== 4
set_rec_prop non_recursive fi_properties
= case non_recursive of
True -> fi_properties bitor FI_IsNonRecursive
_ -> fi_properties bitand (bitnot FI_IsNonRecursive)
......@@ -776,6 +776,7 @@ cNonRecursiveAppl :== False
, aci_opt_unfolder :: !(Optional SymbIdent)
, aci_free_vars :: !Optional [BoundVar]
, aci_linearity_of_patterns :: ![[Bool]]
, aci_safe :: !Bool
}
:: RefCountsInCase =
......
......@@ -2017,6 +2017,8 @@ where
collectVariables (DynamicPatterns patterns) free_vars dynamics cos
# (patterns, free_vars, dynamics, cos) = collectVariables patterns free_vars dynamics cos
= (DynamicPatterns patterns, free_vars, dynamics, cos)
collectVariables NoPattern free_vars dynamics cos
= (NoPattern, free_vars, dynamics, cos)
instance collectVariables AlgebraicPattern
where
......@@ -2069,7 +2071,7 @@ where
-> (var, [{fv_name = var_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = 0} : free_vars ], dynamics,
{ cos & cos_var_heap = writePtr var_info_ptr (VI_Count 1 is_global) cos.cos_var_heap })
_
-> abort "collectVariables [BoundVar] (transform, 1227)" // <<- (var_info ---> (var_name, ptrToInt var_info_ptr))
-> abort "collectVariables [BoundVar] (transform, 1227)" //---> (var_info ,var_name, ptrToInt var_info_ptr)
instance <<< (Ptr a)
where
......
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