Commit 4e35d0ec authored by John van Groningen's avatar John van Groningen
Browse files

make field aci_linearity_of_patterns of record ActiveCaseInfo strict

parent 0231d05e
......@@ -1376,14 +1376,14 @@ get_linearity_info cc_linear_bits (AlgebraicPatterns _ algebraic_patterns) var_h
get_linearity_info cc_linear_bits (OverloadedListPatterns _ _ algebraic_patterns) var_heap
= get_linearity_info_of_patterns cc_linear_bits algebraic_patterns var_heap
get_linearity_info cc_linear_bits _ var_heap
= ([], var_heap)
= ([!!], var_heap)
get_linearity_info_of_patterns cc_linear_bits algebraic_patterns var_heap
= mapSt (get_linearity_info_of_pattern cc_linear_bits) algebraic_patterns var_heap
= mapStStrictR (get_linearity_info_of_pattern cc_linear_bits) algebraic_patterns var_heap
where
get_linearity_info_of_pattern cc_linear_bits {ap_vars} var_heap
# (var_indices, var_heap) = mapSt get_var_index ap_vars var_heap
= ([if (index==cNope) True (cc_linear_bits!!$index) \\ index<-var_indices], var_heap)
= ([#if (index==cNope) True (cc_linear_bits!!$index) \\ index<-var_indices!], var_heap)
get_var_index {fv_info_ptr} var_heap
# (vi, var_heap) = readPtr fv_info_ptr var_heap
......@@ -1397,6 +1397,17 @@ set_linearity_info fun fun_index fun_cons_class fun_ref_counts group_strictness
cc_args = add_unused_args fun fun_index fun_cons_class.cc_args fun_ref_counts group_strictness
= { fun_cons_class & cc_args = cc_args }
mapStStrictR f l s :== map_st l s
where
map_st [x : xs] s
# (x, s) = f x s
(xs, s) = map_st xs s
#! s = s
= ([!x : xs!], s)
map_st [] s
#! s = s
= ([!!], s)
foldComponentMembersSt op l st :== fold_ComponentMembers_st l st
where
fold_ComponentMembers_st (ComponentMember a as) st
......
......@@ -893,7 +893,7 @@ cNotVarNumber :== -1
{ aci_params :: ![FreeVar]
, aci_opt_unfolder :: !(Optional SymbIdent)
, aci_free_vars :: !Optional [BoundVar]
, aci_linearity_of_patterns :: ![[Bool]]
, aci_linearity_of_patterns :: ![![#Bool!]!]
, aci_safe :: !Bool
}
......
......@@ -530,7 +530,7 @@ where
match_and_instantiate linearities cons_index app_args (AlgebraicPatterns _ algebraicPatterns) case_default ro ti
= match_and_instantiate_algebraic_type linearities cons_index app_args algebraicPatterns case_default ro ti
where
match_and_instantiate_algebraic_type [linearity:linearities] cons_index app_args
match_and_instantiate_algebraic_type [!linearity:linearities!] cons_index app_args
[{ap_symbol={glob_module,glob_object={ds_index}}, ap_vars, ap_expr} : guards] case_default ro ti
| cons_index.glob_module == glob_module && cons_index.glob_object == ds_index
# {cons_type} = ro.ro_common_defs.[glob_module].com_cons_defs.[ds_index]
......@@ -541,7 +541,7 @@ where
match_and_instantiate linearities cons_index app_args (OverloadedListPatterns (OverloadedList _ _ _ _) _ algebraicPatterns) case_default ro ti
= match_and_instantiate_overloaded_list linearities cons_index app_args algebraicPatterns case_default ro ti
where
match_and_instantiate_overloaded_list [linearity:linearities] cons_index=:{glob_module=cons_glob_module,glob_object=cons_ds_index} app_args
match_and_instantiate_overloaded_list [!linearity:linearities!] cons_index=:{glob_module=cons_glob_module,glob_object=cons_ds_index} app_args
[{ap_symbol={glob_module,glob_object={ds_index}}, ap_vars, ap_expr} : guards]
case_default ro ti
| equal_list_contructor glob_module ds_index cons_glob_module cons_ds_index
......@@ -587,7 +587,7 @@ where
match_and_instantiate_overloaded_cons cons_function_type linearities app_args (AlgebraicPatterns _ algebraicPatterns) case_default ro ti
= match_and_instantiate_overloaded_cons_boxed_match linearities app_args algebraicPatterns case_default ro ti
where
match_and_instantiate_overloaded_cons_boxed_match [linearity:linearities] app_args
match_and_instantiate_overloaded_cons_boxed_match [!linearity:linearities!] app_args
[{ap_symbol={glob_module,glob_object={ds_index}}, ap_vars, ap_expr} : guards]
case_default ro ti
| glob_module==cPredefinedModuleIndex
......@@ -603,7 +603,7 @@ where
match_and_instantiate_overloaded_cons cons_function_type linearities app_args (OverloadedListPatterns _ _ algebraicPatterns) case_default ro ti
= match_and_instantiate_overloaded_cons_overloaded_match linearities app_args algebraicPatterns case_default ro ti
where
match_and_instantiate_overloaded_cons_overloaded_match [linearity:linearities] app_args
match_and_instantiate_overloaded_cons_overloaded_match [!linearity:linearities!] app_args
[{ap_symbol={glob_module,glob_object={ds_index}}, ap_vars, ap_expr} : guards]
case_default ro ti
| glob_module==cPredefinedModuleIndex
......@@ -644,7 +644,7 @@ where
(body_strictness,ti_fun_defs,ti_fun_heap) = body_strict ap_expr ap_vars ro ti.ti_fun_defs ti.ti_fun_heap
ti = {ti & ti_fun_defs = ti_fun_defs, ti_fun_heap = ti_fun_heap}
unfoldables = [ (arg_is_strict i body_strictness || ((not (arg_is_strict i cons_type_args_strictness))) && linear) || in_normal_form app_arg
\\ linear <- linearity & app_arg <- app_args & i <- [0..]]
\\ linear <|- linearity & app_arg <- app_args & i <- [0..]]
unfoldable_args = filterWith unfoldables zipped_ap_vars_and_args
not_unfoldable = map not unfoldables
ti_var_heap = foldSt (\({fv_info_ptr}, arg) -> writeVarInfo fv_info_ptr (VI_Expression arg)) unfoldable_args ti.ti_var_heap
......
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