[m-dev.] for review: fix warnings with no context

[Simon Taylor]

> Thus, I think simplify.m really need to keep two sets of warnings,
> one for warnings which apply if they occur in any mode, and
> one for warnings that apply only if they occur in every mode.
> 

OK, here's a relative diff.

Simon.


Estimated hours taken: 2

Fix a bug reported by Philip Dart where "this disjunct cannot succeed"
warnings for predicates using sub-typing in modes were being output
without a context.

compiler/hlds_goal.m
	Add versions of true_goal and fail_goal which take
	a context for the goal.

compiler/simplify.m
	Pass a valid context to true_goal and fail_goal.
	Only report most of the --warn-simple-code messages if they 
	occur for all modes of a predicate - this avoids spurious 
	"this disjunct cannot succeed" warnings for sub-typing.

compiler/det_report.m
	Added det_report__is_any_mode_msg to return whether a
	message should only be reported if it occurs for all modes
	of a predicate.

compiler/passes_aux.m
	Add a task type update_pred_error for use by simplify.m.

tests/warnings/simple_code.m
	Add some more test cases.

Index: det_report.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_report.m,v
retrieving revision 1.52
diff -u -t -u -r1.52 det_report.m
--- det_report.m	1998/06/09 02:12:26	1.52
+++ det_report.m	1998/06/12 05:53:52
@@ -95,6 +95,18 @@
         io__state, io__state).
 :- mode det_report_msgs(in, in, out, out, di, uo) is det.
 
+
+:- type msg_modes
+        --->    all_modes       % the warning should be reported only
+                                % if it occurs in all modes of the predicate
+        ;       any_mode        % the warning should be reported 
+                                % if it occurs in any mode of the predicate
+        .
+
+        % Return `yes' if the warning should be reported if it occurs in
+        % any mode of the predicate, not only if it occurs in all modes.
+:- pred det_msg_is_any_mode_msg(det_msg::in, msg_modes::out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- type det_comparison  --->    tighter ; sameas ; looser.
@@ -992,6 +1004,26 @@
 det_msg_get_type(error_in_lambda(_, _, _, _, _, _), error).
 det_msg_get_type(par_conj_not_det(_, _, _, _, _), error).
 det_msg_get_type(pragma_c_code_without_det_decl(_, _), error).
+
+det_msg_is_any_mode_msg(multidet_disj(_, _), all_modes).
+det_msg_is_any_mode_msg(det_disj(_, _), all_modes).
+det_msg_is_any_mode_msg(semidet_disj(_, _), all_modes).
+det_msg_is_any_mode_msg(zero_soln_disj(_, _), all_modes).
+det_msg_is_any_mode_msg(zero_soln_disjunct(_), all_modes).
+det_msg_is_any_mode_msg(ite_cond_cannot_fail(_), all_modes).
+det_msg_is_any_mode_msg(ite_cond_cannot_succeed(_), all_modes).
+det_msg_is_any_mode_msg(negated_goal_cannot_fail(_), all_modes).
+det_msg_is_any_mode_msg(negated_goal_cannot_succeed(_), all_modes).
+det_msg_is_any_mode_msg(warn_obsolete(_, _), all_modes).
+det_msg_is_any_mode_msg(warn_infinite_recursion(_), any_mode).
+det_msg_is_any_mode_msg(duplicate_call(_, _, _), any_mode).
+det_msg_is_any_mode_msg(cc_unify_can_fail(_, _, _, _, _), any_mode).
+det_msg_is_any_mode_msg(cc_unify_in_wrong_context(_, _, _, _, _), any_mode).
+det_msg_is_any_mode_msg(cc_pred_in_wrong_context(_, _, _, _), any_mode).
+det_msg_is_any_mode_msg(higher_order_cc_pred_in_wrong_context(_, _), any_mode).
+det_msg_is_any_mode_msg(error_in_lambda(_, _, _, _, _, _), any_mode).
+det_msg_is_any_mode_msg(par_conj_not_det(_, _, _, _, _), any_mode).
+det_msg_is_any_mode_msg(pragma_c_code_without_det_decl(_, _), any_mode).
 
 :- pred det_report_msg(det_msg, module_info, io__state, io__state).
 :- mode det_report_msg(in, in, di, uo) is det.
===================================================================
RCS file: RCS/simplify.m,v
retrieving revision 1.1
diff -u -r1.1 simplify.m
--- simplify.m	1998/06/12 04:59:48	1.1
+++ simplify.m	1998/06/12 06:39:45
@@ -95,8 +95,9 @@
 	},
 	simplify__procs(Simplifications, PredId, ProcIds, ModuleInfo0,
 		ModuleInfo, PredInfo0, PredInfo, MaybeMsgs0, MaybeMsgs),
-	( { MaybeMsgs = yes(Msgs0) } ->
-		{ set__to_sorted_list(Msgs0, Msgs) },
+	( { MaybeMsgs = yes(Msgs0 - Msgs1) } ->
+		{ set__union(Msgs0, Msgs1, Msgs2) },
+		{ set__to_sorted_list(Msgs2, Msgs) },
 		det_report_msgs(Msgs, ModuleInfo, WarnCnt, ErrCnt)
 	;
 		{ WarnCnt = 0 },
@@ -105,7 +106,7 @@
 
 :- pred simplify__procs(list(simplification), pred_id, list(proc_id),
 		module_info, module_info, pred_info, pred_info,
-		maybe(set(det_msg)), maybe(set(det_msg)),
+		maybe(pair(set(det_msg))), maybe(pair(set(det_msg))),
 		io__state, io__state).
 :- mode simplify__procs(in, in, in, in, out, in, out,
 		in, out, di, uo) is det.
@@ -120,15 +121,22 @@
 			ModuleInfo1, Proc0, Proc, Msgs1),
 	{ map__det_update(Procs0, ProcId, Proc, Procs) },
 	{ pred_info_set_procedures(PredInfo0, Procs, PredInfo1) },
-	{ MaybeMsgs0 = yes(Msgs0) ->
-		set__intersect(Msgs0, Msgs1, Msgs),
-		MaybeMsgs1 = yes(Msgs)
+	{ set__to_sorted_list(Msgs1, Msgs2) },
+	{ list__filter(lambda([Msg::in] is semidet,
+		det_msg_is_any_mode_msg(Msg, any_mode)),
+		Msgs2, AnyModeMsgs1, AllModeMsgs1) },
+	{ set__sorted_list_to_set(AnyModeMsgs1, AnyModeMsgs2) },
+	{ set__sorted_list_to_set(AllModeMsgs1, AllModeMsgs2) },
+	{ MaybeMsgs0 = yes(AnyModeMsgs0 - AllModeMsgs0) ->
+		set__union(AnyModeMsgs0, AnyModeMsgs2, AnyModeMsgs),
+		set__intersect(AllModeMsgs0, AllModeMsgs2, AllModeMsgs),
+		MaybeMsgs1 = yes(AllModeMsgs - AnyModeMsgs)
 	;
-		MaybeMsgs1 = yes(Msgs1)
+		MaybeMsgs1 = yes(AnyModeMsgs2 - AllModeMsgs2)
 	},
 	simplify__procs(Simplifications, PredId, ProcIds, ModuleInfo1, 
 		ModuleInfo, PredInfo1, PredInfo, MaybeMsgs1, MaybeMsgs).
-	
+
 simplify__proc(Simplifications, PredId, ProcId, ModuleInfo0, ModuleInfo,
 		Proc0, Proc)  -->
 	write_pred_progress_message("% Simplifying ", PredId, ModuleInfo0),


Index: tests/warnings/simple_code.m
===================================================================
RCS file: /home/staff/zs/imp/tests/warnings/simple_code.m,v
retrieving revision 1.2
diff -u -t -u -r1.2 simple_code.m
--- simple_code.m	1997/05/21 02:16:52	1.2
+++ simple_code.m	1998/06/12 06:41:42
@@ -55,3 +55,44 @@
 :- pragma obsolete(obsolete/0).
 
 obsolete.
+
+% This should give a warning about the second disjunct never succeeding.
+:- pred r(int, int).
+:- mode r(in(bound(1)), out(bound(42))) is det.
+
+r(1, 42).
+r(2, 21).
+
+% This should not give a warning, because the second disjunct can
+% succeed in the first mode.
+:- pred q(int, int).
+:- mode q(in, out) is semidet.
+:- mode q(in(bound(1)), out(bound(42))) is det.
+
+q(1, 42).
+q(2, 21).
+
+:- type node ---> a ; b ; c.
+
+:- pred parent(node, node).
+:- mode parent(in, out).
+:- mode parent(out, in).
+parent(a, b).
+parent(b, c).
+parent(a, c).
+
+:- pred node(node).
+:- mode node(out).
+node(a).
+node(b).
+node(c).
+
+:- pred anc(node, node).
+:- mode anc(in, out).
+:- mode anc(out, in).
+anc(X, X) :-
+        node(X).
+anc(X, Z) :-
+        parent(X, Y),
+        anc(Y, Z).
+
Index: tests/warnings/simple_code.exp
===================================================================
RCS file: /home/staff/zs/imp/tests/warnings/simple_code.exp,v
retrieving revision 1.1
diff -u -t -u -r1.1 simple_code.exp
--- simple_code.exp	1997/04/28 00:05:25	1.1
+++ simple_code.exp	1998/06/17 04:35:30
@@ -7,3 +7,5 @@
 simple_code.m:030: Warning: the condition of this if-then-else cannot succeed.
 simple_code.m:033: Warning: the negated goal cannot succeed.
 simple_code.m:039: Warning: call to obsolete predicate `simple_code:obsolete/0'.
+simple_code.m:064: Warning: this disjunct will never have any solutions.
+simple_code.m:097: Warning: recursive call will lead to infinite recursion.