[m-rev.] diff: deconstruct.m: fix will_not_call_mercury bug

[Fergus Henderson]

On 16-Jan-2003, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> Estimated hours taken: 4
> Branches: main
> 
> library/deconstruct.m:
> 	Fix a bug introduced in petdr's 2002/12/02 change (revision 1.18
> 	of deconstruct.m) where a pragma c_code fragment declared
> 	`will_not_call_mercury' was calling Mercury code.
> 
> 	Note that the fix was not as simple as changing the declaration,
> 	since there was other code in the body which relied on MR_hp
> 	being valid, which is only the case if `will_not_call_mercury'
> 	is used.  Instead I changed it so that the c_code fragment
> 	didn't call Mercury code.

There was another occurrence of this bug.
The change above fixed the one in limited_deconstruct_idcc,
but there was also one in univ_arg_idcc.
Similar care is also needed in univ_named_arg_idcc,
which had not yet been converted from cc_nondet to cc_multi.

Hence the following change.

----------

Estimated hours taken: 8
Branches: main

Finish off Peter Ross's partially-completed set of changes to
use `cc_multi' instead of `cc_nondet' for various predicates in
deconstruct.m and std_util.m.  Also, fix a bug in his changes that
broke `deconstruct.arg_cc' in the asm_fast.gc.par grade.

library/std_util.m:
	Changed named_argument_cc from `cc_nondet' to `cc_multi'.

library/deconstruct.m:
	Delete the cc_nondet mode of `named_arg',
	and replace it with a new cc_multi predicate `named_arg_cc'.

	Also, fix a bug where univ_arg_idcc was declared
	`will_not_call_mercury' but was nevertheless calling Mercury code.

NEWS:
	Document the interface changes mentioned above.

	Also, reorganize the description of all the changes relating
	to incorrect use of `cc_nondet' into a single section.

Workspace: /home/ceres/fjh/mercury
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.293
diff -u -d -r1.293 NEWS
--- NEWS	17 Jan 2003 05:56:46 -0000	1.293
+++ NEWS	20 Jan 2003 11:52:41 -0000
@@ -49,17 +49,18 @@
   `is_nan_or_inf/1' to float.m.  These predicates are for use only on
   systems which support IEEE floating point arithmetic.
 
-* The determinisms of the following predicates in the `std_util'
-  module have been changed from cc_nondet to cc_multi: arg_cc/3,
-  argument_cc/3 and limited_deconstruct_cc/3 (formerly
-  limited_deconstruct_cc/5).  The success or failure of these
-  predicates is now encoded in a maybe type.
+* We've fixed some problems with the use of `cc_nondet'.
 
-* The incorrect cc_nondet modes of the following predicates in
-  the `deconstruct' module have been removed: arg/4, limited_deconstruct/6.
-  cc_multi version of the predicates have been introduced where the
-  success or failure of the predicate has been encoded into a maybe
-  type.
+  The incorrect cc_nondet modes of the following predicates have been removed:
+	deconstruct.arg/4
+	deconstruct.named_arg/4
+	deconstruct.limited_deconstruct/6
+	std_util.arg_cc/3
+	std_util.argument_cc/3
+	std_util.named_argument_cc/3
+	std_util.limited_deconstruct_cc/5
+  These have been replaced by cc_multi versions in which success or failure
+  is indicated by returning a maybe type.
 
 Changes to the extras distribution:
 
Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.22
diff -u -d -r1.22 deconstruct.m
--- library/deconstruct.m	16 Jan 2003 16:21:28 -0000	1.22
+++ library/deconstruct.m	20 Jan 2003 11:30:29 -0000
@@ -128,7 +128,9 @@
 :- mode arg(in, in(canonicalize), in, out) is semidet.
 :- mode arg(in, in(canonicalize_or_do_not_allow), in, out) is semidet.
 
-	% See the documentation of std_util__arg_cc
+	% arg_cc/3 is similar to arg/4, except that it
+	% handles arguments with non-canonical types.
+	% See the documentation of std_util__arg_cc.
 :- pred arg_cc(T, int, std_util__maybe_arg).
 :- mode arg_cc(in, in, out) is cc_multi.
 
@@ -141,8 +143,12 @@
 :- some [ArgT] pred named_arg(T, noncanon_handling, string, ArgT).
 :- mode named_arg(in, in(do_not_allow), in, out) is semidet.
 :- mode named_arg(in, in(canonicalize), in, out) is semidet.
-:- mode named_arg(in, in(include_details_cc), in, out) is cc_nondet.
-:- mode named_arg(in, in, in, out) is cc_nondet.
+:- mode named_arg(in, in(canonicalize_or_do_not_allow), in, out) is semidet.
+
+	% named_arg_cc/3 is similar to named_arg/4, except that it
+	% handles arguments with non-canonical types.
+:- pred named_arg_cc(T, string, std_util__maybe_arg) is cc_multi.
+:- mode named_arg_cc(in, in, out) is cc_multi.
 
 	% det_arg(Data, NonCanon, Index, Argument)
 	%
@@ -309,30 +315,45 @@
 		univ_named_arg_can(Term, Name, Univ)
 	;
 		NonCanon = include_details_cc,
-		univ_named_arg_idcc(Term, Name, Univ)
+		error("deconstruct__named_arg called with include_details_cc")
 	),
 	Argument = univ_value(Univ).
 
+named_arg_cc(Term, Name, Argument) :-
+	univ_named_arg_idcc(Term, Name, dummy_univ, Univ, Success),
+	( Success \= 0 ->
+		MaybeArg = 'new arg'(univ_value(Univ))
+	;
+		MaybeArg = std_util__no_arg
+	).
+
+	% This is a dummy value of type `univ'.
+	% It is used only to ensure that the C interface procedure
+	% univ_named_arg_idcc doesn't return an uninitialized
+	% (or otherwise bogus) univ value.
+:- func dummy_univ = univ.
+dummy_univ = univ(0).
+
 det_arg(Term, NonCanon, Index, Argument) :-
 	( NonCanon = do_not_allow,
 		( univ_arg_dna(Term, Index, Univ) ->
-			MaybeArg = yes(Univ)
-		;
-			MaybeArg = no
+			Argument = univ_value(UnivArg)
+		; MaybeArg = no,
+			error("det_arg: argument number out of range")
 		)
 	; NonCanon = canonicalize,
 		( univ_arg_can(Term, Index, Univ) ->
-			MaybeArg = yes(Univ)
-		;
-			MaybeArg = no
+			Argument = univ_value(Univ)
+		; MaybeArg = no,
+			error("det_arg: argument number out of range")
 		)
 	; NonCanon = include_details_cc,
-		univ_arg_idcc(Term, Index, MaybeArg)
-	),
-	( MaybeArg = yes(UnivArg),
-		Argument = univ_value(UnivArg)
-	; MaybeArg = no,
-		error("det_arg: argument number out of range")
+		univ_arg_idcc(Term, Index, dummy_univ, UnivArg, Success),
+		( Success \= 0 ->
+			Argument = univ_value(UnivArg)
+		;
+			error("det_arg: argument number out of range")
+		)
 	).
 
 det_named_arg(Term, NonCanon, Name, Argument) :-
@@ -345,7 +366,13 @@
 			univ_named_arg_can(Term, Name, Univ)
 		;
 			NonCanon = include_details_cc,
-			univ_named_arg_idcc(Term, Name, Univ)
+			univ_named_arg_idcc(Term, Name, dummy_univ, Univ0,
+				Success),
+			( Success \= 0 ->
+				Univ = Univ0
+			;
+				error("det_named_arg: no argument with that name")
+			)
 		)
 	->
 		Argument = univ_value(Univ)
@@ -458,15 +485,31 @@
 
 % XXX These predicates return univs instead of existentially typed arguments
 % in order to work around the typechecking bug reported on 30 Jan, 2002
-% to the mercury-bugs mailing list, and which has sourceforge bug id 512581.
+% to the mercury-bugs mailing list, and which has sourceforge bug id 512581:
+% currently we don't support implementations in multiple languages
+% for procedures with existentially typed arguments.
 
 :- pred univ_arg_dna(T::in, int::in, univ::out) is semidet.
 :- pred univ_arg_can(T::in, int::in, univ::out) is semidet.
-:- pred univ_arg_idcc(T::in, int::in, maybe(univ)::out) is cc_multi.
+
+	% univ_arg_idcc(Term, N, DummyUniv, Argument, Success):
+	%	Attempt to extract the Nth field of (the current
+	%	representation of) Term.  If there is such a field,
+	%	return Success=1 and return the field in Argument.
+	%	If there is not, return Success=0 and Argument=DummyUniv.
+:- pred univ_arg_idcc(T::in, int::in, univ::in, univ::out, int::out)
+	is cc_multi.
 
 :- pred univ_named_arg_dna(T::in, string::in, univ::out) is semidet.
 :- pred univ_named_arg_can(T::in, string::in, univ::out) is semidet.
-:- pred univ_named_arg_idcc(T::in, string::in, univ::out) is cc_nondet.
+
+	% univ_named_arg_idcc(Term, Name, DummyUniv, Univ, Success):
+	%	Attempt to extract the field of (the current representation of)
+	%	Term specified by Name.  If there is such a field,
+	%	return Success=1 and return the field in Univ.
+	%	If there is not, return Success=0 and Univ=DummyUniv.
+:- pred univ_named_arg_idcc(T::in, string::in, univ::in, univ::out, int::out)
+	is cc_multi.
 
 :- pragma foreign_proc("C",
 	univ_arg_dna(Term::in, Index::in, Argument::out),
@@ -511,11 +554,10 @@
 }").
 
 :- pragma foreign_proc("C",
-	univ_arg_idcc(Term::in, Index::in, MaybeArg::out),
+	univ_arg_idcc(Term::in, Index::in, DummyUniv::in, Argument::out,
+		Success::out),
 	[will_not_call_mercury, thread_safe, promise_pure],
 "{
-	MR_Word Argument;
-
 	#define	TYPEINFO_ARG		TypeInfo_for_T
 	#define	TERM_ARG		Term
 	#define	SELECTOR_ARG		Index
@@ -531,12 +573,10 @@
 	#undef	NONCANON
 
 	if (success) {
-		MaybeArg = ML_construct_maybe_yes((MR_Word)
-				&MR_TYPE_CTOR_INFO_NAME(std_util, univ, 0),
-				Argument);
+		Success = 1;
 	} else {
-		MaybeArg = ML_construct_maybe_no((MR_Word)
-				&MR_TYPE_CTOR_INFO_NAME(std_util, univ, 0));
+		Success = 0;
+		Argument = DummyUniv;
 	}
 }").
 
@@ -587,7 +627,8 @@
 }").
 
 :- pragma foreign_proc("C",
-	univ_named_arg_idcc(Term::in, Name::in, Argument::out),
+	univ_named_arg_idcc(Term::in, Name::in, DummyUniv::in,
+	Argument::out, Success::out),
 	[will_not_call_mercury, thread_safe, promise_pure],
 "{
 #define	TYPEINFO_ARG		TypeInfo_for_T
@@ -597,7 +638,6 @@
 #define	SELECTED_TYPE_INFO	TypeInfo_for_ArgT
 #define	NONCANON		MR_NONCANON_CC
 #define	SELECT_BY_NAME
-#define	SAVE_SUCCESS
 #include ""mercury_ml_arg_body.h""
 #undef	TYPEINFO_ARG
 #undef	TERM_ARG
@@ -606,8 +646,20 @@
 #undef	SELECTED_TYPE_INFO
 #undef	NONCANON
 #undef	SELECT_BY_NAME
-#undef	SAVE_SUCCESS
+	
+	if (success) {
+		Success = 1;
+	} else {
+		Success = 0;
+		Argument = DummyUniv;
+	}
+
 }").
+
+% XXX These Mercury implementations are all inefficient,
+%     since they unnecessarily construct the list of univs
+%     for all the arguments, rather than just constructing
+%     one univ for the argument selected.
 
 univ_arg_dna(Term::in, Index::in, Arg::out) :-
 	rtti_implementation__deconstruct(Term,
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.278
diff -u -d -r1.278 std_util.m
--- library/std_util.m	2 Jan 2003 06:53:58 -0000	1.278
+++ library/std_util.m	20 Jan 2003 11:56:55 -0000
@@ -652,7 +652,7 @@
 	% of a non-canonical type.
 	%
 :- func named_argument(T::in, string::in) = (univ::out) is semidet.
-:- pred named_argument_cc(T::in, string::in, univ::out) is cc_nondet.
+:- pred named_argument_cc(T::in, string::in, maybe(univ)::out) is cc_multi.
 
 	% det_arg(Data, ArgumentIndex) = Argument
 	% det_argument(Data, ArgumentIndex) = ArgumentUniv
@@ -797,16 +797,6 @@
 	;
 		Y = no
 	).
-
-	% Utility predicates which are useful for constructing values
-	% of the maybe(T) type from foreign code.
-:- func construct_yes(T) = maybe(T).
-:- pragma export(construct_yes(in) = out, "ML_construct_maybe_yes").
-construct_yes(T) = yes(T).
-
-:- func construct_no = maybe(T).
-:- pragma export(construct_no = out, "ML_construct_maybe_no").
-construct_no = no.
 
 %-----------------------------------------------------------------------------%
 

-- 
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-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------