diff: make_hlds.m pragma c_code singleton var warnings

[Fergus Henderson]

compiler/make_hlds.m:
	Fix a bug that caused spurious warnings of the form
	"variable `_Foo' occurs more than once" for underscored
	singleton variables in pragma c_code declarations.

	Also, simplify the code: replace a 25-line predicate with
	a five-line call to solutions.

Index: make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.231
diff -u -r1.231 make_hlds.m
--- make_hlds.m	1997/05/27 03:06:31	1.231
+++ make_hlds.m	1997/06/02 10:17:35
@@ -1653,7 +1653,7 @@
 			clauses_info_add_pragma_c_code(Clauses0,
 				MayCallMercury, PredId, ProcId, VarSet,
 				PVars, ArgTypes, C_Code, Context, ExtraInfo,
-				Clauses, Goal, Info0, Info),
+				Clauses, Info0, Info),
 			{ pred_info_set_clauses_info(PredInfo1, Clauses, 
 				PredInfo2) },
 			{ pred_info_set_goal_type(PredInfo2, pragmas, 
@@ -1663,8 +1663,9 @@
 				PredicateTable) },
 			{ module_info_set_predicate_table(ModuleInfo0, 
 				PredicateTable, ModuleInfo) },
-			maybe_warn_singletons(VarSet,
-				PredOrFunc - PredName/Arity, Goal)
+			{ pragma_get_var_names(PVars, Names) },
+			maybe_warn_pragma_singletons(C_Code, Names,
+				Context, PredOrFunc - PredName/Arity)
 		;
 			{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }, 
 			io__stderr_stream(StdErr),
@@ -1996,6 +1997,19 @@
 
 %-----------------------------------------------------------------------------%
 
+:- pred maybe_warn_pragma_singletons(string, list(maybe(string)),
+		term__context, pred_or_func_call_id, io__state, io__state).
+:- mode maybe_warn_pragma_singletons(in, in, in, in, di, uo) is det.
+
+maybe_warn_pragma_singletons(C_Code, ArgNames, Context, CallId) -->
+	globals__io_lookup_bool_option(warn_singleton_vars, WarnSingletonVars),
+	( { WarnSingletonVars = yes } ->
+		warn_singletons_in_pragma_c_code(C_Code, ArgNames,
+			Context, CallId)
+	;	
+		[]
+	).
+
 	% warn_singletons_in_pragma_c_code checks to see if each variable is
 	% a substring of the given c code. If not, it gives a warning
 :- pred warn_singletons_in_pragma_c_code(string, list(maybe(string)),
@@ -2005,8 +2019,11 @@
 warn_singletons_in_pragma_c_code(C_Code, ArgNames, 
 		Context, PredOrFunc - PredCallId) -->
 	{ c_code_to_name_list(C_Code, C_CodeList) },
-	{ warn_singletons_in_pragma_c_code_2(C_CodeList, ArgNames,
-		Context, SingletonVars) },
+	{ solutions(lambda([Name::out] is nondet, (
+			list__member(yes(Name), ArgNames),
+			\+ string__prefix(Name, "_"),
+			\+ list__member(Name, C_CodeList)
+		)), SingletonVars) },
 	( { SingletonVars = [] } ->
 		[]
 	;
@@ -2031,31 +2048,6 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred warn_singletons_in_pragma_c_code_2(list(string), list(maybe(string)), 
-				term__context, list(string)).
-:- mode warn_singletons_in_pragma_c_code_2(in, in, in, out) is det.
-
-warn_singletons_in_pragma_c_code_2(_, [], _, []).
-warn_singletons_in_pragma_c_code_2(C_CodeList, [Arg|Args],
-		Context, SingletonVars) :-
-	warn_singletons_in_pragma_c_code_2(C_CodeList, Args,
-		 Context, SingletonVars0),
-	( Arg = yes(Name) ->
-		(
-			( string__prefix(Name, "_")
-			; list__member(Name, C_CodeList)
-			)
-		->
-			SingletonVars = SingletonVars0
-		;
-			SingletonVars = [Name|SingletonVars0]
-		)
-	;
-		SingletonVars = SingletonVars0
-	).
-
-%-----------------------------------------------------------------------------%
-
 	% c_code_to_name_list(Code, List) is true iff List is a list of the 
 	% identifiers used in the C code in Code.
 :- pred c_code_to_name_list(string, list(string)).
@@ -2258,14 +2250,14 @@
 :- pred clauses_info_add_pragma_c_code(clauses_info, may_call_mercury,
 	pred_id, proc_id, varset, list(pragma_var), list(type),
 	string, term__context,
-	maybe(pair(list(string))), clauses_info, hlds_goal,
+	maybe(pair(list(string))), clauses_info,
 	qual_info, qual_info, io__state, io__state) is det.
 :- mode clauses_info_add_pragma_c_code(in, in, in, in, in, in, in, in, in, in,
-	out, out, in, out, di, uo) is det.
+	out, in, out, di, uo) is det.
 
 clauses_info_add_pragma_c_code(ClausesInfo0, MayCallMercury, PredId, ModeId,
 		PVarSet, PVars, OrigArgTypes, C_Code, Context, ExtraInfo,
-		ClausesInfo, HldsGoal, Info0, Info) -->
+		ClausesInfo, Info0, Info) -->
 	{
 	ClausesInfo0 = clauses_info(VarSet0, VarTypes, VarTypes1,
 				 HeadVars, ClauseList),

-- 
Fergus Henderson <fjh at cs.mu.oz.au>   |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>   |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3         |     -- the last words of T. S. Garp.