diff options
| -rw-r--r-- | frontend/checkFunctionBodies.icl | 10 | ||||
| -rw-r--r-- | frontend/mergecases.icl | 42 |
2 files changed, 22 insertions, 30 deletions
diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl index 8ad3ee7..291aff1 100644 --- a/frontend/checkFunctionBodies.icl +++ b/frontend/checkFunctionBodies.icl @@ -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) diff --git a/frontend/mergecases.icl b/frontend/mergecases.icl index f182af7..d1f5787 100644 --- a/frontend/mergecases.icl +++ b/frontend/mergecases.icl @@ -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 _ _ _ _) |