[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