added position information to case alternatives and changed the typing

algorihm so that typing error messages can indicate the alternative in
which the error occured. Before, these error messages always located the
first alternative/function type


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

6 files changed, 281 insertions, 96 deletions

diff --git a/frontend/check.icl b/frontend/check.icl
index 99b941f..082a690 100644
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -1303,9 +1303,9 @@ where
 			!String !*VarHeap !*ExpressionHeap ![DynamicPtr] !*CheckState
 				-> (!CasePatterns, !CasePatterns, !Env Ident VarInfoPtr, !Optional (!Optional FreeVar,!Expression), !*VarHeap, !*ExpressionHeap, ![DynamicPtr], !*CheckState)
 	transform_pattern (AP_Algebraic cons_symbol type_index args opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ var_store expr_heap opt_dynamics cs
-		# (var_args, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns args result_expr var_store expr_heap opt_dynamics cs
+		# (var_args, result_expr, _, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns args result_expr NoPos var_store expr_heap opt_dynamics cs
 		  type_symbol = { glob_module = cons_symbol.glob_module, glob_object = type_index}
-		  pattern = { ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr}
+		  pattern = { ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr, ap_position = NoPos}
 		  pattern_variables = cons_optional opt_var pattern_variables
 		= case pattern_scheme of
 			AlgebraicPatterns alg_type _
@@ -1322,7 +1322,7 @@ where
 				-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,
 						{ cs & cs_error = checkError cons_symbol.glob_object.ds_ident "illegal combination of patterns" cs.cs_error })
 	transform_pattern (AP_Basic basic_val opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ var_store expr_heap opt_dynamics cs
-		# pattern = { bp_value = basic_val, bp_expr = result_expr}
+		# pattern = { bp_value = basic_val, bp_expr = result_expr, bp_position = NoPos}
 		  pattern_variables = cons_optional opt_var pattern_variables
 		  (type_symbol, cs) = typeOfBasicValue basic_val cs
 		= case pattern_scheme of
@@ -1342,9 +1342,10 @@ where
 				-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,
 						{ cs & cs_error = checkError basic_val "illegal combination of patterns" cs.cs_error})
 	transform_pattern (AP_Dynamic pattern type opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ var_store expr_heap opt_dynamics cs
-		# (var_arg, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPattern pattern result_expr var_store expr_heap opt_dynamics cs
+		# (var_arg, result_expr, _, var_store, expr_heap, opt_dynamics, cs) = convertSubPattern pattern result_expr NoPos var_store expr_heap opt_dynamics cs
 		  (dynamic_info_ptr, expr_heap) = newPtr (EI_DynamicType type opt_dynamics) expr_heap
-		  pattern = { dp_var = var_arg, dp_type	= dynamic_info_ptr,	dp_rhs = result_expr, dp_type_patterns_vars = [], dp_type_code = TCE_Empty }
+		  pattern = { dp_var = var_arg, dp_type	= dynamic_info_ptr,	dp_rhs = result_expr, dp_type_patterns_vars = [],
+		  				dp_type_code = TCE_Empty, dp_position = NoPos }
 		  pattern_variables = cons_optional opt_var pattern_variables
 		= case pattern_scheme of
 			DynamicPatterns _
@@ -1866,12 +1867,14 @@ where
 		
 	convert_guards_to_cases [(let_binds, guard, expr)] result_expr es_expr_heap
 		# (case_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
-		  case_expr = Case { case_expr = guard, case_guards = BasicPatterns BT_Bool [{bp_value = (BVB True), bp_expr = expr}],
+		  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 }
 		= 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
-		  case_expr = Case { case_expr = guard, case_guards = BasicPatterns BT_Bool [{bp_value = (BVB True), bp_expr = expr}],
+		  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 }
 		  (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
@@ -1969,57 +1972,68 @@ determinePatternVariable No var_heap
 	# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
 	= ({ bind_src = newVarId "_x", bind_dst = new_info_ptr }, var_heap)
 
-convertSubPatterns [] result_expr var_store expr_heap opt_dynamics cs
-	= ([], result_expr, var_store, expr_heap, opt_dynamics, cs)
-convertSubPatterns [pattern : patterns] result_expr var_store expr_heap opt_dynamics cs
-	# (var_args, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns patterns result_expr var_store expr_heap opt_dynamics cs
-	  (var_arg, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPattern pattern result_expr var_store expr_heap opt_dynamics cs
-	= ([var_arg : var_args], result_expr, var_store, expr_heap, opt_dynamics, cs)
+convertSubPatterns [] result_expr pattern_position var_store expr_heap opt_dynamics cs
+	= ([], result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
+convertSubPatterns [pattern : patterns] result_expr pattern_position var_store expr_heap opt_dynamics cs
+	# (var_args, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs) 
+			= convertSubPatterns patterns result_expr pattern_position var_store expr_heap opt_dynamics cs
+	  (var_arg, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
+	  		= convertSubPattern pattern result_expr pattern_position var_store expr_heap opt_dynamics cs
+	= ([var_arg : var_args], result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
 
-convertSubPattern (AP_Variable name var_info (Yes {bind_src,bind_dst})) result_expr var_store expr_heap opt_dynamics cs
+convertSubPattern (AP_Variable name var_info (Yes {bind_src,bind_dst})) result_expr pattern_position var_store expr_heap opt_dynamics cs
 	# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
 	  bound_var = { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }
 	  free_var = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }
 	  (let_expr, expr_heap)	= buildLetExpression [] [{ bind_src = Var bound_var,
 	  			bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }}] result_expr expr_heap
-	= (free_var, let_expr, var_store, expr_heap, opt_dynamics, cs)
-convertSubPattern (AP_Variable name var_info No) result_expr var_store expr_heap opt_dynamics cs
-	= ({ fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, result_expr, var_store, expr_heap, opt_dynamics, cs)
-convertSubPattern (AP_Algebraic cons_symbol type_index args opt_var) result_expr var_store expr_heap opt_dynamics cs
-	# (var_args, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns args result_expr var_store expr_heap opt_dynamics cs
+	= (free_var, let_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
+convertSubPattern (AP_Variable name var_info No) result_expr pattern_position var_store expr_heap opt_dynamics cs
+	= ({ fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, result_expr, pattern_position, 
+		var_store, expr_heap, opt_dynamics, cs)
+convertSubPattern (AP_Algebraic cons_symbol type_index args opt_var) result_expr pattern_position
+					var_store expr_heap opt_dynamics cs
+	# (var_args, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
+			= convertSubPatterns args result_expr pattern_position var_store expr_heap opt_dynamics cs
 	  type_symbol = { glob_module = cons_symbol.glob_module, glob_object = type_index }
-	  case_guards = AlgebraicPatterns type_symbol [{ ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr }]
+	  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]
 	  ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store
 	  (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
 	  (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 }, var_store, expr_heap, opt_dynamics, cs)
-convertSubPattern (AP_Basic basic_val opt_var) result_expr var_store expr_heap opt_dynamics cs
+		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 },
+		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
-	  case_guards = BasicPatterns basic_type [{ bp_value = basic_val, bp_expr = result_expr }]
+	  case_guards = BasicPatterns basic_type [{ bp_value = basic_val, bp_expr = result_expr, bp_position = pattern_position }]
   	  ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store
 	  (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
 	  (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}, var_store, expr_heap, opt_dynamics, cs)
-convertSubPattern (AP_Dynamic pattern type opt_var) result_expr var_store expr_heap opt_dynamics cs
-	# (var_arg, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPattern pattern result_expr var_store expr_heap opt_dynamics cs
+		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},
+		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)
+			= convertSubPattern pattern result_expr pattern_position var_store expr_heap opt_dynamics cs
  	  ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store
 	  (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
 	  (type_case_info_ptr, expr_heap) = newPtr EI_Empty expr_heap
 	  (dynamic_info_ptr, expr_heap) = newPtr (EI_DynamicType type opt_dynamics) expr_heap
- 	  type_case_patterns = [{ dp_var = var_arg, dp_type = dynamic_info_ptr, dp_rhs = result_expr, dp_type_patterns_vars = [], dp_type_code = TCE_Empty }]
+ 	  type_case_patterns = [{ dp_var = var_arg, dp_type = dynamic_info_ptr, dp_rhs = result_expr, dp_type_patterns_vars = [],
+ 	  						dp_type_code = TCE_Empty, dp_position = pattern_position }]
 	= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 },
-			buildTypeCase (Var { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }) type_case_patterns No type_case_info_ptr,
-				var_store, expr_heap, [dynamic_info_ptr], cs)
-convertSubPattern (AP_WildCard opt_var) result_expr var_store expr_heap opt_dynamics cs
+		buildTypeCase (Var { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }) 
+							type_case_patterns No type_case_info_ptr,
+		NoPos, var_store, expr_heap, [dynamic_info_ptr], cs)
+convertSubPattern (AP_WildCard opt_var) result_expr pattern_position var_store expr_heap opt_dynamics cs
  	# ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store
-	= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0  }, result_expr, var_store, expr_heap, opt_dynamics, cs)
-convertSubPattern (AP_Empty _) result_expr var_store expr_heap opt_dynamics cs
-	= convertSubPattern (AP_WildCard No) EE var_store expr_heap opt_dynamics cs
-
+	= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0  }, result_expr, pattern_position,
+		var_store, expr_heap, opt_dynamics, cs)
+convertSubPattern (AP_Empty _) result_expr pattern_position var_store expr_heap opt_dynamics cs
+	= convertSubPattern (AP_WildCard No) EE pattern_position var_store expr_heap opt_dynamics cs
 
 typeOfBasicValue :: !BasicValue !*CheckState -> (!BasicType, !*CheckState)
 typeOfBasicValue (BVI _) cs = (BT_Int, cs)
@@ -2110,7 +2124,7 @@ allocate_free_var ident var_heap
 	# (new_var_info_ptr, var_heap) = newPtr VI_Empty var_heap
 	= ({ fv_def_level = NotALevel, fv_name = ident, fv_info_ptr = new_var_info_ptr,	fv_count = 0 }, var_heap)
 
-checkFunctionBodies (ParsedBody [{pb_args,pb_rhs={rhs_alts,rhs_locals}} : bodies]) e_input=:{ei_expr_level,ei_mod_index}
+checkFunctionBodies (ParsedBody [{pb_args,pb_rhs={rhs_alts,rhs_locals}, pb_position} : bodies]) e_input=:{ei_expr_level,ei_mod_index}
 		e_state=:{es_var_heap, es_fun_defs} e_info cs
 	# (aux_patterns, (var_env, array_patterns), {ps_var_heap, ps_fun_defs}, e_info, cs)
 			= check_patterns pb_args {pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False} ([], [])
@@ -2126,8 +2140,8 @@ checkFunctionBodies (ParsedBody [{pb_args,pb_rhs={rhs_alts,rhs_locals}} : bodies
 	  (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)
-	  		= transform_patterns_into_cases aux_patterns cb_args expr_with_array_selections es_var_heap es_expr_heap
+	  (rhs, _, 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,
 		{ e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap, es_dynamics = dynamics_in_patterns ++ es_dynamics }, e_info, cs)
@@ -2156,8 +2170,8 @@ where
 		# ({bind_src,bind_dst}, var_store) = determinePatternVariable No var_store
 		= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store)
 	
-	check_function_bodies free_vars fun_args [{pb_args,pb_rhs={rhs_alts,rhs_locals}} : bodies] e_input=:{ei_expr_level,ei_mod_index}
-			e_state=:{es_var_heap,es_fun_defs} e_info cs
+	check_function_bodies free_vars fun_args [{pb_args,pb_rhs={rhs_alts,rhs_locals},pb_position} : bodies]
+							e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_var_heap,es_fun_defs} e_info cs
 		# (aux_patterns, (var_env, array_patterns), {ps_var_heap, ps_fun_defs}, e_info, cs)
 				= check_patterns pb_args { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False } ([], [])
 					{ps_var_heap = es_var_heap, ps_fun_defs = es_fun_defs} e_info cs
@@ -2168,30 +2182,37 @@ 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)
-		  		= transform_patterns_into_cases aux_patterns fun_args rhs_expr es_var_heap es_expr_heap dynamics_in_rhs cs
+		  (rhs_expr, _, 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)
 	check_function_bodies free_vars fun_args [] e_input e_state e_info cs
 		= ([], free_vars, e_state, e_info, cs) 
 		
-	transform_patterns_into_cases [pattern : patterns] [fun_arg : fun_args] result_expr var_store expr_heap opt_dynamics cs
-		# (patterns_expr, var_store, expr_heap, opt_dynamics, cs)
-				= transform_succeeding_patterns_into_cases patterns fun_args result_expr var_store expr_heap opt_dynamics cs
-		= transform_pattern_into_cases pattern fun_arg patterns_expr var_store expr_heap opt_dynamics cs
+	transform_patterns_into_cases [pattern : patterns] [fun_arg : fun_args] result_expr pattern_position
+									var_store expr_heap opt_dynamics cs
+		# (patterns_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
+				= transform_succeeding_patterns_into_cases patterns fun_args result_expr pattern_position
+															var_store expr_heap opt_dynamics cs
+		= transform_pattern_into_cases pattern fun_arg patterns_expr pattern_position var_store expr_heap opt_dynamics cs
 	where
-		transform_succeeding_patterns_into_cases [] _ result_expr var_store expr_heap opt_dynamics cs
-			= (result_expr, var_store, expr_heap, opt_dynamics, cs)
-		transform_succeeding_patterns_into_cases [pattern : patterns] [fun_arg : fun_args] result_expr var_store expr_heap opt_dynamics cs
-			# (patterns_expr, var_store, expr_heap, opt_dynamics, cs)
-				= transform_succeeding_patterns_into_cases patterns fun_args result_expr var_store expr_heap opt_dynamics cs
-			= transform_pattern_into_cases pattern fun_arg patterns_expr var_store expr_heap opt_dynamics cs
-	transform_patterns_into_cases [] _ result_expr var_store expr_heap opt_dynamics cs
-		= (result_expr, var_store, expr_heap, opt_dynamics, cs)
+		transform_succeeding_patterns_into_cases [] _ result_expr pattern_position var_store expr_heap opt_dynamics cs
+			= (result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
+		transform_succeeding_patterns_into_cases [pattern : patterns] [fun_arg : fun_args] result_expr pattern_position
+												var_store expr_heap opt_dynamics cs
+			# (patterns_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
+				= transform_succeeding_patterns_into_cases patterns fun_args result_expr pattern_position
+															var_store expr_heap opt_dynamics cs
+			= transform_pattern_into_cases pattern fun_arg patterns_expr pattern_position var_store expr_heap opt_dynamics cs
+
+	transform_patterns_into_cases [] _ result_expr pattern_position var_store expr_heap opt_dynamics cs
+		= (result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
 		
-	transform_pattern_into_cases :: !AuxiliaryPattern !FreeVar !Expression !*VarHeap !*ExpressionHeap ![DynamicPtr] !*CheckState
-		-> (!Expression, !*VarHeap, !*ExpressionHeap, ![DynamicPtr], !*CheckState)
-	transform_pattern_into_cases (AP_Variable name var_info opt_var) fun_arg=:{fv_info_ptr,fv_name} result_expr var_store expr_heap opt_dynamics cs
+	transform_pattern_into_cases :: !AuxiliaryPattern !FreeVar !Expression !Position !*VarHeap !*ExpressionHeap ![DynamicPtr] !*CheckState
+		-> (!Expression, !Position, !*VarHeap, !*ExpressionHeap, ![DynamicPtr], !*CheckState)
+	transform_pattern_into_cases (AP_Variable name var_info opt_var) fun_arg=:{fv_info_ptr,fv_name} result_expr pattern_position
+									var_store expr_heap opt_dynamics cs
 		= case opt_var of
 			Yes {bind_src, bind_dst}
 				| bind_dst == fv_info_ptr
@@ -2200,7 +2221,8 @@ where
 					-> (Let { let_strict_binds = [], let_lazy_binds= [
 								{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr },
 									bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }}],
-							  let_expr = result_expr, let_info_ptr = let_expr_ptr}, var_store, expr_heap, opt_dynamics, cs)
+							  let_expr = result_expr, let_info_ptr = let_expr_ptr}, 
+						pattern_position, var_store, expr_heap, opt_dynamics, cs)
 					# (var_expr_ptr1, expr_heap) = newPtr EI_Empty expr_heap
 					  (var_expr_ptr2, expr_heap) = newPtr EI_Empty expr_heap
 					  (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
@@ -2209,43 +2231,50 @@ where
 									bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }},
 								{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr2 },
 									bind_dst = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }}],
-							  let_expr = result_expr, let_info_ptr = let_expr_ptr}, var_store, expr_heap, opt_dynamics, cs)
+							  let_expr = result_expr, let_info_ptr = let_expr_ptr}, 
+						pattern_position, var_store, expr_heap, opt_dynamics, cs)
 			No
 				| var_info == fv_info_ptr
-					-> (result_expr, var_store, expr_heap, opt_dynamics, cs)
+					-> (result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
 					# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
 					  (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
 					-> (Let { let_strict_binds = [], let_lazy_binds=
 									[{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr },
 										 bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }}],
-							  let_expr = result_expr, let_info_ptr = let_expr_ptr}, var_store, expr_heap, opt_dynamics, cs)
+							  let_expr = result_expr, let_info_ptr = let_expr_ptr},
+						pattern_position, var_store, expr_heap, opt_dynamics, cs)
 
-	transform_pattern_into_cases (AP_Algebraic cons_symbol type_index args opt_var) fun_arg result_expr var_store expr_heap opt_dynamics cs
-		# (var_args, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns args result_expr var_store expr_heap opt_dynamics cs
+	transform_pattern_into_cases (AP_Algebraic cons_symbol type_index args opt_var) fun_arg result_expr pattern_position
+									var_store expr_heap opt_dynamics cs
+		# (var_args, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
+				= convertSubPatterns args result_expr pattern_position var_store expr_heap opt_dynamics cs
 		  type_symbol = {glob_module = cons_symbol.glob_module, glob_object = type_index}
 	  	  (act_var, result_expr, expr_heap) = transform_pattern_variable fun_arg opt_var result_expr expr_heap
-	  	  case_guards = AlgebraicPatterns type_symbol [{ ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr }]
+		  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 },
-				var_store, expr_heap, opt_dynamics, cs)	
-	transform_pattern_into_cases (AP_Basic basic_val opt_var) fun_arg result_expr var_store expr_heap opt_dynamics cs
+				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 }]
+		  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 },
-			var_store, expr_heap, opt_dynamics, cs)	
-	transform_pattern_into_cases (AP_Dynamic pattern type opt_var) fun_arg result_expr var_store expr_heap opt_dynamics cs
-		# (var_arg, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPattern pattern result_expr var_store expr_heap opt_dynamics cs
+			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)
+				= convertSubPattern pattern result_expr pattern_position var_store expr_heap opt_dynamics cs
 		  (type_case_info_ptr, expr_heap) = newPtr EI_Empty expr_heap
 		  (dynamic_info_ptr, expr_heap) = newPtr (EI_DynamicType type opt_dynamics) expr_heap
 	  	  (act_var, result_expr, expr_heap) = transform_pattern_variable fun_arg opt_var result_expr expr_heap
-	  	  type_case_patterns = [{ dp_var = var_arg, dp_type	= dynamic_info_ptr,	dp_rhs = result_expr, dp_type_patterns_vars = [], dp_type_code = TCE_Empty }]
-		= (buildTypeCase act_var type_case_patterns No type_case_info_ptr, var_store, expr_heap, [dynamic_info_ptr], cs)	
-	transform_pattern_into_cases (AP_WildCard _) fun_arg result_expr var_store expr_heap opt_dynamics cs
-		= (result_expr, var_store, expr_heap, opt_dynamics, cs)	
-	transform_pattern_into_cases (AP_Empty name) fun_arg result_expr var_store expr_heap opt_dynamics cs
-		= (result_expr, var_store, expr_heap, opt_dynamics, cs)
+	  	  type_case_patterns = [{ dp_var = var_arg, dp_type	= dynamic_info_ptr,	dp_rhs = result_expr, dp_type_patterns_vars = [],
+	  	  							dp_type_code = TCE_Empty, dp_position = pattern_position }]
+		= (buildTypeCase act_var type_case_patterns No type_case_info_ptr, NoPos, var_store, expr_heap, [dynamic_info_ptr], cs)	
+	transform_pattern_into_cases (AP_WildCard _) fun_arg result_expr pattern_position var_store expr_heap opt_dynamics cs
+		= (result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)	
+	transform_pattern_into_cases (AP_Empty name) fun_arg result_expr pattern_position var_store expr_heap opt_dynamics cs
+		= (result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
 
 	transform_pattern_variable :: !FreeVar !(Optional !(Bind Ident VarInfoPtr)) !Expression !*ExpressionHeap
 		-> (!Expression, !Expression, !*ExpressionHeap)
diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl
index 11caa44..5f4a29c 100644
--- a/frontend/convertDynamics.icl
+++ b/frontend/convertDynamics.icl
@@ -396,7 +396,8 @@ where
 		  								   bind_dst = unify_bool_fv } : let_binds
 		  								],
 		  					let_expr = Case {	case_expr 		= Var unify_bool_var,
-												case_guards		= BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = dp_rhs}],
+// MW was:												case_guards		= BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = dp_rhs}],
+												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	},
diff --git a/frontend/postparse.icl b/frontend/postparse.icl
index 282dc16..eea5437 100644
--- a/frontend/postparse.icl
+++ b/frontend/postparse.icl
@@ -306,7 +306,8 @@ transformLambda :: Ident [ParsedExpr] ParsedExpr Position -> FunDef
 transformLambda lam_ident args result pos
 	# lam_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = result, ewl_locals = NoCollectedLocalDefs },
 	  			  rhs_locals = NoCollectedLocalDefs }
-	  lam_body = [{pb_args = args, pb_rhs = lam_rhs }]
+// MW4 was:	  lam_body = [{pb_args = args, pb_rhs = lam_rhs }]
+	  lam_body = [{pb_args = args, pb_rhs = lam_rhs, pb_position = pos }]
 // MW was:	  fun_def = MakeNewFunction lam_ident (length args) lam_body (FK_Function cNameLocationDependent) NoPrio No NoPos
 	  fun_def = MakeNewFunction lam_ident (length args) lam_body (FK_Function cNameLocationDependent) NoPrio No pos
 	= fun_def
@@ -789,8 +790,10 @@ collectFunctionBodies fun_name fun_arity fun_prio fun_kind all_defs=:[PD_Functio
 		  (bodies, new_fun_kind, rest_defs, ca) = collectFunctionBodies fun_name fun_arity fun_prio new_fun_kind defs ca
 		  act_arity	= length args
 		| fun_arity == act_arity
-			= ([{ pb_args = args, pb_rhs = rhs } : bodies ], new_fun_kind, rest_defs, ca)
-			= ([{ pb_args = args, pb_rhs = rhs } : bodies ], new_fun_kind, rest_defs, 
+// MW4 was:			= ([{ pb_args = args, pb_rhs = rhs } : bodies ], new_fun_kind, rest_defs, ca)
+			= ([{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ], new_fun_kind, rest_defs, ca)
+// MW4 was:			= ([{ pb_args = args, pb_rhs = rhs } : bodies ], new_fun_kind, rest_defs, 
+			= ([{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ], new_fun_kind, rest_defs, 
 			    postParseError pos	("This alternative has " + toString act_arity +
 			  						 (if (act_arity == 1)" argument instead of " " arguments instead of ") + toString fun_arity
 			  						) ca
@@ -814,7 +817,8 @@ reorganiseDefinitions icl_module [PD_Function pos name is_infix args rhs fun_kin
 	  fun_arity = length args
 	  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
 	  (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca
-	  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies] fun_kind prio No pos
+// MW4 was:	  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies] fun_kind prio No pos
+	  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies] fun_kind prio No pos
 	| fun_kind == FK_Macro
 		= (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros ]}, imports, imported_objects, ca)
 		= ([ fun : fun_defs ], c_defs, imports, imported_objects, ca)
@@ -829,7 +833,8 @@ reorganiseDefinitions icl_module [PD_TypeSpec fun_pos fun_name prio No specials
   				# fun_arity = length args
 				  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
 	  			  (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca
-				  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
+// MW4 was:				  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
+				  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos
 				| fun_kind == FK_Macro
 					-> (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros]}, imports, imported_objects, ca)
 					-> ([ fun : fun_defs ], c_defs, imports, imported_objects, ca)
@@ -932,7 +937,8 @@ where
 		  fun_arity = length args
 		  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
 		  (mem_defs, mem_macros, ca) = check_symbols_of_class_members defs type_context ca
-		  macro = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies] FK_Macro prio No fun_pos
+// MW4 was:		  macro = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies] FK_Macro prio No fun_pos
+		  macro = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = fun_pos } : bodies] FK_Macro prio No fun_pos
 		= (mem_defs, [macro : mem_macros], ca)
 	check_symbols_of_class_members [def : _] type_context ca
 		= abort "postparse.check_symbols_of_class_members: unknown def"  <<- def
@@ -966,7 +972,8 @@ where
 		  prio = if is_infix (Prio NoAssoc 9) NoPrio
 		  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
 		  (fun_defs, ca) = collect_member_instances defs ca
-		  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
+// MW4 was:		  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
+		  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos
 		= ([ fun : fun_defs ], ca)
 	collect_member_instances [PD_TypeSpec fun_pos fun_name prio type specials : defs] ca
 		= case defs of
@@ -1005,7 +1012,8 @@ reorganiseLocalDefinitions [PD_Function pos name is_infix args rhs fun_kind : de
 	  fun_arity = length args
 	  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
 	  (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca
-	  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
+// MW4 was:	  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
+	  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos
 	= ([ fun : fun_defs ], node_defs, ca)
 reorganiseLocalDefinitions [PD_TypeSpec pos1 name1 prio type specials : defs] ca
 	= case defs of
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index b2f77dc..d70b6e7 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -374,8 +374,9 @@ cIsNonCoercible			:== 2
 	}
 
 ::	ParsedBody =
-	{	pb_args	:: ![ParsedExpr]
-	,	pb_rhs	:: !Rhs
+	{	pb_args		:: ![ParsedExpr]
+	,	pb_rhs		:: !Rhs
+	,	pb_position	:: !Position
 	}
 
 ::	CheckedBody =
@@ -1081,11 +1082,13 @@ cIsNotStrict	:== False
 	{	ap_symbol	:: !(Global DefinedSymbol)
 	,	ap_vars		:: ![FreeVar]
 	,	ap_expr		:: !Expression
+	,	ap_position	:: !Position
 	}
 	
 ::	BasicPattern =
 	{	bp_value	:: !BasicValue
 	,	bp_expr		:: !Expression
+	,	bp_position	:: !Position
 	}
 
 ::	TypeCase =
@@ -1101,6 +1104,7 @@ cIsNotStrict	:== False
 	,	dp_type_patterns_vars	:: ![VarInfoPtr]			/* filled after type checking */
 	,	dp_type_code			:: !TypeCodeExpression		/* filled after type checking */
 	,	dp_rhs					:: !Expression
+	,	dp_position				:: !Position
 	}
 	
 /*
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index fe0044b..5f34227 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -351,6 +351,7 @@ cMayBeNonCoercible		:== 4
 ::	ParsedBody =
 	{	pb_args	:: ![ParsedExpr]
 	,	pb_rhs	:: !Rhs
+	,	pb_position	:: !Position
 	}
 
 ::	CheckedBody =
@@ -1012,11 +1013,13 @@ cIsNotStrict	:== False
 	{	ap_symbol	:: !(Global DefinedSymbol)
 	,	ap_vars		:: ![FreeVar]
 	,	ap_expr		:: !Expression
+	,	ap_position	:: !Position
 	}
 	
 ::	BasicPattern =
 	{	bp_value	:: !BasicValue
 	,	bp_expr		:: !Expression
+	,	bp_position	:: !Position
 	}
 
 ::	TypeCase =
@@ -1032,6 +1035,7 @@ cIsNotStrict	:== False
 	,	dp_type_patterns_vars	:: ![VarInfoPtr]			/* filled after type checking */
 	,	dp_type_code			:: !TypeCodeExpression		/* filled after type checking */
 	,	dp_rhs					:: !Expression
+	,	dp_position				:: !Position
 	}
 	
 	
@@ -1293,7 +1297,8 @@ where
 
 instance <<< AlgebraicPattern
 where
-	(<<<) file g = file <<< g.ap_symbol <<< g.ap_vars <<< " -> " <<< g.ap_expr
+//	(<<<) file g = file <<< g.ap_symbol <<< g.ap_vars <<< " -> " <<< g.ap_expr
+	(<<<) file g = file <<< g.ap_symbol <<< g.ap_vars <<< " " <<< g.ap_position <<< "-> " <<< g.ap_expr
 
 instance <<< BasicPattern
 where
diff --git a/frontend/type.icl b/frontend/type.icl
index 1af65ca..37dc4b6 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -36,11 +36,20 @@ import RWSDebug
 ::	Requirements =
 	{	req_overloaded_calls	:: ![ExprInfoPtr]
 	,	req_type_coercions		:: ![TypeCoercion]
+	,	req_type_coercion_groups:: ![TypeCoercionGroup] // MW4++
 	,	req_attr_coercions		:: ![AttrCoercion]
 	,	req_cons_variables		:: ![[TempVarId]]
 	,	req_case_and_let_exprs	:: ![ExprInfoPtr]
 	}
-	
+
+// MW4 added..
+// one TypeCoercionGroup collects coercions for one function alternative
+::	TypeCoercionGroup =
+	{	tcg_type_coercions	:: ![TypeCoercion]
+	,	tcg_position		:: !Position
+	}
+// ..MW4
+
 instance toString BoundVar
 where
 	toString varid = varid.var_name.id_name
@@ -863,6 +872,7 @@ where
 			= (reverse used_dyn_types, ({ reqs & req_type_coercions = [{tc_demanded = dyn_type, tc_offered = pattern_type, tc_position = CP_Expression match_expr, tc_coercible = True} :
 						reqs.req_type_coercions] }, { ts & ts_expr_heap = ts_expr_heap }))
 	
+/* MW4 was:
 		requirements_of_algebraic_patterns ti [] cons_types goal_type used_cons_types reqs_ts
 			= (used_cons_types, reqs_ts)
 		requirements_of_algebraic_patterns ti=:{ti_common_defs} [{ap_symbol, ap_vars, ap_expr }:gs] [ cons_arg_types : cons_types] goal_type used_cons_types (reqs, ts)
@@ -872,7 +882,29 @@ where
 			= requirements_of_algebraic_patterns ti gs cons_types goal_type [ cons_arg_types : used_cons_types ]
 				({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = CP_Expression ap_expr, tc_coercible = True } : reqs.req_type_coercions] },
 					  { ts & ts_expr_heap = ts_expr_heap })
+*/
+
+		requirements_of_algebraic_patterns ti [] cons_types goal_type used_cons_types reqs_ts
+			= (used_cons_types, reqs_ts)
+		requirements_of_algebraic_patterns ti [alg_pattern=:{ap_position}:alg_patterns] [ cons_arg_types : cons_types] 
+											goal_type used_cons_types reqs_ts
+			= requirements_of_algebraic_patterns ti alg_patterns cons_types goal_type [ cons_arg_types : used_cons_types ]
+					(possibly_accumulate_reqs_in_new_group 
+						ap_position
+						(requirements_of_algebraic_pattern ti alg_pattern cons_arg_types goal_type) 
+						reqs_ts
+					) 
+
+// MW4++..
+		requirements_of_algebraic_pattern ti {ap_symbol, ap_vars, ap_expr} cons_arg_types goal_type (reqs, ts)
+			# (res_type, opt_expr_ptr, (reqs, ts)) 
+					= requirements ti ap_expr (reqs, { ts & ts_var_heap = makeBase ap_symbol.glob_object.ds_ident 1 ap_vars cons_arg_types ts.ts_var_heap})
+			  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 ap_expr, tc_coercible = True } : reqs.req_type_coercions] },
+					  { ts & ts_expr_heap = ts_expr_heap })
+// ..MW4
 	
+/*
 		requirements_of_basic_patterns _ [] goal_type reqs_ts
 			= reqs_ts
 		requirements_of_basic_patterns ti=:{ti_common_defs} [{bp_expr }:gs] goal_type reqs_ts
@@ -881,7 +913,26 @@ where
 			= requirements_of_basic_patterns ti gs goal_type
 				({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = CP_Expression bp_expr, tc_coercible = True } : reqs.req_type_coercions] },
 						 { ts & ts_expr_heap = ts_expr_heap })
+*/	
+		requirements_of_basic_patterns _ [] goal_type reqs_ts
+			= reqs_ts
+		requirements_of_basic_patterns ti [{bp_expr, bp_position}:gs] goal_type reqs_ts
+			= requirements_of_basic_patterns ti gs goal_type
+				(possibly_accumulate_reqs_in_new_group
+					bp_position
+					(requirements_of_basic_pattern ti bp_expr goal_type)
+					reqs_ts
+				)
+
+// MW4++..
+		requirements_of_basic_pattern ti bp_expr goal_type reqs_ts
+		  	# (res_type, opt_expr_ptr, (reqs, ts)) = requirements ti bp_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 bp_expr, tc_coercible = True } : reqs.req_type_coercions] },
+						 { ts & ts_expr_heap = ts_expr_heap })
+// ..MW4
 	
+/* MW4 was
 		requirements_of_dynamic_patterns ti goal_type [{dp_var={fv_info_ptr},dp_type,dp_rhs} : dps] used_dyn_types (reqs, ts=:{ts_expr_heap, ts_var_heap})
 			# (EI_TempDynamicPattern _ _ _ _ dyn_type dyn_context dyn_expr_ptr type_code_symbol, ts_expr_heap) = readPtr dp_type ts_expr_heap
 			  ts_var_heap = ts_var_heap <:= (fv_info_ptr, VI_Type dyn_type No)
@@ -896,6 +947,34 @@ where
 						(dyn_expr_ptr,  EI_Overloaded {  oc_symbol = type_code_symbol, oc_context = dyn_context, oc_specials = [] }) })
 		requirements_of_dynamic_patterns ti goal_type [] used_dyn_types reqs_ts
 			= (used_dyn_types, reqs_ts)
+*/
+	
+		requirements_of_dynamic_patterns ti goal_type [] used_dyn_types reqs_ts
+			= (used_dyn_types, reqs_ts)
+		requirements_of_dynamic_patterns ti goal_type [dp=:{dp_position, dp_type} : dps] used_dyn_types (reqs, ts=:{ts_expr_heap})
+			# (EI_TempDynamicPattern _ _ _ _ dyn_type dyn_context dyn_expr_ptr type_code_symbol, ts_expr_heap)
+					= readPtr dp_type ts_expr_heap
+			  (reqs_ts) 
+			  		= possibly_accumulate_reqs_in_new_group
+			  				dp_position
+							(requirements_of_dynamic_pattern dyn_type dyn_context dyn_expr_ptr type_code_symbol ti goal_type dp)
+							(reqs, { ts & ts_expr_heap = ts_expr_heap})
+			= requirements_of_dynamic_patterns ti goal_type dps [ [dyn_type] : used_dyn_types ] reqs_ts
+	
+// MW4++..
+		requirements_of_dynamic_pattern dyn_type dyn_context dyn_expr_ptr type_code_symbol 
+										ti goal_type {dp_var={fv_info_ptr},dp_rhs} (reqs, ts=:{ts_expr_heap, ts_var_heap})
+			# ts_var_heap = ts_var_heap <:= (fv_info_ptr, VI_Type dyn_type No)
+			  (dp_rhs_type, opt_expr_ptr, (reqs, ts)) = requirements ti dp_rhs (reqs, { ts & ts_expr_heap = ts_expr_heap, ts_var_heap = ts_var_heap })
+			  ts_expr_heap = storeAttribute opt_expr_ptr dp_rhs_type.at_attribute ts.ts_expr_heap
+			  type_coercion = { tc_demanded = goal_type, tc_offered = dp_rhs_type, tc_position = CP_Expression dp_rhs, tc_coercible = True }
+			| isEmpty dyn_context
+				# reqs = {reqs & req_type_coercions = [ type_coercion : reqs.req_type_coercions]}
+				= (reqs, { ts &  ts_expr_heap = ts_expr_heap })
+				# reqs = { reqs & req_type_coercions = [ type_coercion : reqs.req_type_coercions], req_overloaded_calls = [dyn_expr_ptr : reqs.req_overloaded_calls ]}
+				= (reqs, { ts & ts_expr_heap = ts_expr_heap <:=
+						(dyn_expr_ptr,  EI_Overloaded {  oc_symbol = type_code_symbol, oc_context = dyn_context, oc_specials = [] }) })
+// ..MW4
 	
 	
 		requirements_of_default ti (Yes expr) goal_type reqs_ts
@@ -1139,6 +1218,27 @@ where
 						tc_position = CP_Expression elem_expr, tc_coercible = True } : reqs.req_type_coercions ]}
 		= (reqs, ts)
 
+// MW4..
+possibly_accumulate_reqs_in_new_group position state_transition reqs_ts
+	:== possibly_accumulate_reqs position reqs_ts
+  where
+	possibly_accumulate_reqs position=:(FunPos _ _ _) (reqs=:{req_type_coercions=old_req_type_coercions}, ts)
+		# reqs_with_empty_accu
+				= { reqs & req_type_coercions = [] }
+		  (reqs_with_new_group_in_accu, ts)
+		  		= state_transition (reqs_with_empty_accu, ts)
+		  new_group 
+		  		= { tcg_type_coercions = reqs_with_new_group_in_accu.req_type_coercions,
+		  			tcg_position = position }
+		  reqs_with_new_group
+		  		= { reqs_with_new_group_in_accu & 
+		  				req_type_coercion_groups = [new_group:reqs_with_new_group_in_accu.req_type_coercion_groups],
+			  			req_type_coercions = old_req_type_coercions }
+		= (reqs_with_new_group, ts)
+	possibly_accumulate_reqs _ reqs_ts
+		= state_transition reqs_ts
+
+// ..MW4
 makeBase _ _ [] [] ts_var_heap
 	= ts_var_heap
 makeBase fun_or_cons_ident arg_nr [{fv_name, fv_info_ptr}:vars] [type:types] ts_var_heap
@@ -1524,8 +1624,7 @@ where
 		# (start_index, predef_symbols) = get_index_of_start_rule predef_symbols
 		# (fun_defs, predef_symbols, cons_variables, ts) = CreateInitialSymbolTypes start_index ti_common_defs comp (fun_defs, predef_symbols, [], ts)
 		  (fun_reqs, (cons_variables, fun_defs, ts)) = type_functions comp ti cons_variables fun_defs ts
-		#! nr_of_type_variables = ts.ts_var_store
-										
+		#! nr_of_type_variables = ts.ts_var_store 
 		# (subst, ts_type_heaps, ts_error)
 		  		= unify_requirements_of_functions fun_reqs ti (createArray nr_of_type_variables TE) ts.ts_type_heaps ts.ts_error
 		| not ts_error.ea_ok //---> (("begin\n" ---> subst.[2]) ---> "\nend")
@@ -1582,6 +1681,7 @@ where
 				{ ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_expr_heap = ts_expr_heap, ts_error = { ts_error & ea_ok = True },
 					  ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars =  tci_type_var_heap }, ts_fun_env = ts_fun_env})
 
+/* MW4 was
 	unify_requirements_of_functions :: ![FunctionRequirements] !TypeInput !*{!Type} !*TypeHeaps !*ErrorAdmin -> (!*{!Type},!*TypeHeaps,!*ErrorAdmin)
 	unify_requirements_of_functions [{fe_requirements={req_type_coercions},fe_location} : reqs_list] modules subst heaps ts_error
 		# ts_error = setErrorAdmin fe_location ts_error
@@ -1589,6 +1689,21 @@ where
 		= unify_requirements_of_functions reqs_list modules subst heaps ts_error
 	unify_requirements_of_functions [] modules subst heaps ts_error
 		= (subst, heaps, ts_error)
+*/
+	unify_requirements_of_functions :: ![FunctionRequirements] !TypeInput !*{!Type} !*TypeHeaps !*ErrorAdmin -> (!*{!Type},!*TypeHeaps,!*ErrorAdmin)
+	unify_requirements_of_functions [{fe_requirements={req_type_coercion_groups},fe_location={ip_ident}} : reqs_list] ti subst heaps ts_error
+		# (subst, heaps, ts_error) = foldSt (unify_requirements_of_alternative ip_ident ti) req_type_coercion_groups (subst, heaps, ts_error)
+		= unify_requirements_of_functions reqs_list ti subst heaps ts_error
+	unify_requirements_of_functions [] ti subst heaps ts_error
+		= (subst, heaps, ts_error)
+
+// MW4 added..
+  	unify_requirements_of_alternative :: !Ident !TypeInput !TypeCoercionGroup !(*{!Type}, !*TypeHeaps, !*ErrorAdmin)
+ 						-> (*{!Type}, !*TypeHeaps, !*ErrorAdmin)
+	unify_requirements_of_alternative fun_symb ti {tcg_type_coercions, tcg_position} (subst, heaps, ts_error)
+		# ts_error = setErrorAdmin (newPosition fun_symb tcg_position) ts_error
+		= unify_coercions tcg_type_coercions ti subst heaps ts_error
+// ..MW4
 
 	build_initial_coercion_env [{fe_requirements={req_attr_coercions},fe_location} : reqs_list] coercion_env
 		= build_initial_coercion_env reqs_list (add_to_initial_coercion_env req_attr_coercions coercion_env)
@@ -1618,6 +1733,7 @@ where
 			  (prev_vect, bitvects) = bitvects![bit_index]
 			= { bitvects & [bit_index] = prev_vect bitor (1 << BITNUMBER var_number) }
 
+/* MW4 was
 	build_coercion_env [{fe_requirements={req_type_coercions},fe_location} : reqs_list] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
 		# error = setErrorAdmin fe_location error
 		  (subst, coercion_env, type_signs, type_var_heap, error)
@@ -1625,6 +1741,22 @@ where
 		= build_coercion_env reqs_list subst coercion_env common_defs cons_var_vects  type_signs type_var_heap error
 	build_coercion_env []  subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
 		= (subst, coercion_env, type_signs, type_var_heap, error)
+*/
+	build_coercion_env [{fe_requirements={req_type_coercion_groups},fe_location={ip_ident}} : reqs_list] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
+		# (subst, coercion_env, type_signs, type_var_heap, error)
+			= foldSt (build_coercion_env_for_alternative ip_ident common_defs cons_var_vects)
+					req_type_coercion_groups
+					(subst, coercion_env, type_signs, type_var_heap, error)
+		= build_coercion_env reqs_list subst coercion_env common_defs cons_var_vects  type_signs type_var_heap error
+	build_coercion_env []  subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
+		= (subst, coercion_env, type_signs, type_var_heap, error)
+
+// MW4 added..
+	build_coercion_env_for_alternative fun_symb common_defs cons_var_vects {tcg_position, tcg_type_coercions}
+										(subst, coercion_env, type_signs, type_var_heap, error)
+		# error = setErrorAdmin (newPosition fun_symb tcg_position) error
+		= add_to_coercion_env tcg_type_coercions subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
+// MW4
 
 	add_to_coercion_env [{tc_offered,tc_demanded,tc_coercible,tc_position} : attr_coercions] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
 		# (subst, coercion_env, type_signs, type_var_heap, error)
@@ -1714,15 +1846,21 @@ where
 		  ts_var_heap = makeBase fun_symb 1 tb_args temp_fun_type.tst_args ts_var_heap
 		  fe_location = newPosition fun_symb fun_pos
 		  ts_error = setErrorAdmin fe_location ts_error
-		  reqs = { req_overloaded_calls = [], req_type_coercions = [], req_attr_coercions = [], req_case_and_let_exprs = [], req_cons_variables = cons_variables }
+// MW4 was:		  reqs = { req_overloaded_calls = [], req_type_coercions = [], req_attr_coercions = [], req_case_and_let_exprs = [], req_cons_variables = cons_variables }
+		  reqs = { req_overloaded_calls = [], req_type_coercion_groups = [], req_type_coercions = [],
+		  			 req_attr_coercions = [], req_case_and_let_exprs = [], req_cons_variables = cons_variables }
 		  ( rhs_type, rhs_expr_ptr, (rhs_reqs, ts)) = requirements ti tb_rhs (reqs,
 		  		{ ts & ts_var_heap = ts_var_heap, ts_expr_heap = ts_expr_heap, ts_error = ts_error, ts_fun_env = ts_fun_env })
 		  req_type_coercions = [{tc_demanded = temp_fun_type.tst_result,tc_offered = rhs_type, tc_position = CP_Expression tb_rhs, tc_coercible = True} :
 		  		rhs_reqs.req_type_coercions ]
 		  ts_expr_heap = storeAttribute rhs_expr_ptr temp_fun_type.tst_result.at_attribute ts.ts_expr_heap
-		= ({fe_location = fe_location, fe_context = if (has_option fun_type) (Yes temp_fun_type.tst_context) No, fe_index = fun_index,
-			fe_requirements = { rhs_reqs & req_type_coercions = req_type_coercions, req_cons_variables = [] }}, (rhs_reqs.req_cons_variables, fun_defs,
-				{ ts & ts_expr_heap = ts_expr_heap }))
+		  type_coercion_group_from_accu = { tcg_type_coercions = req_type_coercions, tcg_position = fun_pos }
+		  req_type_coercion_groups = [type_coercion_group_from_accu:rhs_reqs.req_type_coercion_groups]
+		= ( { fe_location = fe_location, fe_context = if (has_option fun_type) (Yes temp_fun_type.tst_context) No, fe_index = fun_index,
+// MW4 was:			fe_requirements = { rhs_reqs & req_type_coercions = req_type_coercions, req_cons_variables = [] }}, (rhs_reqs.req_cons_variables, fun_defs,
+			  fe_requirements = { rhs_reqs & req_type_coercions = [], req_type_coercion_groups = req_type_coercion_groups, req_cons_variables = [] }
+		    },
+		    (rhs_reqs.req_cons_variables, fun_defs, { ts & ts_expr_heap = ts_expr_heap }))
 //					 ---> ("type_function", fun_symb, tb_args, tb_rhs, fun_info.fi_local_vars)
 	where
 		has_option (Yes _)	= True