diff: extras/trailed_update/var.m changes

[Fergus Henderson]

Hi,

You have seen part of this before.  But I decided to add a test case
before committing, and then the test case discovered a couple of bugs,
so there are now a few more changes...

extras/trailed_update/var.m:
	Add new predicate var__is_ground/2.
	Also fix a bug: it was not handling unifications between
	already-aliased variables correctly.

extras/trailed_update/samples/tests.m:
	Add some more test cases.

cvs diff: Diffing .
Index: var.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/var.m,v
retrieving revision 1.7
diff -u -u -r1.7 var.m
--- var.m	1997/11/11 10:25:54	1.7
+++ var.m	1997/11/13 16:08:15
@@ -97,6 +97,25 @@
 	% dump_var prints out a representation of a variable.
 :- pred dump_var(var(T)::in(any), io__state::di, io__state::uo) is cc_multi.
 
+	% var__is_ground/2 can be used to test if a variable is ground.
+	%
+	% Declaratively, is_ground(Var, Result) is true iff
+	% either Result = no or Var = var(Value) and Result = yes(Value);
+	% that is, it is equivalent to the following clauses:
+	%
+	%	is_ground(var(Value), yes(Value)).
+	%	is_ground(_, no).
+	%
+	% Operationally, is_ground(Var, Result) returns Result = no
+	% if Var is non-ground, and Result = yes(Value) if Var is ground;
+	% that is, execution will select the first clause if the variable
+	% is ground, and the second clause if the variable is non-ground.
+	%
+	% Beware that is_ground is, and must be, `cc_multi';
+	% making it `det' would not be safe.
+
+:- pred is_ground(var(T)::in(any), maybe(T)::out) is cc_multi.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 :- implementation.
@@ -322,6 +341,32 @@
 		wakeup_delayed_goals(DelayedGoals, Value)
 	).
 
+:- pragma c_code( is_ground(Var::in(any), Result::out) /* cc_multi */,
+	may_call_mercury,
+"
+	ML_var_is_ground(TypeInfo_for_T, Var, &Result);
+").
+
+:- pred var__rep_is_ground(var_rep(T), maybe(T)).
+:- mode var__rep_is_ground(in(ptr(var_rep_any)), out) is det.
+:- pragma export(var__rep_is_ground(in(ptr(var_rep_any)), out),
+	"ML_var_is_ground").
+var__rep_is_ground(VarPtr, Result) :-
+	VarPtr = alias(Var),
+	( 
+		Var = alias(_),
+		var__rep_is_ground(Var, Result)
+	;
+		Var = ground(Value),
+		Result = yes(Value)
+	;
+		Var = free,
+		Result = no
+	;
+		Var = free(_DelayedGoals),
+		Result = no
+	).
+
 %-----------------------------------------------------------------------------%
 
 %
@@ -739,8 +784,11 @@
 		var__rep_unify(X, YPtr)
 	;
 		X = free,
-		% would it be better to deref YPtr here?
-		destructively_update_binding(XPtr, YPtr)
+		( var__identical(XPtr, YPtr) ->
+			true
+		;
+			destructively_update_binding(XPtr, YPtr)
+		)
 	;
 		X = ground(_),
 		var__rep_unify_gr(X, YPtr)
@@ -792,10 +840,26 @@
 	;
 		Y = free(YGoals),
 		X = free(XGoals),
-		XY = free((XGoals, YGoals)),
-		destructively_update_binding(XPtr, XY),
-		destructively_update_binding(YPtr, XY)
+		( identical(XPtr, YPtr) ->
+			true
+		;
+			XY = free((XGoals, YGoals)),
+			destructively_update_binding(XPtr, XY),
+			destructively_update_binding(YPtr, XY)
+		)
 	).
+
+%-----------------------------------------------------------------------------%
+
+/* impure */
+:- pred identical(var_rep(T), var_rep(T)).
+:- mode identical(in(ptr(var_rep_any)), in(ptr(var_rep_any))) is semidet.
+
+:- pragma c_code(identical(X::in(ptr(var_rep_any)), Y::in(ptr(var_rep_any))),
+		will_not_call_mercury,
+"{
+	SUCCESS_INDICATOR = (X == Y);
+}").
 
 %-----------------------------------------------------------------------------%
 
cvs diff: Diffing samples
Index: samples/tests.exp
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/samples/tests.exp,v
retrieving revision 1.2
diff -u -u -r1.2 tests.exp
--- tests.exp	1997/10/07 11:48:04	1.2
+++ tests.exp	1997/11/13 16:54:08
@@ -2,14 +2,23 @@
 test_delaying_2: yes
 var.m: warning: goal floundered.
        1 outstanding delayed goal.
-X = alias(free(<delayed goal>))
-Y = alias(free)
+X = alias(free(<delayed goal>)) [ground: no]
+Y = alias(free) [ground: no]
 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)
+yes: X = alias(free(<delayed goal>)) [ground: no], Y = alias(free) [ground: no]
 test_delaying_4: var.m: warning: goal floundered.
        1 outstanding delayed goal.
-yes: X = alias(free(<delayed goal>))
+yes: X = alias(free(<delayed goal>)) [ground: no]
+test_ground:
+Z = alias(ground(42)) [ground: yes(42)]
+Z2 = alias(alias(alias(ground(42)))) [ground: yes(42)]
+test_alias_twice:
+A = alias(free) [ground: no]
+B = alias(free) [ground: no]
+test_dup_call_bug:
+A1 = alias(ground(42)) [ground: yes(42)]
+A2 = alias(free) [ground: no]
 Done.
Index: samples/tests.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/samples/tests.m,v
retrieving revision 1.1
diff -u -u -r1.1 tests.m
--- tests.m	1997/10/06 18:46:58	1.1
+++ tests.m	1997/11/13 17:10:46
@@ -36,8 +36,8 @@
 	),
 
 	( { create_solvable_delayed_goal(X, Y) } ->
-		print("X = "), dump_var(X), nl,
-		print("Y = "), dump_var(Y), nl
+		print("X = "), output_var(X), nl,
+		print("Y = "), output_var(Y), nl
 	;
 		print("Oops.\n")
 	),
@@ -57,19 +57,47 @@
 
 	print("test_delaying_3: "),
 	( { create_solvable_delayed_goal(X3, Y3) } ->
-		print("yes: X = "), dump_var(X3),
-		print(", Y = "), dump_var(Y3), nl
+		print("yes: X = "), output_var(X3),
+		print(", Y = "), output_var(Y3), nl
 	;
 		print("no"), nl
 	),
 	print("test_delaying_4: "),
 	( { create_unsolvable_delayed_goal(X4) } ->
-		print("yes: X = "), dump_var(X4), nl
+		print("yes: X = "), output_var(X4), nl
 	;
 		print("no"), nl
 	),
+	print("test_ground:"), nl,
+	{ Z = var(42) },
+	print("Z = "), output_var(Z), nl,
+	( { var__init(Z2), var__init(Z3), Z2 = Z3, Z3 = Z } ->
+		print("Z2 = "), output_var(Z2), nl
+	;
+		print("oops"), nl
+	),
+	print("test_alias_twice:"), nl,
+	( { A == B, A = B } ->
+		print("A = "), output_var(A), nl,
+		print("B = "), output_var(B), nl
+	;
+		print("oops"), nl
+	),
+	print("test_dup_call_bug:"), nl,
+	( { var__init(A1), var__init(A2), A1 = var(42) } ->
+		print("A1 = "), output_var(A1), nl,
+		print("A2 = "), output_var(A2), nl
+	;
+		print("oops"), nl
+	),
 	print("Done.\n").
 
+:- mode output_var(in(any), di, uo) is cc_multi.
+output_var(Var) -->
+	dump_var(Var),
+	{ var__is_ground(Var, MaybeVal) },
+	print(" [ground: "), write(MaybeVal), print("]").
+
 test_delaying_1 :-
 	create_solvable_delayed_goal(X, Y),
 	wake_and_fail(X, Y).
@@ -86,7 +114,7 @@
 
 wake_and_succeed(var(0), var(1)).  % 1 = 0 + 1 succeeds
 %	unsafe_perform_io(print("Y = ")),
-%	unsafe_perform_io(dump_var(Y)),
+%	unsafe_perform_io(output_var(Y)),
 %	unsafe_perform_io(nl).
 
 wake_and_fail(var(0), var(42)). % 42 = 0 + 1 fails.

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