[m-rev.] for review: fix singleton variable warning problem

[Simon Taylor]

On 01-Jun-2002, Simon Taylor <stayl at cs.mu.OZ.AU> wrote:
> > One possible solution, then, might be to change the way we handle
> > foreign_proc clauses, so that we do introduce "HeadVar__N" variables
> > and the corresponding unifications for those.  I don't know if that
> > would be a good idea, or if it might result in other problems...
> 
> Adding unifications could cause spurious unique mode errors due to
> the addition of aliasing that the current mode checker is incapable
> of tracking. Howver, it should be possible to specify the HeadVar__N
> variables as the arguments of the foreign code goal directly.
> 
> The diff below has the same effect as Pete's change, but it also
> simplifies the code. This isn't well tested.

I've committed the following diff.

Simon.


Estimated hours taken: 0.5 (+4 by petdr)
Branches: main

compiler/make_hlds.m:
	Fix spurious "`_Var' occurs more than once" warnings for
	underscore variables in `:- pragma foreign_proc' declarations
	for predicates which also have Mercury clauses.

tests/invalid/Mmakefile:
tests/invalid/foreign_singleton.m:
tests/invalid/foreign_singleton.err_exp:
tests/valid/Mmakefile:
tests/valid/foreign_underscore_var.m:
	Test cases.

Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.411
diff -u -u -r1.411 make_hlds.m
--- compiler/make_hlds.m	9 May 2002 16:30:55 -0000	1.411
+++ compiler/make_hlds.m	1 Jun 2002 10:38:17 -0000
@@ -5500,7 +5500,7 @@
 clauses_info_add_pragma_foreign_proc(ClausesInfo0, Purity, Attributes0, PredId,
 		ProcId, PVarSet, PVars, OrigArgTypes, PragmaImpl0, Context,
 		PredOrFunc, PredName, Arity, ClausesInfo, ModuleInfo0,
-		ModuleInfo, Info0, Info) -->
+		ModuleInfo, Info, Info) -->
 
 	{ ClausesInfo0 = clauses_info(VarSet0, VarTypes, TVarNameMap,
 		VarTypes1, HeadVars, ClauseList, TI_VarMap, TCI_VarMap,
@@ -5618,7 +5618,6 @@
 	( { MultipleArgs = [_ | _] } ->
 		{ ClausesInfo = ClausesInfo0 },
 		{ ModuleInfo = ModuleInfo1 },
-		{ Info = Info0 },
 		prog_out__write_context(Context),
 		io__write_string(
 			"In `:- pragma foreign_proc' declaration for "),
@@ -5644,12 +5643,7 @@
 		io__write_string("  in the argument list.\n"),
 		io__set_exit_status(1)
 	;
-		% merge the varsets of the proc and the new pragma_c_code
 		{
-		varset__merge_subst(VarSet0, PVarSet, VarSet1, Subst),
-		map__apply_to_list(Args0, Subst, TermArgs),
-		term__term_list_to_var_list(TermArgs, Args),
-
 			% build the pragma_c_code
 		goal_info_init(GoalInfo0),
 		goal_info_set_context(GoalInfo0, Context, GoalInfo1),
@@ -5657,22 +5651,12 @@
 		% this foreign code is inlined
 		add_goal_info_purity_feature(GoalInfo1, Purity, GoalInfo),
 		HldsGoal0 = foreign_proc(Attributes, PredId, 
-			ProcId, Args, ArgInfo, OrigArgTypes, PragmaImpl)
-			- GoalInfo
-		}, 
-			% Apply unifications with the head args.
-			% Since the set of head vars and the set vars in the
-			% pragma foreign code are disjoint, the
-			% unifications can be implemented as
-			% substitutions, and they will be.
-		insert_arg_unifications(HeadVars, TermArgs, Context,
-			head(PredOrFunc, Arity), yes, HldsGoal0, VarSet1,
-			HldsGoal1, VarSet2, transform_info(ModuleInfo1, Info0),
-				transform_info(ModuleInfo, Info)),
-		{
+			ProcId, HeadVars, ArgInfo, OrigArgTypes, PragmaImpl)
+			- GoalInfo,
+		ModuleInfo = ModuleInfo1,
 		map__init(EmptyVarTypes),
 		implicitly_quantify_clause_body(HeadVars,
-			HldsGoal1, VarSet2, EmptyVarTypes,
+			HldsGoal0, VarSet0, EmptyVarTypes,
 			HldsGoal, VarSet, _, _Warnings),
 		NewClause = clause([ProcId], HldsGoal,
 			foreign_language(NewLang), Context),
@@ -5726,7 +5710,7 @@
 	;
 		{ ArgContext = head(PredOrFunc, Arity) },
 		insert_arg_unifications(HeadVars, Args, Context, ArgContext,
-			no, Goal1, VarSet1, Goal2, VarSet2, Info1, Info2)
+			Goal1, VarSet1, Goal2, VarSet2, Info1, Info2)
 	),
 	{ VarTypes2 = Info2 ^ qual_info ^ vartypes },
 	{ implicitly_quantify_clause_body(HeadVars, Goal2, VarSet2, VarTypes2,
@@ -5937,7 +5921,7 @@
 		{ record_called_pred_or_func(predicate, Name, Arity,
 			Info0, Info1) },
 		insert_arg_unifications(HeadVars, Args,
-			Context, call(CallId), no,
+			Context, call(CallId),
 			Goal0, VarSet1, Goal, VarSet, Info1, Info)
 	).
 
@@ -6493,7 +6477,7 @@
 			{ record_called_pred_or_func(PredOrFunc, SymName, 
 				InsertArity, Info0, Info1) },
 			insert_arg_unifications(AllArgs, AllArgTerms,
-				Context, call(CallId), no,
+				Context, call(CallId),
 				Goal0, VarSet3, Goal, VarSet, Info1, Info)
 		;
 			{ invalid_goal(UpdateStr, Args0, GoalInfo,
@@ -6596,7 +6580,7 @@
 			PredGoal0, VarSet3, Info0, Info1),
 		{ ArgContext = head(PredOrFunc, PredArity) },
 		insert_arg_unifications(HeadArgs, HeadArgs1, Context,
-			ArgContext, no, PredGoal0, VarSet3, PredGoal1, VarSet4,
+			ArgContext, PredGoal0, VarSet3, PredGoal1, VarSet4,
 			Info1, Info2),
 
 		% Quantification will reduce this down to
@@ -6668,7 +6652,7 @@
 		insert_arg_unifications(AllArgs,
 			[term__variable(LambdaVar), AditiState0Term,
 				AditiStateTerm],
-			Context, CallId, no, UpdateConj, VarSet7, UpdateGoal,
+			Context, CallId, UpdateConj, VarSet7, UpdateGoal,
 			VarSet, Info4, Info)
 	;
 		%
@@ -6709,7 +6693,7 @@
 		{ record_called_pred_or_func(PredOrFunc, SymName, Arity,
 			Info0, Info1) },
 		insert_arg_unifications(OtherArgs, OtherArgs0, Context, CallId,
-			no, Call, VarSet1, UpdateGoal, VarSet, Info1, Info)
+			Call, VarSet1, UpdateGoal, VarSet, Info1, Info)
 	;
 		{ invalid_goal(Descr, Args0, GoalInfo,
 			UpdateGoal, VarSet0, VarSet) },
@@ -6917,17 +6901,7 @@
 	% that each unification gets reduced to superhomogeneous form.
 	% It also gets passed a `arg_context', which indicates
 	% where the terms came from.
-
 	% We never insert unifications of the form X = X.
-	% If ForPragmaC is yes, we process unifications of the form
-	% X = Y by substituting the var expected by the outside environment
-	% (the head variable) for the variable inside the goal (which was
-	% created just for the pragma_c_code goal), while giving the headvar
-	% the name of the just eliminated variable. The result will be
-	% a proc_info in which the head variables have meaningful names
-	% and the body goal is just a pragma C code. Without this special
-	% treatment, the body goal will be a conjunction, which would
-	% complicate the handling of code generation for nondet pragma C codes.
 
 :- type arg_context
 	--->	
@@ -6945,13 +6919,13 @@
 		).
 
 :- pred insert_arg_unifications(list(prog_var), list(prog_term),
-		prog_context, arg_context, bool, hlds_goal, prog_varset,
+		prog_context, arg_context, hlds_goal, prog_varset,
 		hlds_goal, prog_varset, transform_info, transform_info,
 		io__state, io__state).
-:- mode insert_arg_unifications(in, in, in, in, in, in, in, out,
+:- mode insert_arg_unifications(in, in, in, in, in, in, out,
 		out, in, out, di, uo) is det.
 
-insert_arg_unifications(HeadVars, Args, Context, ArgContext, ForPragmaC,
+insert_arg_unifications(HeadVars, Args, Context, ArgContext,
 		Goal0, VarSet0, Goal, VarSet, Info0, Info) -->
 	( { HeadVars = [] } ->
 		{ Goal = Goal0 },
@@ -6961,40 +6935,40 @@
 		{ Goal0 = _ - GoalInfo0 },
 		{ goal_to_conj_list(Goal0, List0) },
 		insert_arg_unifications_2(HeadVars, Args, Context, ArgContext,
-			ForPragmaC, 0, List0, VarSet0, List, VarSet,
+			0, List0, VarSet0, List, VarSet,
 			Info0, Info),
 		{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
 		{ conj_list_to_goal(List, GoalInfo, Goal) }
 	).
 
 :- pred insert_arg_unifications_2(list(prog_var), list(prog_term),
-		prog_context, arg_context, bool, int, list(hlds_goal),
+		prog_context, arg_context, int, list(hlds_goal),
 		prog_varset, list(hlds_goal), prog_varset,
 		transform_info, transform_info, io__state, io__state).
-:- mode insert_arg_unifications_2(in, in, in, in, in, in, in, in,
+:- mode insert_arg_unifications_2(in, in, in, in, in, in, in,
 		out, out, in, out, di, uo) is det.
 
-insert_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _, _) -->
+insert_arg_unifications_2([], [_|_], _,  _, _, _, _, _, _, _, _) -->
 	{ error("insert_arg_unifications_2: length mismatch") }.
-insert_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _, _) -->
+insert_arg_unifications_2([_|_], [], _,  _, _, _, _, _, _, _, _) -->
 	{ error("insert_arg_unifications_2: length mismatch") }.
-insert_arg_unifications_2([], [], _, _, _, _, List, VarSet, List, VarSet,
+insert_arg_unifications_2([], [], _, _,  _, List, VarSet, List, VarSet,
 		Info, Info) --> [].
 insert_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext,
-		ForPragmaC, N0, List0, VarSet0, List, VarSet, Info0, Info) -->
+		N0, List0, VarSet0, List, VarSet, Info0, Info) -->
 	{ N1 is N0 + 1 },
 	insert_arg_unification(Var, Arg, Context, ArgContext,
-		ForPragmaC, N1, List0, VarSet0, List1, VarSet1, ArgUnifyConj,
+		N1, List0, VarSet0, List1, VarSet1, ArgUnifyConj,
 		Info0, Info1),
 	(
 		{ ArgUnifyConj = [] }
 	->
 		insert_arg_unifications_2(Vars, Args, Context, ArgContext,
-			ForPragmaC, N1, List1, VarSet1, List, VarSet,
+			N1, List1, VarSet1, List, VarSet,
 			Info1, Info)
 	;
 		insert_arg_unifications_2(Vars, Args, Context, ArgContext,
-			ForPragmaC, N1, List1, VarSet1, List2, VarSet,
+			N1, List1, VarSet1, List2, VarSet,
 			Info1, Info),
 		{ list__append(ArgUnifyConj, List2, List) }
 	).	
@@ -7043,7 +7017,7 @@
 		{ Terms = [Term | Terms1] },
 		{ ArgContexts = [ArgNumber - ArgContext | ArgContexts1] }
 	->
-		insert_arg_unification(Var, Term, Context, ArgContext, no,
+		insert_arg_unification(Var, Term, Context, ArgContext,
 			ArgNumber, List0, VarSet0, List1, VarSet1,
 			UnifyConj, Info0, Info1),
 		insert_arg_unifications_with_supplied_contexts_2(Vars1, Terms1,
@@ -7055,14 +7029,14 @@
 	).
 
 :- pred insert_arg_unification(prog_var, prog_term,
-		prog_context, arg_context, bool, int,
+		prog_context, arg_context, int,
 		list(hlds_goal), prog_varset, list(hlds_goal), prog_varset,
 		list(hlds_goal), transform_info, transform_info,
 		io__state, io__state).
-:- mode insert_arg_unification(in, in, in, in, in, in,
+:- mode insert_arg_unification(in, in, in, in, in,
 		in, in, out, out, out, in, out, di, uo) is det.
 
-insert_arg_unification(Var, Arg, Context, ArgContext, ForPragmaC, N1,
+insert_arg_unification(Var, Arg, Context, ArgContext, N1,
 		List0, VarSet0, List1, VarSet1, ArgUnifyConj, Info0, Info) -->
 	(
 		{ Arg = term__variable(Var) }
@@ -7073,23 +7047,6 @@
 		{ ArgUnifyConj = [] },
 		{ List1 = List0 }
 	;
-		{ Arg = term__variable(ArgVar) },
-		{ ForPragmaC = yes }
-	->
-		% Handle unifications of the form `X = Y' by substitution
-		% if this is safe.
-		{ Info = Info0 },
-		{ ArgUnifyConj = [] },
-		{ map__init(Subst0) },
-		{ map__det_insert(Subst0, ArgVar, Var, Subst) },
-		{ goal_util__rename_vars_in_goals(List0, no, Subst,
-			List1) },
-		{ varset__search_name(VarSet0, ArgVar, ArgVarName) ->
-			varset__name_var(VarSet0, Var, ArgVarName, VarSet1)
-		;
-			VarSet1 = VarSet0
-		}
-	;
 		{ arg_context_to_unify_context(ArgContext, N1,
 			UnifyMainContext, UnifySubContext) },
 		unravel_unification(term__variable(Var), Arg,
@@ -7497,7 +7454,7 @@
 					Purity, GoalInfo) },
 				{ Goal1 = GoalExpr - GoalInfo },
 				insert_arg_unifications(HeadVars, FunctorArgs,
-					FunctorContext, ArgContext, no, Goal1,
+					FunctorContext, ArgContext, Goal1,
 					VarSet1, Goal, VarSet, Info1, Info)
 			)
 		)
@@ -7647,7 +7604,7 @@
 			HLDS_Goal0, VarSet2, Info1, Info2),
 	{ ArgContext = head(PredOrFunc, NumArgs) },
 	insert_arg_unifications(LambdaVars, Args, Context, ArgContext,
-		no, HLDS_Goal0, VarSet2, HLDS_Goal1, VarSet, Info2, Info3),
+		HLDS_Goal0, VarSet2, HLDS_Goal1, VarSet, Info2, Info3),
 
 	%
 	% Now figure out which variables we need to explicitly existentially
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.112
diff -u -u -r1.112 Mmakefile
--- tests/invalid/Mmakefile	9 May 2002 16:31:13 -0000	1.112
+++ tests/invalid/Mmakefile	1 Jun 2002 10:50:11 -0000
@@ -52,6 +52,7 @@
 	ext_type_bug.m \
 	exported_mode.m \
 	field_syntax_error.m \
+	foreign_singleton.m \
 	func_errors.m \
 	funcs_as_preds.m \
 	ho_default_func_1.m \
@@ -170,6 +171,7 @@
 MCFLAGS-duplicate_modes	=	--verbose-error-messages
 MCFLAGS-exported_mode =		--infer-all --no-intermodule-optimization
 MCFLAGS-foreign_type =		--compile-only
+MCFLAGS-foreign_singleton =	--halt-at-warn
 MCFLAGS-imported_mode =		--infer-all --no-intermodule-optimization
 MCFLAGS-missing_det_decls =	--no-infer-det
 MCFLAGS-missing_interface_import = --make-interface
Index: tests/invalid/foreign_singleton.err_exp
===================================================================
RCS file: tests/invalid/foreign_singleton.err_exp
diff -N tests/invalid/foreign_singleton.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/foreign_singleton.err_exp	1 Jun 2002 13:31:13 -0000
@@ -0,0 +1,5 @@
+foreign_singleton.m:026: In clause for predicate `foreign_singleton:f/3':
+foreign_singleton.m:026:   warning: variable `X' occurs only once in this scope.
+foreign_singleton.m:030: In clause for predicate `foreign_singleton:g/3':
+foreign_singleton.m:030:   warning: variable `X' occurs only once in this scope.
+For more information, try recompiling with `-E'.
Index: tests/invalid/foreign_singleton.m
===================================================================
RCS file: tests/invalid/foreign_singleton.m
diff -N tests/invalid/foreign_singleton.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/foreign_singleton.m	1 Jun 2002 13:31:06 -0000
@@ -0,0 +1,36 @@
+:- module foreign_singleton.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+main -->
+       f(X),
+       io__write_int(X),
+       io__nl,
+       g(Y),
+       io__write_int(Y),
+       io__nl.
+
+:- pred f(int::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C", f(X::out, _IO0::di, _IO::uo),
+        [will_not_call_mercury, promise_pure], "
+    X = 5;
+").
+
+f(X) --> [].
+
+:- pred g(int::out, io::di, io::uo) is det.
+
+g(X) --> [].
+
+:- pragma foreign_proc("C", g(X::out, _IO0::di, _IO::uo),
+        [will_not_call_mercury, promise_pure], "
+    X = 5;
+").
+
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.104
diff -u -u -r1.104 Mmakefile
--- tests/valid/Mmakefile	1 Jun 2002 10:58:52 -0000	1.104
+++ tests/valid/Mmakefile	1 Jun 2002 10:59:42 -0000
@@ -75,6 +75,7 @@
 	explicit_quant.m \
 	fail_ite.m \
 	followcode_det_problem.m \
+	foreign_underscore_var.m \
 	func_int_bug_main.m \
 	func_default_modes.m \
 	headvar_not_found.m \
@@ -278,6 +279,7 @@
 MCFLAGS-deforest_rerun_det	= -O3 --check-termination
 MCFLAGS-double_vn		= -O4
 MCFLAGS-explicit_quant		= --halt-at-warn
+MCFLAGS-foreign_underscore_var	= --halt-at-warn
 MCFLAGS-higher_order_implied_mode = -O-1
 MCFLAGS-inhibit_warn_test       = --inhibit-warnings --halt-at-warn
 MCFLAGS-intermod_dcg_bug	= --intermodule-optimization
Index: tests/valid/foreign_underscore_var.m
===================================================================
RCS file: tests/valid/foreign_underscore_var.m
diff -N tests/valid/foreign_underscore_var.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/valid/foreign_underscore_var.m	1 Jun 2002 10:45:17 -0000
@@ -0,0 +1,24 @@
+:- module foreign_underscore_var.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+main -->
+       f(X),
+       io__write_int(X),
+       io__nl.
+
+:- pred f(int::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C", f(X::out, _IO0::di, _IO::uo),
+        [will_not_call_mercury, promise_pure], "
+    X = 5;
+").
+
+f(5) --> [].
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------