Commit 46ed5ee5 authored by Martin Wierich's avatar Martin Wierich
Browse files

added position information to case defaults to improve type error messages

parent d2e07b78
......@@ -1041,7 +1041,7 @@ newFreeVariable new_var []
buildTypeCase type_case_dynamic type_case_patterns type_case_default type_case_info_ptr :==
Case { case_expr = type_case_dynamic, case_guards = DynamicPatterns type_case_patterns, case_default = type_case_default,
case_info_ptr = type_case_info_ptr, case_ident = No }
case_info_ptr = type_case_info_ptr, case_ident = No, case_default_pos = NoPos }
consOptional (Yes thing) things
......@@ -1427,16 +1427,18 @@ where
# (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
(bound_var, expr_heap) = allocate_bound_var var expr_heap
result = Case {case_expr = Var bound_var, case_guards = patterns, case_default = Yes result,
case_ident = Yes case_ident, case_info_ptr = case_expr_ptr}
case_ident = Yes case_ident, case_info_ptr = case_expr_ptr,
case_default_pos = NoPos }
(case_expression, expr_heap) = bind_default_variable expr var result expr_heap
-> (case_expression, expr_heap)
No
# (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
-> (Case {case_expr = expr, case_guards = patterns, case_default = Yes result,
case_ident = Yes case_ident, case_info_ptr = case_expr_ptr }, expr_heap)
case_ident = Yes case_ident, case_info_ptr = case_expr_ptr, case_default_pos = NoPos }, expr_heap)
build_case patterns No expr case_ident expr_heap
# (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
= (Case {case_expr = expr, case_guards = patterns, case_default = No, case_ident = Yes case_ident, case_info_ptr = case_expr_ptr }, expr_heap)
= (Case {case_expr = expr, case_guards = patterns, case_default = No, case_ident = Yes case_ident,
case_info_ptr = case_expr_ptr, case_default_pos = NoPos }, expr_heap)
bind_default_variable bind_src bind_dst result_expr expr_heap
# (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
......@@ -1869,13 +1871,15 @@ where
# (case_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
basic_pattern = {bp_value = (BVB True), bp_expr = expr, bp_position = NoPos }
case_expr = Case { case_expr = guard, case_guards = BasicPatterns BT_Bool [basic_pattern],
case_default = result_expr, case_ident = No, case_info_ptr = case_expr_ptr }
case_default = result_expr, case_ident = No, case_info_ptr = case_expr_ptr,
case_default_pos = NoPos }
= build_sequential_lets let_binds case_expr es_expr_heap
convert_guards_to_cases [(let_binds, guard, expr) : rev_guarded_exprs] result_expr es_expr_heap
# (case_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
basic_pattern = {bp_value = (BVB True), bp_expr = expr, bp_position = NoPos }
case_expr = Case { case_expr = guard, case_guards = BasicPatterns BT_Bool [basic_pattern],
case_default = result_expr, case_ident = No, case_info_ptr = case_expr_ptr }
case_default = result_expr, case_ident = No, case_info_ptr = case_expr_ptr,
case_default_pos = NoPos }
(result_expr, es_expr_heap) = build_sequential_lets let_binds case_expr es_expr_heap
= convert_guards_to_cases rev_guarded_exprs (Yes result_expr) es_expr_heap
......@@ -2003,7 +2007,8 @@ convertSubPattern (AP_Algebraic cons_symbol type_index args opt_var) result_expr
(case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 },
Case { case_expr = Var { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr },
case_guards = case_guards, case_default = No, case_ident = No, case_info_ptr = case_expr_ptr },
case_guards = case_guards, case_default = No, case_ident = No, case_info_ptr = case_expr_ptr,
case_default_pos = NoPos },
NoPos, var_store, expr_heap, opt_dynamics, cs)
convertSubPattern (AP_Basic basic_val opt_var) result_expr pattern_position var_store expr_heap opt_dynamics cs
# (basic_type, cs) = typeOfBasicValue basic_val cs
......@@ -2013,7 +2018,8 @@ convertSubPattern (AP_Basic basic_val opt_var) result_expr pattern_position var_
(case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 },
Case { case_expr = Var { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr },
case_guards = case_guards, case_default = No, case_ident = No, case_info_ptr = case_expr_ptr},
case_guards = case_guards, case_default = No, case_ident = No, case_info_ptr = case_expr_ptr,
case_default_pos = NoPos},
NoPos, var_store, expr_heap, opt_dynamics, cs)
convertSubPattern (AP_Dynamic pattern type opt_var) result_expr pattern_position var_store expr_heap opt_dynamics cs
# (var_arg, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
......@@ -2140,10 +2146,10 @@ checkFunctionBodies (ParsedBody [{pb_args,pb_rhs={rhs_alts,rhs_locals}, pb_posit
(rhss, free_vars, e_state=:{es_dynamics,es_expr_heap,es_var_heap}, e_info, cs)
= check_function_bodies free_vars cb_args bodies e_input { e_state & es_dynamics = [], es_var_heap = es_var_heap } e_info
{ cs & cs_symbol_table = cs_symbol_table }
(rhs, _, es_var_heap, es_expr_heap, dynamics_in_patterns, cs)
(rhs, position, es_var_heap, es_expr_heap, dynamics_in_patterns, cs)
= transform_patterns_into_cases aux_patterns cb_args expr_with_array_selections pb_position es_var_heap es_expr_heap
dynamics_in_rhs cs
= (CheckedBody { cb_args = cb_args, cb_rhs = [rhs : rhss] }, free_vars,
= (CheckedBody { cb_args = cb_args, cb_rhs = [{ ca_rhs = rhs, ca_position = position } : rhss] }, free_vars,
{ e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap, es_dynamics = dynamics_in_patterns ++ es_dynamics }, e_info, cs)
where
check_patterns [pattern : patterns] p_input accus var_store e_info cs
......@@ -2182,10 +2188,11 @@ where
cs_symbol_table = removeLocalIdentsFromSymbolTable ei_expr_level var_env cs.cs_symbol_table
(rhs_exprs, free_vars, e_state=:{es_dynamics,es_expr_heap,es_var_heap}, e_info, cs)
= check_function_bodies free_vars fun_args bodies e_input { e_state & es_dynamics = [] } e_info { cs & cs_symbol_table = cs_symbol_table }
(rhs_expr, _, es_var_heap, es_expr_heap, dynamics_in_patterns, cs)
(rhs_expr, position, es_var_heap, es_expr_heap, dynamics_in_patterns, cs)
= transform_patterns_into_cases aux_patterns fun_args rhs_expr pb_position
es_var_heap es_expr_heap dynamics_in_rhs cs
= ([rhs_expr : rhs_exprs], free_vars, { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap,
= ([{ ca_rhs = rhs_expr, ca_position = position } : rhs_exprs], free_vars,
{ e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap,
es_dynamics = dynamics_in_patterns ++ es_dynamics }, e_info, cs)
check_function_bodies free_vars fun_args [] e_input e_state e_info cs
= ([], free_vars, e_state, e_info, cs)
......@@ -2253,14 +2260,16 @@ where
alg_pattern = { ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr, ap_position = pattern_position }
case_guards = AlgebraicPatterns type_symbol [alg_pattern]
(case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
= (Case { case_expr = act_var, case_guards = case_guards, case_default = No, case_ident = No, case_info_ptr = case_expr_ptr },
= (Case { case_expr = act_var, case_guards = case_guards, case_default = No, case_ident = No,
case_info_ptr = case_expr_ptr, case_default_pos = NoPos },
NoPos, var_store, expr_heap, opt_dynamics, cs)
transform_pattern_into_cases (AP_Basic basic_val opt_var) fun_arg result_expr pattern_position var_store expr_heap opt_dynamics cs
# (basic_type, cs) = typeOfBasicValue basic_val cs
(act_var, result_expr, expr_heap) = transform_pattern_variable fun_arg opt_var result_expr expr_heap
case_guards = BasicPatterns basic_type [{ bp_value = basic_val, bp_expr = result_expr, bp_position = pattern_position }]
(case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
= (Case { case_expr = act_var, case_guards = case_guards, case_default = No, case_ident = No, case_info_ptr = case_expr_ptr },
= (Case { case_expr = act_var, case_guards = case_guards, case_default = No, case_ident = No,
case_info_ptr = case_expr_ptr, case_default_pos = NoPos },
NoPos, var_store, expr_heap, opt_dynamics, cs)
transform_pattern_into_cases (AP_Dynamic pattern type opt_var) fun_arg result_expr pattern_position var_store expr_heap opt_dynamics cs
# (var_arg, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
......
......@@ -742,7 +742,7 @@ instance e_corresponds FunctionBody where
= e_corresponds (from_body dclDef) (from_body iclDef)
where
from_body (TransformedBody {tb_args, tb_rhs}) = (tb_args, [tb_rhs])
from_body (CheckedBody {cb_args, cb_rhs}) = (cb_args, cb_rhs)
from_body (CheckedBody {cb_args, cb_rhs}) = (cb_args, [ca_rhs \\ {ca_rhs} <- cb_rhs])
instance e_corresponds TransformedBody where
e_corresponds dclDef iclDef
......
......@@ -400,7 +400,8 @@ where
case_guards = BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = dp_rhs, bp_position = NoPos }],
case_default = default_expr,
case_ident = No,
case_info_ptr = case_info_ptr },
case_info_ptr = case_info_ptr,
case_default_pos= NoPos }, // MW4++
let_info_ptr = let_info_ptr }
= (a_ij_binds ++ binds, let_expr, { ci & ci_new_variables = [unify_result_fv, unify_bool_fv : ci.ci_new_variables]})
where
......
......@@ -665,6 +665,10 @@ instance check_completeness CasePatterns where
check_completeness NoPattern _ ccs
= ccs
instance check_completeness CheckedAlternative where
check_completeness {ca_rhs} cci ccs
= check_completeness ca_rhs cci ccs
instance check_completeness CheckedBody where
check_completeness {cb_rhs} cci ccs
= check_completeness cb_rhs cci ccs
......
......@@ -381,9 +381,15 @@ cIsNonCoercible :== 2
:: CheckedBody =
{ cb_args :: ![FreeVar]
, cb_rhs :: ![Expression]
, cb_rhs :: ![CheckedAlternative]
}
:: CheckedAlternative =
{ ca_rhs :: !Expression
, ca_position :: !Position // the position is NoPos iff the position information for this
} // alternative is already stored in a case alternative
// (in ap_position, bp_position or dp_position)
:: TransformedBody =
{ tb_args :: ![FreeVar]
, tb_rhs :: !Expression
......@@ -1012,6 +1018,7 @@ cIsNotStrict :== False
, case_default :: !Optional Expression
, case_ident :: !Optional Ident
, case_info_ptr :: !ExprInfoPtr
, case_default_pos:: !Position
}
:: Let =
......
......@@ -356,9 +356,15 @@ cMayBeNonCoercible :== 4
:: CheckedBody =
{ cb_args :: ![FreeVar]
, cb_rhs :: ![Expression]
, cb_rhs :: ![CheckedAlternative]
}
:: CheckedAlternative =
{ ca_rhs :: !Expression
, ca_position :: !Position // the position is NoPos iff the position information for this
} // alternative is already stored in a case alternative
// (in ap_position, bp_position or dp_position)
:: TransformedBody =
{ tb_args :: ![FreeVar]
, tb_rhs :: !Expression
......@@ -972,6 +978,7 @@ cIsNotStrict :== False
, case_default :: !Optional Expression
, case_ident :: !Optional Ident
, case_info_ptr :: !ExprInfoPtr
, case_default_pos:: !Position
}
:: Let =
......@@ -994,7 +1001,6 @@ cIsNotStrict :== False
| DynamicPatterns [DynamicPattern] /* auxiliary */
| NoPattern /* auxiliary */
:: Selection = RecordSelection !(Global DefinedSymbol) !Int
| ArraySelection !(Global DefinedSymbol) !ExprInfoPtr !Expression
| DictionarySelection !BoundVar ![Selection] !ExprInfoPtr !Expression
......@@ -1311,6 +1317,10 @@ where
(<<<) file (DynamicPatterns patterns) = file <<< patterns
(<<<) file NoPattern = file
instance <<< CheckedAlternative
where
(<<<) file {ca_rhs} = file <<< ca_rhs
instance <<< Qualifier
where
(<<<) file {qual_generators,qual_filter = Yes qual_filter} = file <<< qual_generators <<< "| " <<< qual_filter
......@@ -1352,7 +1362,7 @@ where
(<<<) file (Case {case_expr,case_guards,case_default=No})
= file <<< "case " <<< case_expr <<< " of\n" <<< case_guards
(<<<) file (Case {case_expr,case_guards,case_default= Yes def_expr})
= file <<< "case " <<< case_expr <<< " of\n" <<< case_guards <<< "\n\t-> " <<< def_expr
= file <<< "case " <<< case_expr <<< " of\n" <<< case_guards <<< "\n\t->" <<< def_expr
(<<<) file (BasicExpr basic_value basic_type) = file <<< basic_value
(<<<) file (Conditional {if_cond,if_then,if_else}) =
else_part (file <<< "IF " <<< if_cond <<< "\nTHEN\n" <<< if_then) if_else
......
......@@ -704,7 +704,8 @@ setExtendedVarInfo var_info_ptr extension var_heap
= case old_var_info of
VI_Extended _ original_var_info -> writePtr var_info_ptr (VI_Extended extension original_var_info) var_heap
_ -> writePtr var_info_ptr (VI_Extended extension old_var_info) var_heap
neverMatchingCase = { case_expr = EE, case_guards = NoPattern, case_default = No, case_ident = No, case_info_ptr = nilPtr }
neverMatchingCase = { case_expr = EE, case_guards = NoPattern, case_default = No, case_ident = No,
case_info_ptr = nilPtr, case_default_pos = NoPos }
instance transform DynamicExpr where
transform dyn=:{dyn_expr} ro ti
......
......@@ -26,6 +26,12 @@ where
lift no ls
= (no, ls)
instance lift CheckedAlternative
where
lift ca=:{ca_rhs} ls
# (ca_rhs, ls) = lift ca_rhs ls
= ({ ca & ca_rhs = ca_rhs }, ls)
instance lift Expression
where
lift (FreeVar {fv_name,fv_info_ptr}) ls=:{ls_var_heap}
......@@ -735,10 +741,15 @@ where
expandMacrosInBody fi_calls {cb_args,cb_rhs} fun_defs mod_index alias_dummy modules es=:{es_symbol_table}
# (prev_calls, fun_defs, es_symbol_table) = addFunctionCallsToSymbolTable fi_calls fun_defs es_symbol_table
([rhs:rhss], fun_defs, modules, (all_calls, es)) = expand cb_rhs fun_defs mod_index modules (prev_calls, { es & es_symbol_table = es_symbol_table })
(fun_defs, es_symbol_table) = removeFunctionCallsFromSymbolTable all_calls fun_defs es.es_symbol_table
(merged_rhs, es_var_heap, es_symbol_heap, es_error) = mergeCases rhs rhss es.es_var_heap es.es_symbol_heap es.es_error
# (prev_calls, fun_defs, es_symbol_table)
= addFunctionCallsToSymbolTable fi_calls fun_defs es_symbol_table
([rhs:rhss], (fun_defs, modules, (all_calls, es)) )
= mapSt (expandCheckedAlternative mod_index) cb_rhs
(fun_defs, modules, (prev_calls, { es & es_symbol_table = es_symbol_table }))
(fun_defs, es_symbol_table)
= removeFunctionCallsFromSymbolTable all_calls fun_defs es.es_symbol_table
((merged_rhs, _), es_var_heap, es_symbol_heap, es_error)
= mergeCases rhs rhss es.es_var_heap es.es_symbol_heap es.es_error
(new_rhs, new_args, local_vars, {cos_error, cos_var_heap, cos_symbol_heap})
= determineVariablesAndRefCounts cb_args merged_rhs
{ cos_error = es_error, cos_var_heap = es_var_heap, cos_symbol_heap = es_symbol_heap,
......@@ -746,7 +757,11 @@ expandMacrosInBody fi_calls {cb_args,cb_rhs} fun_defs mod_index alias_dummy modu
= (new_args, new_rhs, local_vars, all_calls, fun_defs, modules,
{ es & es_error = cos_error, es_var_heap = cos_var_heap, es_symbol_heap = cos_symbol_heap,
es_symbol_table = es_symbol_table })
// ---> ("expandMacrosInBody", (cb_args, cb_rhs, '\n'), ("merged_rhs", merged_rhs, '\n'), ("new_rhs", new_args, local_vars, (new_rhs, '\n')))
// ---> ("expandMacrosInBody", (cb_args, ca_rhs, '\n'), ("merged_rhs", merged_rhs, '\n'), ("new_rhs", new_args, local_vars, (new_rhs, '\n')))
expandCheckedAlternative mod_index {ca_rhs, ca_position} (fun_defs, modules, es)
# (ca_rhs, fun_defs, modules, es) = expand ca_rhs fun_defs mod_index modules es
= ((ca_rhs, ca_position), (fun_defs, modules, es))
cContainsFreeVars :== True
cContainsNoFreeVars :== False
......@@ -755,21 +770,25 @@ cMacroIsCalled :== True
cNoMacroIsCalled :== False
mergeCases :: !Expression ![Expression] !*VarHeap !*ExpressionHeap !*ErrorAdmin -> *(!Expression, !*VarHeap, !*ExpressionHeap, !*ErrorAdmin);
mergeCases expr [] var_heap symbol_heap error
= (expr, var_heap, symbol_heap, error)
mergeCases (Let lad=:{let_expr}) exprs var_heap symbol_heap error
# (let_expr, var_heap, symbol_heap, error) = mergeCases let_expr exprs var_heap symbol_heap error
= (Let {lad & let_expr = let_expr}, var_heap,symbol_heap, error)
mergeCases case_expr=:(Case first_case=:{case_expr = Var {var_info_ptr}, case_default = No}) [expr : exprs] var_heap symbol_heap error
mergeCases :: !(!Expression, !Position) ![(!Expression, !Position)] !*VarHeap !*ExpressionHeap !*ErrorAdmin
-> *(!(!Expression, !Position), !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
mergeCases 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
= ((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)
[(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 }) exprs 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, var_heap, symbol_heap, error) = mergeCases expr exprs var_heap symbol_heap error
-> (Case { first_case & case_default = Yes case_default}, 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
......@@ -941,10 +960,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 [new_pattern.ap_expr] 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) = mergeCases ap_expr [new_expr] 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)
......@@ -965,23 +984,25 @@ 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 [new_pattern.bp_expr] 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)
merge_basic_pattern_with_patterns new_pattern [] var_heap symbol_heap error
= ([new_pattern], var_heap, symbol_heap, error)
mergeCases case_expr=:(Case first_case=:{case_default}) [expr : exprs] var_heap symbol_heap 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, var_heap, symbol_heap, error) = mergeCases default_expr [expr : exprs] var_heap symbol_heap error
-> (Case { first_case & case_default = Yes default_expr }, 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, var_heap, symbol_heap, error) = mergeCases expr exprs var_heap symbol_heap error
-> (Case { first_case & case_default = Yes default_expr }, var_heap, symbol_heap, error)
mergeCases expr _ var_heap symbol_heap error
= (expr, var_heap, symbol_heap, checkWarning "" " alternative will never match" 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)
mergeCases expr_and_pos _ var_heap symbol_heap error
= (expr_and_pos, var_heap, symbol_heap, checkWarning "" " alternative will never match" error)
liftFunctions min_level group group_index fun_defs var_heap expr_heap
......
......@@ -840,11 +840,13 @@ where
instance requirements Case
where
requirements ti {case_expr,case_guards,case_default,case_info_ptr} reqs_ts
// MW4 was: requirements ti {case_expr,case_guards,case_default,case_info_ptr} reqs_ts
requirements ti {case_expr,case_guards,case_default,case_info_ptr, case_default_pos} reqs_ts
# (expr_type, opt_expr_ptr, (reqs, ts)) = requirements ti case_expr reqs_ts
(fresh_v, ts) = freshAttributedVariable ts
(cons_types, reqs_ts) = requirements_of_guarded_expressions ti case_guards case_expr expr_type opt_expr_ptr fresh_v (reqs, ts)
(reqs, ts) = requirements_of_default ti case_default fresh_v reqs_ts
// MW4 was: (reqs, ts) = requirements_of_default ti case_default fresh_v reqs_ts
(reqs, ts) = requirements_of_default ti case_default case_default_pos fresh_v reqs_ts
ts_expr_heap = ts.ts_expr_heap <:= (case_info_ptr, EI_CaseType { ct_pattern_type = expr_type, ct_result_type = fresh_v, ct_cons_types = cons_types })
= (fresh_v, No, ({ reqs & req_case_and_let_exprs = [case_info_ptr : reqs.req_case_and_let_exprs]},
{ ts & ts_expr_heap = ts_expr_heap }))
......@@ -977,6 +979,7 @@ where
// ..MW4
/* MW4 was:
requirements_of_default ti (Yes expr) goal_type reqs_ts
# (res_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts
ts_expr_heap = storeAttribute opt_expr_ptr res_type.at_attribute ts.ts_expr_heap
......@@ -984,6 +987,20 @@ where
{ ts & ts_expr_heap = ts_expr_heap })
requirements_of_default ti No goal_type reqs_ts
= reqs_ts
*/
requirements_of_default ti (Yes expr) case_default_pos goal_type reqs_ts
= possibly_accumulate_reqs_in_new_group
case_default_pos
(reqs_of_default ti expr goal_type)
reqs_ts
requirements_of_default ti No _ goal_type reqs_ts
= reqs_ts
reqs_of_default ti expr goal_type reqs_ts
# (res_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts
ts_expr_heap = storeAttribute opt_expr_ptr res_type.at_attribute ts.ts_expr_heap
= ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = CP_Expression expr, tc_coercible = True } : reqs.req_type_coercions] },
{ ts & ts_expr_heap = ts_expr_heap })
instance requirements Let
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