[m-dev.] for review: add exception__try_store

[Fergus Henderson]

For the main branch only, not the release branch.

----------

Estimated hours taken: 2.5

library/exception.m:
	Add new predicate `try_store'.
	This is like `try_io', but for stores.

tests/hard_coded/exceptions/Mmakefile:
tests/hard_coded/exceptions/tricky_try_store.m:
tests/hard_coded/exceptions/tricky_try_store.exp:
	Add a test case for `try_store'.

NEWS:
	Mention the new predicate.

Workspace: /home/hg/fjh/mercury
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.43
diff -u -d -r1.43 exception.m
--- library/exception.m	2001/02/04 04:10:34	1.43
+++ library/exception.m	2001/02/21 16:01:58
@@ -19,7 +19,7 @@
 %-----------------------------------------------------------------------------%
 :- module exception.
 :- interface.
-:- import_module std_util, list, io.
+:- import_module std_util, list, io, store.
 
 %
 % throw(Exception):
@@ -84,6 +84,17 @@
 		out(cannot_fail), di, uo) is cc_multi.
 
 %
+% try_store(Goal, Result, Store_0, Store):
+%    Just like try_io, but for stores rather than io__states.
+%
+:- pred try_store(pred(T, store(S), store(S)),
+		exception_result(T), store(S), store(S)).
+:- mode try_store(pred(out, di, uo) is det,     
+		out(cannot_fail), di, uo) is cc_multi.
+:- mode try_store(pred(out, di, uo) is cc_multi,
+		out(cannot_fail), di, uo) is cc_multi.
+
+%
 % try_all(Goal, ResultList):
 %    Operational semantics:
 %	Try to find all solutions to Goal(R), using backtracking.
@@ -165,6 +176,13 @@
 :- mode try_io(in(bound(cc_multi)), pred(out, di, uo) is cc_multi,
 				    out(cannot_fail), di, uo) is cc_multi.
 
+:- pred try_store(determinism, 	    pred(T, store(S), store(S)),
+				    exception_result(T), store(S), store(S)).
+:- mode try_store(in(bound(det)),   pred(out, di, uo) is det,
+				    out(cannot_fail), di, uo) is cc_multi.
+:- mode try_store(in(bound(cc_multi)), pred(out, di, uo) is cc_multi,
+				    out(cannot_fail), di, uo) is cc_multi.
+
 :- pred try_all(determinism,        pred(T), list(exception_result(T))).
 :- mode try_all(in(bound(det)),	    pred(out) is det, 
 				    	     out(try_all_det)) is cc_multi.
@@ -198,7 +216,7 @@
 :- mode get_determinism(pred(out) is cc_nondet, out(bound(cc_nondet)))
 								  is cc_multi.
 
-:- pred get_determinism_2(pred(T, io__state, io__state), determinism).
+:- pred get_determinism_2(pred(T, S, S), determinism).
 :- mode get_determinism_2(pred(out, di, uo) is det,      out(bound(det)))
 	is cc_multi.
 :- mode get_determinism_2(pred(out, di, uo) is cc_multi, out(bound(cc_multi)))
@@ -476,6 +494,54 @@
 				wrap_success(Goal, R)),
 			wrap_exception, Result)),
 		AccPred, Acc0, Acc).
+
+% We need to switch on the Detism argument
+% for the same reason as above.
+
+try_store(StoreGoal, Result) -->
+	{ get_determinism_2(StoreGoal, Detism) },
+	try_store(Detism, StoreGoal, Result).
+
+	% Store0 is not really unique in the calls to unsafe_promise_unique
+	% below, since it is also used in the calls to handle_store_result.
+	% But it is safe to treat it as if it were unique, because the
+	% other reference is only used in the case when an exception is
+	% thrown, and in that case the declarative semantics of this
+	% predicate say that the final store returned is unspecified.
+try_store(det, StoreGoal, Result, Store0, Store) :-
+	Goal = (pred({R, S}::out) is det :-
+		unsafe_promise_unique(Store0, S0),
+		StoreGoal(R, S0, S)),
+	try(det, Goal, Result0),
+	handle_store_result(Result0, Result, Store0, Store).
+try_store(cc_multi, StoreGoal, Result, Store0, Store) :-
+	Goal = (pred({R, S}::out) is cc_multi :-
+		unsafe_promise_unique(Store0, S0),
+		StoreGoal(R, S0, S)),
+	try(cc_multi, Goal, Result0),
+	handle_store_result(Result0, Result, Store0, Store).
+
+:- pred handle_store_result(exception_result({T, store(S)})::in(cannot_fail),
+		exception_result(T)::out(cannot_fail),
+		store(S)::in, store(S)::uo) is det.
+handle_store_result(Result0, Result, Store0, Store) :-
+	(
+		Result0 = succeeded({Res, S1}),
+		Result = succeeded(Res),
+		% S1 is now unique because the only other reference to the
+		% store was from Store0, which we're throwing away here
+		unsafe_promise_unique(S1, Store)
+	;
+		Result0 = exception(E0),
+		% We need to make a copy of the exception object, in case
+		% it contains a value returned from store__extract_ref_value.
+		% See tests/hard_coded/exceptions/tricky_try_store.m.
+		copy(E0, E),
+		Result = exception(E),
+		% Store0 is now unique because the only other reference to
+		% the store was from the goal which just threw an exception.
+		unsafe_promise_unique(Store0, Store)
+	).
 
 try_io(IO_Goal, Result) -->
 	{ get_determinism_2(IO_Goal, Detism) },
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.201
diff -u -d -r1.201 NEWS
--- NEWS	2001/02/19 10:41:47	1.201
+++ NEWS	2001/02/21 16:08:22
@@ -1,3 +1,15 @@
+NEWS since Mercury release 0.10
+-------------------------------
+Note that Mercury 0.10 has not actually been officially announced;
+this section documents changes in the development version of
+Mercury since we established a feature freeze for Mercury 0.10
+and split development of that version off onto a separate branch
+of our CVS repository (the `version-0_10_y' branch).
+
+Changes to the Mercury standard library:
+* The exception module has a new predicate `try_store', which is
+  like `try_io', but which works with stores rather than io__states.
+
 NEWS for Mercury release 0.10:
 ------------------------------
 
Index: tests/hard_coded/exceptions/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/exceptions/Mmakefile,v
retrieving revision 1.6
diff -u -d -r1.6 Mmakefile
--- tests/hard_coded/exceptions/Mmakefile	2001/01/10 05:27:53	1.6
+++ tests/hard_coded/exceptions/Mmakefile	2001/02/21 16:03:26
@@ -13,11 +13,17 @@
 -include ../../Mmake.params
 
 PROGS = test_exceptions.m test_uncaught_exception.m test_exceptions_func.m \
-	test_try_all.m
+	test_try_all.m tricky_try_store.m
 #
 # XXX the following tests are not enabled because we do not pass them yet:
 #	test_memo.m test_loop_check.m
 #       (those two tests test the combination of tabling and exceptions).
+#
+# Also currently the compiler has a bug where it generates
+# static ground terms even for things with `di' modes;
+# tricky_try_store.m contains a work-around for that,
+# which should be deleted once that bug is fixed.
+#
 
 depend: $(PROGS:.m=.depend)
 all: $(PROGS:.m=)
Index: tests/hard_coded/exceptions/tricky_try_store.exp
===================================================================
RCS file: tricky_try_store.exp
diff -N tricky_try_store.exp
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ tricky_try_store.exp	Thu Feb 22 02:52:05 2001
@@ -0,0 +1,3 @@
+Result = exception(univ_cons(["initial"]))
+Result = exception(univ_cons(["initial"]))
+Val = ["updated"]
Index: tests/hard_coded/exceptions/tricky_try_store.m
===================================================================
RCS file: tricky_try_store.m
diff -N tricky_try_store.m
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ tricky_try_store.m	Thu Feb 22 03:04:35 2001
@@ -0,0 +1,54 @@
+% There is one tricky aspect with exception__try_store.  If we're not
+% careful, the user could use `store__extract_ref_value', which destroys
+% the store and extracts the referenced value without making a copy.
+% The user could then throw the extracted value, and if the handler gets
+% both the extracted value and a unique version of the store, then it
+% can update the reference, which would modify the extracted value,
+% breaking referential transparency.
+%
+% In other words, with a naive implementation of `try_store',
+% the following program could print out 
+% 
+% 	Result = exception(initial)
+% 	Result = exception(updated)
+% 
+% To avoid this, the implementation of try_store must make a copy of the
+% thrown object before returning it from try_store.
+%
+% This test case checks that the implementation of try_store does the
+% right thing in this tricky case.
+
+:- module tricky_try_store.
+:- interface.
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+:- import_module exception, store, list.
+
+:- pred tricky(store__ref(T, S), int, store(S), store(S)).
+:- mode tricky(in, out, di, uo) is det.
+
+tricky(Key, _Output, Store0, _Store) :-
+	store__extract_ref_value(Store0, Key, Value),
+	throw(Value).
+
+main -->
+	{ store__new(Store0) },
+	{ store__new_ref(mklist("initial"), Key, Store0, Store1) },
+	{ store__arg_ref(Key, 0, SubKey, Store1, Store2) },
+	{ exception__try_store(tricky(Key), Result, Store2, Store3) },
+	print("Result = "), print(Result), nl,
+	{ store__set_ref_value(SubKey, "updated", Store3, Store) },
+	print("Result = "), print(Result), nl,
+	{ store__extract_ref_value(Store, Key, Val) },
+	print("Val = "), print(Val), nl.
+
+% XXX the current compiler has a bug whereby it generates static ground terms
+%     even for things that are used in `di' modes.  To avoid that bug,
+%     we use the following hack -- a `pragma no_inline' function --
+%     to ensure that `["initial"]' doesn't get stored as a static constant.
+:- func mklist(T) = list(T).
+:- mode mklist(di) = uo is det.
+:- pragma no_inline(mklist/1).
+mklist(X) = [X].

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------