Skip to content

GitLab

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
Hide whitespace changes
Inline Side-by-side
frontend/classify.icl
View file @ 8addc7be
......@@ -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
......
frontend/partition.dcl
View file @ 8addc7be
......@@ -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)
frontend/partition.icl
View file @ 8addc7be
......@@ -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)
frontend/syntax.dcl
View file @ 8addc7be
......@@ -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 =
......
frontend/transform.icl
View file @ 8addc7be
......@@ -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