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

[Fergus Henderson]

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.

Workspace: /home/ceres/fjh/mercury
Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.21
diff -u -d -r1.21 deconstruct.m
--- library/deconstruct.m	4 Dec 2002 10:06:59 -0000	1.21
+++ library/deconstruct.m	13 Jan 2003 17:04:32 -0000
@@ -379,8 +379,13 @@
 		error("limited_deconstruct called with include_details_cc")
 	).
 
-limited_deconstruct_cc(Term, MaxArity, Result) :-
-	limited_deconstruct_idcc(Term, MaxArity, Result).
+limited_deconstruct_cc(Term, MaxArity, MaybeResult) :-
+	limited_deconstruct_idcc(Term, MaxArity, Functor, Arity, Arguments),
+	( Arity =< MaxArity ->
+		MaybeResult = yes({Functor, Arity, Arguments})
+	;
+		MaybeResult = no
+	).
 
 %-----------------------------------------------------------------------------%
 
@@ -646,7 +651,7 @@
 :- pred limited_deconstruct_can(T::in, int::in,
 	string::out, int::out, list(univ)::out) is semidet.
 :- pred limited_deconstruct_idcc(T::in, int::in,
-	maybe({string, int, list(univ)})::out) is cc_multi.
+	string::out, int::out, list(univ)::out) is cc_multi.
 
 :- pragma foreign_proc("C", 
 	deconstruct_dna(Term::in, Functor::out, Arity::out, Arguments::out),
@@ -774,13 +779,10 @@
 }").
 
 :- pragma foreign_proc("C", 
-	limited_deconstruct_idcc(Term::in, MaxArity::in, Maybe::out),
+	limited_deconstruct_idcc(Term::in, MaxArity::in, Functor::out,
+		Arity::out, Arguments::out),
 	[will_not_call_mercury, thread_safe, promise_pure],
 "{
-	MR_String	Functor;
-	MR_Integer	Arity;
-	MR_Word		Arguments;
-
 	#define	EXPAND_INFO_TYPE	MR_Expand_Functor_Args_Limit_Info
 	#define	EXPAND_INFO_CALL	MR_expand_functor_args_limit
 	#define	TYPEINFO_ARG		TypeInfo_for_T
@@ -801,23 +803,17 @@
 	#undef	ARGUMENTS_ARG
 	#undef	NONCANON
 
-	if (success) {
-		Maybe = ML_construct_idcc_yes(Functor, Arity, Arguments);
-	} else {
-		Maybe = ML_construct_idcc_no();
+	if (!success) {
+		/* Fill in some dummy values, to ensure that we don't
+		   try to return uninitialized memory to Mercury.
+		   It doesn't matter what we put here, except that
+		   we must have Arity > MaxArity. */
+		Arity = MaxArity + 1;
+		Functor = """";
+		Arguments = MR_list_empty();
 	}
 }").
 
-:- func construct_idcc_yes(string, int, list(univ)) =
-		maybe({string, int, list(univ)}).
-:- pragma export(construct_idcc_yes(in, in, in) = out, "ML_construct_idcc_yes").
-construct_idcc_yes(Functor, Arity, Args) = yes({Functor, Arity, Args}).
-
-:- func construct_idcc_no = maybe({string, int, list(univ)}).
-:- pragma export(construct_idcc_no = out, "ML_construct_idcc_no").
-construct_idcc_no = no.
-
-
 
 deconstruct_dna(Term::in, Functor::out, Arity::out, Arguments::out) :-
 	rtti_implementation__deconstruct(Term,
@@ -829,6 +825,9 @@
 	rtti_implementation__deconstruct(Term,
 			include_details_cc, Functor, Arity, Arguments).
 
+	% XXX The Mercury implementations of all of these limited_* procedures
+	%     are inefficient -- they construct Functor and Arguments even in
+	%     the case when Arity > MaxArity.
 limited_deconstruct_dna(Term::in, MaxArity::in,
 		Functor::out, Arity::out, Arguments::out) :-
 	rtti_implementation__deconstruct(Term,
@@ -839,14 +838,11 @@
 	rtti_implementation__deconstruct(Term,
 			canonicalize, Functor, Arity, Arguments),
 	Arity =< MaxArity.
-limited_deconstruct_idcc(Term::in, MaxArity::in, MaybeResult::out) :-
+limited_deconstruct_idcc(Term::in, _MaxArity::in,
+		Functor::out, Arity::out, Arguments::out) :-
+	% For this one, the caller checks Arity =< MaxArity.
 	rtti_implementation__deconstruct(Term,
-			include_details_cc, Functor, Arity, Arguments),
-	( Arity =< MaxArity ->
-		MaybeResult = yes({Functor, Arity, Arguments})
-	;
-		MaybeResult = no
-	).
+			include_details_cc, Functor, Arity, Arguments).
 
 %-----------------------------------------------------------------------------%
 

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