Commit 403517b9 authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur

fixed bugs in merging explicit cases

parent 3018f259
......@@ -19,7 +19,7 @@ cEndWithSelection :== False
, es_fun_defs :: !.{# FunDef}
, es_dynamic_expr_count :: !Int // used to give each dynamic expr an unique id
}
:: ExpressionInput =
{ ei_expr_level :: !Level
, ei_fun_index :: !FunctionOrMacroIndex
......@@ -902,7 +902,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 kees.case_explicit) (split_patterns kees.case_guards)
# 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
......@@ -921,8 +921,8 @@ where
split_patterns NoPattern
= [NoPattern]
make_case :: Expression Bool CasePatterns -> Case
make_case expr explicit guard
make_case :: Expression CasePatterns -> Case
make_case expr guard
=
{ case_expr = expr
, case_guards = guard
......@@ -930,7 +930,7 @@ where
, case_ident = No
, case_info_ptr = nilPtr
, case_default_pos= NoPos
, case_explicit = explicit
, case_explicit = False
}
merge_case expr var_heap expr_heap error_admin
= (expr, var_heap, expr_heap, error_admin)
......
......@@ -36,34 +36,26 @@ instance GetSetPatternRhs DynamicPattern
mergeCases :: !(!Expression, !Position) ![(!Expression, !Position)] !*VarHeap !*ExpressionHeap !*ErrorAdmin
-> *(!(!Expression, !Position), !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
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
mergeCases expr_and_pos [] var_heap symbol_heap error
= (expr_and_pos, 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
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
= ((Let {lad & let_expr = let_expr}, pos), var_heap,symbol_heap, error)
mergeCaseWithCases nested (case_expr=:(Case first_case=:{case_expr = Var {var_info_ptr}, case_default = No, case_explicit}), case_pos)
mergeCases (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
| not (nested && case_explicit)
| not 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}
Yes {case_guards,case_default, case_explicit, case_ident}
# (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)
-> mergeCases (Case { first_case & case_guards = case_guards, case_default = case_default, case_explicit = case_explicit, case_ident = case_ident}, 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_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)
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_case split_var_info_ptr (Case this_case=:{case_expr = Var {var_info_ptr}, case_guards, case_default, case_explicit}) var_heap symbol_heap
| split_var_info_ptr == skip_alias var_info_ptr var_heap
= (Yes this_case, var_heap, symbol_heap)
| has_no_default case_default
......@@ -324,10 +316,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) = mergeNestedCases (ap_expr, NoPos) [(new_pattern.ap_expr, NoPos)] var_heap symbol_heap error
# ((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (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) = mergeNestedCases (ap_expr, NoPos) [(new_expr, NoPos)] var_heap symbol_heap error
((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (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)
......@@ -342,7 +334,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) = mergeNestedCases (bp_expr, NoPos) [(new_pattern.bp_expr, NoPos)] var_heap symbol_heap error
# ((bp_expr, _), var_heap, symbol_heap, error) = mergeCases (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)
......@@ -389,18 +381,18 @@ where
incompatible_patterns_in_case_error error
= checkError "" "incompatible patterns in case" 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)
mergeCases (case_expr=:(Case first_case=:{case_default, case_default_pos, case_explicit}), case_pos) [expr : exprs] var_heap symbol_heap error
| not 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
# ((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) = mergeCaseWithCases nested expr exprs var_heap symbol_heap error
# ((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)
mergeCaseWithCases _ expr_and_pos _ var_heap symbol_heap error
mergeCases expr_and_pos _ var_heap symbol_heap error
= (expr_and_pos, var_heap, symbol_heap, checkWarning "" " alternative will never match" error)
isOverloaded (OverloadedList _ _ _ _)
......
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