[m-dev.] question about exception.m and also mode-specific clauses

[Fergus Henderson]

On 17-Aug-2001, Tyson Dowd <trd at miscrit.be> wrote:
> On 17-Aug-2001, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> > On 17-Aug-2001, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> > > One way to solve this is by writing each mode-specific clause so that
> > > it contains a disjunction, with the only difference between the clauses
> > > for different modes being that the disjuncts are in a different order.
> > 
> > Forgot to mention that this will solve *both* the warning
> > *and* the problem that the semantics of different modes don't match.
> 
> I'm not sure I fully understand what you are proposing.
> 
> Something like:
> 
> get_determinism(_Pred::(pred(out) is det), det::out(bound(det))).
> get_determinism(_Pred::(pred(out) is det), det::out(bound(semidet))).
> get_determinism(_Pred::(pred(out) is det), det::out(bound(nondet))).
> get_determinism(_Pred::(pred(out) is det), det::out(bound(cc_multi))).
> get_determinism(_Pred::(pred(out) is det), det::out(bound(multi))).

No.  I was thinking of something like

	get_determinism(_Pred::(pred(out) is det), Det::out(bound(det))) :-
		( Det = det
		% these are unreachable
		; Det = erroneous
		; Det = multi
		; Det = cc_multi
		; Det = failure
		; Det = semidet
		; Det = nondet
		; Det = cc_nondet
		).
	get_determinism(_Pred::(pred(out) is semidet),
			Det::out(bound(semidet))) :-
		( Det = semidet
		% these are unreachable
		; Det = erroneous
		; Det = det
		; Det = multi
		; Det = cc_multi
		; Det = failure
		; Det = nondet
		; Det = cc_nondet
		).
	... etc.

Or more simply, abstracting out the common code:

	get_determinism(_Pred::(pred(out) is det), Det::out(bound(det))) :-
		( Det = det
		; is_det(Det)
		).
	get_determinism(_Pred::(pred(out) is semidet),
			Det::out(bound(semidet))) :-
		( Det = semidet
		; is_det(Det)
		).
	... etc. ...

	is_det(erroneous).
	is_det(det).
	is_det(multi).
	is_det(cc_multi).
	is_det(failure).
	is_det(semidet).
	is_det(nondet).
	is_det(cc_nondet).

Or even more simply:

	get_determinism(_Pred::(pred(out) is det), Det::out(bound(det))) :-
		( Det = det
		; true
		).
	get_determinism(_Pred::(pred(out) is semidet),
			Det::out(bound(semidet))) :-
		( Det = semidet
		; true
		).
	... etc. ...

However, those don't actually work; you get a mode error because `Det' isn't
bound to the right subtype in the unreachable disjuncts.

To make it work, you need to put a call to error/1 instead of is_det/1 or
true/0.

So how about the following diff?

----------

Estimated hours taken: 1
Branches: main

library/exception.m:
	Use mode-specific Mercury code rather than C code.

library/Mmakefile:
	Compile the library with --strict-sequential.
	This is needed by the new code in exception.m
	and is a good idea anyway.

Workspace: /mnt/venus/home/venus/fjh/ws-venus4/mercury
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.49
diff -u -d -r1.49 exception.m
--- library/exception.m	2001/07/03 08:16:25	1.49
+++ library/exception.m	2001/08/17 11:18:44
@@ -196,9 +196,6 @@
 :- mode try_all(in(bound(nondet)),  pred(out) is nondet,
 				    	     out(try_all_nondet)) is cc_multi.
 
-% The functors in this type must be in the same order as the
-% enumeration constants in the foreign language enums `ML_Determinism'
-% defined below.
 :- type determinism
 	--->	det
 	;	semidet
@@ -224,160 +221,59 @@
 	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, since Mercury doesn't allow different code for different
-% modes.
-
-:- pragma foreign_decl("C", "
-/* The `#ifndef ... #define ... #endif' guards against multiple inclusion */
-#ifndef ML_DETERMINISM_GUARD
-#define ML_DETERMINISM_GUARD
-	/*
-	** The enumeration constants in this enum must be in the same
-	** order as the functors in the Mercury type `determinism'
-	** defined above.
-	*/
-	typedef enum {
-		ML_DET,
-		ML_SEMIDET,
-		ML_CC_MULTI,
-		ML_CC_NONDET,
-		ML_MULTI,
-		ML_NONDET,
-		ML_ERRONEOUS,
-		ML_FAILURE
-	} ML_Determinism;
-#endif
-").
-
-:- pragma foreign_proc("C",
-	get_determinism(_Pred::pred(out) is det,
-			Det::out(bound(det))),
-	will_not_call_mercury,
-	"Det = ML_DET"
-).
-:- pragma foreign_proc("C",
-	get_determinism(_Pred::pred(out) is semidet,
-			Det::out(bound(semidet))),
-	will_not_call_mercury,
-	"Det = ML_SEMIDET"
-).
-:- pragma foreign_proc("C",
-	get_determinism(_Pred::pred(out) is cc_multi,
-			Det::out(bound(cc_multi))),
-	will_not_call_mercury,
-	"Det = ML_CC_MULTI"
-).
-:- pragma foreign_proc("C",
-	get_determinism(_Pred::pred(out) is cc_nondet,
-			Det::out(bound(cc_nondet))),
-	will_not_call_mercury,
-	"Det = ML_CC_NONDET"
-).
-:- pragma foreign_proc("C",
-	get_determinism(_Pred::pred(out) is multi,
-			Det::out(bound(multi))),
-	will_not_call_mercury,
-	"Det = ML_MULTI"
-).
-:- pragma foreign_proc("C",
-	get_determinism(_Pred::pred(out) is nondet,
-			Det::out(bound(nondet))),
-	will_not_call_mercury,
-	"Det = ML_NONDET"
-).
-
-:- pragma foreign_proc("C",
-	get_determinism_2(_Pred::pred(out, di, uo) is det,
-			Det::out(bound(det))),
-	will_not_call_mercury,
-	"Det = ML_DET"
-).
-
-:- pragma foreign_proc("C",
-	get_determinism_2(_Pred::pred(out, di, uo) is cc_multi,
-			Det::out(bound(cc_multi))),
-	will_not_call_mercury,
-	"Det = ML_CC_MULTI"
-).
-
-:- pragma foreign_decl("MC++", "
-/* The `#ifndef ... #define ... #endif' guards against multiple inclusion */
-#ifndef ML_DETERMINISM_GUARD
-#define ML_DETERMINISM_GUARD
-
-	/*
-	** The constants in these #defines must be in the same
-	** order as the functors in the Mercury type `determinism'
-	** defined above.
-	** XXX It would be nice to use an enum here, but at the moment
-	** I can't convince the MC++ compiler to accept the syntax for it.
-	*/
-
-#define ML_DET	0
-#define	ML_SEMIDET	1
-#define	ML_CC_MULTI	2
-#define	ML_CC_NONDET	3
-#define	ML_MULTI	4
-#define	ML_NONDET	5
-#define	ML_ERRONEOUS	6
-#define	ML_FAILURE	7
 
-#endif
-").
-
-:- pragma foreign_proc("MC++",
-	get_determinism(_Pred::pred(out) is det,
-			Det::out(bound(det))),
-	will_not_call_mercury,
-	"MR_newenum(Det, ML_DET);"
-).
-:- pragma foreign_proc("MC++",
-	get_determinism(_Pred::pred(out) is semidet,
-			Det::out(bound(semidet))),
-	will_not_call_mercury,
-	"MR_newenum(Det, ML_SEMIDET);"
-).
-:- pragma foreign_proc("MC++",
-	get_determinism(_Pred::pred(out) is cc_multi,
-			Det::out(bound(cc_multi))),
-	will_not_call_mercury,
-	"MR_newenum(Det, ML_CC_MULTI);"
-).
-:- pragma foreign_proc("MC++",
-	get_determinism(_Pred::pred(out) is cc_nondet,
-			Det::out(bound(cc_nondet))),
-	will_not_call_mercury,
-	"MR_newenum(Det, ML_CC_NONDET);"
-).
-:- pragma foreign_proc("MC++",
-	get_determinism(_Pred::pred(out) is multi,
-			Det::out(bound(multi))),
-	will_not_call_mercury,
-	"MR_newenum(Det, ML_MULTI);"
-).
-:- pragma foreign_proc("MC++",
-	get_determinism(_Pred::pred(out) is nondet,
-			Det::out(bound(nondet))),
-	will_not_call_mercury,
-	"MR_newenum(Det, ML_NONDET);"
-).
-
-:- pragma foreign_proc("MC++",
-	get_determinism_2(_Pred::pred(out, di, uo) is det,
-			Det::out(bound(det))),
-	will_not_call_mercury,
-	"MR_newenum(Det, ML_DET);"
-).
+% The calls to error/1 here are needed to ensure that the
+% declarative semantics of each clause is equivalent,
+% but operationally they are unreachable;
+% since each mode has determinism cc_multi,
+% it will pick the first disjunct and discard the call to error/1.
+% This relies on --no-reorder-disj.
 
-:- pragma foreign_proc("MC++",
-	get_determinism_2(_Pred::pred(out, di, uo) is cc_multi,
-			Det::out(bound(cc_multi))),
-	will_not_call_mercury,
-	"MR_newenum(Det, ML_CC_MULTI);"
-).
+get_determinism(_Pred::(pred(out) is det), Det::out(bound(det))) :-
+	( Det = det
+	; error("get_determinism")
+	).
+get_determinism(_Pred::(pred(out) is semidet), Det::out(bound(semidet))) :-
+	( Det = det
+	; error("get_determinism")
+	).
+get_determinism(_Pred::(pred(out) is cc_multi), Det::out(bound(cc_multi))) :-
+	( Det = cc_multi
+	; error("get_determinism")
+	).
+get_determinism(_Pred::(pred(out) is cc_nondet), Det::out(bound(cc_nondet))) :-
+	( Det = cc_nondet
+	; error("get_determinism")
+	).
+get_determinism(_Pred::(pred(out) is multi), Det::out(bound(multi))) :-
+	( Det = multi
+	; error("get_determinism")
+	).
+get_determinism(_Pred::(pred(out) is nondet), Det::out(bound(nondet))) :-
+	( Det = nondet
+	; error("get_determinism")
+	).
+get_determinism(_Pred::(pred(out) is erroneous), Det::out(bound(erroneous))) :-
+	( Det = erroneous
+	; error("get_determinism")
+	).
+get_determinism(_Pred::(pred(out) is failure), Det::out(bound(failure))) :-
+	( Det = failure
+	; error("get_determinism")
+	).
 
+get_determinism_2(
+	_Pred::pred(out, di, uo) is det,
+			Det::out(bound(det))) :-
+	( Det = det
+	; error("get_determinism_2")
+	).
+get_determinism_2(
+	_Pred::pred(out, di, uo) is det,
+			Det::out(bound(cc_multi))) :-
+	( Det = cc_multi
+	; error("get_determinism_2")
+	).
 
 % These are not worth inlining, since they will
 % (presumably) not be called frequently, and so
Index: library/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/library/Mmakefile,v
retrieving revision 1.76
diff -u -d -r1.76 Mmakefile
--- library/Mmakefile	2001/08/03 12:30:50	1.76
+++ library/Mmakefile	2001/08/17 11:25:00
@@ -22,11 +22,18 @@
 VPATH=.
 
 #-----------------------------------------------------------------------------#
-#
+
+# We need to compile the library with --strict-sequential for two reasons:
+# (1) Otherwise Mercury code that is compiled with --strict-sequential
+#     might do the wrong thing, because the standard library wasn't compiled
+#     with --strict-sequential.  (We could make it a separate grade, but
+#     that's not worth it.)
+# (2) The code for get_determinism in library/exception.m relies on it
+#     (in particular it relies on --no-reorder-disj).
+MCFLAGS = --strict-sequential
+
 # XXX The following is needed only for bootstrapping
 # the new modes of int__xor.
-#
-
 MCFLAGS-int = --no-halt-at-warn
 
 # Modules which use user-guided type specialization need to be

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  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
--------------------------------------------------------------------------