diff: impurity bug fixes

[Fergus Henderson]

I'll commit this now, but of course anyone who wants should
feel free to review it.

Estimated hours taken: 1.5

Fix a couple of bugs related to pruning of impure goals with no output
variables.

compiler/det_analysis.m:
	Fix a bug: the compiler was automatically inserting pruning
	across impure goals with no output variables.  That should
	happen only for pure or semipure goals.  To prevent pruning
	in those cases, I changed it so that impure goals with no
	output variables are not considered single-solution contexts.

doc/reference_manual.texi:
	Document the above-mentioned change.

compiler/clause_to_proc.m:
	Fix a bug: when converting a bunch of clauses into a disjunction,
	clause_to_proc.m was not computing the proper purity annotation
	on the goal_info for the disjunction.

tests/hard_coded/Mmakefile:
tests/hard_coded/impure_prune.m:
tests/hard_coded/impure_prune.exp:
	A test case for the above-mentioned changes to det_analysis.m
	and clause_to_proc.m.

Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.22
diff -u -r1.22 clause_to_proc.m
--- clause_to_proc.m	1998/08/04 14:56:06	1.22
+++ clause_to_proc.m	1998/10/20 14:56:40
@@ -50,7 +50,7 @@
 
 :- implementation.
 
-:- import_module hlds_goal, hlds_data, prog_data, mode_util, make_hlds.
+:- import_module hlds_goal, hlds_data, prog_data, mode_util, make_hlds, purity.
 :- import_module globals.
 :- import_module int, set, map.
 
@@ -141,11 +141,16 @@
 	( GoalList = [SingleGoal] ->
 		Goal = SingleGoal
 	;
-		% Construct a goal_info for the disjunction.
+		%
+		% Convert the list of clauses into a disjunction,
+		% and construct a goal_info for the disjunction.
+		%
+
+		%
 		% We use the context of the first clause, unless
 		% there weren't any clauses at all, in which case
 		% we use the context of the mode declaration.
-		% The non-local vars are just the head variables.
+		%
 		goal_info_init(GoalInfo0),
 		( GoalList = [FirstGoal | _] ->
 			FirstGoal = _ - FirstGoalInfo,
@@ -154,12 +159,39 @@
 			proc_info_context(Proc0, Context)
 		),
 		goal_info_set_context(GoalInfo0, Context, GoalInfo1),
+
+		%
+		% The non-local vars are just the head variables.
+		%
 		set__list_to_set(HeadVars, NonLocalVars),
-		goal_info_set_nonlocals(GoalInfo1, NonLocalVars, GoalInfo),
+		goal_info_set_nonlocals(GoalInfo1, NonLocalVars, GoalInfo2),
+
+		%
+		% The disjunction is impure/semipure if any of the disjuncts
+		% is impure/semipure.
+		%
+		(
+			list__member(_SubGoal - SubGoalInfo, GoalList),
+			\+ goal_info_is_pure(SubGoalInfo)
+		->
+			list__map(get_purity, GoalList, PurityList),
+			list__foldl(worst_purity, PurityList, (pure), Purity),
+			add_goal_info_purity_feature(GoalInfo2, Purity,
+				GoalInfo)
+		;
+			GoalInfo2 = GoalInfo
+		),
+
 		map__init(Empty),
 		Goal = disj(GoalList, Empty) - GoalInfo
 	),
 	proc_info_set_body(Proc0, VarSet, VarTypes, HeadVars, Goal, Proc).
+
+:- pred get_purity(hlds_goal, purity).
+:- mode get_purity(in, out) is det.
+
+get_purity(_Goal - GoalInfo, Purity) :-
+	infer_goal_info_purity(GoalInfo, Purity).
 
 :- pred select_matching_clauses(list(clause), proc_id, list(clause)).
 :- mode select_matching_clauses(in, in, out) is det.
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.135
diff -u -r1.135 det_analysis.m
--- det_analysis.m	1998/09/10 06:38:21	1.135
+++ det_analysis.m	1998/10/20 14:25:56
@@ -119,7 +119,7 @@
 
 :- implementation.
 
-:- import_module prog_data, det_report.
+:- import_module prog_data, det_report, purity.
 :- import_module type_util, modecheck_call, mode_util, options, passes_aux.
 :- import_module hlds_out, mercury_to_mercury.
 :- import_module assoc_list, bool, map, set, require, term.
@@ -294,10 +294,14 @@
 	goal_info_get_nonlocals(GoalInfo0, NonLocalVars),
 	goal_info_get_instmap_delta(GoalInfo0, DeltaInstMap),
 
-	% If a goal has no output variables, then the goal is in
-	% single-solution context
+	% If a pure or semipure goal has no output variables,
+	% then the goal is in single-solution context
 
-	( det_no_output_vars(NonLocalVars, InstMap0, DeltaInstMap, DetInfo) ->
+	(
+		det_no_output_vars(NonLocalVars, InstMap0, DeltaInstMap,
+			DetInfo),
+		\+ goal_info_is_impure(GoalInfo0)
+	->
 		OutputVars = no,
 		SolnContext = first_soln
 	;
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.105
diff -u -r1.105 reference_manual.texi
--- reference_manual.texi	1998/09/28 06:26:54	1.105
+++ reference_manual.texi	1998/10/20 14:08:37
@@ -1646,7 +1646,8 @@
 and the maximum number of solutions of the goal (0, 1, or more).
 If the inference process below reports that a goal can succeed more than once,
 but the goal generates no outputs that are visible from outside the goal,
-the final determinism of the goal
+and the goal is not impure (@pxref{Impurity}),
+then the final determinism of the goal
 will be based on the goal succeeding at most once,
 since the compiler will implicitly prune away any duplicate solutions.
 
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.43
diff -u -r1.43 Mmakefile
--- Mmakefile	1998/10/01 07:41:24	1.43
+++ Mmakefile	1998/10/20 14:23:12
@@ -51,6 +51,7 @@
 	ho_solns \
 	ho_univ_to_type \
 	impossible_unify \
+	impure_prune \
 	integer_test \
 	merge_and_remove_dups \
 	minint_bug \
Index: tests/hard_coded/impure_prune.exp
===================================================================
RCS file: impure_prune.exp
diff -N impure_prune.exp
--- /dev/null	Wed Oct 21 00:13:20 1998
+++ impure_prune.exp	Wed Oct 21 00:58:15 1998
@@ -0,0 +1 @@
+X = 3
Index: tests/hard_coded/impure_prune.m
===================================================================
RCS file: impure_prune.m
diff -N impure_prune.m
--- /dev/null	Wed Oct 21 00:13:20 1998
+++ impure_prune.m	Wed Oct 21 00:21:10 1998
@@ -0,0 +1,40 @@
+:- module impure_prune.
+:- interface.
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module int, require.
+
+:- pragma promise_pure(main/2).
+
+main -->
+	( { impure do_impure_stuff, fail } ->
+		{ error("not reached") }
+	;
+		{ semipure get_counter(X) },
+		print("X = "), print(X), nl
+	).
+
+:- impure pred do_impure_stuff is multi.
+do_impure_stuff :-
+	impure bump_counter.
+do_impure_stuff :-
+	impure bump_counter.
+do_impure_stuff :-
+	impure bump_counter.
+
+:- impure pred bump_counter is det.
+bump_counter :-
+	semipure get_counter(X),
+	impure set_counter(X + 1).
+
+:- semipure pred get_counter(int::out) is det.
+:- impure pred set_counter(int::in) is det.
+
+:- pragma c_header_code("extern Integer counter;").
+:- pragma c_code("Integer counter = 0;").
+:- pragma c_code(get_counter(X::out), will_not_call_mercury, "X = counter;").
+:- pragma c_code(set_counter(X::in), will_not_call_mercury, "counter = X;").
+

-- 
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.