[m-rev.] diff: fix misleading mode error

[Fergus Henderson]

Estimated hours taken: 0.5
Branches: main, release

compiler/modecheck_unify.m:
	Fix a couple of bugs where we were setting the call context before
	mode-checking some sub-goal, and then forgetting to unset it
	afterwards.  This resulted in the compiler issuing some misleading
	error messages.

Most of the diff below is variable renumbering.
The only real change was to insert to calls to mode_info_unset_call_context.

Workspace: /home/mars/fjh/ws1/mercury
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.46
diff -u -d -r1.46 modecheck_unify.m
--- compiler/modecheck_unify.m	2001/07/10 10:45:27	1.46
+++ compiler/modecheck_unify.m	2001/07/31 18:35:18
@@ -864,7 +864,7 @@
 	%
 	( UnifyTypeInfoVars = [] ->
 		% optimize common case
-		ModeInfo2 = ModeInfo0
+		ModeInfo3 = ModeInfo0
 	;
 		list__length(UnifyTypeInfoVars, NumTypeInfoVars),
 		list__duplicate(NumTypeInfoVars, ground(shared, none),
@@ -875,18 +875,19 @@
 		InitialArgNum = 0,
 		modecheck_var_has_inst_list(UnifyTypeInfoVars, ExpectedInsts,
 			NeedExactMatch, InitialArgNum, _InstVarSub,
-			ModeInfo1, ModeInfo2)
+			ModeInfo1, ModeInfo2),
 			% We can ignore _InstVarSub since type_info variables
 			% should not have variable insts.
+		mode_info_unset_call_context(ModeInfo2, ModeInfo3)
 	),
 
-	mode_info_get_module_info(ModeInfo2, ModuleInfo2),
+	mode_info_get_module_info(ModeInfo3, ModuleInfo3),
 
 	(
-		mode_info_get_errors(ModeInfo2, Errors),
+		mode_info_get_errors(ModeInfo3, Errors),
 		Errors \= []
 	->
-		ModeInfo = ModeInfo2
+		ModeInfo = ModeInfo3
 	;
 		%
 		% Check that we're not trying to do a polymorphic unification
@@ -896,20 +897,20 @@
 		% also be able to handle (in(any), in(any)) unifications.]
 		%
 		Type = term__variable(_),
-		\+ inst_is_ground_or_any(ModuleInfo2, InitialInstX)
+		\+ inst_is_ground_or_any(ModuleInfo3, InitialInstX)
 	->
 		set__singleton_set(WaitingVars, X),
 		mode_info_error(WaitingVars,
 			mode_error_poly_unify(X, InitialInstX),
-			ModeInfo2, ModeInfo)
+			ModeInfo3, ModeInfo)
 	;
 		Type = term__variable(_),
-		\+ inst_is_ground_or_any(ModuleInfo2, InitialInstY)
+		\+ inst_is_ground_or_any(ModuleInfo3, InitialInstY)
 	->
 		set__singleton_set(WaitingVars, Y),
 		mode_info_error(WaitingVars,
 			mode_error_poly_unify(Y, InitialInstY),
-			ModeInfo2, ModeInfo)
+			ModeInfo3, ModeInfo)
 	;
 
 		%
@@ -925,22 +926,22 @@
 		% not_reached is considered bound, so the 
 		% error message would be spurious if the 
 		% instmap is unreachable.
-		mode_info_get_predid(ModeInfo2, PredId),
-		module_info_pred_info(ModuleInfo2, PredId,
+		mode_info_get_predid(ModeInfo3, PredId),
+		module_info_pred_info(ModuleInfo3, PredId,
 				PredInfo),
-		mode_info_get_instmap(ModeInfo2, InstMap0),
+		mode_info_get_instmap(ModeInfo3, InstMap0),
 		( 
 			( code_util__compiler_generated(PredInfo) 
 			; instmap__is_unreachable(InstMap0)
 			)
 		->
-			ModeInfo = ModeInfo2
+			ModeInfo = ModeInfo3
 		;
 			set__init(WaitingVars),
 			mode_info_error(WaitingVars,
 				mode_error_unify_pred(X, error_at_var(Y),
 						Type, PredOrFunc),
-				ModeInfo2, ModeInfo)
+				ModeInfo3, ModeInfo)
 		)
 	;
 		%
@@ -950,14 +951,14 @@
 		%
 		type_to_type_id(Type, TypeId, _)
 	->
-		mode_info_get_context(ModeInfo2, Context),
-		mode_info_get_instvarset(ModeInfo2, InstVarSet),
+		mode_info_get_context(ModeInfo3, Context),
+		mode_info_get_instvarset(ModeInfo3, InstVarSet),
 		unify_proc__request_unify(TypeId - UniMode, InstVarSet,
-			Det, Context, ModuleInfo2, ModuleInfo),
-		mode_info_set_module_info(ModeInfo2, ModuleInfo,
+			Det, Context, ModuleInfo3, ModuleInfo),
+		mode_info_set_module_info(ModeInfo3, ModuleInfo,
 			ModeInfo)
 	;
-		ModeInfo = ModeInfo2
+		ModeInfo = ModeInfo3
 	).
 		
 
@@ -1167,7 +1168,8 @@
 		modecheck_var_has_inst_list([ArgVar], [ground(shared, none)],
 			NeedExactMatch, InitialArgNum, _InstVarSub),
 		check_type_info_args_are_ground(ArgVars, VarTypes,
-			UnifyContext)
+			UnifyContext),
+		mode_info_unset_call_context
 	;
 		[]
 	).

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------