for review: add promise_only_solution/1 to std_util.m

[Fergus Henderson]

Hi, 

Could someone please review this?

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

Estimated hours taken: 0.5

library/std_util.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:05:34
@@ -306,6 +306,10 @@
 Changes to the Mercury standard library:
 ****************************************
 
+* There is also a new function promise_only_soln/1 in the std_util module,
+  for calling `cc_multi' or `cc_nondet' code from `det' or `semidet'
+  procedures.
+
 * 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/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.133
diff -u -r1.133 std_util.m
--- std_util.m	1998/11/05 16:35:26	1.133
+++ std_util.m	1998/11/06 01:11:18
@@ -197,6 +197,29 @@
 
 %-----------------------------------------------------------------------------%
 
+	% A call to `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.
+
+%-----------------------------------------------------------------------------%
+
 	% The `type_info' and `type_ctor_info' types: these
 	% provide access to type information.
 	% A type_info represents a type, e.g. `list(int)'.
@@ -948,6 +971,25 @@
 		"Y = X;").
 :- pragma c_code(cc_multi_equal(X::di, Y::uo), will_not_call_mercury,
 		"Y = X;").
+
+%-----------------------------------------------------------------------------%
+
+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;").
+
 %-----------------------------------------------------------------------------%
 
 	% The type `std_util:type_info/0' happens to use much the same

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