for review: add promise_only_solution/1 to builtin.m ;-)

[Fergus Henderson]

OK, let's have another go at that...
This time it's in builtin.m.

--------------------

Estimated hours taken: 0.5

library/builtin.m:
	Add `promise_only_solution/1'.

NEWS:
	Mention this addition.

Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.122
diff -u -r1.122 NEWS
--- NEWS	1998/10/20 02:02:29	1.122
+++ NEWS	1998/11/06 01:44:48
@@ -306,6 +306,11 @@
 Changes to the Mercury standard library:
 ****************************************
 
+* There is also a new builtin function promise_only_soln/1,
+  for calling `cc_multi' or `cc_nondet' code from `det' or `semidet'
+  procedures.  See the "builtin" chapter of the Mercury Library
+  Reference Manual for details.
+
 * The getopt module now supports a new type of option data, namely
   `maybe_int(maybe(int))', to allow optional arguments with integer values.
   There is also a new corresponding lookup predicate,
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.7
diff -u -r1.7 builtin.m
--- builtin.m	1998/11/05 03:53:13	1.7
+++ builtin.m	1998/11/06 02:04:07
@@ -116,10 +116,39 @@
 % It is used to work around limitations in the current support for unique
 % modes.  `unsafe_promise_unique(X, Y)' is the same as `Y = X' except that
 % the compiler will assume that `Y' is unique.
+%
+% Note that misuse of this predicate may lead to unsound results:
+% if there is more than one reference to the data in question,
+% i.e. it is not `unique', then the behaviour is undefined.
+% (If you lie to the compiler, the compiler will get its revenge!)
 
 :- pred unsafe_promise_unique(T, T).
 :- mode unsafe_promise_unique(in, uo) is det.
 
+%-----------------------------------------------------------------------------%
+
+% A call to the function `promise_only_solution(Pred)' constitutes a
+% promise on the part of the caller that `Pred' has at most one solution,
+% i.e. that `not some [X1, X2] (Pred(X1), Pred(X2), X1 \= X2)'.
+% `promise_only_solution(Pred)' presumes that this assumption is
+% satisfied, and returns the X for which Pred(X) is true, if
+% there is one.
+%
+% You can use `promise_only_solution' as a way of 
+% introducing `cc_multi' or `cc_nondet' code inside a
+% `det' or `semidet' procedure.
+%
+% Note that misuse of this function may lead to unsound results:
+% if the assumption is not satisfied, the behaviour is undefined.
+% (If you lie to the compiler, the compiler will get its revenge!)
+
+:- func promise_only_solution(pred(T)) = T.
+:- mode promise_only_solution(pred(out) is cc_multi) = out is det.
+:- mode promise_only_solution(pred(out) is cc_nondet) = out is semidet.
+
+%-----------------------------------------------------------------------------%
+
+
 % We define !/0 (and !/2 for dcgs) to be equivalent to `true'.  This is for
 % backwards compatibility with Prolog systems.  But of course it only works
 % if all your cuts are green cuts.
@@ -176,6 +205,24 @@
 
 :- implementation.
 :- import_module require, string, std_util, int, float, char, string, list.
+
+%-----------------------------------------------------------------------------%
+
+promise_only_solution(Pred) = OutVal :-
+        call(cc_cast(Pred), OutVal).
+
+:- func cc_cast(pred(T)) = pred(T).
+:- mode cc_cast(pred(out) is cc_nondet) = out(pred(out) is semidet) is det.
+:- mode cc_cast(pred(out) is cc_multi) = out(pred(out) is det) is det.
+
+:- pragma c_code(cc_cast(X::(pred(out) is cc_multi)) =
+                        (Y::out(pred(out) is det)),
+                [will_not_call_mercury, thread_safe],
+                "Y = X;").
+:- pragma c_code(cc_cast(X::(pred(out) is cc_nondet)) =
+                        (Y::out(pred(out) is semidet)),
+                [will_not_call_mercury, thread_safe],
+                "Y = 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.