Diff: Fix inappropriate warning message for purity markers.

[Peter Schachte]

Turns out the `no mode declaration for predicate' error in my last
message was due to a syntax error in the test case.  Oops.

Fix inappropriate warning message for purity markers.

Estimated hours taken:  3

Ripped out code to warn if impurity markers were put before non-atomic
goals.  Such errors are now handled in prog_io_goal.m, and a suitable
error message is printed by typecheck.m.  So the code in purity.m was
vestigial.  It was triggered by implied modes of semipure or impure
goals, because they are turned into conjunctions, which then appear to
have been marked {im,semi}pure.

compiler/purity.m:
	Ripped out no-longer-needed error checking code.
tests/hard_coded/purity.exp:
tests/hard_coded/purity.m:
	Add a regression test.
tests/invalid/purity_nonsense.err_exp:
tests/invalid/purity_nonsense.m:
	Add a `impure call(P)' test (should give a warning/error).

Index: compiler/purity.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/purity.m,v
retrieving revision 1.4
diff -u -r1.4 purity.m
--- purity.m	1998/01/02 00:10:47	1.4
+++ purity.m	1998/01/05 23:57:36
@@ -502,9 +502,8 @@
 :- mode compute_expr_purity(in, out, in, in, in, in, out, in, out, di, uo)
 	is det.
 
-compute_expr_purity(conj(Goals0), conj(Goals), GoalInfo, PredInfo, ModuleInfo,
+compute_expr_purity(conj(Goals0), conj(Goals), _, PredInfo, ModuleInfo,
 		InClosure, Purity, NumErrors0, NumErrors) -->
-	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
 	compute_goals_purity(Goals0, Goals, PredInfo, ModuleInfo,
 			     InClosure, pure, Purity, NumErrors0, NumErrors).
 compute_expr_purity(call(PredId0,ProcId,Vars,BIState,UContext,Name0),
@@ -540,57 +539,44 @@
 						    DeclaredPurity),
 		{ NumErrors = NumErrors0 }
 	).
-compute_expr_purity(HOCall, HOCall, GoalInfo, _, _, InClosure, pure,
-		NumErrors0, NumErrors) -->
-	{ HOCall = higher_order_call(_,_,_,_,_,_) },
-	error_if_body_purity_indicated(GoalInfo, NumErrors0, NumErrors,
-				       InClosure, "higher order goal").
-compute_expr_purity(CMCall, CMCall, GoalInfo, _, _, InClosure, pure,
-		NumErrors0, NumErrors) -->
-	{ CMCall = class_method_call(_,_,_,_,_,_) },
-	error_if_body_purity_indicated(GoalInfo, NumErrors0, NumErrors,
-				       InClosure, "class method goal").
+compute_expr_purity(HOCall, HOCall, _, _, _, _, pure, NumErrors, NumErrors) -->
+	{ HOCall = higher_order_call(_,_,_,_,_,_) }.
+compute_expr_purity(CMCall, CMCall, _, _, _, _, pure, NumErrors, NumErrors) -->
+	{ CMCall = class_method_call(_,_,_,_,_,_) }.
 compute_expr_purity(switch(Var,Canfail,Cases0,Storemap),
-		switch(Var,Canfail,Cases,Storemap), GoalInfo, PredInfo,
+		switch(Var,Canfail,Cases,Storemap), _, PredInfo,
 		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
-	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
 	compute_cases_purity(Cases0, Cases, PredInfo, ModuleInfo,
 			     InClosure, pure, Purity, NumErrors0, NumErrors).
-compute_expr_purity(Unif0, Unif, GoalInfo, PredInfo, ModuleInfo, InClosure,
+compute_expr_purity(Unif0, Unif, GoalInfo, PredInfo, ModuleInfo, _,
 		pure, NumErrors0, NumErrors) -->
 	{ Unif0 = unify(A,RHS0,C,D,E) },
 	{ Unif  = unify(A,RHS,C,D,E) },
-	error_if_body_purity_indicated(GoalInfo, NumErrors0, NumErrors1,
-				       InClosure, "unification"),
 	(   { RHS0 = lambda_goal(F, G, H, I, Goal0 - Info0) } ->
 		{ RHS = lambda_goal(F, G, H, I, Goal - Info0) },
 		compute_expr_purity(Goal0, Goal, Info0, PredInfo, ModuleInfo,
-				    yes, Purity, NumErrors1, NumErrors2),
+				    yes, Purity, NumErrors0, NumErrors1),
 		error_if_closure_impure(GoalInfo, Purity,
-					NumErrors2, NumErrors)
+					NumErrors1, NumErrors)
 	;
 		{ RHS = RHS0 },
 		{ NumErrors = NumErrors0 }
 	).
-compute_expr_purity(disj(Goals0,Store), disj(Goals,Store), GoalInfo, PredInfo,
+compute_expr_purity(disj(Goals0,Store), disj(Goals,Store), _, PredInfo,
 		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
-	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
 	compute_goals_purity(Goals0, Goals, PredInfo, ModuleInfo,
 			     InClosure, pure, Purity, NumErrors0, NumErrors).
-compute_expr_purity(not(Goal0), not(Goal), GoalInfo, PredInfo, ModuleInfo,
+compute_expr_purity(not(Goal0), not(Goal), _, PredInfo, ModuleInfo,
 		InClosure, Purity, NumErrors0, NumErrors) -->
-	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
 	compute_goal_purity(Goal0, Goal, PredInfo, ModuleInfo, 
 			    InClosure, Purity, NumErrors0, NumErrors).
-compute_expr_purity(some(Vars,Goal0), some(Vars,Goal), GoalInfo, PredInfo,
+compute_expr_purity(some(Vars,Goal0), some(Vars,Goal), _, PredInfo,
 		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
-	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
 	compute_goal_purity(Goal0, Goal, PredInfo, ModuleInfo, 
 			    InClosure, Purity, NumErrors0, NumErrors).
 compute_expr_purity(if_then_else(Vars,Goali0,Goalt0,Goale0,Store),
-		if_then_else(Vars,Goali,Goalt,Goale,Store), GoalInfo, PredInfo,
+		if_then_else(Vars,Goali,Goalt,Goale,Store), _, PredInfo,
 		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
-	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
 	compute_goal_purity(Goali0, Goali, PredInfo, ModuleInfo,
 			    InClosure, Purity1, NumErrors0, NumErrors1),
 	compute_goal_purity(Goalt0, Goalt, PredInfo, ModuleInfo,
@@ -797,73 +783,6 @@
 		io__write_string("' is sufficient.\n")
 	).
 	
-
-:- pred warn_if_body_purity_indicated(hlds_goal_info, pred_info, bool,
-	io__state, io__state).
-:- mode warn_if_body_purity_indicated(in, in, in, di, uo) is det.
-
-warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure) -->
-	(   { InClosure = yes } ->
-		[]
-	;   { code_util__compiler_generated(PredInfo) } ->
-		[]
-	;   { infer_goal_info_purity(GoalInfo, Purity) },
-	    (   { Purity = pure } ->
-		    []
-	    ;	
-		    { goal_info_get_context(GoalInfo, Context) },
-		    prog_out__write_context(Context),
-		    io__write_string("Warning: inappropriate placement of `"),
-		    write_purity(Purity),
-		    io__write_string("' indicator.\n"),
-		    globals__io_lookup_bool_option(verbose_errors,
-						   VerboseErrors),
-		    (   { VerboseErrors = yes } ->
-			    prog_out__write_context(Context),
-			    io__write_string(
-	    "  Impurity indicators only belong before predicate calls.\n")
-		    ;   
-			    []
-		    )
-	    )
-	).
-
-
-
-:- pred error_if_body_purity_indicated(hlds_goal_info, int, int, bool,
-	string, io__state, io__state).
-:- mode error_if_body_purity_indicated(in, in, out, in, in, di, uo) is det.
-
-error_if_body_purity_indicated(GoalInfo, NumErrors0, NumErrors, InClosure,
-		Kind) -->
-	{ infer_goal_info_purity(GoalInfo, Purity) },
-	(   { Purity = pure } ->
-		{ NumErrors = NumErrors0 }
-	;   { InClosure = yes } ->
-		% Don't report purity errors inside a closure
-		{ NumErrors = NumErrors0 }
-	;
-		{ NumErrors is NumErrors0 + 1 },
-		{ goal_info_get_context(GoalInfo, Context) },
-		prog_out__write_context(Context),
-		io__write_string("Error: inappropriate placement of `"),
-		write_purity(Purity),
-		io__write_string("' indicator.\n"),
-		prog_out__write_context(Context),
-		io__write_string("  A "),
-		io__write_string(Kind),
-		io__write_string(" can never be "),
-		write_purity(Purity),
-		io__write_string(".\n"),
-		globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
-		(   { VerboseErrors = yes } ->
-			prog_out__write_context(Context),
-			io__write_string("  Impurity indicators only belong before predicate calls.\n")
-		;   
-			[]
-		)
-	).
-
 
 :- pred error_if_closure_impure(hlds_goal_info, purity, int, int,
 	io__state, io__state).
Index: tests/hard_coded/purity.exp
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/purity.exp,v
retrieving revision 1.1
diff -u -r1.1 purity.exp
--- purity.exp	1997/12/09 04:09:31	1.1
+++ purity.exp	1998/01/06 03:36:17
@@ -2,7 +2,9 @@
 1
 3
 4
+test4 succeeds
 4
 5
 7
 8
+test4_inline succeeds
Index: tests/hard_coded/purity.m
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/purity.m,v
retrieving revision 1.2
diff -u -r1.2 purity.m
--- purity.m	1997/12/12 05:31:42	1.2
+++ purity.m	1998/01/06 03:34:52
@@ -12,18 +12,22 @@
 	impure test1,
 	impure test2,
 	impure test3,
+	impure test4,
 	impure test1_inline,
 	impure test2_inline,
-	impure test3_inline.
+	impure test3_inline,
+	impure test4_inline.
 
 
 :- impure pred test1(io__state::di, io__state::uo) is det.
 :- impure pred test2(io__state::di, io__state::uo) is det.
 :- impure pred test3(io__state::di, io__state::uo) is det.
+:- impure pred test4(io__state::di, io__state::uo) is det.
 
 :- impure pred test1_inline(io__state::di, io__state::uo) is det.
 :- impure pred test2_inline(io__state::di, io__state::uo) is det.
 :- impure pred test3_inline(io__state::di, io__state::uo) is det.
+:- impure pred test4_inline(io__state::di, io__state::uo) is det.
 
 
 :- impure pred set_x(int::in) is det.
@@ -80,8 +84,21 @@
 	    io__format("%d\n", [i(Y)])
 	).
 
+% regression test for problem with calls to implied modes of impure/semipure
+% preds reporting spurious warnings about impurity markers in the wrong place.
+test4 -->
+	{ semipure get_x(OldX) },
+	{ impure incr_x },
+	(   { semipure get_x(OldX+1) } ->
+		io__write_string("test4 succeeds\n")
+	;   io__write_string("test4 fails\n")
+	),
+	{ impure set_x(OldX) }.
+
+
 %  Now do it all again with inlining requested
 
+% tempt compiler to optimize away duplicate semipure goals.
 test1_inline -->
 	{ semipure get_x_inline(X) },
 	io__format("%d\n", [i(X)]),
@@ -89,7 +106,6 @@
 	{ semipure get_x_inline(Y) },
 	io__format("%d\n", [i(Y)]).
 
-
 % tempt compiler to optimize away duplicate impure goals, or to compile away
 % det goals with no outputs.
 test2_inline -->
@@ -106,3 +122,13 @@
 	    io__format("%d\n", [i(Y)])
 	).
 
+% regression test for problem with calls to implied modes of impure/semipure
+% preds reporting spurious warnings about impurity markers in the wrong place.
+test4_inline -->
+	{ semipure get_x_inline(OldX) },
+	{ impure incr_x_inline },
+	(   { semipure get_x_inline(OldX+1) } ->
+		io__write_string("test4_inline succeeds\n")
+	;   io__write_string("test4_inline fails\n")
+	),
+	{ impure set_x_inline(OldX) }.
Index: tests/invalid/purity_nonsense.err_exp
===================================================================
RCS file: /home/staff/zs/imp/tests/invalid/purity_nonsense.err_exp,v
retrieving revision 1.1
diff -u -r1.1 purity_nonsense.err_exp
--- purity_nonsense.err_exp	1997/12/09 04:02:45	1.1
+++ purity_nonsense.err_exp	1998/01/06 05:39:41
@@ -7,6 +7,8 @@
 purity_nonsense.m:012:   without preceding `pred' declaration.
 purity_nonsense.m:013: Error: clause for predicate `purity_nonsense:e13/0'
 purity_nonsense.m:013:   without preceding `pred' declaration.
+purity_nonsense.m:018: Warning: unnecessary `impure' marker.
+purity_nonsense.m:018:   Higher-order goals are always pure.
 purity_nonsense.m:008: Error: no clauses for predicate `purity_nonsense:undefined/0'
 purity_nonsense.m:012: In clause for predicate `purity_nonsense:e12/0':
 purity_nonsense.m:012:   in argument 1 of call to predicate `impure/1':
@@ -40,4 +42,6 @@
 purity_nonsense.m:013:   error: undefined symbol `semi/0'.
 purity_nonsense.m:013: In clause for predicate `purity_nonsense:e13/0':
 purity_nonsense.m:013:   error: `semipure' marker in an inappropriate place.
+purity_nonsense.m:015: In predicate `purity_nonsense:e14/1':
+purity_nonsense.m:015:   warning: declared `impure' but actually pure.
 For more information, try recompiling with `-E'.
Index: tests/invalid/purity_nonsense.m
===================================================================
RCS file: /home/staff/zs/imp/tests/invalid/purity_nonsense.m,v
retrieving revision 1.1
diff -u -r1.1 purity_nonsense.m
--- purity_nonsense.m	1997/12/09 04:02:47	1.1
+++ purity_nonsense.m	1998/01/06 05:39:29
@@ -12,3 +12,7 @@
 e12 :- impure (\+ impure imp).
 e13 :- semipure (\+ semipure semi).
 
+:- impure pred e14(pred).
+:- mode e14(((pred) is semidet)) is semidet.
+
+e14(P) :- impure call(P).