Commit d86fd076 authored by John van Groningen's avatar John van Groningen
Browse files

refactor, add function mergeExplicitCasePatterns, use it to merge explicit...

refactor, add function mergeExplicitCasePatterns, use it to merge explicit case expressions in module transform, note that cases with a case_expr that is not a variable can also be merged now, so function share_case_expr in module checkFunctionBodies is probably not necessary anymore
parent f2e017a8
......@@ -2,5 +2,8 @@ definition module mergecases
import syntax, checksupport
mergeExplicitCasePatterns :: !CasePatterns !*VarHeap !*ExpressionHeap !*ErrorAdmin
-> *(!CasePatterns,!*VarHeap,!*ExpressionHeap,!*ErrorAdmin)
mergeCases :: !(!Expression, !Position) ![(Expression, Position)] !*VarHeap !*ExpressionHeap !*ErrorAdmin
-> *(!(!Expression, !Position),!*VarHeap,!*ExpressionHeap,!*ErrorAdmin)
This diff is collapsed.
......@@ -1788,43 +1788,12 @@ where
# ((case_expr,(case_guards,case_default)), ei) = expand (case_expr,(case_guards,case_default)) ei
= ({ kees & case_expr = case_expr,case_guards = case_guards, case_default = case_default }, ei)
where
merge_if_explicit_case kees=:{ case_explicit } var_heap expr_heap error_admin
merge_if_explicit_case kees=:{case_explicit,case_guards} var_heap expr_heap error_admin
| case_explicit
# cases = map (make_case kees.case_expr) (split_patterns kees.case_guards)
cases = init cases ++ [{last cases & case_default = kees.case_default}]
[firstCase : otherCases] = [(Case kees, NoPos) \\ kees <- cases]
((Case {case_guards},_), var_heap, expr_heap, error_admin)
= mergeCases firstCase otherCases var_heap expr_heap error_admin
kees = {kees & case_guards = case_guards}
= (kees, var_heap, expr_heap, error_admin)
with
split_patterns :: CasePatterns -> [CasePatterns]
split_patterns (AlgebraicPatterns index patterns)
= [AlgebraicPatterns index [pattern] \\ pattern <- patterns]
split_patterns (BasicPatterns basicType patterns)
= [BasicPatterns basicType [pattern] \\ pattern <- patterns]
split_patterns (OverloadedPatterns overloaded_list_type decons_expr patterns)
= [OverloadedPatterns overloaded_list_type decons_expr [pattern] \\ pattern <- patterns]
split_patterns (NewTypePatterns index patterns)
= [NewTypePatterns index [pattern] \\ pattern <- patterns]
split_patterns (DynamicPatterns patterns)
= [DynamicPatterns [pattern] \\ pattern <- patterns]
split_patterns NoPattern
= [NoPattern]
make_case :: Expression CasePatterns -> Case
make_case expr guard
=
{ case_expr = expr
, case_guards = guard
, case_default = No
, case_ident = No
, case_info_ptr = nilPtr
, case_default_pos= NoPos
, case_explicit = False
}
// otherwise // not case_explicit
= (kees, var_heap, expr_heap, error_admin)
# (case_guards, var_heap, expr_heap, error_admin)
= mergeExplicitCasePatterns case_guards var_heap expr_heap error_admin
= ({kees & case_guards = case_guards}, var_heap, expr_heap, error_admin)
= (kees, var_heap, expr_heap, error_admin)
instance expand CasePatterns
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