[m-dev.] for review: fix bug in unique mode checking

[Fergus Henderson]

On 09-Apr-1999, Peter Schachte <schachte at cs.mu.OZ.AU> wrote:
> [Fergus wrote:]
> > My first inclination is to say oh well, never mind,
> > and to just comment out that part of that test case.
> > 
> > Would anyone object to that?
> 
> That sounds OK to me.  The warning in question seems a bit of a "gee
> whiz" feature:  maybe a bit too clever.  I think it's just about as
> likely to be annoying as it is to be helpful.

OK, I will go ahead and commit this one now.

Estimated hours taken: 1.5

Perform some minor simplifications in mode analysis,
so as to provide more information to unique mode analysis.
Previously unique_modes.m was reporting spurious errors
for tests/hard_coded/bidirectional.m, because modes.m
produced output containing a subgoal of the form
`disj([Goal, conj([disj([])]])' instead of just `Goal',
and the presence of a disjunction then caused unique mode
analysis to make overly conservative assumptions.

compiler/modes.m:
	Ensure that we do not produce singleton conjunctions or disjunctions.
	Also, if the result of mode checking a disjunct is a (nested)
	disjunction, then merge it with the containing disjunction.
	If the nested disjunction is the empty disjunction (fail),
	then this means it will be deleted.

tests/hard_coded/Mmakefile:
	Re-enable the test case bidirectional.m, since the compiler now
	accepts it, due to the above change.

tests/warnings/simple_code.m:
tests/warnings/simple_code.exp:
	Update this test case, because the above change meant that the
	compiler no longer issues the warning about "this disjunct can
	never succeed" in cases like this -- mode analysis will already
	have optimized it away, before we even get to simplify.m (which
	handles those kinds of warnings).  This warning is not as
	important as allowing bidirectional code.

Index: tests/warnings/simple_code.exp
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/simple_code.exp,v
retrieving revision 1.3
diff -u -r1.3 simple_code.exp
--- simple_code.exp	1998/08/25 10:26:26	1.3
+++ simple_code.exp	1999/04/16 08:00:01
@@ -10,5 +10,4 @@
 simple_code.m:033: Warning: the negated goal cannot succeed.
 simple_code.m:038: 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.
Index: tests/warnings/simple_code.m
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/simple_code.m,v
retrieving revision 1.3
diff -u -r1.3 simple_code.m
--- simple_code.m	1998/06/17 05:14:15	1.3
+++ simple_code.m	1999/04/16 07:54:55
@@ -57,6 +57,8 @@
 obsolete.
 
 % This should give a warning about the second disjunct never succeeding.
+% XXX Currently it doesn't, because mode analysis simplifies away the
+% whole disjunction.
 :- pred r(int, int).
 :- mode r(in(bound(1)), out(bound(42))) is det.
 
***************************************************************************
The following parts of the diff are the same as last time I posted them.
***************************************************************************

Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.228
diff -u -r1.228 modes.m
--- modes.m	1998/11/20 04:08:33	1.228
+++ modes.m	1999/04/08 19:39:54
@@ -925,12 +925,13 @@
 	compute_instmap_delta(InstMap0, InstMap, NonLocals, DeltaInstMap),
 	goal_info_set_instmap_delta(GoalInfo0, DeltaInstMap, GoalInfo).
 
-modecheck_goal_expr(conj(List0), _GoalInfo0, conj(List)) -->
+modecheck_goal_expr(conj(List0), GoalInfo0, Goal) -->
 	mode_checkpoint(enter, "conj"),
 	( { List0 = [] } ->	% for efficiency, optimize common case
-		{ List = [] }
+		{ Goal = conj([]) }
 	;
-		modecheck_conj_list(List0, List)
+		modecheck_conj_list(List0, List),
+		{ conj_list_to_goal(List, GoalInfo0, Goal - _GoalInfo) }
 	),
 	mode_checkpoint(exit, "conj").
 
@@ -961,16 +962,17 @@
 	instmap__unify(NonLocals, InstMapNonlocalList),
 	mode_checkpoint(exit, "par_conj").
 
-modecheck_goal_expr(disj(List0, SM), GoalInfo0, disj(List, SM)) -->
+modecheck_goal_expr(disj(List0, SM), GoalInfo0, Goal) -->
 	mode_checkpoint(enter, "disj"),
 	( { List0 = [] } ->	% for efficiency, optimize common case
-		{ List = [] },
+		{ Goal = disj(List0, SM) },
 		{ instmap__init_unreachable(InstMap) },
 		mode_info_set_instmap(InstMap)
 	;
 		{ goal_info_get_nonlocals(GoalInfo0, NonLocals) },
 		modecheck_disj_list(List0, List, InstMapList),
-		instmap__merge(NonLocals, InstMapList, disj)
+		instmap__merge(NonLocals, InstMapList, disj),
+		{ disj_list_to_goal(List, GoalInfo0, Goal - _GoalInfo) }
 	),
 	mode_checkpoint(exit, "disj").
 
@@ -1450,12 +1452,19 @@
 :- mode modecheck_disj_list(in, out, out, mode_info_di, mode_info_uo) is det.
 
 modecheck_disj_list([], [], []) --> [].
-modecheck_disj_list([Goal0 | Goals0], [Goal | Goals], [InstMap | InstMaps]) -->
+modecheck_disj_list([Goal0 | Goals0], Goals, [InstMap | InstMaps]) -->
 	mode_info_dcg_get_instmap(InstMap0),
 	modecheck_goal(Goal0, Goal),
 	mode_info_dcg_get_instmap(InstMap),
 	mode_info_set_instmap(InstMap0),
-	modecheck_disj_list(Goals0, Goals, InstMaps).
+	modecheck_disj_list(Goals0, Goals1, InstMaps),
+	%
+	% If Goal is a nested disjunction,
+	% then merge it with the outer disjunction.
+	% If Goal is `fail', this will delete it.
+	%
+	{ goal_to_disj_list(Goal, DisjList) },
+	{ list__append(DisjList, Goals1, Goals) }.
 
 :- pred modecheck_case_list(list(case), prog_var, list(case), list(instmap),
 				mode_info, mode_info).
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.56
diff -u -r1.56 Mmakefile
--- Mmakefile	1999/04/16 07:52:01	1.56
+++ Mmakefile	1999/04/16 08:03:14
@@ -9,6 +9,7 @@
 PROGS=	\
 	address_of_builtins \
 	agg \
+	bidirectional \
 	bigtest \
 	boyer \
 	c_write_string \
@@ -94,8 +95,6 @@
 
 # we do no pass the following tests
 #	var_not_found -- "sorry, not implemented" in polymorphism.m.
-#	bidirectional -- unique mode analysis is overly conservative
-#		and thus rejects this test case.
 
 #-----------------------------------------------------------------------------#
 
-- 
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.