Commit 0a3eb782 authored by John van Groningen's avatar John van Groningen
Browse files

optimise the following case: an alternative for each constructor, at least 3,...

optimise the following case: an alternative for each constructor, at least 3, one alternative cannot fail and the other
alternatives yield the same boolean result.
Remove those boolean result alternatives, and add a default with this result.
parent 24cde797
......@@ -1261,6 +1261,90 @@ convert_condition (Case {case_expr,case_guards=(BasicPatterns BT_Bool [{bp_value
convert_condition expr ci cs
= convertCases ci expr cs
// optimise the following case: an alternative for each constructor, at least 3, one alternative cannot fail and the other
// alternatives yield the same boolean result. Remove those boolean result alternatives, and add a default with this result.
optimise_case :: !CasePatterns !(Optional Expression) ExprInfoPtr !{#CommonDefs} !*ExpressionHeap
-> (!CasePatterns,!Optional Expression,!*ExpressionHeap)
optimise_case case_guards=:(AlgebraicPatterns global_type_index algebraic_patterns) case_default=:No case_info_ptr common_defs expr_heap
= case common_defs.[global_type_index.gi_module].com_type_defs.[global_type_index.gi_index].td_rhs of
AlgType cons_symbols
| at_least_three_same_length_lists algebraic_patterns cons_symbols
# (new_guard_n,new_algebraic_patterns,new_case_default) = try_replace_case_alts_by_default algebraic_patterns
| new_guard_n<0
-> (case_guards,case_default,expr_heap)
-> case readPtr case_info_ptr expr_heap of
(EI_CaseTypeAndSplits case_type=:{ct_cons_types} splits,expr_heap)
# case_type & ct_cons_types=[ct_cons_types!!new_guard_n]
# expr_heap = writePtr case_info_ptr (EI_CaseTypeAndSplits case_type splits) expr_heap
-> (AlgebraicPatterns global_type_index new_algebraic_patterns,new_case_default,expr_heap)
(_,expr_heap)
-> abort "optimise_case No EI_CaseTypeAndSplits"
-> (case_guards,case_default,expr_heap)
_
-> (case_guards,case_default,expr_heap)
where
at_least_three_same_length_lists :: ![a] ![b] -> Bool
at_least_three_same_length_lists [_,_,_:l1] [_,_,_:l2] = same_length_lists l1 l2
at_least_three_same_length_lists _ _ = False
same_length_lists :: ![a] ![b] -> Bool
same_length_lists [_:l1] [_:l2] = same_length_lists l1 l2
same_length_lists [] [] = True
same_length_lists _ _ = False
try_replace_case_alts_by_default :: ![AlgebraicPattern] -> (!Int,![AlgebraicPattern],!Optional Expression)
try_replace_case_alts_by_default [{ap_expr=ap1_expr=:BasicExpr (BVB bool1)},{ap_expr=BasicExpr (BVB bool2)}:algebraic_patterns3]
| bool1==bool2
# (algebraic_patterns3,guard_n) = skip_case_alt_results_this_bool algebraic_patterns3 bool1 2
= case algebraic_patterns3 of
[algebraic_pattern:algebraic_patterns2]
| all_case_alt_results_this_bool algebraic_patterns2 bool1 && no_partial_match algebraic_pattern.ap_expr
-> (guard_n,[algebraic_pattern],Yes ap1_expr)
_
-> (-1,[],No)
try_replace_case_alts_by_default [ap1=:{ap_expr=BasicExpr (BVB bool1)},ap2=:{ap_expr=BasicExpr (BVB bool2)},{ap_expr=BasicExpr (BVB bool3)}:algebraic_patterns4]
// bool1<>bool2
| all_case_alt_results_this_bool algebraic_patterns4 bool3
| bool3<>bool1 // bool3==bool2
= (0,[ap1],Yes ap2.ap_expr)
// | bool3==bool1
= (1,[ap2],Yes ap1.ap_expr)
= (-1,[],No)
try_replace_case_alts_by_default [ap1=:{ap_expr=BasicExpr (BVB bool1)},ap2,{ap_expr=BasicExpr (BVB bool3)}:algebraic_patterns4]
| bool1==bool3 && all_case_alt_results_this_bool algebraic_patterns4 bool1 && no_partial_match ap2.ap_expr
= (1,[ap2],Yes ap1.ap_expr)
= (-1,[],No)
try_replace_case_alts_by_default [ap1,ap2=:{ap_expr=BasicExpr (BVB bool2)},{ap_expr=BasicExpr (BVB bool3)}:algebraic_patterns4]
| bool2==bool3 && all_case_alt_results_this_bool algebraic_patterns4 bool2 && no_partial_match ap1.ap_expr
= (0,[ap1],Yes ap2.ap_expr)
= (-1,[],No)
try_replace_case_alts_by_default algebraic_patterns
= (-1,[],No)
skip_case_alt_results_this_bool :: ![AlgebraicPattern] !Bool !Int -> (![AlgebraicPattern],!Int)
skip_case_alt_results_this_bool [{ap_expr=BasicExpr (BVB bool1)}:algebraic_patterns2] bool guard_n
| bool1==bool
= skip_case_alt_results_this_bool algebraic_patterns2 bool (guard_n+1)
skip_case_alt_results_this_bool algebraic_patterns bool guard_n
= (algebraic_patterns,guard_n)
all_case_alt_results_this_bool :: ![AlgebraicPattern] !Bool -> Bool
all_case_alt_results_this_bool [{ap_expr=BasicExpr (BVB bool1)}:algebraic_patterns2] bool
= bool1==bool && all_case_alt_results_this_bool algebraic_patterns2 bool
all_case_alt_results_this_bool [_:_] bool
= False
all_case_alt_results_this_bool [] bool
= True
no_partial_match (Case {case_explicit})
= case_explicit
no_partial_match (Let {let_expr})
= no_partial_match let_expr
no_partial_match _
= True
optimise_case case_guards case_default case_info_ptr common_defs expr_heap
= (case_guards,case_default,expr_heap)
class convertRootCases a :: !ConvertInfo !a *ConvertState -> (a, *ConvertState)
instance convertRootCases TransformedBody where
......@@ -1290,11 +1374,12 @@ instance convertRootCases Expression where
CaseKindLeave
# (kees=:{case_expr, case_guards, case_default, case_explicit, case_info_ptr}, cs)
= splitCase ci kees cs
# (EI_CaseTypeAndSplits case_type _, cs_expr_heap)
= readPtr case_info_ptr cs.cs_expr_heap
# (case_expr, cs) = convertCases ci case_expr {cs & cs_expr_heap=cs_expr_heap}
# (case_guards, cs) = convertRootCasesCasePatterns ci case_guards case_type.ct_cons_types cs
# (case_default, cs)= convertRootCases ci case_default cs
(EI_CaseTypeAndSplits case_type _, cs_expr_heap) = readPtr case_info_ptr cs.cs_expr_heap
(case_expr, cs) = convertCases ci case_expr {cs & cs_expr_heap=cs_expr_heap}
(case_guards, cs) = convertRootCasesCasePatterns ci case_guards case_type.ct_cons_types cs
(case_default, cs)= convertRootCases ci case_default cs
(case_guards,case_default,expr_heap) = optimise_case case_guards case_default case_info_ptr ci.ci_common_defs cs.cs_expr_heap
cs & cs_expr_heap = expr_heap
-> (Case {kees & case_expr=case_expr, case_guards=case_guards, case_default=case_default}, cs)
CaseKindTransform
-> convertNonRootCase ci kees cs
......
Markdown is supported
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