[m-dev.] for review: add extras/exceptions

[Tyson Dowd]

On 22-Jul-1998, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> Anyone care to review this one?
> 

Sure.

> --------------------
> 
> Add support for exception handling, in extras/exceptions.
> 
> extras/exceptions/README:
> 	Describes the files in this directory.
> 
> extras/exceptions/exception.m:
> 	Contains the exception handling interface and implementation.
> 
> extras/exceptions/test_exceptions.m:
> extras/exceptions/test_exceptions.exp:
> extras/exceptions/test_uncaught_exception.m:
> extras/exceptions/test_uncaught_exception.exp:
> extras/exceptions/test_exceptions_func.m:
> extras/exceptions/test_exceptions_func.exp:
> 	Test cases.
> 
> extras/exceptions/Mmakefile:
> 	The Mmakefile for building and running the test cases.
> 

> Index: extras/exceptions/exception.m
> ===================================================================
> RCS file: exception.m
> diff -N exception.m
> --- /dev/null	Wed Jul 22 04:55:53 1998
> +++ exception.m	Wed Jul 22 04:33:51 1998
> @@ -0,0 +1,1108 @@
> +%-----------------------------------------------------------------------------%
> +% Copyright (C) 1997-1998 The University of Melbourne.
> +% This file may only be copied under the terms of the GNU Library General
> +% Public License - see the file COPYING.LIB in the Mercury distribution.
> +%-----------------------------------------------------------------------------%
> +
> +% File: exception.m.
> +% Main author: fjh.
> +% Stability: low
> +
> +% This file contains experimental code for exception handling.
> +
> +% Note that throwing an exception across the C interface won't work --
> +% if you try to do that, you will get undefined behaviour.
> +

Please explain "across the C interface" a little better.

> +%-----------------------------------------------------------------------------%
> +
> +% Since this module is implemented using C code with `BEGIN_MODULE()'
> +% and `END_MODULE', and because it is not part of the standard library,
> +% to use this module you need the following two lines in your Mmakefile:
> +%
> +%	RM_C=:
> +%	C2INITFLAGS=$($(subst _init.c,,$@).cs)
> +%
> +% This ensures that the module initialization code will be run.
> +% (Actually these two lines are needed only in certain grades, e.g.
> +% for profiling.)

One for the wishlist -- make this cleaner.

> +%
> +:- pred try_io(pred(T, io__state, io__state), exception_result(T),
> +						io__state, io__state).
> +:- mode try_io(pred(out, di, uo) is det,      out(cannot_fail),
> +						di, uo) is cc_multi.
> +:- mode try_io(pred(out, di, uo) is cc_multi, out(cannot_fail),
> +						di, uo) is cc_multi.
> +

I find this ugly.

:- pred try_io(pred(T, io__state, io__state),
			exception_result(T), io__state, io__state).
:- mode try_io(pred(out, di, uo) is det,
			out(cannot_fail), di, uo) is cc_multi.
:- mode try_io(pred(out, di, uo) is cc_multi,
			out(cannot_fail), di, uo) is cc_multi.

Perhaps this is a little easier to read?  (not much, I admit!).

> +
> +% The functors in this type must be in the same order as the
> +% enumeration constants in the C enum `ME_Determinism' defined below.
> +:- type determinism
> +	--->	det
> +	;	semidet
> +	;	cc_multi
> +	;	cc_nondet
> +	;	multi
> +	;	nondet
> +	;	erroneous
> +	;	failure.

Another one for the wish list -- better foreign data type interfaces
(actually, that's already on the wish list.  Let's underline it). 

> +
> +:- pred get_determinism(pred(T), determinism).
> +:- mode get_determinism(pred(out) is det,     out(bound(det)))     is cc_multi.
> +:- mode get_determinism(pred(out) is semidet, out(bound(semidet))) is cc_multi.
> +:- mode get_determinism(pred(out) is multi, out(bound(multi)))     is cc_multi.
> +:- mode get_determinism(pred(out) is nondet, out(bound(nondet)))   is cc_multi.
> +:- mode get_determinism(pred(out) is cc_multi, out(bound(cc_multi)))
> +								  is cc_multi.
> +:- mode get_determinism(pred(out) is cc_nondet, out(bound(cc_nondet)))
> +								  is cc_multi.
> +

Tricky!  I like it.

> +:- pred get_determinism_2(pred(T, io__state, io__state), 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)))
> +	is cc_multi.
> +
> +% Unfortunately the only way to implement get_determinism/2 is to use
> +% the C interface.

Is this because the wishlist item "different code for different mode"
isn't done yet? 

> +
> +rethrow(exception(Univ)) :-
> +	builtin_throw(Univ).
> +rethrow(succeeded(_)) :-
> +	error("rethrow/1: invalid argument").
> +rethrow(failed) :-
> +	error("rethrow/1: invalid argument").

More informative error messages please.

rethrow(succeeded(_)) :-
	error("rethrow/1: invalid argument: succeeded(_)").
rethrow(failed) :-
	error("rethrow/1: invalid argument: failed").

Would it make sense to have rethrow(in(bound(exception(...)))) and
avoid these (or rather, force the caller to avoid these?

> +:- pragma no_inline(try_io/5).
> +try_io(det, IO_Goal, Result) -->
> +	{ Goal = (pred(R::out) is det :-
> +		very_unsafe_perform_io(IO_Goal, R)) },
> +	{ try(det, Goal, Result) }.
> +try_io(cc_multi, IO_Goal, Result) -->
> +	{ Goal = (pred(R::out) is cc_multi :-
> +		very_unsafe_perform_io(IO_Goal, R)) },
> +	{ try(cc_multi, Goal, Result) }.
> +

I love the name 'very_unsafe_perform_io'

> +:- pred very_unsafe_perform_io(pred(T, io__state, io__state), T).
> +:- mode very_unsafe_perform_io(pred(out, di, uo) is det, out) is det.
> +:- mode very_unsafe_perform_io(pred(out, di, uo) is cc_multi, out)
> +								is det.
> +% Mercury doesn't support impure higher-order pred terms, so if we want
> +% to form a closure from unsafe_perform_io, as we need to do above,
> +% then we must (falsely!) promise that it is pure.
> +:- pragma promise_pure(very_unsafe_perform_io/2). % XXX this is a lie
> +

I can find no mention of this limitation of purity anywhere (reference
manual, LIMITATIONS, purity.m).  It would be good to be in all three.
(How many wishes to do I get?).

> +Declare_label(mercury__exception__builtin_catch_3_2_i1);
> +Declare_label(mercury__exception__builtin_catch_3_2_i2);
> +Declare_label(mercury__exception__builtin_catch_3_3_i1);
> +Declare_label(mercury__exception__builtin_catch_3_3_i2);
> +Declare_label(mercury__exception__builtin_catch_3_5_i1);
> +Declare_label(mercury__exception__builtin_catch_3_5_i2);
> +#ifdef MR_USE_TRAIL
> +  Declare_label(mercury__exception__builtin_catch_3_5_i3);
> +#endif
> +#ifndef COMPACT_ARGS
> +  Declare_label(mercury__exception__builtin_throw_1_0_i1);
> +  Declare_label(mercury__exception__builtin_throw_1_0_i2);
> +  Declare_label(mercury__exception__builtin_throw_1_0_i3);
> +#endif
> +

Please add MR_MAKE_STACK_LAYOUT_ENTRY(...) and
MR_MAKE_STACK_LAYOUT_INTERNAL(...) for all these labels.

> +Define_entry(mercury__exception__builtin_catch_3_0); /* det */
> +#ifdef PROFILE_CALLS
> +{
> +	tailcall(ENTRY(mercury__exception__builtin_catch_3_2), 
> +		ENTRY(mercury__exception__builtin_catch_3_0));
> +}
> +#endif
> +Define_entry(mercury__exception__builtin_catch_3_2); /* cc_multi */

Once upone a time PROFILE_CALLS was the only code that needed this,
but it's now useful for stack traces (e.g. debug grade) so we should
probably change the name of this macro and have PROFILE_CALLS imply
the new name.

(No, I don't have any suggestions on a good name at the moment).

> +#ifdef COMPACT_ARGS
> +	FRAMEVARS->handler = r3;	/* save the Handler closure */
> +#else
> +	FRAMEVARS->handler = r4;	/* save the Handler closure */
> +#endif

I prefer the approach of
	#ifdef COMPACT_ARGS
	  #define handler_reg r3
	#else
	  #define handler_reg r4
	#endif
particularly as you have more conditional code below.

Actually, COMPACT_ARGS makes a real mess of all this code.  Are you
sure we need to support it?

> +	/*
> +	** Reset the heap.  But we need to be careful to preserve the
> +	** thrown exception object.
> +	**
> +	** The following algorithm uses the `solutions heap', and will work
> +	** with non-conservative gc. We copy the exception object to the
> +	** solutions_heap, reset the heap pointer, and then copy it back.
> +	**
> +	** An improvement to this would be to copy the exception object to the
> +	** solutions heap, but have deep_copy add an offset to the pointers
> +	** (at least, those that would otherwise point to the solutions heap),
> +	** so that, when finished, a block move of the solutions heap back to
> +	** the real heap will leave all the pointers in the correct place.
> +	*/

It corresponds quite closely to copying a data item and leaving
forwarding pointers.  Except the forwarding pointers are left in the
copy, not the original, and they point to the final destination.
I think it's just SMOP.

> Index: extras/exceptions/test_exceptions.exp
> ===================================================================
> RCS file: test_exceptions.exp
> diff -N test_exceptions.exp
> --- /dev/null	Wed Jul 22 04:55:53 1998
> +++ test_exceptions.exp	Wed Jul 22 00:13:21 1998
> @@ -0,0 +1,17 @@
> +det_throw: exception(univ("det_throw" : string))
> +det_succeed: succeeded("det_succeed")
> +semidet_throw: exception(univ("semidet_throw" : string))
> +semidet_succeed: succeeded("semidet_succeed")
> +semidet_fail: failed
> +cc_multi_throw: exception(univ("cc_multi_throw" : string))
> +cc_multi_succeed: succeeded("cc_multi_succeed")
> +cc_nondet_throw: exception(univ("cc_nondet_throw" : string))
> +cc_nondet_succeed: succeeded("cc_nondet_succeed")
> +cc_nondet_fail: failed
> +multi_throw: exception(univ("multi_throw" : string))
> +multi_succeed: succeeded(["multi_succeed 1", "multi_succeed 2"])
> +multi_succeed_then_throw: exception(univ("multi_succeed_then_throw 3" : string))
> +nondet_throw: exception(univ("nondet_throw" : string))
> +nondet_succeed: succeeded(["nondet_succeed 1", "nondet_succeed 2"])
> +nondet_fail: succeeded([])
> +nondet_succeed_then_throw: exception(univ("nondet_succeed_then_throw 3" : string))
> Index: extras/exceptions/test_exceptions.m
> ===================================================================
> RCS file: test_exceptions.m
> diff -N test_exceptions.m
> --- /dev/null	Wed Jul 22 04:55:53 1998
> +++ test_exceptions.m	Wed Jul 22 00:13:18 1998
> @@ -0,0 +1,161 @@
> +%---------------------------------------------------------------------------%
> +% Copyright (C) 1997-1998 The University of Melbourne.
> +% This file may only be copied under the terms of the GNU Library General
> +% Public License - see the file COPYING.LIB in the Mercury distribution.
> +%---------------------------------------------------------------------------%
> +
> +% File: test_exceptions.m.
> +% Main author: fjh.
> +
> +% Test cases for exception handling.
> +
> +% XXX we should test nested exception handlers.

XXX and with nested calls to solutions in non-conservative GC grades.

> +
> +%-----------------------------------------------------------------------------%
> +
> +:- module test_exceptions.
> +:- interface.
> +:- import_module io.
> +
> +:- pred main(io__state::di, io__state::uo) is cc_multi.
> +
> +:- implementation.
> +:- import_module std_util.
> +:- import_module exception.
> +
> +main --> 
> +	{ try(det_throw, DetThrowResult) },
> +	print("det_throw: "), print(DetThrowResult), nl,
> +	{ try(det_succeed, DetSucceedResult) },
> +	print("det_succeed: "), print(DetSucceedResult), nl,
> +
> +	(if { try(semidet_throw, SemidetThrowResult) } then
> +		print("semidet_throw: "), print(SemidetThrowResult), nl
> +	else
> +		print("semidet_throw failed"), nl
> +	),
> +	(if { try(semidet_succeed, SemidetSucceedResult) } then
> +		print("semidet_succeed: "), print(SemidetSucceedResult), nl
> +	else
> +		print("semidet_succeed failed"), nl
> +	),
> +	(if { try(semidet_fail, SemidetFailResult) } then
> +		print("semidet_fail: "), print(SemidetFailResult), nl
> +	else
> +		print("semidet_fail failed"), nl
> +	),
> +
> +	{ try(cc_multi_throw, CCMultiThrowResult) },
> +	print("cc_multi_throw: "), print(CCMultiThrowResult), nl,
> +	{ try(cc_multi_succeed, CCMultiSucceedResult) },
> +	print("cc_multi_succeed: "), print(CCMultiSucceedResult), nl,
> +
> +	(if { try(cc_nondet_throw, CCNondetThrowResult) } then
> +		print("cc_nondet_throw: "), print(CCNondetThrowResult), nl
> +	else
> +		print("cc_nondet_throw failed"), nl
> +	),
> +	(if { try(cc_nondet_succeed, CCNondetSucceedResult) } then
> +		print("cc_nondet_succeed: "), print(CCNondetSucceedResult), nl
> +	else
> +		print("cc_nondet_succeed failed"), nl
> +	),
> +	(if { try(cc_nondet_fail, CCNondetFailResult) } then
> +		print("cc_nondet_fail: "), print(CCNondetFailResult), nl
> +	else
> +		print("cc_nondet_fail failed"), nl
> +	),
> +
> +	{ try((pred(R::out) is det :- solutions(multi_throw, R)),
> +		MultiThrowResult) },
> +	print("multi_throw: "), print(MultiThrowResult), nl,
> +	{ try((pred(R::out) is det :- solutions(multi_succeed, R)),
> +		MultiSucceedResult) },
> +	print("multi_succeed: "), print(MultiSucceedResult), nl,
> +	{ try((pred(R::out) is det :-
> +			solutions(multi_succeed_then_throw, R)),
> +		MultiSucceedThenThrowResult) },
> +	print("multi_succeed_then_throw: "),
> +	print(MultiSucceedThenThrowResult), nl,
> +
> +	{ try((pred(R::out) is det :- solutions(nondet_throw, R)),
> +		NondetThrowResult) },
> +	print("nondet_throw: "), print(NondetThrowResult), nl,
> +	{ try((pred(R::out) is det :- solutions(nondet_succeed, R)),
> +		NondetSucceedResult) },
> +	print("nondet_succeed: "), print(NondetSucceedResult), nl,
> +	{ try((pred(R::out) is det :- solutions(nondet_fail, R)),
> +		NondetFailResult) },
> +	print("nondet_fail: "), print(NondetFailResult), nl,
> +	{ try((pred(R::out) is det :-
> +			solutions(nondet_succeed_then_throw, R)),
> +		NondetSucceedThenThrowResult) },
> +	print("nondet_succeed_then_throw: "),
> +	print(NondetSucceedThenThrowResult), nl.
> +
> +:- pred det_throw(string::out) is det.
> +det_throw(_) :- throw("det_throw").
> +
> +:- pred semidet_throw(string::out) is semidet.
> +semidet_throw(_) :- throw("semidet_throw").
> +
> +:- pred nondet_throw(string::out) is nondet.
> +nondet_throw(_) :- throw("nondet_throw").
> +
> +:- pred multi_throw(string::out) is multi.
> +multi_throw(_) :- throw("multi_throw").
> +
> +:- pred cc_nondet_throw(string::out) is cc_nondet.
> +cc_nondet_throw(_) :- throw("cc_nondet_throw").
> +
> +:- pred cc_multi_throw(string::out) is cc_multi.
> +cc_multi_throw(_) :- throw("cc_multi_throw").
> +
> +
> +:- pred det_succeed(string::out) is det.
> +det_succeed("det_succeed").
> +
> +:- pred semidet_succeed(string::out) is semidet.
> +semidet_succeed("semidet_succeed").
> +
> +:- pred nondet_succeed(string::out) is nondet.
> +nondet_succeed("nondet_succeed 1").
> +nondet_succeed("nondet_succeed 2").
> +
> +:- pred multi_succeed(string::out) is multi.
> +multi_succeed("multi_succeed 1").
> +multi_succeed("multi_succeed 2").
> +
> +:- pred cc_nondet_succeed(string::out) is cc_nondet.
> +cc_nondet_succeed("cc_nondet_succeed").
> +cc_nondet_succeed("cc_nondet_succeed 2").
> +
> +:- pred cc_multi_succeed(string::out) is cc_multi.
> +cc_multi_succeed("cc_multi_succeed").
> +cc_multi_succeed("cc_multi_succeed 2").
> +
> +
> +:- pred semidet_fail(string::out) is semidet.
> +semidet_fail("semidet_fail") :- fail.
> +
> +:- pred nondet_fail(string::out) is nondet.
> +nondet_fail("nondet_fail 1") :- fail.
> +nondet_fail("nondet_fail 2") :- fail.
> +
> +:- pred cc_nondet_fail(string::out) is cc_nondet.
> +cc_nondet_fail("cc_nondet_fail") :- fail.
> +cc_nondet_fail("cc_nondet_succeed 2") :- fail.

Is that right?  
Shouldn't it be "cc_nondet_fail 1" and  "cc_nondet_fail 2"

(hopefully it will always pick the same one and we won't need
a non-det testcase).

Otherwise this seems fine, although I'm not completely confident with
the handwritten nondet code sections -- testing nested exceptions is
definitely a good idea.

It's fine to commit.

-- 
       Tyson Dowd           # "Bill Gates is a white persian cat and a monocle
                            # away from becoming another James Bond villan."
     trd at cs.mu.oz.au        # "No Mr Bond, I expect you to upgrade."
http://www.cs.mu.oz.au/~trd #                -- Dennis Miller and Terri Branch