diff: cc disj bug fix

[Fergus Henderson]

Fix a bug reported by Renaud Paquay <rpa at miscrit.be> where the
compiler got an internal compiler error for certain disjunctions
in single-solution contexts, e.g. ones with the first two disjuncts
`det' and third disjunct `cc_multi'.

compiler/det_analysis.m:
	In det_infer_disj, replace `at_most_many' with `at_most_many_cc'
	if in a single-solution context.  This is also done by det_infer_goal,
	but it needs to be done here too, to avoid calling error/1 in
	det_disjunction_maxsoln.

tests/hard_coded/Mmakefile:
tests/hard_coded/cc_multi_bug.m:
tests/hard_coded/cc_multi_bug.exp:
	Test case for the above-mentioned bug.

Index: compiler/det_analysis.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_analysis.m,v
retrieving revision 1.136
diff -u -r1.136 det_analysis.m
--- det_analysis.m	1998/10/20 15:06:45	1.136
+++ det_analysis.m	1998/10/23 14:53:54
@@ -327,7 +327,8 @@
 	determinism_components(InternalDetism, InternalCanFail, InternalSolns),
 
 	(
-		% If a goal with multiple solutions has no output variables,
+		% If a pure or semipure goal with multiple solutions
+		% has no output variables,
 		% then it really it has only one solution
 		% (we will need to do pruning)
 
@@ -784,8 +785,15 @@
 	determinism_components(Detism1, CanFail1, MaxSolns1),
 	det_disjunction_canfail(CanFail0, CanFail1, CanFail2),
 	det_disjunction_maxsoln(MaxSolns0, MaxSolns1, MaxSolns2),
+	% if we're in a single-solution context,
+	% convert `at_most_many' to `at_most_many_cc'
+	( SolnContext = first_soln, MaxSolns2 = at_most_many ->
+		MaxSolns3 = at_most_many_cc
+	;
+		MaxSolns3 = MaxSolns2
+	),
 	det_infer_disj(Goals0, InstMap0, SolnContext, DetInfo, CanFail2,
-		MaxSolns2, Goals1, Detism, Msgs2),
+		MaxSolns3, Goals1, Detism, Msgs2),
 	list__append(Msgs1, Msgs2, Msgs).
 
 :- pred det_infer_switch(list(case), instmap, soln_context, det_info,
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/Mmakefile,v
retrieving revision 1.44
diff -u -r1.44 Mmakefile
--- Mmakefile	1998/10/20 15:07:05	1.44
+++ Mmakefile	1998/10/23 15:03:09
@@ -13,8 +13,9 @@
 	bigtest \
 	boyer \
 	c_write_string \
-	cc_nondet_disj \
 	cc_and_non_cc_test \
+	cc_nondet_disj \
+	cc_multi_bug \
 	common_type_cast \
 	construct \
 	curry \
Index: tests/hard_coded/cc_multi_bug.exp
===================================================================
RCS file: cc_multi_bug.exp
diff -N cc_multi_bug.exp
--- /dev/null	Wed May 28 10:49:58 1997
+++ cc_multi_bug.exp	Sat Oct 24 01:08:14 1998
@@ -0,0 +1,2 @@
+zero
+s(zero)
Index: tests/hard_coded/cc_multi_bug.m
===================================================================
RCS file: cc_multi_bug.m
diff -N cc_multi_bug.m
--- /dev/null	Wed May 28 10:49:58 1997
+++ cc_multi_bug.m	Sat Oct 24 01:02:47 1998
@@ -0,0 +1,28 @@
+:- module cc_multi_bug.
+
+:- interface.
+
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+:- import_module io.
+
+:- type nat ---> zero ; s(nat).
+
+:- pred plus(nat,nat,nat).
+:- mode plus(out,out,in) is multi.
+:- mode plus(out,out,in) is cc_multi.
+
+plus(zero,zero,zero).
+plus(zero,s(N),s(N)).
+plus(s(N),zero,s(N)).
+plus(s(N1),s(N2),s(N3)):-
+	plus(N1,s(N2),N3).
+
+
+main -->
+        {plus(N1,N2,s(zero))},
+	print(N1), nl,
+	print(N2), nl.
+

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