Commit d4607be4 authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur

bug fix: do not merge nested explicit cases

parent 39637d40
......@@ -900,7 +900,7 @@ where
# (let_expr, var_heap, expr_heap, error_admin) = merge_case let_expr var_heap expr_heap error_admin
= (Let {lad & let_expr = let_expr}, var_heap, expr_heap, error_admin)
merge_case (Case kees) var_heap expr_heap error_admin
# cases = map (make_case kees.case_expr) (split_patterns kees.case_guards)
# cases = map (make_case kees.case_expr kees.case_explicit) (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
......@@ -919,8 +919,8 @@ where
split_patterns NoPattern
= [NoPattern]
make_case :: Expression CasePatterns -> Case
make_case expr guard
make_case :: Expression Bool CasePatterns -> Case
make_case expr explicit guard
=
{ case_expr = expr
, case_guards = guard
......@@ -928,9 +928,7 @@ where
, case_ident = No
, case_info_ptr = nilPtr
, case_default_pos= NoPos
// RWS ...
, case_explicit = False
// ... RWS
, case_explicit = explicit
}
merge_case expr var_heap expr_heap error_admin
= (expr, var_heap, expr_heap, error_admin)
......
......@@ -33,26 +33,35 @@ instance GetSetPatternRhs DynamicPattern
get_pattern_rhs p = p.dp_rhs
set_pattern_rhs p expr = {p & dp_rhs=expr}
mergeCases :: !(!Expression, !Position) ![(!Expression, !Position)] !*VarHeap !*ExpressionHeap !*ErrorAdmin
-> *(!(!Expression, !Position), !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
mergeCases expr_and_pos [] var_heap symbol_heap error
mergeCases expr_and_pos exprs var_heap symbol_heap error
= mergeCaseWithCases False expr_and_pos exprs var_heap symbol_heap error
mergeNestedCases
:== mergeCaseWithCases True
mergeCaseWithCases :: !Bool !(!Expression, !Position) ![(!Expression, !Position)] !*VarHeap !*ExpressionHeap !*ErrorAdmin
-> *(!(!Expression, !Position), !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
mergeCaseWithCases _ expr_and_pos [] var_heap symbol_heap error
= (expr_and_pos, var_heap, symbol_heap, error)
mergeCases (Let lad=:{let_expr}, pos) exprs var_heap symbol_heap error
# ((let_expr, _), var_heap, symbol_heap, error) = mergeCases (let_expr, NoPos) exprs var_heap symbol_heap error
mergeCaseWithCases nested (Let lad=:{let_expr}, pos) exprs var_heap symbol_heap error
# ((let_expr, _), var_heap, symbol_heap, error) = mergeCaseWithCases nested (let_expr, NoPos) exprs var_heap symbol_heap error
= ((Let {lad & let_expr = let_expr}, pos), var_heap,symbol_heap, error)
mergeCases (case_expr=:(Case first_case=:{case_expr = Var {var_info_ptr}, case_default = No}), case_pos)
mergeCaseWithCases nested (case_expr=:(Case first_case=:{case_expr = Var {var_info_ptr}, case_default = No, case_explicit}), case_pos)
[(expr, expr_pos) : exprs] var_heap symbol_heap error
# (split_result, var_heap, symbol_heap) = split_case var_info_ptr expr var_heap symbol_heap
= case split_result of
Yes {case_guards,case_default}
# (case_guards, var_heap, symbol_heap, error) = merge_guards first_case.case_guards case_guards var_heap symbol_heap error
-> mergeCases (Case { first_case & case_guards = case_guards, case_default = case_default }, NoPos)
exprs var_heap symbol_heap error
No
# ((case_default, pos), var_heap, symbol_heap, error) = mergeCases (expr, expr_pos) exprs var_heap symbol_heap error
-> ((Case { first_case & case_default = Yes case_default, case_default_pos = pos }, case_pos),
var_heap, symbol_heap, error)
| not (nested && case_explicit)
# (split_result, var_heap, symbol_heap) = split_case var_info_ptr expr var_heap symbol_heap
= case split_result of
Yes {case_guards,case_default}
# (case_guards, var_heap, symbol_heap, error) = merge_guards first_case.case_guards case_guards var_heap symbol_heap error
-> mergeCaseWithCases nested (Case { first_case & case_guards = case_guards, case_default = case_default }, NoPos)
exprs var_heap symbol_heap error
No
# ((case_default, pos), var_heap, symbol_heap, error) = mergeCaseWithCases nested (expr, expr_pos) exprs var_heap symbol_heap error
-> ((Case { first_case & case_default = Yes case_default, case_default_pos = pos }, case_pos),
var_heap, symbol_heap, error)
where
split_case split_var_info_ptr (Case this_case=:{case_expr = Var {var_info_ptr}, case_guards, case_default}) var_heap symbol_heap
| split_var_info_ptr == skip_alias var_info_ptr var_heap
......@@ -315,10 +324,10 @@ where
merge_algebraic_pattern_with_patterns new_pattern [pattern=:{ap_symbol,ap_vars,ap_expr} : patterns] var_heap symbol_heap error
| new_pattern.ap_symbol == ap_symbol
| isEmpty new_pattern.ap_vars
# ((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (ap_expr, NoPos) [(new_pattern.ap_expr, NoPos)] var_heap symbol_heap error
# ((ap_expr, _), var_heap, symbol_heap, error) = mergeNestedCases (ap_expr, NoPos) [(new_pattern.ap_expr, NoPos)] var_heap symbol_heap error
= ([{ pattern & ap_expr = ap_expr} : patterns], var_heap, symbol_heap, error)
# (new_expr, var_heap, symbol_heap) = replace_variables new_pattern.ap_vars new_pattern.ap_expr ap_vars var_heap symbol_heap
((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (ap_expr, NoPos) [(new_expr, NoPos)] var_heap symbol_heap error
((ap_expr, _), var_heap, symbol_heap, error) = mergeNestedCases (ap_expr, NoPos) [(new_expr, NoPos)] var_heap symbol_heap error
= ([{ pattern & ap_expr = ap_expr} : patterns], var_heap, symbol_heap, error)
# (patterns, var_heap, symbol_heap, error) = merge_algebraic_pattern_with_patterns new_pattern patterns var_heap symbol_heap error
= ([ pattern : patterns ], var_heap, symbol_heap, error)
......@@ -333,7 +342,7 @@ where
where
merge_basic_pattern_with_patterns new_pattern [pattern=:{bp_value,bp_expr} : patterns] var_heap symbol_heap error
| new_pattern.bp_value == bp_value
# ((bp_expr, _), var_heap, symbol_heap, error) = mergeCases (bp_expr, NoPos) [(new_pattern.bp_expr, NoPos)] var_heap symbol_heap error
# ((bp_expr, _), var_heap, symbol_heap, error) = mergeNestedCases (bp_expr, NoPos) [(new_pattern.bp_expr, NoPos)] var_heap symbol_heap error
= ([{ pattern & bp_expr = bp_expr} : patterns], var_heap, symbol_heap, error)
# (patterns, var_heap, symbol_heap, error) = merge_basic_pattern_with_patterns new_pattern patterns var_heap symbol_heap error
= ([ pattern : patterns ], var_heap, symbol_heap, error)
......@@ -380,16 +389,17 @@ where
incompatible_patterns_in_case_error error
= checkError "" "incompatible patterns in case" error
mergeCases (case_expr=:(Case first_case=:{case_default, case_default_pos}), case_pos) [expr : exprs] var_heap symbol_heap error
= case case_default of
Yes default_expr
# ((default_expr, case_default_pos), var_heap, symbol_heap, error) = mergeCases (default_expr, case_default_pos) [expr : exprs] var_heap symbol_heap error
-> ((Case { first_case & case_default = Yes default_expr, case_default_pos = case_default_pos }, case_pos),
var_heap, symbol_heap, error)
No
# ((default_expr, pos), var_heap, symbol_heap, error) = mergeCases expr exprs var_heap symbol_heap error
-> ((Case { first_case & case_default = Yes default_expr, case_default_pos = pos }, case_pos),
var_heap, symbol_heap, error)
mergeCases expr_and_pos _ var_heap symbol_heap error
mergeCaseWithCases nested (case_expr=:(Case first_case=:{case_default, case_default_pos, case_explicit}), case_pos) [expr : exprs] var_heap symbol_heap error
| not (nested && case_explicit)
= case case_default of
Yes default_expr
# ((default_expr, case_default_pos), var_heap, symbol_heap, error) = mergeCaseWithCases nested (default_expr, case_default_pos) [expr : exprs] var_heap symbol_heap error
-> ((Case { first_case & case_default = Yes default_expr, case_default_pos = case_default_pos }, case_pos),
var_heap, symbol_heap, error)
No
# ((default_expr, pos), var_heap, symbol_heap, error) = mergeCaseWithCases nested expr exprs var_heap symbol_heap error
-> ((Case { first_case & case_default = Yes default_expr, case_default_pos = pos }, case_pos),
var_heap, symbol_heap, error)
mergeCaseWithCases _ expr_and_pos _ var_heap symbol_heap error
= (expr_and_pos, var_heap, symbol_heap, checkWarning "" " alternative will never match" error)
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