[m-rev.] for review: implement arg_cc in Mercury
Peter Ross
pro at missioncriticalit.com
Mon Dec 2 22:32:04 AEDT 2002
On Mon, Dec 01, 2002 at 08:05:06PM +1100, Fergus Henderson wrote:
> Apart from that, this looks fine. I'd like to see another diff, though.
>
Estimated hours taken: 6
Branches: main
Implement arg_cc in Mercury using rtti_implementation.
library/deconstruct.m:
Implement univ_arg_idcc as a cc_multi predicate with the
success of the predicate encoded into a maybe type, as it is
impossible to implement is as cc_nondet.
Change the C code version of univ_arg_idcc to match the
Mercury versions behaviour.
Delete the bogus modes of arg/4 and implement them as arg_cc/3
instead.
library/std_util.m:
Introduce a new type maybe_arg which is returned by arg_cc to
return its result.
Change arg_cc to have the correct determinism and type
signature.
Add utility predicates which allow us to construct values of
the maybe type from a foreign language.
runtime/mercury_ml_arg_body.h:
Add a new #define which controls whether or not success is
saved into SUCCESS_INDICATOR.
NEWS:
Document the changes to interface of arg and arg_cc.
tests/hard_coded/deconstruct_arg.m:
Update the test case to test this new functionality.
diff -u library/deconstruct.m library/deconstruct.m
--- library/deconstruct.m
+++ library/deconstruct.m
@@ -115,6 +115,10 @@
% -- that is, greater than or equal to the arity of the functor or
% lower than 0 -- then the call fails.
%
+ % 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__arg_cc/3.
+ %
:- some [ArgT] pred arg(T, noncanon_handling, int, ArgT).
:- mode arg(in, in(do_not_allow), in, out) is semidet.
:- mode arg(in, in(canonicalize), in, out) is semidet.
@@ -455,6 +459,7 @@
#define SELECTED_ARG Argument
#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
#define NONCANON MR_NONCANON_ABORT
+#define SAVE_SUCCESS
#include ""mercury_ml_arg_body.h""
#undef TYPEINFO_ARG
#undef TERM_ARG
@@ -462,6 +467,7 @@
#undef SELECTED_ARG
#undef SELECTED_TYPE_INFO
#undef NONCANON
+#undef SAVE_SUCCESS
}").
:- pragma foreign_proc("C",
@@ -474,6 +480,7 @@
#define SELECTED_ARG Argument
#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
#define NONCANON MR_NONCANON_ALLOW
+#define SAVE_SUCCESS
#include ""mercury_ml_arg_body.h""
#undef TYPEINFO_ARG
#undef TERM_ARG
@@ -481,6 +488,7 @@
#undef SELECTED_ARG
#undef SELECTED_TYPE_INFO
#undef NONCANON
+#undef SAVE_SUCCESS
}").
:- pragma foreign_proc("C",
@@ -504,9 +512,12 @@
#undef NONCANON
if (success) {
- MaybeArg = ML_construct_maybe_yes((MR_Word) NULL, Argument);
+ MaybeArg = ML_construct_maybe_yes((MR_Word)
+ &MR_TYPE_CTOR_INFO_NAME(std_util, univ, 0),
+ Argument);
} else {
- MaybeArg = ML_construct_maybe_no((MR_Word) NULL);
+ MaybeArg = ML_construct_maybe_no((MR_Word)
+ &MR_TYPE_CTOR_INFO_NAME(std_util, univ, 0));
}
}").
@@ -521,6 +532,7 @@
#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
#define NONCANON MR_NONCANON_ABORT
#define SELECT_BY_NAME
+#define SAVE_SUCCESS
#include ""mercury_ml_arg_body.h""
#undef TYPEINFO_ARG
#undef TERM_ARG
@@ -529,6 +541,7 @@
#undef SELECTED_TYPE_INFO
#undef NONCANON
#undef SELECT_BY_NAME
+#undef SAVE_SUCCESS
}").
:- pragma foreign_proc("C",
@@ -542,6 +555,7 @@
#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
#define NONCANON MR_NONCANON_ALLOW
#define SELECT_BY_NAME
+#define SAVE_SUCCESS
#include ""mercury_ml_arg_body.h""
#undef TYPEINFO_ARG
#undef TERM_ARG
@@ -550,6 +564,7 @@
#undef SELECTED_TYPE_INFO
#undef NONCANON
#undef SELECT_BY_NAME
+#undef SAVE_SUCCESS
}").
:- pragma foreign_proc("C",
@@ -563,6 +578,7 @@
#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
@@ -571,6 +587,7 @@
#undef SELECTED_TYPE_INFO
#undef NONCANON
#undef SELECT_BY_NAME
+#undef SAVE_SUCCESS
}").
univ_arg_dna(Term::in, Index::in, Arg::out) :-
diff -u library/std_util.m library/std_util.m
--- library/std_util.m
+++ library/std_util.m
@@ -564,7 +564,7 @@
%-----------------------------------------------------------------------------%
:- type maybe_arg
- ---> some[T] arg(T)
+ ---> some [T] arg(T)
; no.
% functor, argument and deconstruct and their variants take any type
@@ -631,7 +631,9 @@
% equality predicate.)
%
% arg_cc and argument_cc succeed even if the first argument is
- % of a non-canonical type.
+ % of a non-canonical type. arg_cc encodes the possible
+ % non-existence of an argument at the requested location by using
+ % a maybe type.
%
:- func arg(T::in, int::in) = (ArgT::out) is semidet.
:- pred arg_cc(T::in, int::in, maybe_arg::out) is cc_multi.
diff -u runtime/mercury_ml_arg_body.h runtime/mercury_ml_arg_body.h
--- runtime/mercury_ml_arg_body.h
+++ runtime/mercury_ml_arg_body.h
@@ -38,6 +38,8 @@
**
** SELECT_BY_NAME If defined, the argument is selected by name; if it is
** not defined, the argument is selected by position.
+**
+** SAVE_SUCCESS If defined, success is saved into SUCCESS_INDICATOR.
*/
#ifdef SELECT_BY_NAME
@@ -70,7 +72,7 @@
MR_new_univ_on_hp(SELECTED_ARG, arg_type_info, *argument_ptr);
}
-#ifndef MR_NONCANON_CC
+#ifdef SAVE_SUCCESS
SUCCESS_INDICATOR = success;
#endif
only in patch2:
--- NEWS 2 Dec 2002 10:20:11 -0000 1.284
+++ NEWS 2 Dec 2002 11:24:24 -0000
@@ -34,6 +34,15 @@
`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 incorrect cc_nondet modes of the following predicates in
+ deconstruct have been removed: arg. cc_multi version of the
+ predicates have been introduced where the success or failure of the
+ predicate have been encoded into a maybe type.
+
Changes to the extras distribution:
* Nothing yet.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.284
diff -u -r1.284 NEWS
--- NEWS 2 Dec 2002 10:20:11 -0000 1.284
+++ NEWS 2 Dec 2002 11:24:24 -0000
@@ -34,6 +34,15 @@
`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 incorrect cc_nondet modes of the following predicates in
+ deconstruct have been removed: arg. cc_multi version of the
+ predicates have been introduced where the success or failure of the
+ predicate have been encoded into a maybe type.
+
Changes to the extras distribution:
* Nothing yet.
Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.15
diff -u -r1.15 deconstruct.m
--- library/deconstruct.m 30 Nov 2002 08:03:33 -0000 1.15
+++ library/deconstruct.m 2 Dec 2002 11:24:24 -0000
@@ -115,11 +115,19 @@
% -- that is, greater than or equal to the arity of the functor or
% lower than 0 -- then the call fails.
%
+ % 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__arg_cc/3.
+ %
:- some [ArgT] pred arg(T, noncanon_handling, int, ArgT).
:- mode arg(in, in(do_not_allow), in, out) is semidet.
:- mode arg(in, in(canonicalize), in, out) is semidet.
-:- mode arg(in, in(include_details_cc), in, out) is cc_nondet.
-:- mode arg(in, in, in, out) is cc_nondet.
+:- mode arg(in, in(include_details_cc), in, out) is erroneous.
+:- mode arg(in, in, in, out) is semidet.
+
+ % 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.
% named_arg(Data, NonCanon, Name, Argument)
%
@@ -225,6 +233,7 @@
:- implementation.
:- import_module int, require, rtti_implementation.
+:- pragma foreign_import_module("C", std_util).
%-----------------------------------------------------------------------------%
@@ -271,10 +280,18 @@
univ_arg_can(Term, Index, Univ)
;
NonCanon = include_details_cc,
- univ_arg_idcc(Term, Index, Univ)
+ error("deconstruct__arg called with include_details_cc")
),
Argument = univ_value(Univ).
+arg_cc(Term, Index, MaybeArg) :-
+ univ_arg_idcc(Term, Index, MaybeUniv),
+ ( MaybeUniv = yes(Univ),
+ MaybeArg = 'new arg'(univ_value(Univ))
+ ; MaybeUniv = no,
+ MaybeArg = std_util__no
+ ).
+
named_arg(Term, NonCanon, Name, Argument) :-
(
NonCanon = do_not_allow,
@@ -298,7 +315,7 @@
univ_arg_can(Term, Index, Univ)
;
NonCanon = include_details_cc,
- univ_arg_idcc(Term, Index, Univ)
+ error("deconstruct__arg called with include_details_cc")
)
->
Argument = univ_value(Univ)
@@ -426,7 +443,7 @@
:- 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, univ::out) is cc_nondet.
+:- pred univ_arg_idcc(T::in, int::in, maybe(univ)::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.
@@ -442,6 +459,7 @@
#define SELECTED_ARG Argument
#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
#define NONCANON MR_NONCANON_ABORT
+#define SAVE_SUCCESS
#include ""mercury_ml_arg_body.h""
#undef TYPEINFO_ARG
#undef TERM_ARG
@@ -449,6 +467,7 @@
#undef SELECTED_ARG
#undef SELECTED_TYPE_INFO
#undef NONCANON
+#undef SAVE_SUCCESS
}").
:- pragma foreign_proc("C",
@@ -461,6 +480,7 @@
#define SELECTED_ARG Argument
#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
#define NONCANON MR_NONCANON_ALLOW
+#define SAVE_SUCCESS
#include ""mercury_ml_arg_body.h""
#undef TYPEINFO_ARG
#undef TERM_ARG
@@ -468,25 +488,37 @@
#undef SELECTED_ARG
#undef SELECTED_TYPE_INFO
#undef NONCANON
+#undef SAVE_SUCCESS
}").
:- pragma foreign_proc("C",
- univ_arg_idcc(Term::in, Index::in, Argument::out),
+ univ_arg_idcc(Term::in, Index::in, MaybeArg::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define TYPEINFO_ARG TypeInfo_for_T
-#define TERM_ARG Term
-#define SELECTOR_ARG Index
-#define SELECTED_ARG Argument
-#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
-#define NONCANON MR_NONCANON_CC
-#include ""mercury_ml_arg_body.h""
-#undef TYPEINFO_ARG
-#undef TERM_ARG
-#undef SELECTOR_ARG
-#undef SELECTED_ARG
-#undef SELECTED_TYPE_INFO
-#undef NONCANON
+ MR_Word Argument;
+
+ #define TYPEINFO_ARG TypeInfo_for_T
+ #define TERM_ARG Term
+ #define SELECTOR_ARG Index
+ #define SELECTED_ARG Argument
+ #define SELECTED_TYPE_INFO TypeInfo_for_ArgT
+ #define NONCANON MR_NONCANON_CC
+ #include ""mercury_ml_arg_body.h""
+ #undef TYPEINFO_ARG
+ #undef TERM_ARG
+ #undef SELECTOR_ARG
+ #undef SELECTED_ARG
+ #undef SELECTED_TYPE_INFO
+ #undef NONCANON
+
+ if (success) {
+ MaybeArg = ML_construct_maybe_yes((MR_Word)
+ &MR_TYPE_CTOR_INFO_NAME(std_util, univ, 0),
+ Argument);
+ } else {
+ MaybeArg = ML_construct_maybe_no((MR_Word)
+ &MR_TYPE_CTOR_INFO_NAME(std_util, univ, 0));
+ }
}").
:- pragma foreign_proc("C",
@@ -500,6 +532,7 @@
#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
#define NONCANON MR_NONCANON_ABORT
#define SELECT_BY_NAME
+#define SAVE_SUCCESS
#include ""mercury_ml_arg_body.h""
#undef TYPEINFO_ARG
#undef TERM_ARG
@@ -508,6 +541,7 @@
#undef SELECTED_TYPE_INFO
#undef NONCANON
#undef SELECT_BY_NAME
+#undef SAVE_SUCCESS
}").
:- pragma foreign_proc("C",
@@ -521,6 +555,7 @@
#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
#define NONCANON MR_NONCANON_ALLOW
#define SELECT_BY_NAME
+#define SAVE_SUCCESS
#include ""mercury_ml_arg_body.h""
#undef TYPEINFO_ARG
#undef TERM_ARG
@@ -529,6 +564,7 @@
#undef SELECTED_TYPE_INFO
#undef NONCANON
#undef SELECT_BY_NAME
+#undef SAVE_SUCCESS
}").
:- pragma foreign_proc("C",
@@ -542,6 +578,7 @@
#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
@@ -550,6 +587,7 @@
#undef SELECTED_TYPE_INFO
#undef NONCANON
#undef SELECT_BY_NAME
+#undef SAVE_SUCCESS
}").
univ_arg_dna(Term::in, Index::in, Arg::out) :-
@@ -560,10 +598,14 @@
rtti_implementation__deconstruct(Term,
canonicalize, _Functor, _Arity, Arguments),
list__index0(Arguments, Index, Arg).
-univ_arg_idcc(_Term::in, _Index::in, _Arg::out) :-
- % This version is only used for back-ends for which there is no
- % matching foreign_proc version.
- private_builtin__sorry("univ_arg_idcc/3").
+univ_arg_idcc(Term::in, Index::in, MaybeArg::out) :-
+ rtti_implementation__deconstruct(Term,
+ include_details_cc, _Functor, _Arity, Arguments),
+ ( list__index0(Arguments, Index, Arg) ->
+ MaybeArg = yes(Arg)
+ ;
+ MaybeArg = no
+ ).
univ_named_arg_dna(_Term::in, _Name::in, _Arg::out) :-
% This version is only used for back-ends for which there is no
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.273
diff -u -r1.273 std_util.m
--- library/std_util.m 8 Nov 2002 00:44:25 -0000 1.273
+++ library/std_util.m 2 Dec 2002 11:24:44 -0000
@@ -563,6 +563,10 @@
%-----------------------------------------------------------------------------%
+:- type maybe_arg
+ ---> some [T] arg(T)
+ ; no.
+
% functor, argument and deconstruct and their variants take any type
% (including univ), and return representation information for that type.
%
@@ -627,10 +631,12 @@
% equality predicate.)
%
% arg_cc and argument_cc succeed even if the first argument is
- % of a non-canonical type.
+ % of a non-canonical type. arg_cc encodes the possible
+ % non-existence of an argument at the requested location by using
+ % a maybe type.
%
:- func arg(T::in, int::in) = (ArgT::out) is semidet.
-:- pred arg_cc(T::in, int::in, ArgT::out) is cc_nondet.
+:- pred arg_cc(T::in, int::in, maybe_arg::out) is cc_multi.
:- func argument(T::in, int::in) = (univ::out) is semidet.
:- pred argument_cc(T::in, int::in, univ::out) is cc_nondet.
@@ -789,6 +795,16 @@
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.
+
%-----------------------------------------------------------------------------%
/*
@@ -1606,12 +1622,7 @@
private_builtin__typed_unify(Argument0, Argument).
arg_cc(Term, Index, Argument) :-
- deconstruct__arg(Term, include_details_cc, Index, Argument0),
- ( private_builtin__typed_unify(Argument0, Argument1) ->
- Argument = Argument1
- ;
- error("arg_cc: argument has wrong type")
- ).
+ deconstruct__arg_cc(Term, Index, Argument).
argument(Term, Index) = ArgumentUniv :-
deconstruct__arg(Term, canonicalize, Index, Argument),
Index: runtime/mercury_ml_arg_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_arg_body.h,v
retrieving revision 1.3
diff -u -r1.3 mercury_ml_arg_body.h
--- runtime/mercury_ml_arg_body.h 18 Feb 2002 07:01:18 -0000 1.3
+++ runtime/mercury_ml_arg_body.h 2 Dec 2002 11:24:44 -0000
@@ -38,6 +38,8 @@
**
** SELECT_BY_NAME If defined, the argument is selected by name; if it is
** not defined, the argument is selected by position.
+**
+** SAVE_SUCCESS If defined, success is saved into SUCCESS_INDICATOR.
*/
#ifdef SELECT_BY_NAME
@@ -70,6 +72,8 @@
MR_new_univ_on_hp(SELECTED_ARG, arg_type_info, *argument_ptr);
}
+#ifdef SAVE_SUCCESS
SUCCESS_INDICATOR = success;
+#endif
#undef arg_func
Index: tests/hard_coded/deconstruct_arg.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/deconstruct_arg.m,v
retrieving revision 1.4
diff -u -r1.4 deconstruct_arg.m
--- tests/hard_coded/deconstruct_arg.m 29 Nov 2002 13:26:00 -0000 1.4
+++ tests/hard_coded/deconstruct_arg.m 2 Dec 2002 11:24:45 -0000
@@ -154,7 +154,8 @@
{ string__format("deconstruct argument %d of ", [i(ArgNum)], Str) },
io__write_string(Str),
io__print(T),
- ( { deconstruct__arg(T, include_details_cc, ArgNum, Arg) } ->
+ { deconstruct__arg_cc(T, ArgNum, MaybeArg) },
+ ( { MaybeArg = arg(Arg) } ->
io__write_string(" is "),
io__write(Arg),
io__write_string("\n")
--------------------------------------------------------------------------
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