added position information to case defaults to improve type error messages

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@201 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

9 files changed, 122 insertions, 52 deletions

diff --git a/frontend/check.icl b/frontend/check.icl
index 082a690..883e81f 100644
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -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,11 +2188,12 @@ 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,
-				es_dynamics = dynamics_in_patterns ++ es_dynamics }, e_info, cs)
+		= ([{ 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)
diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl
index 489ccb1..46ce20c 100644
--- a/frontend/comparedefimp.icl
+++ b/frontend/comparedefimp.icl
@@ -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
diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl
index 5f4a29c..d4f4d52 100644
--- a/frontend/convertDynamics.icl
+++ b/frontend/convertDynamics.icl
@@ -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
diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl
index 35e9b06..4487bf8 100644
--- a/frontend/explicitimports.icl
+++ b/frontend/explicitimports.icl
@@ -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
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index d70b6e7..350717d 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -380,10 +380,16 @@ cIsNonCoercible			:== 2
 	}
 
 ::	CheckedBody =
-	{	cb_args			:: ![FreeVar]
-	,	cb_rhs			:: ![Expression]
+	{	cb_args		:: ![FreeVar]
+	,	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 =
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index 5f34227..fae746d 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -355,10 +355,16 @@ cMayBeNonCoercible		:== 4
 	}
 
 ::	CheckedBody =
-	{	cb_args			:: ![FreeVar]
-	,	cb_rhs			:: ![Expression]
+	{	cb_args		:: ![FreeVar]
+	,	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
diff --git a/frontend/trans.icl b/frontend/trans.icl
index df7c9a7..3ba0218 100644
--- a/frontend/trans.icl
+++ b/frontend/trans.icl
@@ -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
diff --git a/frontend/transform.icl b/frontend/transform.icl
index a562be4..57dd93b 100644
--- a/frontend/transform.icl
+++ b/frontend/transform.icl
@@ -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,25 +984,27 @@ 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
 	# (contains_free_vars, lifted_function_called, fun_defs)
 			= foldSt (add_free_vars_of_non_recursive_calls_to_function group_index) group (False, False, fun_defs)
diff --git a/frontend/type.icl b/frontend/type.icl
index 37dc4b6..afd8528 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -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