[m-rev.] diff: implement limited_deconstruct_cc in Mercury.

Fergus Henderson fjh at cs.mu.OZ.AU
Tue Jan 14 03:44:08 AEDT 2003


This change broke things in grade asm_fast.par.gc.
The problem is that it added a call to Mercury code from inside a
C foreign_proc pragma declared `will_not_call_mercury'.

I am working on a fix.

On 02-Dec-2002, Peter Ross <pro at missioncriticalit.com> wrote:
> 
> Implemented limited_deconstruct_cc in Mercury.
> 
> library/deconstruct.m:
> 	Implement limited_deconstruct_idcc as a cc_multi predicate
> 	with the success of the predicate encoded into a maybe type,
> 	as it is impossible to implement it as cc_nondet.
> 	Change the C code version of limited_deconstruct_idcc to match
> 	the Mercurys version behaviour.
> 	Delete the bogus modes of limited_deconstruct/5 and implement
> 	them as limited_deconstruct_cc/3 instead.
> 	
> library/std_util.m:
> 	Change limited_deconstruct_cc to have the correct determinism
> 	and type signature.
> 	
> runtime/mercury_ml_deconstruct_body.h:
> 	Add a new #define which controls whether we save a success
> 	indicator into SUCCESS_INDICATOR.
> 
> NEWS:
> 	Document the changes to interfaces of limited_deconstruct and
> 	limited_deconstruct_cc.
> 	
> tests/hard_coded/deconstruct_arg.m:
> 	Update the test case to test this new functionality.
> 
> Index: NEWS
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/NEWS,v
> retrieving revision 1.287
> diff -u -r1.287 NEWS
> --- NEWS	2 Dec 2002 12:16:02 -0000	1.287
> +++ NEWS	2 Dec 2002 15:42:21 -0000
> @@ -34,14 +34,17 @@
>    `is_nan_or_inf/1' to float.m.  These predicates are for use only on
>    systems which support IEEE floating point arithmetic.
>  
> -* The determinism of std_util__arg_cc has changed to cc_multi from cc_nondet.
> -  The success or failure of the argument lookup is now encoded in the
> -  new maybe_arg type.
> +* The determinisms of the following predicates in the `std_util'
> +  module have been changed from cc_nondet to cc_multi: arg_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.
>  
>  * The incorrect cc_nondet modes of the following predicates in
> -  the `deconstruct' module have been removed: arg/4.  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 `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.
>  
>  Changes to the extras distribution:
>  
> Index: library/deconstruct.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/deconstruct.m,v
> retrieving revision 1.17
> diff -u -r1.17 deconstruct.m
> --- library/deconstruct.m	2 Dec 2002 12:52:21 -0000	1.17
> +++ library/deconstruct.m	2 Dec 2002 15:42:22 -0000
> @@ -191,6 +191,10 @@
>  	% greater than MaxArity, limited_deconstruct fails. This is useful in
>  	% avoiding bad performance in cases where Data may be a large array.
>  	%
> +	% Note that this predicate only returns an answer when NonCanon is
> +	% do_not_allow or canonicalize.  If you need the include_details_cc
> +	% behaviour use deconstruct__limited_deconstruct_cc/3.
> +	%
>  :- pred limited_deconstruct(T, noncanon_handling, int, string, int,
>  	list(univ)).
>  :- mode limited_deconstruct(in, in(do_not_allow), in, out, out, out)
> @@ -198,8 +202,12 @@
>  :- mode limited_deconstruct(in, in(canonicalize), in, out, out, out)
>  	is semidet.
>  :- mode limited_deconstruct(in, in(include_details_cc), in, out, out, out)
> -	is cc_nondet.
> -:- mode limited_deconstruct(in, in, in, out, out, out) is cc_nondet.
> +	is erroneous.
> +:- mode limited_deconstruct(in, in, in, out, out, out) is semidet.
> +
> +	% See the documentation of std_util__limited_deconstruct_cc.
> +:- pred limited_deconstruct_cc(T, int, maybe({string, int, list(univ)})).
> +:- mode limited_deconstruct_cc(in, in, out) is cc_multi.
>  
>  :- implementation.
>  :- interface.
> @@ -364,10 +372,12 @@
>  			Functor, Arity, Arguments)
>  	;
>  		NonCanon = include_details_cc,
> -		limited_deconstruct_idcc(Term, MaxArity,
> -			Functor, Arity, Arguments)
> +		error("limited_deconstruct called with include_details_cc")
>  	).
>  
> +limited_deconstruct_cc(Term, MaxArity, Result) :-
> +	limited_deconstruct_idcc(Term, MaxArity, Result).
> +
>  %-----------------------------------------------------------------------------%
>  
>  :- pred functor_dna(T::in, string::out, int::out) is det.
> @@ -632,7 +642,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,
> -	string::out, int::out, list(univ)::out) is cc_nondet.
> +	maybe({string, int, list(univ)})::out) is cc_multi.
>  
>  :- pragma foreign_proc("C", 
>  	deconstruct_dna(Term::in, Functor::out, Arity::out, Arguments::out),
> @@ -717,6 +727,7 @@
>  #define	ARITY_ARG		Arity
>  #define	ARGUMENTS_ARG		Arguments
>  #define	NONCANON		MR_NONCANON_ABORT
> +#define	SAVE_SUCCESS
>  #include ""mercury_ml_deconstruct_body.h""
>  #undef	EXPAND_INFO_TYPE
>  #undef	EXPAND_INFO_CALL
> @@ -727,6 +738,7 @@
>  #undef	ARITY_ARG
>  #undef	ARGUMENTS_ARG
>  #undef	NONCANON
> +#undef	SAVE_SUCCESS
>  }").
>  
>  :- pragma foreign_proc("C", 
> @@ -743,6 +755,7 @@
>  #define	ARITY_ARG		Arity
>  #define	ARGUMENTS_ARG		Arguments
>  #define	NONCANON		MR_NONCANON_ALLOW
> +#define	SAVE_SUCCESS
>  #include ""mercury_ml_deconstruct_body.h""
>  #undef	EXPAND_INFO_TYPE
>  #undef	EXPAND_INFO_CALL
> @@ -753,34 +766,55 @@
>  #undef	ARITY_ARG
>  #undef	ARGUMENTS_ARG
>  #undef	NONCANON
> +#undef	SAVE_SUCCESS
>  }").
>  
>  :- pragma foreign_proc("C", 
> -	limited_deconstruct_idcc(Term::in, MaxArity::in,
> -		Functor::out, Arity::out, Arguments::out),
> +	limited_deconstruct_idcc(Term::in, MaxArity::in, Maybe::out),
>  	[will_not_call_mercury, thread_safe, promise_pure],
>  "{
> -#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
> -#define	TERM_ARG		Term
> -#define	MAX_ARITY_ARG		MaxArity
> -#define	FUNCTOR_ARG		Functor
> -#define	ARITY_ARG		Arity
> -#define	ARGUMENTS_ARG		Arguments
> -#define	NONCANON		MR_NONCANON_CC
> -#include ""mercury_ml_deconstruct_body.h""
> -#undef	EXPAND_INFO_TYPE
> -#undef	EXPAND_INFO_CALL
> -#undef	TYPEINFO_ARG
> -#undef	TERM_ARG
> -#undef	MAX_ARITY_ARG
> -#undef	FUNCTOR_ARG
> -#undef	ARITY_ARG
> -#undef	ARGUMENTS_ARG
> -#undef	NONCANON
> +	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
> +	#define	TERM_ARG		Term
> +	#define	MAX_ARITY_ARG		MaxArity
> +	#define	FUNCTOR_ARG		Functor
> +	#define	ARITY_ARG		Arity
> +	#define	ARGUMENTS_ARG		Arguments
> +	#define	NONCANON		MR_NONCANON_CC
> +	#include ""mercury_ml_deconstruct_body.h""
> +	#undef	EXPAND_INFO_TYPE
> +	#undef	EXPAND_INFO_CALL
> +	#undef	TYPEINFO_ARG
> +	#undef	TERM_ARG
> +	#undef	MAX_ARITY_ARG
> +	#undef	FUNCTOR_ARG
> +	#undef	ARITY_ARG
> +	#undef	ARGUMENTS_ARG
> +	#undef	NONCANON
> +
> +	if (success) {
> +		Maybe = ML_construct_idcc_yes(Functor, Arity, Arguments);
> +	} else {
> +		Maybe = ML_construct_idcc_no();
> +	}
>  }").
>  
> +:- 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,
>  			do_not_allow, Functor, Arity, Arguments).
> @@ -801,11 +835,14 @@
>  	rtti_implementation__deconstruct(Term,
>  			canonicalize, Functor, Arity, Arguments),
>  	Arity =< MaxArity.
> -limited_deconstruct_idcc(_Term::in, _MaxArity::in,
> -		_Functor::out, _Arity::out, _Arguments::out) :-
> -	% This version is only used for back-ends for which there is no
> -	% matching foreign_proc version.
> -	private_builtin__sorry("limited_deconstruct_idcc/5").
> +limited_deconstruct_idcc(Term::in, MaxArity::in, MaybeResult::out) :-
> +	rtti_implementation__deconstruct(Term,
> +			include_details_cc, Functor, Arity, Arguments),
> +	( Arity =< MaxArity ->
> +		MaybeResult = yes({Functor, Arity, Arguments})
> +	;
> +		MaybeResult = no
> +	).
>  
>  %-----------------------------------------------------------------------------%
>  
> Index: library/std_util.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
> retrieving revision 1.274
> diff -u -r1.274 std_util.m
> --- library/std_util.m	2 Dec 2002 12:16:04 -0000	1.274
> +++ library/std_util.m	2 Dec 2002 15:42:28 -0000
> @@ -707,12 +707,13 @@
>  	% avoiding bad performance in cases where Data may be a large array.
>  	%
>  	% limited_deconstruct_cc succeeds even if the first argument is
> -	% of a non-canonical type.
> +	% of a non-canonical type.  limited_deconstruct_cc encodes the
> +	% possible failure of the predicate by using a maybe type.
>  	%
>  :- pred limited_deconstruct(T::in, int::in, string::out,
>  	int::out, list(univ)::out) is semidet.
> -:- pred limited_deconstruct_cc(T::in, int::in, string::out,
> -	int::out, list(univ)::out) is cc_nondet.
> +:- pred limited_deconstruct_cc(T::in, int::in,
> +		maybe({string, int, list(univ)})::out) is cc_multi.
>  
>  %-----------------------------------------------------------------------------%
>  
> @@ -1653,9 +1654,8 @@
>  	deconstruct__limited_deconstruct(Term, canonicalize,
>  		MaxArity, Functor, Arity, Arguments).
>  
> -limited_deconstruct_cc(Term, MaxArity, Functor, Arity, Arguments) :-
> -	deconstruct__limited_deconstruct(Term, include_details_cc,
> -		MaxArity, Functor, Arity, Arguments).
> +limited_deconstruct_cc(Term, MaxArity, Result) :-
> +	deconstruct__limited_deconstruct_cc(Term, MaxArity, Result).
>  
>  det_arg(Type, Index) = Argument :-
>  	deconstruct__det_arg(Type, canonicalize, Index, Argument0),
> Index: runtime/mercury_ml_deconstruct_body.h
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_deconstruct_body.h,v
> retrieving revision 1.3
> diff -u -r1.3 mercury_ml_deconstruct_body.h
> --- runtime/mercury_ml_deconstruct_body.h	18 Feb 2002 07:01:18 -0000	1.3
> +++ runtime/mercury_ml_deconstruct_body.h	2 Dec 2002 15:42:28 -0000
> @@ -49,15 +49,21 @@
>  ** MAX_ARITY_ARG        If defined, gives the name of the argument whose value
>  **                      gives the maximum number of arguments we want to
>  **                      succeed for.
> +**
> +** SAVE_SUCCESS         If defined, success is saved into SUCCESS_INDICATOR.
>  */
>  
> +#if defined(SAVE_SUCCESS) && !defined(MAX_ARITY_ARG)
> +  #error "SAVE_SUCCESS requires MAX_ARITY_ARG is defined"
> +#endif
> +
>  #ifdef  MAX_ARITY_ARG
>    #define   maybe_max_arity_arg     MAX_ARITY_ARG,
>    #define   max_arity_check_start                                       \
>                                      if (expand_info.limit_reached) {    \
> -                                        SUCCESS_INDICATOR = MR_FALSE;   \
> +                                        success = MR_FALSE;   \
>                                      } else {                            \
> -                                        SUCCESS_INDICATOR = MR_TRUE;
> +                                        success = MR_TRUE;
>    #define   max_arity_check_end     }
>  #else
>    #define   maybe_max_arity_arg
> @@ -65,6 +71,10 @@
>    #define   max_arity_check_end
>  #endif
>  
> +#ifdef  MAX_ARITY_ARG
> +    MR_bool             success;
> +#endif
> +
>      EXPAND_INFO_TYPE	expand_info;
>      MR_TypeInfo    		type_info;
>  
> @@ -81,6 +91,10 @@
>          MR_deconstruct_get_arg_list(expand_info, args, ARGUMENTS_ARG);
>          MR_deconstruct_free_allocated_arg_type_infos(expand_info, args);
>      max_arity_check_end
> +
> +#ifdef SAVE_SUCCESS
> +    SUCCESS_INDICATOR = success;
> +#endif
>  
>  #undef  maybe_max_arity_arg
>  #undef  max_arity_check_start
> Index: tests/hard_coded/deconstruct_arg.m
> ===================================================================
> RCS file: /home/mercury1/repository/tests/hard_coded/deconstruct_arg.m,v
> retrieving revision 1.5
> diff -u -r1.5 deconstruct_arg.m
> --- tests/hard_coded/deconstruct_arg.m	2 Dec 2002 12:16:07 -0000	1.5
> +++ tests/hard_coded/deconstruct_arg.m	2 Dec 2002 15:42:28 -0000
> @@ -219,10 +219,8 @@
>  	io__write_string(Str),
>  	io__print(T),
>  	io__write_string("\n"),
> -	(
> -		{ deconstruct__limited_deconstruct(T, include_details_cc,
> -			Limit, Functor, Arity, Arguments) }
> -	->
> +	{ deconstruct__limited_deconstruct_cc(T, Limit, Result) },
> +	( { Result = yes({Functor, Arity, Arguments}) } ->
>  		{ string__format("functor %s arity %d ",
>  			[s(Functor), i(Arity)], Str2) },
>  		io__write_string(Str2),
> --------------------------------------------------------------------------
> 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
> --------------------------------------------------------------------------

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



More information about the reviews mailing list