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

[Fergus Henderson]

On 22-Jul-1998, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> > Would it make sense to have rethrow(in(bound(exception(...)))) and
> > avoid these (or rather, force the caller to avoid these?
> 
> I thought about that.  But often you will want to write
> 
> 	( Exception = 

Oops, incomplete thought.  Yes, it probably would make sense to do it
that way.  I shall.

Here's a relative diff from last time.  I will commit this one.

===================================================================
RCS file: RCS/Mmakefile,v
retrieving revision 1.2
diff -u -r1.2 Mmakefile
--- Mmakefile	1998/07/22 13:50:45	1.2
+++ Mmakefile	1998/07/22 13:40:42
@@ -1,14 +1,5 @@
 #-----------------------------------------------------------------------------#
 #
-# the following two lines are required for exception.m
-# (see the comment at the top of exception.m)
-#
-
-RM_C=:
-C2INITFLAGS=$($(subst _init.c,,$@).cs)
-
-#-----------------------------------------------------------------------------#
-#
 # These rules define the main targets: depend, all, check.
 #
 
@@ -19,6 +10,16 @@
 depend: $(PROGS:.m=.depend)
 all: $(PROGS:.m=)
 check: $(PROGS:.m=.res)
+
+#-----------------------------------------------------------------------------#
+#
+# the following lines are required for exception.m
+# (see the comment at the top of exception.m)
+#
+
+RM_C=:
+C2INITFLAGS=--extra-inits
+$(PROGS:.m=_init.c): $(PROGS:.m=.c) exception.c
 
 #-----------------------------------------------------------------------------#
 #
===================================================================
RCS file: RCS/exception.m,v
retrieving revision 1.17
diff -u -r1.17 exception.m
--- exception.m	1998/07/21 18:35:19	1.17
+++ exception.m	1998/07/22 14:20:17
@@ -10,21 +10,23 @@
 
 % 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.
+% Note that throwing an exception across the C interface won't work.
+% That is, if a Mercury procedure that is exported to C using `pragma export'
+% throws an exception which is not caught within that procedure, then
+% you will get undefined behaviour.
 
 %-----------------------------------------------------------------------------%
 
-% 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:
+% To compile this module you need the following two lines in your Mmakefile:
 %
 %	RM_C=:
-%	C2INITFLAGS=$($(subst _init.c,,$@).cs)
+%	C2INITFLAGS=--extra-inits
 %
-% This ensures that the module initialization code will be run.
-% (Actually these two lines are needed only in certain grades, e.g.
-% for profiling.)
+% You also need to add dependencies to ensure that Mmake knows that
+% the *_init.c files depend on the *.c files.
+%
+% This ensures that the module initialization code for this module will be run.
+% (Actually these steps are needed only in certain grades, e.g. for profiling.)
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -87,12 +89,12 @@
 %		; Result = exception(_)
 %		).
 %
-:- 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.
+:- 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.
 
 %
 % try_all(Goal, ResultList):
@@ -150,10 +152,10 @@
 %	not `succeeded(_)' or `failed'.).
 %
 :- pred rethrow(exception_result(T)).
-:- mode rethrow(in) is erroneous.
+:- mode rethrow(in(bound(exception(ground)))) is erroneous.
 
 :- func rethrow(exception_result(T)) = _.
-:- mode rethrow(in) = out is erroneous.
+:- mode rethrow(in(bound(exception(ground)))) = out is erroneous.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -215,7 +217,8 @@
 	is cc_multi.
 
 % Unfortunately the only way to implement get_determinism/2 is to use
-% the C interface.
+% the C interface, since Mercury doesn't allow different code for different
+% modes.
 
 % The enumeration constants in this enum must be in the same order as the
 % functors in the Mercury type `determinism' defined above.
@@ -292,10 +295,6 @@
 
 rethrow(exception(Univ)) :-
 	builtin_throw(Univ).
-rethrow(succeeded(_)) :-
-	error("rethrow/1: invalid argument").
-rethrow(failed) :-
-	error("rethrow/1: invalid argument").
 
 rethrow(ExceptionResult) = _ :-
 	rethrow(ExceptionResult).
@@ -345,8 +344,11 @@
 		wrap_exception, Result0),
 	cc_multi_equal(Result0, Result).
 try(cc_multi, Goal, Result) :-
-	builtin_catch((pred(R::out) is cc_multi :-
-				wrap_success_or_failure(Goal, R)),
+
+	builtin_catch(
+		(pred(R::out) is cc_multi :-
+				wrap_success_or_failure(Goal, R)
+				),
 		wrap_exception, Result).
 try(cc_nondet, Goal, Result) :-
 	builtin_catch((pred(R::out) is cc_multi :-
@@ -539,6 +541,31 @@
   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
+
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__exception__builtin_catch_3_0)
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__exception__builtin_catch_3_1)
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__exception__builtin_catch_3_2)
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__exception__builtin_catch_3_3)
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__exception__builtin_catch_3_4)
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__exception__builtin_catch_3_5)
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__exception__builtin_throw_1_0)
+MR_MAKE_STACK_LAYOUT_ENTRY(exception_handler_do_fail)
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__exception__builtin_catch_3_0)
+
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__builtin_catch_3_2, 1)
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__builtin_catch_3_2, 2)
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__builtin_catch_3_3, 1)
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__builtin_catch_3_3, 2)
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__builtin_catch_3_5, 1)
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__builtin_catch_3_5, 2)
+#ifdef MR_USE_TRAIL
+  MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__builtin_catch_3_5, 3)
+#endif
+#ifndef COMPACT_ARGS
+  MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__builtin_throw_1_0, 1)
+  MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__builtin_throw_1_0, 2)
+  MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__builtin_throw_1_0, 3)
 #endif
 
 BEGIN_MODULE(exceptions_module)
===================================================================
RCS file: RCS/test_exceptions.m,v
retrieving revision 1.5
diff -u -r1.5 test_exceptions.m
--- test_exceptions.m	1998/07/18 17:15:32	1.5
+++ test_exceptions.m	1998/07/22 14:09:59
@@ -10,6 +10,7 @@
 % Test cases for exception handling.
 
 % XXX we should test nested exception handlers.
+% XXX we should also test exceptions with nested calls to solutions/2.
 
 %-----------------------------------------------------------------------------%
 
@@ -29,42 +30,28 @@
 	{ 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(semidet_throw, SemidetThrowResult) },
+	print("semidet_throw: "), print(SemidetThrowResult), nl,
+
+	{ try(semidet_succeed, SemidetSucceedResult) },
+	print("semidet_succeed: "), print(SemidetSucceedResult), nl,
+
+	{ try(semidet_fail, SemidetFailResult) },
+	print("semidet_fail: "), print(SemidetFailResult), 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(cc_nondet_throw, CCNondetThrowResult) },
+	print("cc_nondet_throw: "), print(CCNondetThrowResult), nl,
+
+	{ try(cc_nondet_succeed, CCNondetSucceedResult) },
+	print("cc_nondet_succeed: "), print(CCNondetSucceedResult), nl,
+
+	{ try(cc_nondet_fail, CCNondetFailResult) },
+	print("cc_nondet_fail: "), print(CCNondetFailResult), nl,
 
 	{ try((pred(R::out) is det :- solutions(multi_throw, R)),
 		MultiThrowResult) },
@@ -143,8 +130,8 @@
 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.
+cc_nondet_fail("cc_nondet_fail 1") :- fail.
+cc_nondet_fail("cc_nondet_fail 2") :- fail.
 
 
 :- pred nondet_succeed_then_throw(string::out) is nondet.
===================================================================
RCS file: RCS/test_exceptions_func.m,v
retrieving revision 1.4
diff -u -r1.4 test_exceptions_func.m
===================================================================
RCS file: RCS/test_uncaught_exception.m,v
retrieving revision 1.1
diff -u -r1.1 test_uncaught_exception.m
===================================================================
RCS file: RCS/test_exceptions.exp,v
retrieving revision 1.2
diff -u -r1.2 test_exceptions.exp
===================================================================
RCS file: RCS/test_exceptions_func.exp,v
retrieving revision 1.2
diff -u -r1.2 test_exceptions_func.exp
===================================================================
RCS file: RCS/test_uncaught_exception.exp,v
retrieving revision 1.1
diff -u -r1.1 test_uncaught_exception.exp

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