diff: var.m bug fix

[Fergus Henderson]

extras/trailed_update/var.m:
	Fix a bug in the code for detecting floundering.
	Improve the error message for floundering slightly
	(print out how many floundered goals there are).

extras/trailed_update/Mmakefile:
	Add an `mmake check' target.

extras/trailed_update/samples/tests.exp:
	Update the expected test output to reflect the new
	floundering error message.

cvs diff extras/trailed_update/Mmakefile extras/trailed_update/samples/tests.exp extras/trailed_update/var.m
Index: extras/trailed_update/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/Mmakefile,v
retrieving revision 1.2
diff -u -r1.2 Mmakefile
--- Mmakefile	1997/10/06 18:44:54	1.2
+++ Mmakefile	1997/10/06 18:48:10
@@ -15,5 +15,8 @@
 
 depend : trailed_update.depend
 
+check : libtrailed_update
+	cd samples && mmake $(MMAKEFLAGS) check
+
 # We need this to use shared libraries on Linux
 ML = ml --mercury-libs shared
Index: extras/trailed_update/var.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/var.m,v
retrieving revision 1.4
diff -u -r1.4 var.m
--- var.m	1997/10/06 18:44:58	1.4
+++ var.m	1997/10/07 11:44:40
@@ -389,6 +389,7 @@
 	/* impure */ get_last_delayed_goal(LastGoal),
 	LastGoal = goal(_, _LastWoken, LastPrev, _LastNext),
 	Goal = goal(Pred, no, LastPrev, LastGoal),
+	setarg(LastPrev, 4, Goal),		       % LastPrev->next := Goal
 	/* impure */ set_last_delayed_goal_prev(Goal). % LastGoal->prev := Goal
 
 /* impure */
@@ -403,7 +404,7 @@
 	%
 	/* impure */ setarg(Goal, 2, yes),	% Goal->woken := yes
 	/* impure */ setarg(Next, 3, Prev),	% Next->prev := Prev
-	/* impure */ setarg(Prev, 3, Next),	% Prev->next := Next
+	/* impure */ setarg(Prev, 4, Next),	% Prev->next := Next
 	%
 	% Call it.
 	%
@@ -423,6 +424,9 @@
 
 :- pragma c_code("
 
+static void
+ML_var_report_goal_floundered(ML_var_delayed_conj *old_goal);
+
 void
 ML_var_untrail_func(ML_var_delayed_conj *old_goal, MR_untrail_reason reason)
 {
@@ -453,10 +457,7 @@
 			** can't commit, so the goal flounders.
 			*/
 			if (old_goal != ML_var_last_goal.prev) {
-				/* XXX should improve error message */
-				fflush(stdout);
-				fprintf(stderr, ""var.m: warning: ""
-					""goal floundered.\n"");
+				report_goal_floundered(old_goal);
 			}
 			break;
 
@@ -466,6 +467,26 @@
 	}
 }
 
+static void
+ML_var_report_goal_floundered(ML_var_delayed_conj *old_goal)
+{
+	ML_var_delayed_conj *last = ML_var_last_goal.prev;
+	int num_delayed_goals;
+
+	/* XXX should improve error message */
+	fflush(stdout);
+	fprintf(stderr, ""var.m: warning: goal floundered.\n"");
+
+	num_delayed_goals = 0; 
+	while (last && last != old_goal) {
+		if (!last->woken) {
+			num_delayed_goals++;
+		}
+		last = last->prev;
+	}
+	fprintf(stderr, ""       %d outstanding delayed goal%s.\n"",
+		num_delayed_goals, (num_delayed_goals == 1 ? """" : ""s""));
+}
 ").
 
 %-----------------------------------------------------------------------------%
Index: extras/trailed_update/samples/tests.exp
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/samples/tests.exp,v
retrieving revision 1.1
diff -u -r1.1 tests.exp
--- tests.exp	1997/10/06 18:46:57	1.1
+++ tests.exp	1997/10/07 08:05:13
@@ -1,12 +1,15 @@
 test_delaying_1: no
 test_delaying_2: yes
 var.m: warning: goal floundered.
+       1 outstanding delayed goal.
 X = alias(free(<delayed goal>))
 Y = alias(free)
 test_delaying_1: no
 test_delaying_2: yes
 test_delaying_3: var.m: warning: goal floundered.
+       1 outstanding delayed goal.
 yes: X = alias(free(<delayed goal>)), Y = alias(free)
 test_delaying_4: var.m: warning: goal floundered.
+       1 outstanding delayed goal.
 yes: X = alias(free(<delayed goal>))
 Done.
-- 
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.