make line number in the

"demanded attribute cannot be offered by shared object" error
message more accurate,
store position in CaseAlt (added field calt_position)


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

7 files changed, 240 insertions, 83 deletions

diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl
index 3c8a856..8da8574 100644
--- a/frontend/checkFunctionBodies.icl
+++ b/frontend/checkFunctionBodies.icl
@@ -636,7 +636,7 @@ where
 		  	= check_guarded_expressions free_vars gs pattern_variables case_name e_input e_state e_info cs
 		= check_guarded_expression free_vars g gs pattern_scheme pattern_variables defaul case_name e_input e_state e_info cs 
 
-	check_guarded_expression free_vars {calt_pattern,calt_rhs={rhs_alts,rhs_locals}} patterns pattern_scheme pattern_variables defaul case_name 
+	check_guarded_expression free_vars {calt_pattern,calt_rhs={rhs_alts,rhs_locals},calt_position} patterns pattern_scheme pattern_variables defaul case_name 
 				e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_fun_defs,es_var_heap,es_dynamics=outer_dynamics} e_info cs
 		# (pattern, (var_env, array_patterns), {ps_fun_defs,ps_var_heap}, e_info, cs)
 				= checkPattern calt_pattern No { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False } ([], [])
@@ -648,20 +648,20 @@ where
 				= addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs
 		  cs_symbol_table = removeLocalIdentsFromSymbolTable ei_expr_level var_env cs.cs_symbol_table
 		  (guarded_expr, pattern_scheme, pattern_variables, defaul, es_var_heap, es_expr_heap, dynamics_in_patterns, cs)
-		  		= transform_pattern pattern patterns pattern_scheme pattern_variables defaul expr_with_array_selections case_name
+		  		= transform_pattern pattern patterns pattern_scheme pattern_variables defaul expr_with_array_selections case_name calt_position
 		  									es_var_heap es_expr_heap dynamics_in_rhs { cs & cs_symbol_table = cs_symbol_table }
 		= (guarded_expr, pattern_scheme, pattern_variables, defaul, free_vars,
 			{ e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap, es_dynamics = dynamics_in_patterns ++ outer_dynamics },
 				e_info, cs)
 
 	transform_pattern :: !AuxiliaryPattern !CasePatterns !CasePatterns !(Env Ident VarInfoPtr) !(Optional (!Optional FreeVar, !Expression)) !Expression
-			!String !*VarHeap !*ExpressionHeap !Dynamics !*CheckState
+			!String !Position !*VarHeap !*ExpressionHeap !Dynamics !*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 NoPos var_store expr_heap opt_dynamics cs
+	transform_pattern (AP_Algebraic cons_symbol type_index args opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ pos var_store expr_heap opt_dynamics cs
+		# (var_args, result_expr, _, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns args result_expr pos var_store expr_heap opt_dynamics cs
 		  type_symbol = { glob_module = cons_symbol.glob_module, glob_object = type_index}
 		  pattern_variables = cons_optional opt_var pattern_variables
-		# pattern = { ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr, ap_position = NoPos}
+		# pattern = { ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr, ap_position = pos}
 		| cons_symbol.glob_module==cPredefinedModuleIndex
 			# pd_cons_index=cons_symbol.glob_object.ds_index+FirstConstructorPredefinedSymbolIndex
 			| pd_cons_index==PD_UnboxedConsSymbol || pd_cons_index==PD_UnboxedNilSymbol
@@ -811,8 +811,8 @@ where
 						= ({pattern & ap_symbol.glob_object=glob_object},cs)
 						= abort "replace_overloaded_symbol_in_pattern"
 
-	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, bp_position = NoPos}
+	transform_pattern (AP_Basic basic_val opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ pos var_store expr_heap opt_dynamics cs
+		# pattern = { bp_value = basic_val, bp_expr = result_expr, bp_position = pos}
 		  pattern_variables = cons_optional opt_var pattern_variables
 		  (type_symbol, cs) = typeOfBasicValue basic_val cs
 		= case pattern_scheme of
@@ -831,11 +831,11 @@ 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 NoPos var_store expr_heap opt_dynamics cs
+	transform_pattern (AP_Dynamic pattern type opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ pos var_store expr_heap opt_dynamics cs
+		# (var_arg, result_expr, _, var_store, expr_heap, opt_dynamics, cs) = convertSubPattern pattern result_expr pos 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_code = TCE_Empty, dp_position = NoPos }
+		  				dp_type_code = TCE_Empty, dp_position = pos }
 		  pattern_variables = cons_optional opt_var pattern_variables
 		= case pattern_scheme of
 			DynamicPatterns _
@@ -850,11 +850,11 @@ where
 			_
 				-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,
 						{ cs & cs_error = checkError "<dynamic pattern>" "illegal combination of patterns" cs.cs_error })
-	transform_pattern (AP_Variable name var_info opt_var) NoPattern pattern_scheme pattern_variables No result_expr _ var_store expr_heap opt_dynamics cs
+	transform_pattern (AP_Variable name var_info opt_var) NoPattern pattern_scheme pattern_variables No result_expr _ pos var_store expr_heap opt_dynamics cs
 		= ( NoPattern, pattern_scheme, cons_optional opt_var pattern_variables, 
 		  	Yes (Yes { fv_ident = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, result_expr),
 			var_store, expr_heap, opt_dynamics, cs)		
-	transform_pattern (AP_Variable name var_info opt_var) patterns pattern_scheme pattern_variables defaul result_expr case_name var_store expr_heap opt_dynamics cs
+	transform_pattern (AP_Variable name var_info opt_var) patterns pattern_scheme pattern_variables defaul result_expr case_name pos var_store expr_heap opt_dynamics cs
 		# free_var = { fv_ident = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }
 		  (new_bound_var, expr_heap) = allocate_bound_var free_var expr_heap
 		  case_ident = { id_name = case_name, id_info = nilPtr }
@@ -863,16 +863,16 @@ where
 		  new_defaul = insert_as_default new_case result_expr
 		= (NoPattern, pattern_scheme, (cons_optional opt_var pattern_variables), Yes (Yes free_var, new_defaul),
 			var_store, expr_heap, opt_dynamics, cs)
-	transform_pattern (AP_WildCard (Yes opt_var)) patterns pattern_scheme pattern_variables defaul result_expr case_name var_store expr_heap opt_dynamics cs
+	transform_pattern (AP_WildCard (Yes opt_var)) patterns pattern_scheme pattern_variables defaul result_expr case_name pos var_store expr_heap opt_dynamics cs
 		= transform_pattern (AP_Variable opt_var.bind_src opt_var.bind_dst No) patterns pattern_scheme pattern_variables defaul
-							result_expr case_name var_store expr_heap opt_dynamics cs
-	transform_pattern (AP_WildCard no) NoPattern pattern_scheme pattern_variables No result_expr _ var_store expr_heap opt_dynamics cs
+							result_expr case_name pos var_store expr_heap opt_dynamics cs
+	transform_pattern (AP_WildCard no) NoPattern pattern_scheme pattern_variables No result_expr _ pos var_store expr_heap opt_dynamics cs
 		= (NoPattern, pattern_scheme, pattern_variables, Yes (No, result_expr), var_store, expr_heap, opt_dynamics, cs)
-	transform_pattern (AP_WildCard _) patterns pattern_scheme pattern_variables defaul result_expr case_name var_store expr_heap opt_dynamics cs
+	transform_pattern (AP_WildCard _) patterns pattern_scheme pattern_variables defaul result_expr case_name pos var_store expr_heap opt_dynamics cs
 		# (new_info_ptr, var_store) = newPtr VI_Empty var_store
 		= transform_pattern (AP_Variable (newVarId "wc") new_info_ptr No) patterns pattern_scheme pattern_variables defaul
-							result_expr case_name var_store expr_heap opt_dynamics cs
-	transform_pattern (AP_Empty name) patterns pattern_scheme pattern_variables defaul result_expr _ var_store expr_heap opt_dynamics cs
+							result_expr case_name pos var_store expr_heap opt_dynamics cs
+	transform_pattern (AP_Empty name) patterns pattern_scheme pattern_variables defaul result_expr _ pos var_store expr_heap opt_dynamics cs
 		= (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 
 
diff --git a/frontend/parse.icl b/frontend/parse.icl
index 14a80ab..29d3bec 100644
--- a/frontend/parse.icl
+++ b/frontend/parse.icl
@@ -3210,10 +3210,12 @@ wantCaseExp pState
 where
 	tryCaseAlt :: (!RhsDefiningSymbol, !ParseState) -> (!Bool, CaseAlt, (!RhsDefiningSymbol, !ParseState))
 	tryCaseAlt (definingSymbol, pState)
-		# (succ, pattern, pState) = try_pattern pState
+		# (token, pState) = nextToken FunctionContext pState
+		# (fname,linenr,pState) = getFileAndLineNr pState
+		# (succ, pattern, pState) = try_pattern token pState
 		| succ
 			# (rhs, definingSymbol, pState) = wantRhs True definingSymbol pState
-			= (True, { calt_pattern = pattern, calt_rhs = rhs }, (definingSymbol, pState))
+			= (True, { calt_pattern = pattern, calt_rhs = rhs, calt_position=LinePos fname linenr }, (definingSymbol, pState))
 		// otherwise // ~ succ
 			= (False, abort "no case alt", (definingSymbol, pState))
 	
@@ -3221,16 +3223,17 @@ where
 	tryLastCaseAlt definingSymbol pState
 		# (token, pState)	= nextToken FunctionContext pState
 		| isDefiningSymbol definingSymbol token
-			#	pState			= tokenBack pState
-				(rhs, _, pState)
-								= wantRhs True definingSymbol pState
-			= (True, { calt_pattern = PE_WildCard, calt_rhs = rhs }, pState)
+			# (fname,linenr,pState) = getFileAndLineNr pState
+			  pState			= tokenBack pState
+			  (rhs, _, pState) = wantRhs True definingSymbol pState
+			= (True, { calt_pattern = PE_WildCard, calt_rhs = rhs, calt_position=LinePos fname linenr }, pState)
 		| token == OtherwiseToken
 			# (token, pState)	= nextToken FunctionContext pState
+			  (fname,linenr,pState) = getFileAndLineNr pState
 			  pState			= tokenBack pState
 			| isDefiningSymbol definingSymbol token
 				# (rhs, _, pState) = wantRhs True definingSymbol pState
-				= (True, { calt_pattern = PE_WildCard, calt_rhs = rhs }, pState)
+				= (True, { calt_pattern = PE_WildCard, calt_rhs = rhs, calt_position=LinePos fname linenr }, pState)
 				= (False, abort "no case alt", pState)
 			= (False, abort "no case alt", tokenBack pState)
 
@@ -3238,9 +3241,9 @@ where
 
 	// FIXME: it would be better if this would use (tryExpression cIsNotPattern)
 	// but there's no function tryExpression available yet
-	try_pattern :: !ParseState -> (!Bool, ParsedExpr, !ParseState)
-	try_pattern pState
-		# (succ, expr, pState) = trySimpleLhsExpression pState
+	try_pattern :: !Token !ParseState -> (!Bool, ParsedExpr, !ParseState)
+	try_pattern token pState
+		# (succ, expr, pState) = trySimpleLhsExpressionT token pState
 		| succ
 			# (succ, expr2, pState) = trySimpleLhsExpression pState
 			| succ
diff --git a/frontend/postparse.icl b/frontend/postparse.icl
index 228cba4..4cd3239 100644
--- a/frontend/postparse.icl
+++ b/frontend/postparse.icl
@@ -146,8 +146,8 @@ where
 		# true_pattern		= PE_Basic (BVB True)
 		  false_pattern		= PE_WildCard // PE_Basic (BVB False)
 		= collectFunctions (PE_Case if_ident c
-							[ {calt_pattern = true_pattern , calt_rhs = exprToRhs t}
-							, {calt_pattern = false_pattern, calt_rhs = exprToRhs e}
+							[ {calt_pattern = true_pattern , calt_rhs = exprToRhs t, calt_position=NoPos}
+							, {calt_pattern = false_pattern, calt_rhs = exprToRhs e, calt_position=NoPos}
 							]) icl_module ca
 	collectFunctions (PE_Let strict locals in_expr) icl_module ca
 		# ((node_defs,in_expr), ca) = collectFunctions (locals,in_expr) icl_module ca
@@ -686,8 +686,8 @@ where
 					# smaller_fun = get_predef_id PD_SmallerFun
 					# (case_ident,ca) = prefixAndPositionToIdent ("g_s"+++toString n) gen_position ca
 					= (PE_Case case_ident (PE_List [ident1,PE_Ident smaller_fun,ident2])
-						[{calt_pattern = PE_Basic (BVB True), calt_rhs = exprToRhs ident1},
-						 {calt_pattern = PE_WildCard, calt_rhs = exprToRhs ident2}],ca)
+						[{calt_pattern = PE_Basic (BVB True), calt_rhs = exprToRhs ident1, calt_position=NoPos},
+						 {calt_pattern = PE_WildCard, calt_rhs = exprToRhs ident2, calt_position=NoPos}],ca)
 		= (node_defs,to_exp,ident1,ca)
 
 store_minimum_of_sizes_in_generator :: [ParsedDefinition] ParsedExpr Int TransformedGenerator -> TransformedGenerator;
@@ -948,8 +948,8 @@ makeComprehensions [{tq_generators,tq_let_defs,tq_filter, tq_end, tq_call, tq_lh
 			= rhs
 		case_with_default case_ident expr expr_is_uselect pattern rhs default_rhs
 			=	exprToRhs (PE_Case case_ident expr
-					[	{calt_pattern = pattern, calt_rhs = rhs}
-					,	{calt_pattern = PE_WildCard, calt_rhs = exprToRhs default_rhs}
+					[	{calt_pattern = pattern, calt_rhs = rhs, calt_position=NoPos}
+					,	{calt_pattern = PE_WildCard, calt_rhs = exprToRhs default_rhs, calt_position=NoPos}
 					])
 
 	/* +++ remove code duplication (bug in 2.0 with nested cases)
diff --git a/frontend/refmark.icl b/frontend/refmark.icl
index 698e143..4bfefb5 100644
--- a/frontend/refmark.icl
+++ b/frontend/refmark.icl
@@ -669,7 +669,7 @@ emptyOccurrence type_info =
 /*
 emptyObservingOccurrence	=: VI_Occurrence (emptyOccurrence True)
 emptyNonObservingOccurrence =: VI_Occurrence (emptyOccurrence False)
-*/																	
+*/
 makeSharedReferencesNonUnique :: ![Int] !u:{# FunDef} !*Coercions !w:{! Type} !v:TypeDefInfos !*VarHeap !*ExpressionHeap !*ErrorAdmin
 	-> (!u:{# FunDef}, !*Coercions, !w:{! Type},  !v:TypeDefInfos, !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
 makeSharedReferencesNonUnique [] fun_defs coercion_env subst type_def_infos var_heap expr_heap  error
@@ -680,13 +680,13 @@ makeSharedReferencesNonUnique [fun : funs] fun_defs coercion_env subst type_def_
 		= make_shared_references_of_function_non_unique fun_def coercion_env subst type_def_infos var_heap expr_heap error
 	= makeSharedReferencesNonUnique funs fun_defs coercion_env subst type_def_infos var_heap expr_heap error
 where
-	make_shared_references_of_function_non_unique {fun_ident, fun_pos, fun_body = TransformedBody {tb_args,tb_rhs},fun_info={fi_local_vars}}
+	make_shared_references_of_function_non_unique {fun_ident, fun_pos, fun_body = fun_body =: TransformedBody {tb_args,tb_rhs},fun_info={fi_local_vars}}
 			coercion_env subst type_def_infos var_heap expr_heap error
 	# variables = tb_args ++ fi_local_vars
 	  (subst, type_def_infos, var_heap, expr_heap) = clear_occurrences variables subst type_def_infos var_heap expr_heap
 	  (_, {rms_var_heap}) = fullRefMark [tb_args] NotASelector No /* tb_rhs var_heap */ (tb_rhs ===> ("makeSharedReferencesNonUnique", fun_ident, tb_rhs)) var_heap
 	  position = newPosition fun_ident fun_pos
-	  (coercion_env, var_heap, expr_heap, error) = make_shared_vars_non_unique variables coercion_env rms_var_heap expr_heap
+	  (coercion_env, var_heap, expr_heap, error) = make_shared_vars_non_unique variables fun_body coercion_env rms_var_heap expr_heap
 	  		(setErrorAdmin position error)
 	  var_heap = empty_occurrences variables var_heap
 	= (coercion_env, subst, type_def_infos, var_heap, expr_heap, error)
@@ -724,46 +724,40 @@ where
 		get_type _						= abort "has_observing_base_type (refmark.icl)"
 		
 
-		make_shared_vars_non_unique vars coercion_env var_heap expr_heap error
+		make_shared_vars_non_unique vars fun_body coercion_env var_heap expr_heap error
 			= foldl make_shared_var_non_unique (coercion_env, var_heap, expr_heap, error) vars
-
-		make_shared_var_non_unique (coercion_env, var_heap, expr_heap, error)  fv=:{fv_ident,fv_info_ptr}
-			# (VI_Occurrence occ, var_heap) = readPtr fv_info_ptr var_heap
-			= case occ.occ_ref_count of
-				RC_Used {rcu_multiply,rcu_selectively}
-					# (coercion_env, expr_heap, error) = make_shared_occurrences_non_unique fv rcu_multiply (coercion_env, expr_heap, error)
-					  (coercion_env, expr_heap, error) = foldSt (make_selection_non_unique fv) rcu_selectively (coercion_env, expr_heap, error)  
-					-> (coercion_env, var_heap, expr_heap, error)
-				_
-					-> (coercion_env, var_heap, expr_heap, error)
-//						===> ("make_shared_var_non_unique", fv_ident)
-
-		make_shared_occurrences_non_unique fv multiply (coercion_env, expr_heap, error)
-			= foldSt (make_shared_occurrence_non_unique fv) multiply (coercion_env, expr_heap, error) 
-		
-		make_shared_occurrence_non_unique free_var var_expr_ptr (coercion_env, expr_heap, error) 
-			| isNilPtr var_expr_ptr
-				= (coercion_env, expr_heap, error)
-				# (expr_info, expr_heap) = readPtr var_expr_ptr expr_heap
-				= case expr_info of
-					EI_Attribute sa_attr_nr
-						# (succ, coercion_env) = tryToMakeNonUnique sa_attr_nr coercion_env
-						| succ
-								 ===> ("make_shared_occurrence_non_unique", free_var, var_expr_ptr, sa_attr_nr)
-							-> (coercion_env, expr_heap, error)
-							-> (coercion_env, expr_heap, uniquenessError (CP_Expression (FreeVar free_var)) " demanded attribute cannot be offered by shared object" error)
+		where
+			make_shared_var_non_unique (coercion_env, var_heap, expr_heap, error)  fv=:{fv_ident,fv_info_ptr}
+				# (VI_Occurrence occ, var_heap) = readPtr fv_info_ptr var_heap
+				= case occ.occ_ref_count of
+					RC_Used {rcu_multiply,rcu_selectively}
+						# (coercion_env, expr_heap, error) = make_shared_occurrences_non_unique fv rcu_multiply (coercion_env, expr_heap, error)
+						  (coercion_env, expr_heap, error) = foldSt (make_selection_non_unique fv) rcu_selectively (coercion_env, expr_heap, error)  
+						-> (coercion_env, var_heap, expr_heap, error)
 					_
-						-> abort ("make_shared_occurrence_non_unique" ===> ((free_var, var_expr_ptr) )) // <<- expr_info))
-
-		make_selection_non_unique fv {su_multiply} cee
-			= make_shared_occurrences_non_unique fv su_multiply cee
+						-> (coercion_env, var_heap, expr_heap, error)
+	//						===> ("make_shared_var_non_unique", fv_ident)
+	
+			make_shared_occurrences_non_unique fv multiply (coercion_env, expr_heap, error)
+				= foldSt (make_shared_occurrence_non_unique fv) multiply (coercion_env, expr_heap, error) 
+			
+			make_shared_occurrence_non_unique free_var var_expr_ptr (coercion_env, expr_heap, error) 
+				| isNilPtr var_expr_ptr
+					= (coercion_env, expr_heap, error)
+					# (expr_info, expr_heap) = readPtr var_expr_ptr expr_heap
+					= case expr_info of
+						EI_Attribute sa_attr_nr
+							# (succ, coercion_env) = tryToMakeNonUnique sa_attr_nr coercion_env
+							| succ
+									 ===> ("make_shared_occurrence_non_unique", free_var, var_expr_ptr, sa_attr_nr)
+								-> (coercion_env, expr_heap, error)
+								-> (coercion_env, expr_heap, uniquenessErrorVar free_var fun_body " demanded attribute cannot be offered by shared object" error)
+						_
+							-> abort ("make_shared_occurrence_non_unique" ===> ((free_var, var_expr_ptr) )) // <<- expr_info))
+	
+			make_selection_non_unique fv {su_multiply} cee
+				= make_shared_occurrences_non_unique fv su_multiply cee
 
-/*
-	has_observing_type type_def_infos TE
-		= True
-	has_observing_type type_def_infos (TB basic_type)
-		= True
-*/
 	has_observing_type (TB basic_type) type_def_infos subst
 		= True
 	has_observing_type (TempV var_number) type_def_infos subst
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index cb88692..4986059 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -1081,6 +1081,7 @@ instance toString 	KindInfo
 ::	CaseAlt =
 	{	calt_pattern	:: !ParsedExpr
 	,	calt_rhs		:: !Rhs
+	,	calt_position	:: !Position
 	}
 	
 :: LocalDef		:== ParsedDefinition
diff --git a/frontend/unitype.dcl b/frontend/unitype.dcl
index 4b2dee4..12512e2 100644
--- a/frontend/unitype.dcl
+++ b/frontend/unitype.dcl
@@ -53,7 +53,7 @@ tryToMakeNonUnique :: !Int !*Coercions -> (!Bool, !*Coercions)
 
 tryToMakeUnique :: !Int !*Coercions -> (!Bool, !*Coercions)
 
-uniquenessError :: !CoercionPosition !String !*ErrorAdmin -> *ErrorAdmin
+uniquenessErrorVar :: !FreeVar !FunctionBody !String !*ErrorAdmin -> *ErrorAdmin
 
 liftSubstitution :: !*{! Type} !{# CommonDefs }!{# BOOLVECT } !Int !*TypeHeaps !*TypeDefInfos -> (*{! Type}, !Int, !*TypeHeaps, !*TypeDefInfos)
 
diff --git a/frontend/unitype.icl b/frontend/unitype.icl
index 6f377d9..d05677c 100644
--- a/frontend/unitype.icl
+++ b/frontend/unitype.icl
@@ -26,13 +26,6 @@ FirstAttrVar	:== 3
 	,	pi_deps ::			![Int]
 	}
 
-
-uniquenessError :: !CoercionPosition !String !*ErrorAdmin -> *ErrorAdmin
-uniquenessError position mess err=:{ea_file,ea_loc}
-	# ea_file = ea_file <<< "Uniqueness error " <<< hd ea_loc <<< ": \"" <<<  position <<< '\"' <<< mess <<< '\n'
-	= { err & ea_file = ea_file, ea_ok = False}
-
-
 ::	BOOLVECT :== Int
 
 BITINDEX temp_var_id :== temp_var_id >> 5
@@ -1014,3 +1007,169 @@ where
 		= (CT_NonUnique, tree)
 	copy_coercion_tree tree=:CT_Existential
 		= (CT_Existential, tree)
+
+uniquenessErrorVar :: !FreeVar !FunctionBody !String !*ErrorAdmin -> *ErrorAdmin
+uniquenessErrorVar free_var=:{fv_info_ptr} (TransformedBody {tb_args,tb_rhs}) mess err
+	| var_in_free_vars fv_info_ptr tb_args
+		= uniquenessError (CP_Expression (FreeVar free_var)) mess err
+	# position = find_var_position_in_expression fv_info_ptr tb_rhs
+	= case position of
+		LinePos file_name line_n
+			# ea_file = err.ea_file <<< "Uniqueness error " <<< {ip_file=file_name,ip_line=line_n,ip_ident=free_var.fv_ident} <<< '\"' <<< mess <<< '\n'
+			-> { err & ea_file = ea_file, ea_ok = False}
+		FunPos file_name line_n fun_name
+			# ea_file = err.ea_file <<< "Uniqueness error " <<< {ip_file=file_name,ip_line=line_n,ip_ident=free_var.fv_ident} <<< '\"' <<< mess <<< '\n'
+			-> { err & ea_file = ea_file, ea_ok = False}			
+		_
+			-> uniquenessError (CP_Expression (FreeVar free_var)) mess err
+
+uniquenessError :: !CoercionPosition !String !*ErrorAdmin -> *ErrorAdmin
+uniquenessError position mess err=:{ea_file,ea_loc}
+	# ea_file = ea_file <<< "Uniqueness error " <<< hd ea_loc <<< ": \"" <<<  position <<< '\"' <<< mess <<< '\n'
+	= { err & ea_file = ea_file, ea_ok = False}
+
+var_in_free_vars var_ptr []
+	= False
+var_in_free_vars var_ptr [{fv_info_ptr}:vars]
+	= var_ptr==fv_info_ptr || var_in_free_vars var_ptr vars
+
+find_var_position_in_expression var_ptr expr
+	# (found,pos) = find_var_position_in_expression expr
+	| found
+		= pos
+		= NoPos
+where
+	find_var_position_in_expression (App {app_args})
+		= find_var_position_in_expressions app_args
+	find_var_position_in_expression (f @ a)
+		# (found,pos) = find_var_position_in_expression f
+		| found
+			= (True,pos)
+		= find_var_position_in_expressions a
+	find_var_position_in_expression (Selection _ expr selections)
+		# (found,pos) = find_var_position_in_selections selections
+		| found
+			= (True,pos)
+		= find_var_position_in_expression expr
+	find_var_position_in_expression (TupleSelect _ _ expr)
+		= find_var_position_in_expression expr
+	find_var_position_in_expression (MatchExpr _ expr)
+		= find_var_position_in_expression expr
+	find_var_position_in_expression (Update expr1 selections expr2)
+		# (found,pos) = find_var_position_in_expression expr1
+		| found
+			= (True,pos)
+		# (found,pos) = find_var_position_in_selections selections
+		| found
+			= (True,pos)
+		= find_var_position_in_expression expr2
+	find_var_position_in_expression (RecordUpdate _ expr updated_fields)
+		# (found,pos) = find_var_position_in_updated_fields updated_fields
+		| found
+			= (True,pos)
+		= find_var_position_in_expression expr
+	where
+		find_var_position_in_updated_fields [{bind_src}:updated_fields]
+			# (found,pos) = find_var_position_in_expression bind_src
+			| found
+				= (True,pos)
+			= find_var_position_in_updated_fields updated_fields
+		find_var_position_in_updated_fields []
+			= (False,NoPos)
+	find_var_position_in_expression (Let {let_strict_binds,let_lazy_binds,let_expr})
+		# (found,pos) = find_var_position_in_let_binds let_strict_binds
+		| found
+			= (True,pos)
+		# (found,pos) = find_var_position_in_let_binds let_lazy_binds
+		| found
+			= (True,pos)
+		= find_var_position_in_expression let_expr
+	where
+		find_var_position_in_let_binds [{lb_dst={fv_info_ptr},lb_position}:let_binds]
+			| var_ptr==fv_info_ptr
+				= (True,lb_position)
+				= find_var_position_in_let_binds let_binds
+		find_var_position_in_let_binds []
+			= (False,NoPos)
+	find_var_position_in_expression (Case {case_expr,case_guards,case_default})
+		# (found,pos) = find_var_position_in_expression	case_expr
+		| found
+			= (True,pos);
+		# (found,pos) = find_var_position_in_case_guards case_guards
+		| found
+			= (True,pos);
+		= find_var_position_in_case_default case_default
+	where
+		find_var_position_in_case_guards (AlgebraicPatterns _ algebraic_patterns)
+			= find_var_position_in_algebraic_patterns algebraic_patterns
+		find_var_position_in_case_guards (BasicPatterns _ basic_patterns)
+			= find_var_position_in_basic_patterns basic_patterns
+		where
+			find_var_position_in_basic_patterns [{bp_expr}:basic_patterns]
+				# (found,pos) = find_var_position_in_expression bp_expr
+				| found
+					= (True,pos)
+				= find_var_position_in_basic_patterns basic_patterns
+			find_var_position_in_basic_patterns []
+				= (False,NoPos)
+		find_var_position_in_case_guards (OverloadedListPatterns _ _ algebraic_patterns)
+			= find_var_position_in_algebraic_patterns algebraic_patterns
+		find_var_position_in_case_guards (DynamicPatterns dynamic_patterns)
+			= find_var_position_in_dynamic_patterns dynamic_patterns
+		where
+			find_var_position_in_dynamic_patterns [{dp_var,dp_rhs,dp_position}:dynamic_patterns]
+				| var_ptr==dp_var.fv_info_ptr
+					= (True,dp_position)
+				# (found,pos) = find_var_position_in_expression dp_rhs
+				| found
+					= (True,pos)
+				= find_var_position_in_dynamic_patterns dynamic_patterns
+			find_var_position_in_dynamic_patterns []
+				= (False,NoPos)
+		find_var_position_in_case_guards NoPattern
+			= (False,NoPos)
+
+		find_var_position_in_algebraic_patterns [{ap_vars,ap_expr,ap_position}:algebraic_patterns]
+			| var_in_free_vars var_ptr ap_vars
+				= (True,ap_position);
+			# (found,pos) = find_var_position_in_expression ap_expr
+			| found
+				= (True,pos)
+			= find_var_position_in_algebraic_patterns algebraic_patterns
+		find_var_position_in_algebraic_patterns []
+			= (False,NoPos)
+
+		find_var_position_in_case_default (Yes expr)
+			= find_var_position_in_expression expr
+		find_var_position_in_case_default No
+			= (False,NoPos)
+	find_var_position_in_expression (DynamicExpr {dyn_expr})
+		= find_var_position_in_expression dyn_expr
+	find_var_position_in_expression expr
+		= (False,NoPos)
+
+	find_var_position_in_expressions [expr:exprs]
+		# (found,pos) = find_var_position_in_expression expr
+		| found
+			= (True,pos)
+		= find_var_position_in_expressions exprs
+	find_var_position_in_expressions []
+		= (False,NoPos)
+
+	find_var_position_in_selections [RecordSelection _ _:selections]
+		= find_var_position_in_selections selections
+	find_var_position_in_selections [ArraySelection _ _ expr:selections]
+		# (found,pos) = find_var_position_in_expression expr
+		| found
+			= (True,pos)
+		= find_var_position_in_selections selections
+	find_var_position_in_selections [DictionarySelection _ d_selections _ expr:selections]
+		# (found,pos) = find_var_position_in_expression expr
+		| found
+			= (True,pos)
+		# (found,pos) = find_var_position_in_selections d_selections
+		| found
+			= (True,pos)
+		= find_var_position_in_selections selections
+	find_var_position_in_selections []
+		= (False,NoPos)