[m-rev.] for review: generalize the deconstruction predicates
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Jan 31 19:33:20 AEDT 2002
For review by anyone.
Reorganize deconstruct.m so that each predicate that deconstructs terms has
three variants:
- One that aborts when attempting to deconstruct non-canonical terms.
- One that succeeds when attempting to deconstruct a term of a non-canonical
type, but returns a constant such as "<<noncanonical>>" for such
deconstructions. It still aborts when deconstructing a noncanonical term
of an ordinarily canonical type, which can happen with HAL if the term
is currently a variable.
- One that succeeds when attempting to deconstruct non-canonical terms of both
kinds, but whose determinism requires its caller to be in a committed choice
context.
Each of the predicates function, arg, named_arg, deconstruct and
limited_deconstruct now has an extra argument that selects one of the three
variants above. Each of these predicates now has three modes, one for each
value of this argument. The separate predicates with _cc at the ends of their
names are now superseded by one of these modes.
At the same time, I also eliminated the distinction between arg and argument.
Arg used to check if the returned argument was of the expected type, and fail
if it wasn't, while argument used to return a univ. The new arg now returns
a value of an existential type, which the caller can now typecheck or put
into a univ as it pleases.
This diff requires workarounds for no less than four bugs:
1. The typechecker does not accept different foreign_proc clauses each
producing the same existentially-typed argument, because it does not know
that the clauses are exclusive. The test case for this bug was posted to
mercury-bugs.
2. If a predicate is defined with both foreign_procs and mode-specific clauses,
then the compiler requires a promise_pure declaration for the predicate,
which asserts that the different "clauses" have the same semantics. However,
if the foreign_procs are already marked promise_pure, meaning that the
individual "clause" is pure, the purity checker complains about pragma
promise_pure, saying it is redundant. The test case for this bug is the
code in this change, which produces the redundant warning and requires
the --no-halt-on-warn in the Mmakefile.
3. If a predicate defined with foreign_procs refers to a typeinfo variable
such as TypeInfo_for_T, then inlining that predicate may cause C compiler
errors, because the inlining process puts a numerical suffix on the name
of the type variable, so the type that used to be T is now T_1, making
its C representation TypeInfo_for_T_1. You can get the test case for this
bug by commenting out the no_inline pragmas in deconstruct.m.
4. If a predicate is defined with foreign_procs whose bodies refer to entities
(e.g. types) defined in a header file included via foreign_decl, then
inlining those predicates in another module can cause C compilation errors
due to the fact that mmc puts the foreign_proc clauses in the .opt
file without also putting the foreign_decl into the same .opt file.
You can get the test case for this bug by commenting out the no_inline
pragmas in deconstruct.m and the foreign_decl in std_util.m.
The descriptions of the changes:
library/deconstruct.m:
Implement the changes discussed above. Work around bug #1 by making
the foreign_procs return a univ from which we later extract the value;
this inefficiency should be fixed when bug #1 is fixed. Work around
bug #3 by adding some no_inline pragmas.
library/std_util.m:
Reimplement the forwarding predicates that call deconstruct.m in terms
of its new interface. Add a redundant foreign_decl to work around bug
#4.
library/io.m:
Make use of the new functionality in deconstruct.m to offer versions
of io__print and io__write that allow the user to choose how to print
noncanonical terms.
runtime/mercury_deconstruct.[ch]:
runtime/mercury_ml_expand_body.h:
runtime/mercury_ml_arg_body.h:
runtime/mercury_ml_deconstruct_body.h:
runtime/mercury_ml_functor_body.h:
Implement the new functionality.
library/store.m:
Conform to the new interfaces of some functions in the updated files in
the runtime.
library/type_desc.m:
Add an auxiliary predicate for use in deconstruct.m.
library/Mmakefile:
Suppress some warnings to work around bug #2.
tests/debugger/polymorphic_output.exp*:
Update for an updated error message.
tests/hard_coded/deconstruct_arg.{m,exp*}:
Update the test case to test the committed choice versions of the
deconstruction predicates as well as the usual versions. (The aborting
versions cannot all be tested in a single test case.)
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing library
Index: library/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/library/Mmakefile,v
retrieving revision 1.82
diff -u -b -r1.82 Mmakefile
--- library/Mmakefile 9 Jan 2002 06:41:31 -0000 1.82
+++ library/Mmakefile 31 Jan 2002 03:12:06 -0000
@@ -23,11 +23,14 @@
#-----------------------------------------------------------------------------#
#
-# XXX The following is needed only for bootstrapping
-# the fix to compiler/purity.m.
+# XXX The following are needed because a bug in purity checking, which gives
+# an error if a promise_pure declaration in deconstruct.m is omitted and a
+# warning about the declaration being unnecessary in deconstruct.opt
+# if it is included.
#
-MCFLAGS-private_builtin = --no-halt-at-warn
+MCFLAGS-deconstruct = --no-halt-at-warn
+MCFLAGS-std_util = --no-halt-at-warn
# Modules which use user-guided type specialization need to be
# compiled with these flags to make sure all calls
Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.1
diff -u -b -r1.1 deconstruct.m
--- library/deconstruct.m 30 Jan 2002 05:08:52 -0000 1.1
+++ library/deconstruct.m 31 Jan 2002 08:23:06 -0000
@@ -17,6 +17,26 @@
:- import_module std_util, list.
+:- type noncanon_handling
+ ---> do_not_allow % Abort if an operation tries to deconstruct
+ % a noncanonical value.
+ ; canonicalize % If an operation tries to deconstruct a value
+ % of a noncanonical type, make it return a
+ % marker that says so. This marker will be the
+ % same for all values of that noncanonical
+ % type. Operations will still abort if they try
+ % to deconstruct a variable (this should only
+ % affect HAL users).
+ ; include_details_cc.
+ % Deconstruct noncanonical values, both values
+ % of noncanonical types and variables, as if
+ % they were canonical. Use of this option
+ % requires a committed choice context.
+
+:- inst do_not_allow == bound(do_not_allow).
+:- inst canonicalize == bound(canonicalize).
+:- inst include_details_cc == bound(include_details_cc).
+
% functor, argument and deconstruct and their variants take any type
% (including univ), and return representation information for that type.
%
@@ -27,6 +47,8 @@
% in the type definition. For lists, this
% means the functors [|]/2 and []/0 are used, even if
% the list uses the [....] shorthand.
+ % For types with user-defined equality, the functor will be
+ % <<noncanonical>>/0 except with include_details_cc.
% - for integers, the string is a base 10 number,
% positive integers have no sign.
% - for floats, the string is a floating point,
@@ -38,6 +60,8 @@
% - for functions, the string <<function>>
% - for tuples, the string {}
% - for arrays, the string <<array>>
+ % - for type_infos, the string <<typeinfo>>
+ % - for type_ctor_infos, the string <<typectorinfo>>
%
% The arity that these predicates return is:
%
@@ -50,88 +74,69 @@
% number of arguments expected by the predicate or function.
% - for tuples, the number of elements in the tuple.
% - for arrays, the number of elements in the array.
+ % - for type_infos and type_ctor_infos, zero.
- % functor(Data, Functor, Arity)
+ % functor(Data, NonCanon, Functor, Arity)
%
% Given a data item (Data), binds Functor to a string
% representation of the functor and Arity to the arity of this
- % data item. (Aborts if the type of Data is a type with a
- % non-canonical representation, i.e. one for which there is a
- % user-defined equality predicate.)
- %
- % Functor_cc succeeds even if the first argument is of a
- % non-canonical type.
- %
-:- pred functor(T::in, string::out, int::out) is det.
-:- pred functor_cc(T::in, string::out, int::out) is cc_multi.
-
- % arg(Data, ArgumentIndex) = Argument
- % argument(Data, ArgumentIndex) = ArgumentUniv
- %
- % Given a data item (Data) and an argument index
- % (ArgumentIndex), starting at 0 for the first argument, binds
- % Argument to that argument of the functor of the data item. If
- % the argument index is out of range -- that is, greater than or
- % equal to the arity of the functor or lower than 0 -- then
- % the call fails. For argument/2 the argument returned has the
- % type univ, which can store any type. For arg/2, if the
- % argument has the wrong type, then the call fails.
- % (Both abort if the type of Data is a type with a non-canonical
- % representation, i.e. one for which there is a user-defined
- % equality predicate.)
- %
- % arg_cc and argument_cc succeed even if the first argument is
- % of a non-canonical type.
- %
-:- func arg(T::in, int::in) = (ArgT::out) is semidet.
-:- pred arg_cc(T::in, int::in, ArgT::out) is cc_nondet.
-:- func argument(T::in, int::in) = (univ::out) is semidet.
-:- pred argument_cc(T::in, int::in, univ::out) is cc_nondet.
-
- % named_argument(Data, ArgumentName) = ArgumentUniv
+ % data item.
%
- % Same as argument/2, except the chosen argument is specified by giving
- % its name rather than its position. If Data has no argument with that
- % name, named_argument fails.
+:- pred functor(T, noncanon_handling, string, int).
+:- mode functor(in, in(do_not_allow), out, out) is det.
+:- mode functor(in, in(canonicalize), out, out) is det.
+:- mode functor(in, in(include_details_cc), out, out) is cc_multi.
+
+ % arg(Data, NonCanon, Index, Argument)
%
- % named_argument_cc succeeds even if the first argument is
- % of a non-canonical type.
+ % Given a data item (Data) and an argument index (Index), starting
+ % at 0 for the first argument, binds Argument to that argument of
+ % the functor of the data item. If the argument index is out of range
+ % -- that is, greater than or equal to the arity of the functor or
+ % lower than 0 -- then the call fails.
%
-:- func named_argument(T::in, string::in) = (univ::out) is semidet.
-:- pred named_argument_cc(T::in, string::in, univ::out) is cc_nondet.
+:- 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.
- % det_arg(Data, ArgumentIndex) = Argument
- % det_argument(Data, ArgumentIndex) = ArgumentUniv
+ % named_arg(Data, NonCanon, Name, Argument)
%
- % Same as arg/2 and argument/2 respectively, except that
- % for cases where arg/2 or argument/2 would fail,
- % det_arg/2 or det_argument/2 will abort.
+ % Same as arg/4, except the chosen argument is specified by giving
+ % its name rather than its position. If Data has no argument with that
+ % name, named_arg fails.
+ %
+:- 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.
+
+ % det_arg(Data, NonCanon, Index, Argument)
%
- % det_arg_cc and det_argument_cc succeed even if the first argument is
- % of a non-canonical type.
+ % Same as arg/4, except that for cases where
+ % arg/4 would fail, det_arg/4 will abort.
%
-:- func det_arg(T::in, int::in) = (ArgT::out) is det.
-:- pred det_arg_cc(T::in, int::in, ArgT::out) is cc_multi.
-:- func det_argument(T::in, int::in) = (univ::out) is det.
-:- pred det_argument_cc(T::in, int::in, univ::out) is cc_multi.
+:- some [ArgT] pred det_arg(T, noncanon_handling, int, ArgT).
+:- mode det_arg(in, in(do_not_allow), in, out) is det.
+:- mode det_arg(in, in(canonicalize), in, out) is det.
+:- mode det_arg(in, in(include_details_cc), in, out) is cc_multi.
- % det_named_argument(Data, ArgumentName) = ArgumentUniv
+ % det_named_arg(Data, NonCanon, Name, Argument)
%
- % Same as named_argument/2, except that for cases where
- % named_argument/2 would fail, det_named_argument/2 will abort.
+ % Same as named_arg/4, except that for cases where
+ % named_arg/4 would fail, det_named_arg/4 will abort.
%
-:- func det_named_argument(T::in, string::in) = (univ::out) is det.
-:- pred det_named_argument_cc(T::in, string::in, univ::out) is cc_multi.
+:- some [ArgT] pred det_named_arg(T, noncanon_handling, string, ArgT).
+:- mode det_named_arg(in, in(do_not_allow), in, out) is det.
+:- mode det_named_arg(in, in(canonicalize), in, out) is det.
+:- mode det_named_arg(in, in(include_details_cc), in, out) is cc_multi.
- % deconstruct(Data, Functor, Arity, Arguments)
+ % deconstruct(Data, NonCanon, Functor, Arity, Arguments)
%
% Given a data item (Data), binds Functor to a string
% representation of the functor, Arity to the arity of this data
% item, and Arguments to a list of arguments of the functor.
% The arguments in the list are each of type univ.
- % (Aborts if the type of Data is a type with a non-canonical
- % representation, i.e. one for which there is a user-defined
- % equality predicate.)
%
% The cost of calling deconstruct depends greatly on how many arguments
% Data has. If Data is an array, then each element of the array is
@@ -141,26 +146,26 @@
% pass it a large array, you should probably use limited_deconstruct
% instead.
%
- % deconstruct_cc succeeds even if the first argument is
- % of a non-canonical type.
- %
-:- pred deconstruct(T::in, string::out, int::out, list(univ)::out) is det.
-:- pred deconstruct_cc(T::in, string::out, int::out, list(univ)::out)
- is cc_multi.
+:- pred deconstruct(T, noncanon_handling, string, int, list(univ)).
+:- mode deconstruct(in, in(do_not_allow), out, out, out) is det.
+:- mode deconstruct(in, in(canonicalize), out, out, out) is det.
+:- mode deconstruct(in, in(include_details_cc), out, out, out) is cc_multi.
- % limited_deconstruct(Data, MaxArity, Functor, Arity, Arguments)
+ % limited_deconstruct(Data, NonCanon, MaxArity,
+ % Functor, Arity, Arguments)
%
% limited_deconstruct works like deconstruct, but if the arity of T is
% greater than MaxArity, limited_deconstruct fails. This is useful in
% 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.
- %
-:- 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(T, noncanon_handling, int, string, int,
+ list(univ)).
+:- mode limited_deconstruct(in, in(do_not_allow), in, out, out, out)
+ is semidet.
+:- 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.
:- implementation.
:- interface.
@@ -195,6 +200,16 @@
:- import_module int, require.
+% The foreign_proc implementations include promise_pure, but we need these
+% for the mode-specific clauses of these predicates which are intended for the
+% non-C back ends.
+
+:- pragma promise_pure(functor/4).
+:- pragma promise_pure(univ_arg/4).
+:- pragma promise_pure(univ_named_arg/4).
+:- pragma promise_pure(deconstruct/5).
+:- pragma promise_pure(limited_deconstruct/6).
+
%-----------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
@@ -206,44 +221,96 @@
%-----------------------------------------------------------------------------%
+% The predicates univ_arg/4 and univ_named_arg/4 are used only to work around
+% the typechecking bug reported on 30 Jan, 2002.
+
+:- pred univ_arg(T, noncanon_handling, int, univ).
+:- mode univ_arg(in, in(do_not_allow), in, out) is semidet.
+:- mode univ_arg(in, in(canonicalize), in, out) is semidet.
+:- mode univ_arg(in, in(include_details_cc), in, out) is cc_nondet.
+
+:- pred univ_named_arg(T, noncanon_handling, string, univ).
+:- mode univ_named_arg(in, in(do_not_allow), in, out) is semidet.
+:- mode univ_named_arg(in, in(canonicalize), in, out) is semidet.
+:- mode univ_named_arg(in, in(include_details_cc), in, out) is cc_nondet.
+
+% The no-inline pragmas are necessary because when it inlines a predicate
+% defined by foreign_procs, the compiler does not preserve the names of the
+% typeinfo variables. Thus these foreign_proc's references to TypeInfo_for_T
+% will refer to an undefined variable.
+
+:- pragma no_inline(functor/4).
+:- pragma no_inline(univ_arg/4).
+:- pragma no_inline(univ_named_arg/4).
+:- pragma no_inline(deconstruct/5).
+:- pragma no_inline(limited_deconstruct/6).
+
+%-----------------------------------------------------------------------------%
+
+arg(Term, NonCanon, Index, Argument) :-
+ univ_arg(Term, NonCanon, Index, Univ),
+ Argument = univ_value(Univ).
+
+named_arg(Term, NonCanon, Name, Argument) :-
+ univ_named_arg(Term, NonCanon, Name, Univ),
+ Argument = univ_value(Univ).
+
:- pragma foreign_proc("C",
- functor(Term::in, Functor::out, Arity::out),
+ functor(Term::in, NonCanon::in(do_not_allow), Functor::out,
+ Arity::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""functor/3""
+/* shut up warning about argument NonCanon */
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define FUNCTOR_ARG Functor
#define ARITY_ARG Arity
+#define NONCANON MR_NONCANON_ABORT
#include ""mercury_ml_functor_body.h""
-#undef PREDNAME
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef FUNCTOR_ARG
#undef ARITY_ARG
+#undef NONCANON
}").
:- pragma foreign_proc("C",
- functor_cc(Term::in, Functor::out, Arity::out),
+ functor(Term::in, NonCanon::in(canonicalize), Functor::out,
+ Arity::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""functor_cc/3""
-#define ALLOW_NONCANONICAL
+/* shut up warning about argument NonCanon */
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define FUNCTOR_ARG Functor
#define ARITY_ARG Arity
+#define NONCANON MR_NONCANON_ALLOW
#include ""mercury_ml_functor_body.h""
-#undef PREDNAME
-#undef ALLOW_NONCANONICAL
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef FUNCTOR_ARG
#undef ARITY_ARG
+#undef NONCANON
}").
-functor_cc(_Term::in, _Functor::out, _Arity::out) :-
- error("NYI: std_util__functor_cc/3").
+:- pragma foreign_proc("C",
+ functor(Term::in, NonCanon::in(include_details_cc), Functor::out,
+ Arity::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"{
+/* shut up warning about argument NonCanon */
+#define TYPEINFO_ARG TypeInfo_for_T
+#define TERM_ARG Term
+#define FUNCTOR_ARG Functor
+#define ARITY_ARG Arity
+#define NONCANON MR_NONCANON_CC
+#include ""mercury_ml_functor_body.h""
+#undef TYPEINFO_ARG
+#undef TERM_ARG
+#undef FUNCTOR_ARG
+#undef ARITY_ARG
+#undef NONCANON
+}").
/*
** N.B. any modifications to arg/2 might also require similar
@@ -251,132 +318,143 @@
*/
:- pragma foreign_proc("C",
- arg(Term::in, ArgumentIndex::in) = (Argument::out),
+ univ_arg(Term::in, NonCanon::in(do_not_allow), Index::in,
+ Argument::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""arg/2""
-#define NONCANON_HANDLING MR_ABORT_ON_NONCANONICAL
+/* shut up warning about argument NonCanon */
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
-#define SELECTOR_ARG ArgumentIndex
+#define SELECTOR_ARG Index
#define SELECTED_ARG Argument
-#define EXPECTED_TYPE_INFO TypeInfo_for_ArgT
+#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
+#define NONCANON MR_NONCANON_ABORT
#include ""mercury_ml_arg_body.h""
-#undef PREDNAME
-#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
-#undef EXPECTED_TYPE_INFO
+#undef SELECTED_TYPE_INFO
+#undef NONCANON
}").
:- pragma foreign_proc("C",
- arg_cc(Term::in, ArgumentIndex::in, Argument::out),
+ univ_arg(Term::in, NonCanon::in(canonicalize), Index::in,
+ Argument::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""arg/2""
-#define NONCANON_HANDLING MR_ALLOW_NONCANONICAL
+/* shut up warning about argument NonCanon */
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
-#define SELECTOR_ARG ArgumentIndex
+#define SELECTOR_ARG Index
#define SELECTED_ARG Argument
-#define EXPECTED_TYPE_INFO TypeInfo_for_ArgT
+#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
+#define NONCANON MR_NONCANON_ALLOW
#include ""mercury_ml_arg_body.h""
-#undef PREDNAME
-#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
-#undef EXPECTED_TYPE_INFO
+#undef SELECTED_TYPE_INFO
+#undef NONCANON
}").
:- pragma foreign_proc("C",
- argument(Term::in, ArgumentIndex::in) = (ArgumentUniv::out),
+ univ_arg(Term::in, NonCanon::in(include_details_cc), Index::in,
+ Argument::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""argument/2""
-#define NONCANON_HANDLING MR_FAIL_ON_NONCANONICAL
+/* shut up warning about argument NonCanon */
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
-#define SELECTOR_ARG ArgumentIndex
-#define SELECTED_ARG ArgumentUniv
+#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 PREDNAME
-#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
+#undef SELECTED_TYPE_INFO
+#undef NONCANON
}").
:- pragma foreign_proc("C",
- argument_cc(Term::in, ArgumentIndex::in, ArgumentUniv::out),
+ univ_named_arg(Term::in, NonCanon::in(do_not_allow),
+ Name::in, Argument::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""argument_cc/3""
-#define NONCANON_HANDLING MR_ALLOW_NONCANONICAL
+/* shut up warning about argument NonCanon */
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
-#define SELECTOR_ARG ArgumentIndex
-#define SELECTED_ARG ArgumentUniv
+#define SELECTOR_ARG (MR_ConstString) Name
+#define SELECTED_ARG Argument
+#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
+#define NONCANON MR_NONCANON_ABORT
+#define SELECT_BY_NAME
#include ""mercury_ml_arg_body.h""
-#undef PREDNAME
-#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
+#undef SELECTED_TYPE_INFO
+#undef NONCANON
+#undef SELECT_BY_NAME
}").
:- pragma foreign_proc("C",
- named_argument(Term::in, ArgumentName::in) = (ArgumentUniv::out),
+ univ_named_arg(Term::in, NonCanon::in(canonicalize),
+ Name::in, Argument::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""named_argument/2""
-#define NONCANON_HANDLING MR_FAIL_ON_NONCANONICAL
+/* shut up warning about argument NonCanon */
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
-#define SELECTOR_ARG (MR_ConstString) ArgumentName
-#define SELECTED_ARG ArgumentUniv
+#define SELECTOR_ARG (MR_ConstString) Name
+#define SELECTED_ARG Argument
+#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
+#define NONCANON MR_NONCANON_ALLOW
#define SELECT_BY_NAME
#include ""mercury_ml_arg_body.h""
-#undef PREDNAME
-#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
+#undef SELECTED_TYPE_INFO
+#undef NONCANON
#undef SELECT_BY_NAME
}").
:- pragma foreign_proc("C",
- named_argument_cc(Term::in, ArgumentName::in, ArgumentUniv::out),
+ univ_named_arg(Term::in, NonCanon::in(include_details_cc),
+ Name::in, Argument::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""named_argument_cc/3""
-#define NONCANON_HANDLING MR_ALLOW_NONCANONICAL
+/* shut up warning about argument NonCanon */
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
-#define SELECTOR_ARG (MR_ConstString) ArgumentName
-#define SELECTED_ARG ArgumentUniv
+#define SELECTOR_ARG (MR_ConstString) Name
+#define SELECTED_ARG Argument
+#define SELECTED_TYPE_INFO TypeInfo_for_ArgT
+#define NONCANON MR_NONCANON_CC
#define SELECT_BY_NAME
#include ""mercury_ml_arg_body.h""
-#undef PREDNAME
-#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
+#undef SELECTED_TYPE_INFO
+#undef NONCANON
#undef SELECT_BY_NAME
}").
:- pragma foreign_proc("C",
- deconstruct(Term::in, Functor::out, Arity::out, Arguments::out),
+ deconstruct(Term::in, NonCanon::in(do_not_allow),
+ Functor::out, Arity::out, Arguments::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""deconstruct/4""
+/* shut up warning about argument NonCanon */
#define EXPAND_INFO_TYPE MR_Expand_Functor_Args_Info
#define EXPAND_INFO_CALL MR_expand_functor_args
#define TYPEINFO_ARG TypeInfo_for_T
@@ -384,8 +462,8 @@
#define FUNCTOR_ARG Functor
#define ARITY_ARG Arity
#define ARGUMENTS_ARG Arguments
+#define NONCANON MR_NONCANON_ABORT
#include ""mercury_ml_deconstruct_body.h""
-#undef PREDNAME
#undef EXPAND_INFO_TYPE
#undef EXPAND_INFO_CALL
#undef TYPEINFO_ARG
@@ -393,43 +471,65 @@
#undef FUNCTOR_ARG
#undef ARITY_ARG
#undef ARGUMENTS_ARG
+#undef NONCANON
}").
:- pragma foreign_proc("C",
- deconstruct_cc(Term::in, Functor::out, Arity::out, Arguments::out),
+ deconstruct(Term::in, NonCanon::in(canonicalize),
+ Functor::out, Arity::out, Arguments::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""deconstruct_cc/4""
+/* shut up warning about argument NonCanon */
#define EXPAND_INFO_TYPE MR_Expand_Functor_Args_Info
#define EXPAND_INFO_CALL MR_expand_functor_args
-#define ALLOW_NONCANONICAL
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define FUNCTOR_ARG Functor
#define ARITY_ARG Arity
#define ARGUMENTS_ARG Arguments
+#define NONCANON MR_NONCANON_ALLOW
#include ""mercury_ml_deconstruct_body.h""
-#undef PREDNAME
-#undef NONCANON_HANDLING
#undef EXPAND_INFO_TYPE
#undef EXPAND_INFO_CALL
-#undef ALLOW_NONCANONICAL
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef FUNCTOR_ARG
#undef ARITY_ARG
#undef ARGUMENTS_ARG
+#undef NONCANON
}").
-deconstruct_cc(_Term::in, _Functor::out, _Arity::out, _Arguments::out) :-
- error("NYI: std_util__deconstruct_cc/3").
+:- pragma foreign_proc("C",
+ deconstruct(Term::in, NonCanon::in(include_details_cc),
+ Functor::out, Arity::out, Arguments::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"{
+/* shut up warning about argument NonCanon */
+#define EXPAND_INFO_TYPE MR_Expand_Functor_Args_Info
+#define EXPAND_INFO_CALL MR_expand_functor_args
+#define TYPEINFO_ARG TypeInfo_for_T
+#define TERM_ARG Term
+#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 FUNCTOR_ARG
+#undef ARITY_ARG
+#undef ARGUMENTS_ARG
+#undef NONCANON
+}").
:- pragma foreign_proc("C",
- limited_deconstruct(Term::in, MaxArity::in, Functor::out,
- Arity::out, Arguments::out),
+ limited_deconstruct(Term::in, NonCanon::in(do_not_allow),
+ MaxArity::in, Functor::out, Arity::out, Arguments::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""limited_deconstruct/5""
+/* shut up warning about argument NonCanon */
#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
@@ -438,8 +538,8 @@
#define FUNCTOR_ARG Functor
#define ARITY_ARG Arity
#define ARGUMENTS_ARG Arguments
+#define NONCANON MR_NONCANON_ABORT
#include ""mercury_ml_deconstruct_body.h""
-#undef PREDNAME
#undef EXPAND_INFO_TYPE
#undef EXPAND_INFO_CALL
#undef TYPEINFO_ARG
@@ -448,162 +548,148 @@
#undef FUNCTOR_ARG
#undef ARITY_ARG
#undef ARGUMENTS_ARG
+#undef NONCANON
}").
:- pragma foreign_proc("C",
- limited_deconstruct_cc(Term::in, MaxArity::in, Functor::out,
- Arity::out, Arguments::out),
+ limited_deconstruct(Term::in, NonCanon::in(canonicalize),
+ MaxArity::in, Functor::out, Arity::out, Arguments::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
-#define PREDNAME ""limited_deconstruct_cc/5""
+/* shut up warning about argument NonCanon */
#define EXPAND_INFO_TYPE MR_Expand_Functor_Args_Limit_Info
#define EXPAND_INFO_CALL MR_expand_functor_args_limit
-#define ALLOW_NONCANONICAL
#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_ALLOW
#include ""mercury_ml_deconstruct_body.h""
-#undef PREDNAME
#undef EXPAND_INFO_TYPE
#undef EXPAND_INFO_CALL
-#undef ALLOW_NONCANONICAL
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef MAX_ARITY_ARG
#undef FUNCTOR_ARG
#undef ARITY_ARG
#undef ARGUMENTS_ARG
+#undef NONCANON
}").
-limited_deconstruct_cc(_Term::in, _MaxArity::in, _Functor::out, _Arity::out,
- _Arguments::out) :-
- error("NYI: std_util__limited_deconstruct_cc/3").
-
-:- pragma foreign_proc("MC++",
- functor(_Term::in, _Functor::out, _Arity::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- mercury::runtime::Errors::SORRY(""foreign code for functor"");
-").
-
-:- pragma foreign_proc("C#",
- arg(_Term::in, _ArgumentIndex::in) = (_Argument::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"{
- mercury.runtime.Errors.SORRY(""foreign code for arg"");
- // XXX this is required to keep the C# compiler quiet
- SUCCESS_INDICATOR = false;
-}").
-
-:- pragma foreign_proc("C#",
- arg_cc(_Term::in, _ArgumentIndex::in, _Argument::out),
- [will_not_call_mercury, thread_safe],
-"{
- mercury.runtime.Errors.SORRY(""foreign code for arg_cc"");
- // XXX this is required to keep the C# compiler quiet
- SUCCESS_INDICATOR = false;
-}").
-
-:- pragma foreign_proc("C#",
- argument(_Term::in, _ArgumentIndex::in) = (_ArgumentUniv::out),
+:- pragma foreign_proc("C",
+ limited_deconstruct(Term::in, NonCanon::in(include_details_cc),
+ MaxArity::in, Functor::out, Arity::out, Arguments::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
- mercury.runtime.Errors.SORRY(""foreign code for argument"");
- // XXX this is required to keep the C# compiler quiet
- SUCCESS_INDICATOR = false;
+/* shut up warning about argument NonCanon */
+#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
}").
-:- pragma foreign_proc("C#",
- argument_cc(_Term::in, _ArgumentIndex::in, _ArgumentUniv::out),
- [will_not_call_mercury, thread_safe],
-"{
- mercury.runtime.Errors.SORRY(""foreign code for argument_cc"");
- // XXX this is required to keep the C# compiler quiet
- SUCCESS_INDICATOR = false;
-}").
+%-----------------------------------------------------------------------------%
-:- pragma foreign_proc("C#",
- named_argument(_Term::in, _ArgumentName::in) = (_ArgumentUniv::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"{
- mercury.runtime.Errors.SORRY(""foreign code for named_argument"");
- // XXX this is required to keep the C# compiler quiet
- SUCCESS_INDICATOR = false;
-}").
+functor(_Term::in, _NonCanon::in(do_not_allow), _Functor::out,
+ _Arity::out) :-
+ error("NYI: deconstruct__functor/4").
+functor(_Term::in, _NonCanon::in(canonicalize), _Functor::out,
+ _Arity::out) :-
+ error("NYI: deconstruct__functor/4").
+functor(_Term::in, _NonCanon::in(include_details_cc), _Functor::out,
+ _Arity::out) :-
+ error("NYI: deconstruct__functor/4").
+
+univ_arg(_Term::in, _NonCanon::in(do_not_allow), _Index::in, _Arg::out) :-
+ error("NYI: deconstruct__arg/4").
+univ_arg(_Term::in, _NonCanon::in(canonicalize), _Index::in, _Arg::out) :-
+ error("NYI: deconstruct__arg/4").
+univ_arg(_Term::in, _NonCanon::in(include_details_cc), _Index::in, _Arg::out) :-
+ error("NYI: deconstruct__arg/4").
+
+univ_named_arg(_Term::in, _NonCanon::in(do_not_allow), _Name::in, _Arg::out) :-
+ error("NYI: deconstruct__arg/4").
+univ_named_arg(_Term::in, _NonCanon::in(canonicalize), _Name::in, _Arg::out) :-
+ error("NYI: deconstruct__arg/4").
+univ_named_arg(_Term::in, _NonCanon::in(include_details_cc), _Name::in, _Arg::out) :-
+ error("NYI: deconstruct__arg/4").
+
+deconstruct(_Term::in, _NonCanon::in(do_not_allow),
+ _Functor::out, _Arity::out, _Arguments::out) :-
+ error("NYI: deconstuct__deconstruct/5").
+deconstruct(_Term::in, _NonCanon::in(canonicalize),
+ _Functor::out, _Arity::out, _Arguments::out) :-
+ error("NYI: deconstuct__deconstruct/5").
+deconstruct(_Term::in, _NonCanon::in(include_details_cc),
+ _Functor::out, _Arity::out, _Arguments::out) :-
+ error("NYI: deconstuct__deconstruct/5").
+
+% XXX
+% deconstruct(Term::in, Functor::out, Arity::out, Arguments::out) :-
+% rtti_implementation__deconstruct(Term, Functor, Arity, Arguments).
+
+limited_deconstruct(_Term::in, _NonCanon::in(do_not_allow), _MaxArity::in,
+ _Functor::out, _Arity::out, _Arguments::out) :-
+ error("NYI: deconstuct__limited_deconstruct/6").
+limited_deconstruct(_Term::in, _NonCanon::in(canonicalize), _MaxArity::in,
+ _Functor::out, _Arity::out, _Arguments::out) :-
+ error("NYI: deconstuct__limited_deconstruct/6").
+limited_deconstruct(_Term::in, _NonCanon::in(include_details_cc), _MaxArity::in,
+ _Functor::out, _Arity::out, _Arguments::out) :-
+ error("NYI: deconstuct__limited_deconstruct/6").
-:- pragma foreign_proc("C#",
- named_argument_cc(_Term::in, _ArgumentName::in, _ArgumentUniv::out),
- [will_not_call_mercury, thread_safe],
-"{
- mercury.runtime.Errors.SORRY(""foreign code for named_argument_cc"");
- // XXX this is required to keep the C# compiler quiet
- SUCCESS_INDICATOR = false;
-}").
+%-----------------------------------------------------------------------------%
-det_arg(Type, ArgumentIndex) = Argument :-
- ( deconstruct__arg(Type, ArgumentIndex) = Argument0 ->
- Argument = Argument0
- ;
- ( deconstruct__argument(Type, ArgumentIndex) = _ArgumentUniv ->
- error("det_arg: argument had wrong type")
+% The following are the proper definitions of det_arg and det_named_arg.
+% They cannot be used until the typechecking bug reported on 30 Jan 2002
+% is fixed.
+
+% det_arg(Type, NonCanon, Index, Argument) :-
+% ( deconstruct__arg(Type, NonCanon, Index, Argument0) ->
+% Argument = Argument0
+% ;
+% error("det_arg: argument number out of range")
+% ).
+%
+% det_named_arg(Type, NonCanon, Name, Argument) :-
+% ( deconstruct__named_arg(Type, NonCanon, Name, Argument0) ->
+% Argument = Argument0
+% ;
+% error("det_named_arg: no argument with that name")
+% ).
+
+det_arg(Type, NonCanon, Index, Argument) :-
+ ( deconstruct__univ_arg(Type, NonCanon, Index, Argument0) ->
+ Argument = univ_value(Argument0)
;
error("det_arg: argument number out of range")
- )
).
-det_arg_cc(Type, ArgumentIndex, Argument) :-
- ( deconstruct__arg_cc(Type, ArgumentIndex, Argument0) ->
- Argument = Argument0
+det_named_arg(Type, NonCanon, Name, Argument) :-
+ ( deconstruct__univ_named_arg(Type, NonCanon, Name, Argument0) ->
+ Argument = univ_value(Argument0)
;
- ( deconstruct__argument_cc(Type, ArgumentIndex, _ArgumentUniv) ->
- error("det_arg_cc: argument had wrong type")
- ;
- error("det_arg_cc: argument number out of range")
- )
+ error("det_named_arg: no argument with that name")
).
-det_argument(Type, ArgumentIndex) = Argument :-
- ( deconstruct__argument(Type, ArgumentIndex) = Argument0 ->
- Argument = Argument0
- ;
- error("det_argument: argument out of range")
- ).
-
-det_argument_cc(Type, ArgumentIndex, Argument) :-
- ( deconstruct__argument_cc(Type, ArgumentIndex, Argument0) ->
- Argument = Argument0
- ;
- error("det_argument_cc: argument out of range")
- ).
-
-det_named_argument(Type, ArgumentName) = Argument :-
- ( deconstruct__named_argument(Type, ArgumentName) = Argument0 ->
- Argument = Argument0
- ;
- error("det_named_argument: no argument with that name")
- ).
-
-det_named_argument_cc(Type, ArgumentName, Argument) :-
- ( deconstruct__named_argument_cc(Type, ArgumentName, Argument0) ->
- Argument = Argument0
- ;
- error("det_named_argument_cc: no argument with that name")
- ).
-
-deconstruct(Term::in, Functor::out, Arity::out, Arguments::out) :-
- rtti_implementation__deconstruct(Term, Functor, Arity, Arguments).
-
-:- pragma foreign_proc("MC++",
- limited_deconstruct(_Term::in, _MaxArity::in, _Functor::out,
- _Arity::out, _Arguments::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"{
- mercury::runtime::Errors::SORRY(""foreign code for limited_deconstruct"");
- SUCCESS_INDICATOR = FALSE;
-}").
+%-----------------------------------------------------------------------------%
get_functor_info(Univ, FunctorInfo) :-
( univ_to_type(Univ, Int) ->
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.240
diff -u -b -r1.240 io.m
--- library/io.m 30 Jan 2002 12:47:05 -0000 1.240
+++ library/io.m 31 Jan 2002 06:03:42 -0000
@@ -24,7 +24,7 @@
:- module io.
:- interface.
-:- import_module char, string, std_util, list, time.
+:- import_module char, string, std_util, list, time, deconstruct.
%-----------------------------------------------------------------------------%
@@ -319,13 +319,18 @@
:- pred io__print(T, io__state, io__state).
:- mode io__print(in, di, uo) is det.
+
:- pred io__print(io__output_stream, T, io__state, io__state).
:- mode io__print(in, in, di, uo) is det.
-% io__print/3 writes its argument to the current output stream.
-% io__print/4 writes its argument to the specified output
-% stream. In either case, the argument may be of any type.
-% The argument is written in a format that is intended to
-% be human-readable.
+
+:- pred io__print(io__output_stream, noncanon_handling, T,
+ io__state, io__state).
+:- mode io__print(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__print(in, in(canonicalize), in, di, uo) is det.
+:- mode io__print(in, in(do_not_allow), in, di, uo) is det.
+
+% io__print/5 writes its third argument to the specified output
+% stream in a format that is intended to be human readable.
%
% If the argument is just a single string or character, it
% will be printed out exactly as is (unquoted).
@@ -335,11 +340,24 @@
% foreign language interface (pragma foreign_code), the text
% output will only describe the type that is being printed, not
% the value.
+%
+% io__print/4 implicitly specifies `canonicalize' as the
+% treatment of noncanonical types, while io__print/3 also
+% implicitly specifies the current output stream as the stream
+% for this I/O action.
:- pred io__write(T, io__state, io__state).
:- mode io__write(in, di, uo) is det.
+
:- pred io__write(io__output_stream, T, io__state, io__state).
:- mode io__write(in, in, di, uo) is det.
+
+:- pred io__write(io__output_stream, noncanon_handling, T,
+ io__state, io__state).
+:- mode io__write(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__write(in, in(canonicalize), in, di, uo) is det.
+:- mode io__write(in, in(do_not_allow), in, di, uo) is det.
+
% io__write/3 writes its argument to the current output stream.
% io__write/4 writes its argument to the specified output stream.
% The argument may be of any type.
@@ -2160,30 +2178,52 @@
io__output_stream(Stream),
io__write_many(Stream, Poly_list).
-io__write_many( _Stream, [], IO, IO ).
-io__write_many( Stream, [ c(C) | Rest ] ) -->
+io__write_many(_Stream, [], IO, IO ).
+io__write_many(Stream, [c(C) | Rest] ) -->
io__write_char(Stream, C),
io__write_many(Stream, Rest).
-io__write_many( Stream, [ i(I) | Rest ] ) -->
+io__write_many(Stream, [i(I) | Rest] ) -->
io__write_int(Stream, I),
io__write_many(Stream, Rest).
-io__write_many( Stream, [ s(S) | Rest ]) -->
+io__write_many(Stream, [s(S) | Rest]) -->
io__write_string(Stream, S),
io__write_many(Stream, Rest).
-io__write_many( Stream, [ f(F) | Rest ]) -->
+io__write_many(Stream, [f(F) | Rest]) -->
io__write_float(Stream, F),
io__write_many(Stream, Rest).
+%-----------------------------------------------------------------------------%
+
+:- pragma export(io__print(in, in(include_details_cc), in, di, uo),
+ "ML_io_print_cc_to_stream").
+:- pragma export(io__print(in, in(canonicalize), in, di, uo),
+ "ML_io_print_can_to_stream").
+:- pragma export(io__print(in, in(do_not_allow), in, di, uo),
+ "ML_io_print_dna_to_stream").
+
+io__print(Stream, NonCanon, Term) -->
+ io__set_output_stream(Stream, OrigStream),
+ io__do_print(NonCanon, Term),
+ io__set_output_stream(OrigStream, _Stream).
+
:- pragma export(io__print(in, in, di, uo), "ML_io_print_to_stream").
io__print(Stream, Term) -->
io__set_output_stream(Stream, OrigStream),
- io__print(Term),
+ io__do_print(canonicalize, Term),
io__set_output_stream(OrigStream, _Stream).
:- pragma export(io__print(in, di, uo), "ML_io_print_to_cur_stream").
io__print(Term) -->
+ io__do_print(canonicalize, Term).
+
+:- pred io__do_print(noncanon_handling, T, io__state, io__state).
+:- mode io__do_print(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__do_print(in(canonicalize), in, di, uo) is det.
+:- mode io__do_print(in(do_not_allow), in, di, uo) is det.
+
+io__do_print(NonCanon, Term) -->
% `string', `char' and `univ' are special cases for io__print
{ type_to_univ(Term, Univ) },
( { univ_to_type(Univ, String) } ->
@@ -2193,14 +2233,16 @@
; { univ_to_type(Univ, OrigUniv) } ->
io__write_univ(OrigUniv)
;
- io__print_quoted(Term)
+ io__print_quoted(NonCanon, Term)
).
-:- pred io__print_quoted(T, io__state, io__state).
-:- mode io__print_quoted(in, di, uo) is det.
+:- pred io__print_quoted(noncanon_handling, T, io__state, io__state).
+:- mode io__print_quoted(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__print_quoted(in(canonicalize), in, di, uo) is det.
+:- mode io__print_quoted(in(do_not_allow), in, di, uo) is det.
-io__print_quoted(Term) -->
- io__write(Term).
+io__print_quoted(NonCanon, Term) -->
+ io__do_write(NonCanon, Term).
/*
When we have type classes, then instead of io__write(Term),
we will want to do something like
@@ -2219,25 +2261,50 @@
io__write_anything(Stream, Anything) -->
io__write(Stream, Anything).
-io__write(Stream, X) -->
+io__write(Stream, NonCanon, X) -->
io__set_output_stream(Stream, OrigStream),
- io__write(X),
+ io__do_write(NonCanon, X),
io__set_output_stream(OrigStream, _Stream).
-%-----------------------------------------------------------------------------%
+io__write(Stream, X) -->
+ io__set_output_stream(Stream, OrigStream),
+ io__do_write(canonicalize, X),
+ io__set_output_stream(OrigStream, _Stream).
io__write(Term) -->
{ type_to_univ(Term, Univ) },
io__write_univ(Univ).
+:- pred io__do_write(noncanon_handling, T, io__state, io__state).
+:- mode io__do_write(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__do_write(in(canonicalize), in, di, uo) is det.
+:- mode io__do_write(in(do_not_allow), in, di, uo) is det.
+
+io__do_write(NonCanon, Term) -->
+ { type_to_univ(Term, Univ) },
+ io__get_op_table(OpTable),
+ io__do_write_univ(NonCanon, Univ, ops__max_priority(OpTable) + 1).
+
io__write_univ(Univ) -->
io__get_op_table(OpTable),
- io__write_univ(Univ, ops__max_priority(OpTable) + 1).
+ io__do_write_univ(canonicalize, Univ, ops__max_priority(OpTable) + 1).
-:- pred io__write_univ(univ, ops__priority, io__state, io__state).
-:- mode io__write_univ(in, in, di, uo) is det.
+:- pred io__do_write_univ(noncanon_handling, univ, io__state, io__state).
+:- mode io__do_write_univ(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__do_write_univ(in(canonicalize), in, di, uo) is det.
+:- mode io__do_write_univ(in(do_not_allow), in, di, uo) is det.
+
+io__do_write_univ(NonCanon, Univ) -->
+ io__get_op_table(OpTable),
+ io__do_write_univ(NonCanon, Univ, ops__max_priority(OpTable) + 1).
-io__write_univ(Univ, Priority) -->
+:- pred io__do_write_univ(noncanon_handling, univ, ops__priority,
+ io__state, io__state).
+:- mode io__do_write_univ(in(include_details_cc), in, in, di, uo) is cc_multi.
+:- mode io__do_write_univ(in(canonicalize), in, in, di, uo) is det.
+:- mode io__do_write_univ(in(do_not_allow), in, in, di, uo) is det.
+
+io__do_write_univ(NonCanon, Univ, Priority) -->
%
% we need to special-case the builtin types:
% int, char, float, string
@@ -2305,7 +2372,7 @@
{ det_univ_to_type(Univ, PrivateBuiltinTypeInfo) },
io__write_private_builtin_type_info(PrivateBuiltinTypeInfo)
;
- io__write_ordinary_term(Univ, Priority)
+ io__write_ordinary_term(NonCanon, Univ, Priority)
).
:- pred same_array_elem_type(array(T), T).
@@ -2316,21 +2383,24 @@
:- mode same_private_builtin_type(unused, unused) is det.
same_private_builtin_type(_, _).
+:- pred io__write_ordinary_term(noncanon_handling, univ, ops__priority,
+ io__state, io__state).
+:- mode io__write_ordinary_term(in(include_details_cc), in, in, di, uo)
+ is cc_multi.
+:- mode io__write_ordinary_term(in(canonicalize), in, in, di, uo) is det.
+:- mode io__write_ordinary_term(in(do_not_allow), in, in, di, uo) is det.
-:- pred io__write_ordinary_term(univ, ops__priority, io__state, io__state).
-:- mode io__write_ordinary_term(in, in, di, uo) is det.
-
-io__write_ordinary_term(Univ, Priority) -->
+io__write_ordinary_term(NonCanon, Univ, Priority) -->
{ univ_value(Univ) = Term },
- { deconstruct(Term, Functor, _Arity, Args) },
+ { deconstruct__deconstruct(Term, NonCanon, Functor, _Arity, Args) },
io__get_op_table(OpTable),
(
{ Functor = "[|]" },
{ Args = [ListHead, ListTail] }
->
io__write_char('['),
- io__write_arg(ListHead),
- io__write_list_tail(ListTail),
+ io__write_arg(NonCanon, ListHead),
+ io__write_list_tail(NonCanon, ListTail),
io__write_char(']')
;
{ Functor = "[]" },
@@ -2342,15 +2412,15 @@
{ Args = [BracedTerm] }
->
io__write_string("{ "),
- io__write_univ(BracedTerm),
+ io__do_write_univ(NonCanon, BracedTerm),
io__write_string(" }")
;
{ Functor = "{}" },
{ Args = [BracedHead | BracedTail] }
->
io__write_char('{'),
- io__write_arg(BracedHead),
- io__write_term_args(BracedTail),
+ io__write_arg(NonCanon, BracedHead),
+ io__write_term_args(NonCanon, BracedTail),
io__write_char('}')
;
{ Args = [PrefixArg] },
@@ -2361,7 +2431,7 @@
term_io__quote_atom(Functor),
io__write_char(' '),
{ adjust_priority(OpPriority, OpAssoc, NewPriority) },
- io__write_univ(PrefixArg, NewPriority),
+ io__do_write_univ(NonCanon, PrefixArg, NewPriority),
maybe_write_char(')', Priority, OpPriority)
;
{ Args = [PostfixArg] },
@@ -2370,7 +2440,7 @@
->
maybe_write_char('(', Priority, OpPriority),
{ adjust_priority(OpPriority, OpAssoc, NewPriority) },
- io__write_univ(PostfixArg, NewPriority),
+ io__do_write_univ(NonCanon, PostfixArg, NewPriority),
io__write_char(' '),
term_io__quote_atom(Functor),
maybe_write_char(')', Priority, OpPriority)
@@ -2381,7 +2451,7 @@
->
maybe_write_char('(', Priority, OpPriority),
{ adjust_priority(OpPriority, LeftAssoc, LeftPriority) },
- io__write_univ(Arg1, LeftPriority),
+ io__do_write_univ(NonCanon, Arg1, LeftPriority),
( { Functor = "," } ->
io__write_string(", ")
;
@@ -2390,7 +2460,7 @@
io__write_char(' ')
),
{ adjust_priority(OpPriority, RightAssoc, RightPriority) },
- io__write_univ(Arg2, RightPriority),
+ io__do_write_univ(NonCanon, Arg2, RightPriority),
maybe_write_char(')', Priority, OpPriority)
;
{ Args = [Arg1, Arg2] },
@@ -2401,10 +2471,10 @@
term_io__quote_atom(Functor),
io__write_char(' '),
{ adjust_priority(OpPriority, FirstAssoc, FirstPriority) },
- io__write_univ(Arg1, FirstPriority),
+ io__do_write_univ(NonCanon, Arg1, FirstPriority),
io__write_char(' '),
{ adjust_priority(OpPriority, SecondAssoc, SecondPriority) },
- io__write_univ(Arg2, SecondPriority),
+ io__do_write_univ(NonCanon, Arg2, SecondPriority),
maybe_write_char(')', Priority, OpPriority)
;
(
@@ -2423,8 +2493,8 @@
{ Args = [X|Xs] }
->
io__write_char('('),
- io__write_arg(X),
- io__write_term_args(Xs),
+ io__write_arg(NonCanon, X),
+ io__write_term_args(NonCanon, Xs),
io__write_char(')')
;
[]
@@ -2448,42 +2518,46 @@
adjust_priority(Priority, y, Priority).
adjust_priority(Priority, x, Priority - 1).
-:- pred io__write_list_tail(univ, io__state, io__state).
-:- mode io__write_list_tail(in, di, uo) is det.
+:- pred io__write_list_tail(noncanon_handling, univ, io__state, io__state).
+:- mode io__write_list_tail(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__write_list_tail(in(canonicalize), in, di, uo) is det.
+:- mode io__write_list_tail(in(do_not_allow), in, di, uo) is det.
-io__write_list_tail(Univ) -->
+io__write_list_tail(NonCanon, Univ) -->
{ Term = univ_value(Univ) },
- (
- { deconstruct(Term, "[|]", _Arity, [ListHead, ListTail]) }
- ->
+ { deconstruct__deconstruct(Term, NonCanon, Functor, _Arity, Args) },
+ ( { Functor = "[|]", Args = [ListHead, ListTail] } ->
io__write_string(", "),
- io__write_arg(ListHead),
- io__write_list_tail(ListTail)
- ;
- { deconstruct(Term, "[]", _Arity, []) }
- ->
+ io__write_arg(NonCanon, ListHead),
+ io__write_list_tail(NonCanon, ListTail)
+ ; { Functor = "[]", Args = [] } ->
[]
;
io__write_string(" | "),
- io__write_univ(Univ)
+ io__do_write_univ(NonCanon, Univ)
).
-:- pred io__write_term_args(list(univ), io__state, io__state).
-:- mode io__write_term_args(in, di, uo) is det.
+:- pred io__write_term_args(noncanon_handling, list(univ),
+ io__state, io__state).
+:- mode io__write_term_args(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__write_term_args(in(canonicalize), in, di, uo) is det.
+:- mode io__write_term_args(in(do_not_allow), in, di, uo) is det.
% write the remaining arguments
-io__write_term_args([]) --> [].
-io__write_term_args([X|Xs]) -->
+io__write_term_args(_, []) --> [].
+io__write_term_args(NonCanon, [X|Xs]) -->
io__write_string(", "),
- io__write_arg(X),
- io__write_term_args(Xs).
+ io__write_arg(NonCanon, X),
+ io__write_term_args(NonCanon, Xs).
-:- pred io__write_arg(univ, io__state, io__state).
-:- mode io__write_arg(in, di, uo) is det.
+:- pred io__write_arg(noncanon_handling, univ, io__state, io__state).
+:- mode io__write_arg(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__write_arg(in(canonicalize), in, di, uo) is det.
+:- mode io__write_arg(in(do_not_allow), in, di, uo) is det.
-io__write_arg(X) -->
+io__write_arg(NonCanon, X) -->
arg_priority(ArgPriority),
- io__write_univ(X, ArgPriority).
+ io__do_write_univ(NonCanon, X, ArgPriority).
:- pred arg_priority(int, io__state, io__state).
:- mode arg_priority(out, di, uo) is det.
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.260
diff -u -b -r1.260 std_util.m
--- library/std_util.m 30 Jan 2002 05:08:53 -0000 1.260
+++ library/std_util.m 31 Jan 2002 05:56:46 -0000
@@ -692,7 +692,18 @@
:- implementation.
:- import_module require, set, int, string, bool.
-:- use_module construct, deconstruct.
+:- import_module construct, deconstruct.
+
+% XXX This should not be necessary, but the current compiler is broken in that
+% it puts foreign_proc clauses into deconstruct.opt without also putting the
+% foreign_decl they require into deconstruct.opt as well.
+
+:- pragma foreign_decl("C", "
+
+#include ""mercury_deconstruct.h""
+#include ""mercury_deconstruct_macros.h""
+
+").
%-----------------------------------------------------------------------------%
@@ -1307,9 +1318,6 @@
%-----------------------------------------------------------------------------%
-% The type `std_util:type_desc/0' happens to use much the same
- % representation as `private_builtin:type_info/1'.
-
% We call the constructor for univs `univ_cons' to avoid ambiguity
% with the univ/1 function which returns a univ.
:- type univ --->
@@ -1439,60 +1447,87 @@
% the file deconstruct.m.
functor(Term, Functor, Arity) :-
- deconstruct__functor(Term, Functor, Arity).
+ deconstruct__functor(Term, canonicalize, Functor, Arity).
functor_cc(Term, Functor, Arity) :-
- deconstruct__functor_cc(Term, Functor, Arity).
-
-arg(Term, ArgumentIndex) = Argument :-
- deconstruct__arg(Term, ArgumentIndex) = Argument.
-
-arg_cc(Term, ArgumentIndex, Argument) :-
- deconstruct__arg_cc(Term, ArgumentIndex, Argument).
-
-argument(Term, ArgumentIndex) = ArgumentUniv :-
- deconstruct__argument(Term, ArgumentIndex) = ArgumentUniv.
+ deconstruct__functor(Term, include_details_cc, Functor, Arity).
-argument_cc(Term, ArgumentIndex, ArgumentUniv) :-
- deconstruct__argument_cc(Term, ArgumentIndex, ArgumentUniv).
-
-named_argument(Term, ArgumentName) = ArgumentUniv :-
- deconstruct__named_argument(Term, ArgumentName) = ArgumentUniv.
+arg(Term, Index) = Argument :-
+ deconstruct__arg(Term, canonicalize, Index, Argument0),
+ Argument = same_type(Argument0).
+
+arg_cc(Term, Index, Argument) :-
+ deconstruct__arg(Term, include_details_cc, Index, Argument0),
+ ( Argument1 = same_type(Argument0) ->
+ Argument = Argument1
+ ;
+ error("arg_cc: argument has wrong type")
+ ).
-named_argument_cc(Term, ArgumentName, ArgumentUniv) :-
- deconstruct__named_argument_cc(Term, ArgumentName, ArgumentUniv).
+argument(Term, Index) = ArgumentUniv :-
+ deconstruct__arg(Term, canonicalize, Index, Argument),
+ type_to_univ(Argument, ArgumentUniv).
+
+argument_cc(Term, Index, ArgumentUniv) :-
+ deconstruct__arg(Term, include_details_cc, Index, Argument),
+ type_to_univ(Argument, ArgumentUniv).
+
+named_argument(Term, Name) = ArgumentUniv :-
+ deconstruct__named_arg(Term, canonicalize, Name, Argument),
+ type_to_univ(Argument, ArgumentUniv).
+
+named_argument_cc(Term, Name, ArgumentUniv) :-
+ deconstruct__named_arg(Term, include_details_cc,
+ Name, Argument),
+ type_to_univ(Argument, ArgumentUniv).
deconstruct(Term, Functor, Arity, Arguments) :-
- deconstruct__deconstruct(Term, Functor, Arity, Arguments).
+ deconstruct__deconstruct(Term, canonicalize,
+ Functor, Arity, Arguments).
deconstruct_cc(Term, Functor, Arity, Arguments) :-
- deconstruct__deconstruct_cc(Term, Functor, Arity, Arguments).
+ deconstruct__deconstruct(Term, include_details_cc,
+ Functor, Arity, Arguments).
limited_deconstruct(Term, MaxArity, Functor, Arity, Arguments) :-
- deconstruct__limited_deconstruct(Term, MaxArity, Functor, Arity,
- Arguments).
+ deconstruct__limited_deconstruct(Term, canonicalize,
+ MaxArity, Functor, Arity, Arguments).
limited_deconstruct_cc(Term, MaxArity, Functor, Arity, Arguments) :-
- deconstruct__limited_deconstruct_cc(Term, MaxArity, Functor, Arity,
- Arguments).
-
-det_arg(Type, ArgumentIndex) = Argument :-
- deconstruct__det_arg(Type, ArgumentIndex) = Argument.
-
-det_arg_cc(Type, ArgumentIndex, Argument) :-
- deconstruct__det_arg_cc(Type, ArgumentIndex, Argument).
+ deconstruct__limited_deconstruct(Term, include_details_cc,
+ MaxArity, Functor, Arity, Arguments).
-det_argument(Type, ArgumentIndex) = Argument :-
- deconstruct__det_argument(Type, ArgumentIndex) = Argument.
-
-det_argument_cc(Type, ArgumentIndex, Argument) :-
- deconstruct__det_argument_cc(Type, ArgumentIndex, Argument).
+det_arg(Type, Index) = Argument :-
+ deconstruct__det_arg(Type, canonicalize, Index, Argument0),
+ ( Argument1 = same_type(Argument0) ->
+ Argument = Argument1
+ ;
+ error("det_arg: argument has wrong type")
+ ).
-det_named_argument(Type, ArgumentName) = Argument :-
- deconstruct__det_named_argument(Type, ArgumentName) = Argument.
+det_arg_cc(Type, Index, Argument) :-
+ deconstruct__det_arg(Type, include_details_cc, Index, Argument0),
+ ( Argument1 = same_type(Argument0) ->
+ Argument = Argument1
+ ;
+ error("det_arg_cc: argument has wrong type")
+ ).
-det_named_argument_cc(Type, ArgumentName, Argument) :-
- deconstruct__det_named_argument_cc(Type, ArgumentName, Argument).
+det_argument(Type, Index) = ArgumentUniv :-
+ deconstruct__det_arg(Type, canonicalize, Index, Argument),
+ type_to_univ(Argument, ArgumentUniv).
+
+det_argument_cc(Type, Index, ArgumentUniv) :-
+ deconstruct__det_arg(Type, include_details_cc, Index, Argument),
+ type_to_univ(Argument, ArgumentUniv).
+
+det_named_argument(Type, Name) = ArgumentUniv :-
+ deconstruct__det_named_arg(Type, canonicalize, Name, Argument),
+ type_to_univ(Argument, ArgumentUniv).
+
+det_named_argument_cc(Type, Name, ArgumentUniv) :-
+ deconstruct__det_named_arg(Type, include_details_cc, Name, Argument),
+ type_to_univ(Argument, ArgumentUniv).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/store.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/store.m,v
retrieving revision 1.30
diff -u -b -r1.30 store.m
--- library/store.m 20 Jan 2002 07:32:26 -0000 1.30
+++ library/store.m 31 Jan 2002 02:57:56 -0000
@@ -362,7 +362,7 @@
MR_save_transient_registers();
if (!MR_arg(type_info, (MR_Word *) Ref, ArgNum, &arg_type_info,
- &arg_ref, MR_ABORT_ON_NONCANONICAL, ""arg_ref/4""))
+ &arg_ref, MR_NONCANON_ABORT))
{
MR_fatal_error(
""store__arg_ref: argument number out of range"");
@@ -395,7 +395,7 @@
MR_save_transient_registers();
if (!MR_arg(type_info, (MR_Word *) &Val, ArgNum, &arg_type_info,
- &arg_ref, MR_ABORT_ON_NONCANONICAL, ""new_arg_ref/5""))
+ &arg_ref, MR_NONCANON_ABORT))
{
MR_fatal_error(
""store__new_arg_ref: argument number out of range"");
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.1
diff -u -b -r1.1 type_desc.m
--- library/type_desc.m 30 Jan 2002 05:08:56 -0000 1.1
+++ library/type_desc.m 31 Jan 2002 08:26:56 -0000
@@ -46,6 +46,12 @@
% second argument.
:- some [T] pred has_type(T::unused, type_desc__type_desc::in) is det.
+ % same_type(X) = Y:
+ % If X and Y have the same type at runtime (i.e. types T and U
+ % compare equal), then same_type, assigns X to Y. Otherwise,
+ % it fails.
+:- func same_type(T) = U is semidet.
+
% type_name(Type) returns the name of the specified type
% (e.g. type_name(type_of([2,3])) = "list:list(int)").
% Any equivalence types will be fully expanded.
@@ -152,6 +158,7 @@
#include ""mercury_heap.h"" /* for MR_incr_hp_msg() etc. */
#include ""mercury_misc.h"" /* for MR_fatal_error() */
#include ""mercury_string.h"" /* for MR_make_aligned_string() */
+#include ""mercury_type_info.h"" /* for MR_compare_type_info */
#include ""mercury_type_desc.h""
").
@@ -406,6 +413,28 @@
"
TypeInfo_for_T = TypeInfo;
").
+
+:- pragma foreign_proc("C",
+ same_type(X::in) = (Y::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ int result;
+
+ MR_save_transient_hp();
+ result = MR_compare_type_info((MR_TypeInfo) TypeInfo_for_T,
+ (MR_TypeInfo) TypeInfo_for_U);
+ MR_restore_transient_hp();
+
+ if (result == MR_COMPARE_EQUAL) {
+ Y = X;
+ SUCCESS_INDICATOR = TRUE;
+ } else {
+ SUCCESS_INDICATOR = FALSE;
+ }
+").
+
+same_type(_X::in) = (_Y::out) :-
+ error("NYI: same_type").
% Export this function in order to use it in runtime/mercury_trace_external.c
:- pragma export(type_name(in) = out, "ML_type_name").
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_deconstruct.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deconstruct.c,v
retrieving revision 1.4
diff -u -b -r1.4 mercury_deconstruct.c
--- runtime/mercury_deconstruct.c 30 Jan 2002 05:08:59 -0000 1.4
+++ runtime/mercury_deconstruct.c 30 Jan 2002 09:25:39 -0000
@@ -72,43 +72,15 @@
#undef EXPAND_TYPE_NAME
#undef EXPAND_NAMED_ARG
-/*
-** MR_arg() is a subroutine used to implement arg/2, argument/2,
-** and also store__arg_ref/5 in store.m.
-** It takes the address of a term, its type, and an argument index.
-** If the selected argument exists, it succeeds and returns the address
-** of the argument, and its type; if it doesn't, it fails (i.e. returns FALSE).
-**
-** You need to wrap MR_{save/restore}_transient_hp() around
-** calls to this function.
-*/
-
bool
MR_arg(MR_TypeInfo type_info, MR_Word *term_ptr, int arg_index,
MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr,
- MR_non_canon_handling noncanon_handling, MR_ConstString msg)
+ MR_noncanon_handling noncanon)
{
MR_Expand_Chosen_Arg_Only_Info expand_info;
- MR_expand_chosen_arg_only(type_info, term_ptr, arg_index, &expand_info);
- if (expand_info.non_canonical_type) {
- switch (noncanon_handling) {
- case MR_ALLOW_NONCANONICAL:
- break;
-
- case MR_FAIL_ON_NONCANONICAL:
- return FALSE;
- break;
-
- case MR_ABORT_ON_NONCANONICAL:
- MR_fatal_error(msg);
- break;
-
- default:
- MR_fatal_error("MR_arg: bad noncanon_handling");
- break;
- }
- }
+ MR_expand_chosen_arg_only(type_info, term_ptr, noncanon, arg_index,
+ &expand_info);
/* Check range */
if (expand_info.chosen_index_exists) {
@@ -120,42 +92,15 @@
return FALSE;
}
-/*
-** MR_named_arg() is a subroutine used to implement named_arg/2.
-** It takes the address of a term, its type, and an argument name.
-** If an argument with that name exists, it succeeds and returns the address
-** of the argument, and its type; if it doesn't, it fails (i.e. returns FALSE).
-**
-** You need to wrap MR_{save/restore}_transient_hp() around
-** calls to this function.
-*/
-
bool
MR_named_arg(MR_TypeInfo type_info, MR_Word *term_ptr, MR_ConstString arg_name,
MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr,
- MR_non_canon_handling noncanon_handling, MR_ConstString msg)
+ MR_noncanon_handling noncanon)
{
MR_Expand_Chosen_Arg_Only_Info expand_info;
- MR_expand_named_arg_only(type_info, term_ptr, arg_name, &expand_info);
- if (expand_info.non_canonical_type) {
- switch (noncanon_handling) {
- case MR_ALLOW_NONCANONICAL:
- break;
-
- case MR_FAIL_ON_NONCANONICAL:
- return FALSE;
- break;
-
- case MR_ABORT_ON_NONCANONICAL:
- MR_fatal_error(msg);
- break;
-
- default:
- MR_fatal_error("MR_named_arg: bad noncanon_handling");
- break;
- }
- }
+ MR_expand_named_arg_only(type_info, term_ptr, noncanon, arg_name,
+ &expand_info);
/* Check range */
if (expand_info.chosen_index_exists) {
@@ -166,16 +111,6 @@
return FALSE;
}
-
-/*
-** MR_named_arg_num() takes the address of a term, its type, and an argument
-** name. If the given term has an argument with the given name, it succeeds and
-** returns the argument number (counted starting from 0) of the argument;
-** if it doesn't, it fails (i.e. returns FALSE).
-**
-** You need to wrap MR_{save/restore}_transient_hp() around
-** calls to this function.
-*/
bool
MR_named_arg_num(MR_TypeInfo type_info, MR_Word *term_ptr,
Index: runtime/mercury_deconstruct.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deconstruct.h,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_deconstruct.h
--- runtime/mercury_deconstruct.h 9 Jan 2002 06:41:34 -0000 1.1
+++ runtime/mercury_deconstruct.h 30 Jan 2002 09:27:56 -0000
@@ -29,14 +29,12 @@
} MR_Expand_Args_Fields;
typedef struct {
- bool non_canonical_type;
int arity;
MR_ConstString functor;
MR_Expand_Args_Fields args;
} MR_Expand_Functor_Args_Info;
typedef struct {
- bool non_canonical_type;
int arity;
MR_ConstString functor;
MR_Expand_Args_Fields args;
@@ -44,92 +42,106 @@
} MR_Expand_Functor_Args_Limit_Info;
typedef struct {
- bool non_canonical_type;
int arity;
MR_ConstString functor_only;
} MR_Expand_Functor_Only_Info;
typedef struct {
- bool non_canonical_type;
int arity;
MR_Expand_Args_Fields args_only;
} MR_Expand_Args_Only_Info;
typedef struct {
- bool non_canonical_type;
int arity;
bool chosen_index_exists;
MR_Word *chosen_value_ptr;
MR_TypeInfo chosen_type_info;
} MR_Expand_Chosen_Arg_Only_Info;
+/*
+** MR_NONCANON_ABORT asks that deconstructions of noncanonical types should
+** cause a runtime abort.
+**
+** MR_NONCANON_ALLOW asks that deconstructions of noncanonical types should
+** return a constant that indicates this fact.
+**
+** MR_NONCANON_CC asks that deconstruction of noncanonical types should
+** deconstruct the term as if it were canonical. Since by definition,
+** noncanonical types may have more than one representation for the same value,
+** this requires the caller to be in a committed choice context.
+*/
+
+typedef enum {
+ MR_NONCANON_ABORT,
+ MR_NONCANON_ALLOW,
+ MR_NONCANON_CC
+} MR_noncanon_handling;
+
extern void MR_expand_functor_args(MR_TypeInfo type_info,
- MR_Word *data_word_ptr,
+ MR_Word *data_word_ptr, MR_noncanon_handling noncanon,
MR_Expand_Functor_Args_Info *expand_info);
extern void MR_expand_functor_args_limit(MR_TypeInfo type_info,
- MR_Word *data_word_ptr, int max_arity,
+ MR_Word *data_word_ptr, MR_noncanon_handling noncanon,
+ int max_arity,
MR_Expand_Functor_Args_Limit_Info *expand_info);
extern void MR_expand_functor_only(MR_TypeInfo type_info,
- MR_Word *data_word_ptr,
+ MR_Word *data_word_ptr, MR_noncanon_handling noncanon,
MR_Expand_Functor_Only_Info *expand_info);
extern void MR_expand_args_only(MR_TypeInfo type_info,
- MR_Word *data_word_ptr,
+ MR_Word *data_word_ptr, MR_noncanon_handling noncanon,
MR_Expand_Args_Only_Info *expand_info);
extern void MR_expand_chosen_arg_only(MR_TypeInfo type_info,
- MR_Word *data_word_ptr, int chosen,
- MR_Expand_Chosen_Arg_Only_Info *expand_info);
+ MR_Word *data_word_ptr, MR_noncanon_handling noncanon,
+ int chosen, MR_Expand_Chosen_Arg_Only_Info *expand_info);
extern void MR_expand_named_arg_only(MR_TypeInfo type_info,
- MR_Word *data_word_ptr, MR_ConstString chosen_name,
+ MR_Word *data_word_ptr, MR_noncanon_handling noncanon,
+ MR_ConstString chosen_name,
MR_Expand_Chosen_Arg_Only_Info *expand_info);
-typedef enum {
- MR_ALLOW_NONCANONICAL,
- MR_FAIL_ON_NONCANONICAL,
- MR_ABORT_ON_NONCANONICAL
-} MR_non_canon_handling;
-
- /*
- ** MR_arg() takes the address of a term, its type, and an
- ** argument position (the first argument being at position 1).
- ** If the given term has an argument at that position, MR_arg
- ** returns TRUE and fills in the locations pointed to by the
- ** argument_ptr and arg_type_info_ptr arguments with the value
- ** and type of the argument at the selected position.
- **
- ** The noncanon argument says how MR_arg should behave if the
- ** term being deconstructed is of a non-canonical type. The msg
- ** is for use if noncanon is MR_ABORT_ON_NONCANONICAL.
- */
+/*
+** MR_arg() takes the address of a term, its type, and an
+** argument position (the first argument being at position 1).
+** If the given term has an argument at that position, MR_arg
+** returns TRUE and fills in the locations pointed to by the
+** argument_ptr and arg_type_info_ptr arguments with the value
+** and type of the argument at the selected position.
+** If it doesn't, it fails (i.e. returns FALSE).
+**
+** You need to wrap MR_{save/restore}_transient_hp() around
+** calls to this function.
+*/
extern bool MR_arg(MR_TypeInfo type_info, MR_Word *term, int arg_index,
MR_TypeInfo *arg_type_info_ptr, MR_Word **argument_ptr,
- MR_non_canon_handling noncanon, MR_ConstString msg);
+ MR_noncanon_handling noncanon);
- /*
- ** MR_named_arg() is just like MR_arg, except the argument
- ** is selected by name, not by position.
- */
+/*
+** MR_named_arg() is just like MR_arg, except the argument
+** is selected by name, not by position.
+**
+** You need to wrap MR_{save/restore}_transient_hp() around
+** calls to this function.
+*/
extern bool MR_named_arg(MR_TypeInfo type_info, MR_Word *term,
MR_ConstString arg_name, MR_TypeInfo *arg_type_info_ptr,
- MR_Word **argument_ptr, MR_non_canon_handling noncanon,
- MR_ConstString msg);
+ MR_Word **argument_ptr, MR_noncanon_handling noncanon);
- /*
- ** MR_named_arg_num() takes the address of a term, its type,
- ** and an argument name. If the given term has an argument
- ** with the given name, it succeeds and returns the argument
- ** number (counted starting from 0) of the argument; if it
- ** doesn't, it fails (i.e. returns FALSE).
- **
- ** You need to wrap MR_{save/restore}_transient_hp() around
- ** calls to this function.
- */
+/*
+** MR_named_arg_num() takes the address of a term, its type,
+** and an argument name. If the given term has an argument
+** with the given name, it succeeds and returns the argument
+** number (counted starting from 0) of the argument. If it
+** doesn't, it fails (i.e. returns FALSE).
+**
+** You need to wrap MR_{save/restore}_transient_hp() around
+** calls to this function.
+*/
extern bool MR_named_arg_num(MR_TypeInfo type_info, MR_Word *term_ptr,
const char *arg_name, int *arg_num_ptr);
Index: runtime/mercury_ml_arg_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_arg_body.h,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_ml_arg_body.h
--- runtime/mercury_ml_arg_body.h 9 Jan 2002 06:41:34 -0000 1.1
+++ runtime/mercury_ml_arg_body.h 31 Jan 2002 00:33:16 -0000
@@ -10,17 +10,11 @@
/*
** mercury_ml_arg_body.h
**
-** This file is included several times in library/std_util.m. Each inclusion
-** defines the body of one of several variants of `arg' function.
+** This file is included several times in library/deconstruct.m. Each inclusion
+** defines the body of one of several variants of the `arg' function.
**
** The code including this file must define these macros:
**
-** PREDNAME Gives the name of the function or predicate being
-** defined.
-**
-** NONCANON_HANDLING Gives the desired handling of non-canonical types
-** as a value of C type MR_noncanon_handling.
-**
** TYPEINFO_ARG Gives the name of the argument that contains the
** typeinfo of the term being deconstructed.
**
@@ -33,13 +27,17 @@
** SELECTED_ARG Gives the name of the argument to which the value of
** the selected field should be assigned.
**
+** SELECTED_TYPE_INFO Gives the name of the argument to which the typeinfo of
+** the selected field should be assigned.
+**
+** NONCANON Gives a value of type MR_noncanon_handling; its value
+** will govern the handling of values of noncanonical
+** types.
+**
** The code including this file may define these macros:
**
** SELECT_BY_NAME If defined, the argument is selected by name; if it is
** not defined, the argument is selected by position.
-**
-** EXPECTED_TYPE_INFO If defined, gives a C expression containing the
-** typeinfo of the expected type
*/
#ifdef SELECT_BY_NAME
@@ -57,29 +55,21 @@
MR_save_transient_registers();
success = arg_func(type_info, &TERM_ARG, SELECTOR_ARG, &arg_type_info,
- &argument_ptr, NONCANON_HANDLING, MR_noncanon_msg(PREDNAME));
-#ifdef EXPECTED_TYPE_INFO
- if (success) { \
- /* compare the actual type of the argument with its expected type */\
- int comparison_result; \
- comparison_result = MR_compare_type_info(arg_type_info, \
- (MR_TypeInfo) EXPECTED_TYPE_INFO); \
- success = (comparison_result == MR_COMPARE_EQUAL); \
- \
- if (success) { \
- SELECTED_ARG = *argument_ptr; \
- } \
- } \
- \
- MR_restore_transient_registers(); \
- SUCCESS_INDICATOR = success;
-#else
- MR_restore_transient_registers(); \
- if (success) { \
- MR_new_univ_on_hp(SELECTED_ARG, arg_type_info, *argument_ptr); \
- } \
- \
+ &argument_ptr, NONCANON);
+ MR_restore_transient_registers();
+ if (success) {
+ /*
+ ** The following code is what *should* be here. The reason it is
+ ** commented out, and the code to create a univ used instead, is
+ ** the typechecking bug reported on 30 Jan, 2002.
+ **
+ ** SELECTED_ARG = *argument_ptr;
+ ** SELECTED_TYPE_INFO = arg_type_info;
+ */
+
+ MR_new_univ_on_hp(SELECTED_ARG, arg_type_info, *argument_ptr);
+ }
+
SUCCESS_INDICATOR = success;
-#endif
#undef arg_func
Index: runtime/mercury_ml_deconstruct_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_deconstruct_body.h,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_ml_deconstruct_body.h
--- runtime/mercury_ml_deconstruct_body.h 9 Jan 2002 06:41:34 -0000 1.1
+++ runtime/mercury_ml_deconstruct_body.h 30 Jan 2002 09:39:31 -0000
@@ -10,8 +10,8 @@
/*
** mercury_ml_deconstruct_body.h
**
-** This file is included several times in library/std_util.m. Each inclusion
-** defines the body of one of several variants of `deconstruct' function.
+** This file is included several times in library/deconstruct.m. Each inclusion
+** defines the body of one of several variants of the `deconstruct' function.
**
** The code including this file must define these macros:
**
@@ -40,25 +40,17 @@
** univs representing the arguments of the term should
** be assigned.
**
-** The code including this file may define these macros:
+** NONCANON Gives a value of type MR_noncanon_handling; its value
+** will govern the handling of values of noncanonical
+** types.
**
-** ALLOW_NONCANONICAL If defined, allow the deconstruction of non-canonical
-** types. If not defined, abort if the type being
-** deconstructed is non-canonical.
+** The code including this file may define these macros:
**
** MAX_ARITY_ARG If defined, gives the name of the argument whose value
** gives the maximum number of arguments we want to
** succeed for.
*/
-#ifdef ALLOW_NONCANONICAL
- #define maybe_abort_if_noncanonical(expand_info, msg) \
- ((void) 0)
-#else
- #define maybe_abort_if_noncanonical(expand_info, msg) \
- MR_abort_if_type_is_noncanonical(expand_info, msg)
-#endif
-
#ifdef MAX_ARITY_ARG
#define maybe_max_arity_arg MAX_ARITY_ARG,
#define max_arity_check_start \
@@ -79,11 +71,10 @@
type_info = (MR_TypeInfo) TYPEINFO_ARG;
MR_save_transient_registers();
- EXPAND_INFO_CALL(type_info, &TERM_ARG, maybe_max_arity_arg &expand_info);
+ EXPAND_INFO_CALL(type_info, &TERM_ARG, NONCANON,
+ maybe_max_arity_arg &expand_info);
MR_restore_transient_registers();
- maybe_abort_if_noncanonical(expand_info, MR_noncanon_msg(PREDNAME));
-
max_arity_check_start
MR_deconstruct_get_functor(expand_info, functor, FUNCTOR_ARG);
MR_deconstruct_get_arity(expand_info, ARITY_ARG);
@@ -91,7 +82,6 @@
MR_deconstruct_free_allocated_arg_type_infos(expand_info, args);
max_arity_check_end
-#undef maybe_abort_if_noncanonical
#undef maybe_max_arity_arg
#undef max_arity_check_start
#undef max_arity_check_end
Index: runtime/mercury_ml_expand_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_expand_body.h,v
retrieving revision 1.12
diff -u -b -r1.12 mercury_ml_expand_body.h
--- runtime/mercury_ml_expand_body.h 30 Jan 2002 05:09:00 -0000 1.12
+++ runtime/mercury_ml_expand_body.h 31 Jan 2002 05:53:19 -0000
@@ -61,6 +61,7 @@
** in the limit_reached field of expand_info and will
** not fill in the other fields about the arguments.
**
+**
** Most combinations are allowed, but
**
** - only one of EXPAND_ARGS_FIELD, EXPAND_CHOSEN_ARG and EXPAND_NAMED_ARG
@@ -73,9 +74,8 @@
** be different for different variants. The type in EXPAND_TYPE_NAME must be
** consistent with the set of defined optional macros.
**
-** All variants contain the boolean field non_canonical_type, which will be
-** set to TRUE iff the type has user-defined equality, and the integer field
-** arity, which will be set to the number of arguments the functor has.
+** All variants contain the the integer field arity, which will be set to
+** the number of arguments the functor has.
**
** The variants that return all the arguments do so in a field of type
** MR_Expand_Args_Fields. Its arg_type_infos subfield will contain a pointer
@@ -191,6 +191,7 @@
void
EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
+ MR_noncanon_handling noncanon,
#ifdef EXPAND_APPLY_LIMIT
int max_arity,
#endif /* EXPAND_APPLY_LIMIT */
@@ -215,7 +216,6 @@
#endif /* EXPAND_NAMED_ARG */
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
- expand_info->non_canonical_type = FALSE;
#ifdef EXPAND_ARGS_FIELD
expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos = FALSE;
#endif /* EXPAND_ARGS_FIELD */
@@ -226,8 +226,16 @@
switch(MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_ENUM_USEREQ:
- expand_info->non_canonical_type = TRUE;
- /* fall through */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ } else if (noncanon == MR_NONCANON_ALLOW) {
+ handle_functor_name("noncanonical");
+ handle_zero_arity_args();
+ break;
+ }
+ /* else fall through */
case MR_TYPECTOR_REP_ENUM:
handle_functor_name(MR_type_ctor_layout(type_ctor_info).
@@ -236,8 +244,16 @@
break;
case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
- expand_info->non_canonical_type = TRUE;
- /* fall through */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ } else if (noncanon == MR_NONCANON_ALLOW) {
+ handle_functor_name("noncanonical");
+ handle_zero_arity_args();
+ break;
+ }
+ /* else fall through */
case MR_TYPECTOR_REP_RESERVED_ADDR:
{
@@ -288,8 +304,16 @@
}
case MR_TYPECTOR_REP_DU_USEREQ:
- expand_info->non_canonical_type = TRUE;
- /* fall through */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ } else if (noncanon == MR_NONCANON_ALLOW) {
+ handle_functor_name("noncanonical");
+ handle_zero_arity_args();
+ break;
+ }
+ /* else fall through */
case MR_TYPECTOR_REP_DU:
du_type_layout = MR_type_ctor_layout(type_ctor_info).layout_du;
@@ -333,18 +357,14 @@
arg_vector = (MR_Word *) MR_body(data, ptag) + 1;
break;
case MR_SECTAG_VARIABLE:
+ if (noncanon != MR_NONCANON_CC) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct variable");
+ break;
+ }
+
handle_functor_name("<<variable>>");
handle_zero_arity_args();
-
- /*
- ** XXX We should do something like the
- ** following, since deconstructing a value
- ** that might be a variable should be
- ** cc_multi rather than det. However, there
- ** is no such version of deconstruct yet,
- ** so we'll leave it out.
- */
- /*expand_info->non_canonical_type = TRUE;*/
return;
}
@@ -435,8 +455,16 @@
break;
case MR_TYPECTOR_REP_NOTAG_USEREQ:
- expand_info->non_canonical_type = TRUE;
- /* fall through */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ } else if (noncanon == MR_NONCANON_ALLOW) {
+ handle_functor_name("noncanonical");
+ handle_zero_arity_args();
+ break;
+ }
+ /* else fall through */
case MR_TYPECTOR_REP_NOTAG:
expand_info->arity = 1;
@@ -482,8 +510,16 @@
break;
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
- expand_info->non_canonical_type = TRUE;
- /* fall through */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ } else if (noncanon == MR_NONCANON_ALLOW) {
+ handle_functor_name("noncanonical");
+ handle_zero_arity_args();
+ break;
+ }
+ /* else fall through */
case MR_TYPECTOR_REP_NOTAG_GROUND:
expand_info->arity = 1;
@@ -533,7 +569,7 @@
eqv_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_equiv);
- EXPAND_FUNCTION_NAME(eqv_type_info, data_word_ptr,
+ EXPAND_FUNCTION_NAME(eqv_type_info, data_word_ptr, noncanon,
EXTRA_ARGS expand_info);
}
break;
@@ -541,7 +577,7 @@
case MR_TYPECTOR_REP_EQUIV_GROUND:
EXPAND_FUNCTION_NAME(MR_pseudo_type_info_is_ground(
MR_type_ctor_layout(type_ctor_info).layout_equiv),
- data_word_ptr, EXTRA_ARGS expand_info);
+ data_word_ptr, noncanon, EXTRA_ARGS expand_info);
break;
case MR_TYPECTOR_REP_INT:
@@ -622,13 +658,23 @@
break;
case MR_TYPECTOR_REP_FUNC:
- /* XXX expand_info->non_canonical_type = TRUE; */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ }
+
handle_functor_name("<<function>>");
handle_zero_arity_args();
break;
case MR_TYPECTOR_REP_PRED:
- /* XXX expand_info->non_canonical_type = TRUE; */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ }
+
handle_functor_name("<<predicate>>");
handle_zero_arity_args();
break;
@@ -683,7 +729,7 @@
*/
data_word = *data_word_ptr;
MR_unravel_univ(data_word, univ_type_info, univ_data);
- EXPAND_FUNCTION_NAME(univ_type_info, &univ_data,
+ EXPAND_FUNCTION_NAME(univ_type_info, &univ_data, noncanon,
EXTRA_ARGS expand_info);
break;
}
@@ -697,35 +743,56 @@
": cannot expand void types");
case MR_TYPECTOR_REP_C_POINTER:
- /* XXX expand_info->non_canonical_type = TRUE; */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ }
+
handle_functor_name("<<c_pointer>>");
handle_zero_arity_args();
break;
case MR_TYPECTOR_REP_TYPEINFO:
- /* XXX expand_info->non_canonical_type = TRUE; */
- /* XXX should we return the arguments here? */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ }
+
handle_functor_name("<<typeinfo>>");
handle_zero_arity_args();
break;
case MR_TYPECTOR_REP_TYPECTORINFO:
- /* XXX expand_info->non_canonical_type = TRUE; */
- /* XXX should we return the arguments here? */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ }
+
handle_functor_name("<<typectorinfo>>");
handle_zero_arity_args();
break;
case MR_TYPECTOR_REP_TYPECLASSINFO:
- /* XXX expand_info->non_canonical_type = TRUE; */
- /* XXX should we return the arguments here? */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ }
+
handle_functor_name("<<typeclassinfo>>");
handle_zero_arity_args();
break;
case MR_TYPECTOR_REP_BASETYPECLASSINFO:
- /* XXX expand_info->non_canonical_type = TRUE; */
- /* XXX should we return the arguments here? */
+ if (noncanon == MR_NONCANON_ABORT) {
+ MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
+ ": attempt to deconstruct noncanonical term");
+ break;
+ }
+
handle_functor_name("<<basetypeclassinfo>>");
handle_zero_arity_args();
break;
Index: runtime/mercury_ml_functor_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_functor_body.h,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_ml_functor_body.h
--- runtime/mercury_ml_functor_body.h 9 Jan 2002 06:41:34 -0000 1.1
+++ runtime/mercury_ml_functor_body.h 30 Jan 2002 09:37:31 -0000
@@ -10,14 +10,11 @@
/*
** mercury_ml_functor_body.h
**
-** This file is included several times in library/std_util.m. Each inclusion
-** defines the body of one of several variants of `functor' function.
+** This file is included several times in library/deconstruct.m. Each inclusion
+** defines the body of one of several variants of the `functor' function.
**
** The code including this file must define these macros:
**
-** PREDNAME Gives the name of the function or predicate being
-** defined.
-**
** TYPEINFO_ARG Gives the name of the argument that contains the
** typeinfo of the term being deconstructed.
**
@@ -30,32 +27,19 @@
** ARITY_ARG Gives the name of the argument to which we assign
** the arity of the term.
**
-** The code including this file may define these macros:
-**
-** ALLOW_NONCANONICAL If defined, allow the deconstruction of non-canonical
-** types. If not defined, abort if the type being
-** deconstructed is non-canonical.
+** NONCANON Gives a value of type MR_noncanon_handling; its value
+** will govern the handling of values of noncanonical
+** types.
*/
-#ifdef ALLOW_NONCANONICAL
- #define maybe_abort_if_noncanonical(expand_info, msg) \
- ((void) 0)
-#else
- #define maybe_abort_if_noncanonical(expand_info, msg) \
- MR_abort_if_type_is_noncanonical(expand_info, msg)
-#endif
-
MR_TypeInfo type_info;
MR_Expand_Functor_Only_Info expand_info;
type_info = (MR_TypeInfo) TYPEINFO_ARG;
MR_save_transient_registers();
- MR_expand_functor_only(type_info, &TERM_ARG, &expand_info);
+ MR_expand_functor_only(type_info, &TERM_ARG, NONCANON, &expand_info);
MR_restore_transient_registers();
- maybe_abort_if_noncanonical(expand_info, MR_noncanon_msg(PREDNAME));
MR_deconstruct_get_functor(expand_info, functor_only, FUNCTOR_ARG);
MR_deconstruct_get_arity(expand_info, ARITY_ARG);
-
-#undef maybe_abort_if_noncanonical
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/polymorphic_output.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/polymorphic_output.exp,v
retrieving revision 1.5
diff -u -b -r1.5 polymorphic_output.exp
--- tests/debugger/polymorphic_output.exp 12 Jan 2002 09:08:13 -0000 1.5
+++ tests/debugger/polymorphic_output.exp 31 Jan 2002 07:22:36 -0000
@@ -55,6 +55,6 @@
mdb: there is no such procedure.
mdb> c
Uncaught exception:
-Software Error: det_arg: argument had wrong type
+Software Error: det_arg: argument has wrong type
Last trace event was event #7.
Last trace event before the unhandled exception was event #4.
Index: tests/debugger/polymorphic_output.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/polymorphic_output.exp2,v
retrieving revision 1.8
diff -u -b -r1.8 polymorphic_output.exp2
--- tests/debugger/polymorphic_output.exp2 18 Jan 2002 04:54:03 -0000 1.8
+++ tests/debugger/polymorphic_output.exp2 31 Jan 2002 07:22:38 -0000
@@ -65,6 +65,6 @@
HeadVar__2 3
mdb> c
Uncaught exception:
-Software Error: det_arg: argument had wrong type
+Software Error: det_arg: argument has wrong type
Last trace event was event #15.
Last trace event before the unhandled exception was event #9.
Index: tests/debugger/polymorphic_output.exp3
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/polymorphic_output.exp3,v
retrieving revision 1.4
diff -u -b -r1.4 polymorphic_output.exp3
--- tests/debugger/polymorphic_output.exp3 18 Jan 2002 03:58:23 -0000 1.4
+++ tests/debugger/polymorphic_output.exp3 31 Jan 2002 07:22:41 -0000
@@ -55,6 +55,6 @@
mdb: there is no such procedure.
mdb> c
Uncaught exception:
-Software Error: det_arg: argument had wrong type
+Software Error: det_arg: argument has wrong type
Last trace event was event #7.
Last trace event before the unhandled exception was event #4.
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/deconstruct_arg.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/deconstruct_arg.exp,v
retrieving revision 1.1
diff -u -b -r1.1 deconstruct_arg.exp
--- tests/hard_coded/deconstruct_arg.exp 22 Jun 2001 03:14:33 -0000 1.1
+++ tests/hard_coded/deconstruct_arg.exp 31 Jan 2002 07:58:31 -0000
@@ -1,162 +1,323 @@
-apple/1
-argument 0 of apple([]) is []
-argument 1 of apple([]) doesn't exist
-argument 2 of apple([]) doesn't exist
-deconstruct: functor apple arity 1
+std_util functor: apple/1
+deconstruct functor: apple/1
+std_util argument 0 of apple([]) is []
+deconstruct argument 0 of apple([]) is []
+std_util argument 1 of apple([]) doesn't exist
+deconstruct argument 1 of apple([]) doesn't exist
+std_util argument 2 of apple([]) doesn't exist
+deconstruct argument 2 of apple([]) doesn't exist
+std_util deconstruct: functor apple arity 1
[[]]
-limited deconstruct 3 of apple([])
+deconstruct deconstruct: functor apple arity 1
+[[]]
+std_util limited deconstruct 3 of apple([])
+functor apple arity 1 [[]]
+deconstruct limited deconstruct 3 of apple([])
functor apple arity 1 [[]]
-apple/1
-argument 0 of apple([9, 5, 1]) is [9, 5, 1]
-argument 1 of apple([9, 5, 1]) doesn't exist
-argument 2 of apple([9, 5, 1]) doesn't exist
-deconstruct: functor apple arity 1
+std_util functor: apple/1
+deconstruct functor: apple/1
+std_util argument 0 of apple([9, 5, 1]) is [9, 5, 1]
+deconstruct argument 0 of apple([9, 5, 1]) is [9, 5, 1]
+std_util argument 1 of apple([9, 5, 1]) doesn't exist
+deconstruct argument 1 of apple([9, 5, 1]) doesn't exist
+std_util argument 2 of apple([9, 5, 1]) doesn't exist
+deconstruct argument 2 of apple([9, 5, 1]) doesn't exist
+std_util deconstruct: functor apple arity 1
+[[9, 5, 1]]
+deconstruct deconstruct: functor apple arity 1
[[9, 5, 1]]
-limited deconstruct 3 of apple([9, 5, 1])
+std_util limited deconstruct 3 of apple([9, 5, 1])
+functor apple arity 1 [[9, 5, 1]]
+deconstruct limited deconstruct 3 of apple([9, 5, 1])
functor apple arity 1 [[9, 5, 1]]
-zop/2
-argument 0 of zop(3.30000000000000, 2.03000000000000) is 3.30000000000000
-argument 1 of zop(3.30000000000000, 2.03000000000000) is 2.03000000000000
-argument 2 of zop(3.30000000000000, 2.03000000000000) doesn't exist
-deconstruct: functor zop arity 2
+std_util functor: zop/2
+deconstruct functor: zop/2
+std_util argument 0 of zop(3.30000000000000, 2.03000000000000) is 3.30000000000000
+deconstruct argument 0 of zop(3.30000000000000, 2.03000000000000) is 3.30000000000000
+std_util argument 1 of zop(3.30000000000000, 2.03000000000000) is 2.03000000000000
+deconstruct argument 1 of zop(3.30000000000000, 2.03000000000000) is 2.03000000000000
+std_util argument 2 of zop(3.30000000000000, 2.03000000000000) doesn't exist
+deconstruct argument 2 of zop(3.30000000000000, 2.03000000000000) doesn't exist
+std_util deconstruct: functor zop arity 2
+[3.30000000000000, 2.03000000000000]
+deconstruct deconstruct: functor zop arity 2
[3.30000000000000, 2.03000000000000]
-limited deconstruct 3 of zop(3.30000000000000, 2.03000000000000)
+std_util limited deconstruct 3 of zop(3.30000000000000, 2.03000000000000)
+functor zop arity 2 [3.30000000000000, 2.03000000000000]
+deconstruct limited deconstruct 3 of zop(3.30000000000000, 2.03000000000000)
functor zop arity 2 [3.30000000000000, 2.03000000000000]
-zap/3
-argument 0 of zap(50, 51.0000000000000, 52) is 50
-argument 1 of zap(50, 51.0000000000000, 52) is 51.0000000000000
-argument 2 of zap(50, 51.0000000000000, 52) is 52
-deconstruct: functor zap arity 3
+std_util functor: zap/3
+deconstruct functor: zap/3
+std_util argument 0 of zap(50, 51.0000000000000, 52) is 50
+deconstruct argument 0 of zap(50, 51.0000000000000, 52) is 50
+std_util argument 1 of zap(50, 51.0000000000000, 52) is 51.0000000000000
+deconstruct argument 1 of zap(50, 51.0000000000000, 52) is 51.0000000000000
+std_util argument 2 of zap(50, 51.0000000000000, 52) is 52
+deconstruct argument 2 of zap(50, 51.0000000000000, 52) is 52
+std_util deconstruct: functor zap arity 3
+[50, 51.0000000000000, 52]
+deconstruct deconstruct: functor zap arity 3
[50, 51.0000000000000, 52]
-limited deconstruct 3 of zap(50, 51.0000000000000, 52)
+std_util limited deconstruct 3 of zap(50, 51.0000000000000, 52)
+functor zap arity 3 [50, 51.0000000000000, 52]
+deconstruct limited deconstruct 3 of zap(50, 51.0000000000000, 52)
functor zap arity 3 [50, 51.0000000000000, 52]
-zip/4
-argument 0 of zip(50, 51, 52, 53) is 50
-argument 1 of zip(50, 51, 52, 53) is 51
-argument 2 of zip(50, 51, 52, 53) is 52
-deconstruct: functor zip arity 4
+std_util functor: zip/4
+deconstruct functor: zip/4
+std_util argument 0 of zip(50, 51, 52, 53) is 50
+deconstruct argument 0 of zip(50, 51, 52, 53) is 50
+std_util argument 1 of zip(50, 51, 52, 53) is 51
+deconstruct argument 1 of zip(50, 51, 52, 53) is 51
+std_util argument 2 of zip(50, 51, 52, 53) is 52
+deconstruct argument 2 of zip(50, 51, 52, 53) is 52
+std_util deconstruct: functor zip arity 4
[50, 51, 52, 53]
-limited deconstruct 3 of zip(50, 51, 52, 53)
+deconstruct deconstruct: functor zip arity 4
+[50, 51, 52, 53]
+std_util limited deconstruct 3 of zip(50, 51, 52, 53)
+failed
+deconstruct limited deconstruct 3 of zip(50, 51, 52, 53)
failed
-wombat/0
-argument 0 of wombat doesn't exist
-argument 1 of wombat doesn't exist
-argument 2 of wombat doesn't exist
-deconstruct: functor wombat arity 0
+std_util functor: wombat/0
+deconstruct functor: wombat/0
+std_util argument 0 of wombat doesn't exist
+deconstruct argument 0 of wombat doesn't exist
+std_util argument 1 of wombat doesn't exist
+deconstruct argument 1 of wombat doesn't exist
+std_util argument 2 of wombat doesn't exist
+deconstruct argument 2 of wombat doesn't exist
+std_util deconstruct: functor wombat arity 0
[]
-limited deconstruct 3 of wombat
+deconstruct deconstruct: functor wombat arity 0
+[]
+std_util limited deconstruct 3 of wombat
+functor wombat arity 0 []
+deconstruct limited deconstruct 3 of wombat
functor wombat arity 0 []
-qwerty/1
-argument 0 of qwerty(5) is 5
-argument 1 of qwerty(5) doesn't exist
-argument 2 of qwerty(5) doesn't exist
-deconstruct: functor qwerty arity 1
+std_util functor: qwerty/1
+deconstruct functor: qwerty/1
+std_util argument 0 of qwerty(5) is 5
+deconstruct argument 0 of qwerty(5) is 5
+std_util argument 1 of qwerty(5) doesn't exist
+deconstruct argument 1 of qwerty(5) doesn't exist
+std_util argument 2 of qwerty(5) doesn't exist
+deconstruct argument 2 of qwerty(5) doesn't exist
+std_util deconstruct: functor qwerty arity 1
+[5]
+deconstruct deconstruct: functor qwerty arity 1
[5]
-limited deconstruct 3 of qwerty(5)
+std_util limited deconstruct 3 of qwerty(5)
+functor qwerty arity 1 [5]
+deconstruct limited deconstruct 3 of qwerty(5)
functor qwerty arity 1 [5]
-'a'/0
-argument 0 of a doesn't exist
-argument 1 of a doesn't exist
-argument 2 of a doesn't exist
-deconstruct: functor 'a' arity 0
+std_util functor: 'a'/0
+deconstruct functor: 'a'/0
+std_util argument 0 of a doesn't exist
+deconstruct argument 0 of a doesn't exist
+std_util argument 1 of a doesn't exist
+deconstruct argument 1 of a doesn't exist
+std_util argument 2 of a doesn't exist
+deconstruct argument 2 of a doesn't exist
+std_util deconstruct: functor 'a' arity 0
+[]
+deconstruct deconstruct: functor 'a' arity 0
[]
-limited deconstruct 3 of a
+std_util limited deconstruct 3 of a
+functor 'a' arity 0 []
+deconstruct limited deconstruct 3 of a
functor 'a' arity 0 []
-3.14159000000000/0
-argument 0 of 3.14159000000000 doesn't exist
-argument 1 of 3.14159000000000 doesn't exist
-argument 2 of 3.14159000000000 doesn't exist
-deconstruct: functor 3.14159000000000 arity 0
+std_util functor: 3.14159000000000/0
+deconstruct functor: 3.14159000000000/0
+std_util argument 0 of 3.14159000000000 doesn't exist
+deconstruct argument 0 of 3.14159000000000 doesn't exist
+std_util argument 1 of 3.14159000000000 doesn't exist
+deconstruct argument 1 of 3.14159000000000 doesn't exist
+std_util argument 2 of 3.14159000000000 doesn't exist
+deconstruct argument 2 of 3.14159000000000 doesn't exist
+std_util deconstruct: functor 3.14159000000000 arity 0
+[]
+deconstruct deconstruct: functor 3.14159000000000 arity 0
[]
-limited deconstruct 3 of 3.14159000000000
+std_util limited deconstruct 3 of 3.14159000000000
+functor 3.14159000000000 arity 0 []
+deconstruct limited deconstruct 3 of 3.14159000000000
functor 3.14159000000000 arity 0 []
-4/0
-argument 0 of 4 doesn't exist
-argument 1 of 4 doesn't exist
-argument 2 of 4 doesn't exist
-deconstruct: functor 4 arity 0
+std_util functor: 4/0
+deconstruct functor: 4/0
+std_util argument 0 of 4 doesn't exist
+deconstruct argument 0 of 4 doesn't exist
+std_util argument 1 of 4 doesn't exist
+deconstruct argument 1 of 4 doesn't exist
+std_util argument 2 of 4 doesn't exist
+deconstruct argument 2 of 4 doesn't exist
+std_util deconstruct: functor 4 arity 0
+[]
+deconstruct deconstruct: functor 4 arity 0
[]
-limited deconstruct 3 of 4
+std_util limited deconstruct 3 of 4
+functor 4 arity 0 []
+deconstruct limited deconstruct 3 of 4
functor 4 arity 0 []
-univ_cons/1
-argument 0 of ["hi! I\'m a univ!"] is ["hi! I\'m a univ!"]
-argument 1 of ["hi! I\'m a univ!"] doesn't exist
-argument 2 of ["hi! I\'m a univ!"] doesn't exist
-deconstruct: functor univ_cons arity 1
+std_util functor: univ_cons/1
+deconstruct functor: univ_cons/1
+std_util argument 0 of ["hi! I\'m a univ!"] is ["hi! I\'m a univ!"]
+deconstruct argument 0 of ["hi! I\'m a univ!"] is ["hi! I\'m a univ!"]
+std_util argument 1 of ["hi! I\'m a univ!"] doesn't exist
+deconstruct argument 1 of ["hi! I\'m a univ!"] doesn't exist
+std_util argument 2 of ["hi! I\'m a univ!"] doesn't exist
+deconstruct argument 2 of ["hi! I\'m a univ!"] doesn't exist
+std_util deconstruct: functor univ_cons arity 1
+[["hi! I\'m a univ!"]]
+deconstruct deconstruct: functor univ_cons arity 1
[["hi! I\'m a univ!"]]
-limited deconstruct 3 of ["hi! I\'m a univ!"]
+std_util limited deconstruct 3 of ["hi! I\'m a univ!"]
+functor univ_cons arity 1 [["hi! I\'m a univ!"]]
+deconstruct limited deconstruct 3 of ["hi! I\'m a univ!"]
functor univ_cons arity 1 [["hi! I\'m a univ!"]]
-<<predicate>>/0
-argument 0 of '<<predicate>>' doesn't exist
-argument 1 of '<<predicate>>' doesn't exist
-argument 2 of '<<predicate>>' doesn't exist
-deconstruct: functor <<predicate>> arity 0
+std_util functor: noncanonical/0
+deconstruct functor: set_rep/1
+std_util argument 0 of noncanonical doesn't exist
+deconstruct argument 0 of noncanonical is [1, 2, 3, 3]
+std_util argument 1 of noncanonical doesn't exist
+deconstruct argument 1 of noncanonical doesn't exist
+std_util argument 2 of noncanonical doesn't exist
+deconstruct argument 2 of noncanonical doesn't exist
+std_util deconstruct: functor noncanonical arity 0
+[]
+deconstruct deconstruct: functor set_rep arity 1
+[[1, 2, 3, 3]]
+std_util limited deconstruct 3 of noncanonical
+functor noncanonical arity 0 []
+deconstruct limited deconstruct 3 of noncanonical
+functor set_rep arity 1 [[1, 2, 3, 3]]
+
+std_util functor: <<predicate>>/0
+deconstruct functor: <<predicate>>/0
+std_util argument 0 of '<<predicate>>' doesn't exist
+deconstruct argument 0 of '<<predicate>>' doesn't exist
+std_util argument 1 of '<<predicate>>' doesn't exist
+deconstruct argument 1 of '<<predicate>>' doesn't exist
+std_util argument 2 of '<<predicate>>' doesn't exist
+deconstruct argument 2 of '<<predicate>>' doesn't exist
+std_util deconstruct: functor <<predicate>> arity 0
+[]
+deconstruct deconstruct: functor <<predicate>> arity 0
[]
-limited deconstruct 3 of '<<predicate>>'
+std_util limited deconstruct 3 of '<<predicate>>'
+functor <<predicate>> arity 0 []
+deconstruct limited deconstruct 3 of '<<predicate>>'
functor <<predicate>> arity 0 []
-{}/2
-argument 0 of {1, 'b'} is 1
-argument 1 of {1, 'b'} is 'b'
-argument 2 of {1, 'b'} doesn't exist
-deconstruct: functor {} arity 2
+std_util functor: {}/2
+deconstruct functor: {}/2
+std_util argument 0 of {1, 'b'} is 1
+deconstruct argument 0 of {1, 'b'} is 1
+std_util argument 1 of {1, 'b'} is 'b'
+deconstruct argument 1 of {1, 'b'} is 'b'
+std_util argument 2 of {1, 'b'} doesn't exist
+deconstruct argument 2 of {1, 'b'} doesn't exist
+std_util deconstruct: functor {} arity 2
+[1, 'b']
+deconstruct deconstruct: functor {} arity 2
[1, 'b']
-limited deconstruct 3 of {1, 'b'}
+std_util limited deconstruct 3 of {1, 'b'}
+functor {} arity 2 [1, 'b']
+deconstruct limited deconstruct 3 of {1, 'b'}
functor {} arity 2 [1, 'b']
-{}/3
-argument 0 of {1, 'b', "third"} is 1
-argument 1 of {1, 'b', "third"} is 'b'
-argument 2 of {1, 'b', "third"} is "third"
-deconstruct: functor {} arity 3
+std_util functor: {}/3
+deconstruct functor: {}/3
+std_util argument 0 of {1, 'b', "third"} is 1
+deconstruct argument 0 of {1, 'b', "third"} is 1
+std_util argument 1 of {1, 'b', "third"} is 'b'
+deconstruct argument 1 of {1, 'b', "third"} is 'b'
+std_util argument 2 of {1, 'b', "third"} is "third"
+deconstruct argument 2 of {1, 'b', "third"} is "third"
+std_util deconstruct: functor {} arity 3
+[1, 'b', "third"]
+deconstruct deconstruct: functor {} arity 3
[1, 'b', "third"]
-limited deconstruct 3 of {1, 'b', "third"}
+std_util limited deconstruct 3 of {1, 'b', "third"}
+functor {} arity 3 [1, 'b', "third"]
+deconstruct limited deconstruct 3 of {1, 'b', "third"}
functor {} arity 3 [1, 'b', "third"]
-{}/4
-argument 0 of {1, 'b', "third", {1, 2, 3, 4}} is 1
-argument 1 of {1, 'b', "third", {1, 2, 3, 4}} is 'b'
-argument 2 of {1, 'b', "third", {1, 2, 3, 4}} is "third"
-deconstruct: functor {} arity 4
+std_util functor: {}/4
+deconstruct functor: {}/4
+std_util argument 0 of {1, 'b', "third", {1, 2, 3, 4}} is 1
+deconstruct argument 0 of {1, 'b', "third", {1, 2, 3, 4}} is 1
+std_util argument 1 of {1, 'b', "third", {1, 2, 3, 4}} is 'b'
+deconstruct argument 1 of {1, 'b', "third", {1, 2, 3, 4}} is 'b'
+std_util argument 2 of {1, 'b', "third", {1, 2, 3, 4}} is "third"
+deconstruct argument 2 of {1, 'b', "third", {1, 2, 3, 4}} is "third"
+std_util deconstruct: functor {} arity 4
+[1, 'b', "third", {1, 2, 3, 4}]
+deconstruct deconstruct: functor {} arity 4
[1, 'b', "third", {1, 2, 3, 4}]
-limited deconstruct 3 of {1, 'b', "third", {1, 2, 3, 4}}
+std_util limited deconstruct 3 of {1, 'b', "third", {1, 2, 3, 4}}
+failed
+deconstruct limited deconstruct 3 of {1, 'b', "third", {1, 2, 3, 4}}
failed
-<<array>>/2
-argument 0 of array([1000, 2000]) is 1000
-argument 1 of array([1000, 2000]) is 2000
-argument 2 of array([1000, 2000]) doesn't exist
-deconstruct: functor <<array>> arity 2
+std_util functor: <<array>>/2
+deconstruct functor: <<array>>/2
+std_util argument 0 of array([1000, 2000]) is 1000
+deconstruct argument 0 of array([1000, 2000]) is 1000
+std_util argument 1 of array([1000, 2000]) is 2000
+deconstruct argument 1 of array([1000, 2000]) is 2000
+std_util argument 2 of array([1000, 2000]) doesn't exist
+deconstruct argument 2 of array([1000, 2000]) doesn't exist
+std_util deconstruct: functor <<array>> arity 2
[1000, 2000]
-limited deconstruct 3 of array([1000, 2000])
+deconstruct deconstruct: functor <<array>> arity 2
+[1000, 2000]
+std_util limited deconstruct 3 of array([1000, 2000])
+functor <<array>> arity 2 [1000, 2000]
+deconstruct limited deconstruct 3 of array([1000, 2000])
functor <<array>> arity 2 [1000, 2000]
-<<array>>/3
-argument 0 of array([100, 200, 300]) is 100
-argument 1 of array([100, 200, 300]) is 200
-argument 2 of array([100, 200, 300]) is 300
-deconstruct: functor <<array>> arity 3
+std_util functor: <<array>>/3
+deconstruct functor: <<array>>/3
+std_util argument 0 of array([100, 200, 300]) is 100
+deconstruct argument 0 of array([100, 200, 300]) is 100
+std_util argument 1 of array([100, 200, 300]) is 200
+deconstruct argument 1 of array([100, 200, 300]) is 200
+std_util argument 2 of array([100, 200, 300]) is 300
+deconstruct argument 2 of array([100, 200, 300]) is 300
+std_util deconstruct: functor <<array>> arity 3
[100, 200, 300]
-limited deconstruct 3 of array([100, 200, 300])
+deconstruct deconstruct: functor <<array>> arity 3
+[100, 200, 300]
+std_util limited deconstruct 3 of array([100, 200, 300])
+functor <<array>> arity 3 [100, 200, 300]
+deconstruct limited deconstruct 3 of array([100, 200, 300])
functor <<array>> arity 3 [100, 200, 300]
-<<array>>/4
-argument 0 of array([10, 20, 30, 40]) is 10
-argument 1 of array([10, 20, 30, 40]) is 20
-argument 2 of array([10, 20, 30, 40]) is 30
-deconstruct: functor <<array>> arity 4
+std_util functor: <<array>>/4
+deconstruct functor: <<array>>/4
+std_util argument 0 of array([10, 20, 30, 40]) is 10
+deconstruct argument 0 of array([10, 20, 30, 40]) is 10
+std_util argument 1 of array([10, 20, 30, 40]) is 20
+deconstruct argument 1 of array([10, 20, 30, 40]) is 20
+std_util argument 2 of array([10, 20, 30, 40]) is 30
+deconstruct argument 2 of array([10, 20, 30, 40]) is 30
+std_util deconstruct: functor <<array>> arity 4
[10, 20, 30, 40]
-limited deconstruct 3 of array([10, 20, 30, 40])
+deconstruct deconstruct: functor <<array>> arity 4
+[10, 20, 30, 40]
+std_util limited deconstruct 3 of array([10, 20, 30, 40])
+failed
+deconstruct limited deconstruct 3 of array([10, 20, 30, 40])
failed
Index: tests/hard_coded/deconstruct_arg.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/deconstruct_arg.m,v
retrieving revision 1.1
diff -u -b -r1.1 deconstruct_arg.m
--- tests/hard_coded/deconstruct_arg.m 22 Jun 2001 03:14:33 -0000 1.1
+++ tests/hard_coded/deconstruct_arg.m 31 Jan 2002 07:58:28 -0000
@@ -1,4 +1,5 @@
-% Test case for deconstruct and arg
+%-----------------------------------------------------------------------------%
+% Test case for functor, arg, deconstruct and their variants.
%
% Author: zs
@@ -6,19 +7,13 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io__state::di, io__state::uo) is cc_multi.
:- implementation.
-:- import_module array, list, string, std_util.
+%-----------------------------------------------------------------------------%
-:- pred test_all(T::in, io__state::di, io__state::uo) is det.
-:- pred test_functor(T::in, io__state::di, io__state::uo) is det.
-:- pred test_arg(T::in, int::in, io__state::di, io__state::uo) is det.
-:- pred test_deconstruct(T::in, io__state::di, io__state::uo) is det.
-:- pred test_limited_deconstruct(T::in, int::in, io__state::di, io__state::uo)
- is det.
-:- pred newline(io__state::di, io__state::uo) is det.
+:- import_module array, list, string, std_util, deconstruct.
:- type enum ---> one ; two ; three.
@@ -35,6 +30,31 @@
:- type no_tag ---> qwerty(int).
+:- type set(T) ---> set_rep(list(T)) where equality is set_equal.
+
+%-----------------------------------------------------------------------------%
+
+% convert list to set
+:- func set(list(T)) = set(T).
+
+set(List) = set_rep(List).
+
+% convert set to sorted list
+:- func set_to_sorted_list(set(T)) = list(T).
+
+set_to_sorted_list(Set) =
+ promise_only_solution((pred(Sorted::out) is cc_multi :-
+ Set = set_rep(Unsorted),
+ list__sort(Unsorted, Sorted)
+ )).
+
+:- pred set_equal(set(T)::in, set(T)::in) is semidet.
+
+set_equal(Set1, Set2) :-
+ set_to_sorted_list(Set1) = set_to_sorted_list(Set2).
+
+%-----------------------------------------------------------------------------%
+
main -->
% test enumerations
% test_all(one), newline,
@@ -58,6 +78,8 @@
% test univ.
{ type_to_univ(["hi! I'm a univ!"], Univ) },
test_all(Univ), newline,
+ % test noncanonical type
+ test_all(set([1,2,3,3])), newline,
% test predicates
test_all(newline), newline,
% test tuples
@@ -69,26 +91,54 @@
test_all(array([100, 200, 300])), newline,
test_all(array([10, 20, 30, 40])), newline.
+%-----------------------------------------------------------------------------%
+
+:- pred test_all(T::in, io__state::di, io__state::uo) is cc_multi.
+
test_all(T) -->
- test_functor(T),
- test_arg(T, 0),
- test_arg(T, 1),
- test_arg(T, 2),
- test_deconstruct(T),
- test_limited_deconstruct(T, 3).
+ test_std_util_functor(T),
+ test_deconstruct_functor(T),
+ test_std_util_arg(T, 0),
+ test_deconstruct_arg(T, 0),
+ test_std_util_arg(T, 1),
+ test_deconstruct_arg(T, 1),
+ test_std_util_arg(T, 2),
+ test_deconstruct_arg(T, 2),
+ test_std_util_deconstruct(T),
+ test_deconstruct_deconstruct(T),
+ test_std_util_limited_deconstruct(T, 3),
+ test_deconstruct_limited_deconstruct(T, 3).
+
+%-----------------------------------------------------------------------------%
+
+:- pred test_std_util_functor(T::in, io__state::di, io__state::uo) is det.
+
+test_std_util_functor(T) -->
+ io__write_string("std_util functor: "),
+ { std_util__functor(T, Functor, Arity) },
+ io__write_string(Functor),
+ io__write_string("/"),
+ io__write_int(Arity),
+ io__write_string("\n").
-test_functor(T) -->
- { functor(T, Functor, Arity) },
+:- pred test_deconstruct_functor(T::in, io__state::di, io__state::uo)
+ is cc_multi.
+
+test_deconstruct_functor(T) -->
+ io__write_string("deconstruct functor: "),
+ { deconstruct__functor(T, include_details_cc, Functor, Arity) },
io__write_string(Functor),
io__write_string("/"),
io__write_int(Arity),
io__write_string("\n").
-test_arg(T, ArgNum) -->
- { string__format("argument %d of ", [i(ArgNum)], Str) },
+:- pred test_std_util_arg(T::in, int::in, io__state::di, io__state::uo) is det.
+
+test_std_util_arg(T, ArgNum) -->
+ { string__format("std_util argument %d of ", [i(ArgNum)], Str) },
io__write_string(Str),
io__print(T),
- ( { Argument = argument(T, ArgNum) } ->
+ ( { Argument = std_util__argument(T, ArgNum) } ->
io__write_string(" is "),
io__write_univ(Argument),
io__write_string("\n")
@@ -96,21 +146,81 @@
io__write_string(" doesn't exist\n")
).
-test_deconstruct(T) -->
- { deconstruct(T, Functor, Arity, Arguments) },
- { string__format("deconstruct: functor %s arity %d\n",
+:- pred test_deconstruct_arg(T::in, int::in, io__state::di, io__state::uo)
+ is cc_multi.
+
+test_deconstruct_arg(T, ArgNum) -->
+ { string__format("deconstruct argument %d of ", [i(ArgNum)], Str) },
+ io__write_string(Str),
+ io__print(T),
+ ( { deconstruct__arg(T, include_details_cc, ArgNum, Arg) } ->
+ io__write_string(" is "),
+ io__write(Arg),
+ io__write_string("\n")
+ ;
+ io__write_string(" doesn't exist\n")
+ ).
+
+:- pred test_std_util_deconstruct(T::in, io__state::di, io__state::uo) is det.
+
+test_std_util_deconstruct(T) -->
+ { std_util__deconstruct(T, Functor, Arity, Arguments) },
+ { string__format("std_util deconstruct: functor %s arity %d\n",
[s(Functor), i(Arity)], Str) },
io__write_string(Str),
io__write_string("["),
io__write_list(Arguments, ", ", io__print),
io__write_string("]\n").
-test_limited_deconstruct(T, Limit) -->
- { string__format("limited deconstruct %d of ", [i(Limit)], Str) },
+:- pred test_deconstruct_deconstruct(T::in, io__state::di, io__state::uo)
+ is cc_multi.
+
+test_deconstruct_deconstruct(T) -->
+ { deconstruct__deconstruct(T, include_details_cc,
+ Functor, Arity, Arguments) },
+ { string__format("deconstruct deconstruct: functor %s arity %d\n",
+ [s(Functor), i(Arity)], Str) },
+ io__write_string(Str),
+ io__write_string("["),
+ io__write_list(Arguments, ", ", io__print),
+ io__write_string("]\n").
+
+:- pred test_std_util_limited_deconstruct(T::in, int::in,
+ io__state::di, io__state::uo) is det.
+
+test_std_util_limited_deconstruct(T, Limit) -->
+ { string__format("std_util limited deconstruct %d of ",
+ [i(Limit)], Str) },
+ io__write_string(Str),
+ io__print(T),
+ io__write_string("\n"),
+ (
+ { std_util__limited_deconstruct(T,
+ Limit, Functor, Arity, Arguments) }
+ ->
+ { string__format("functor %s arity %d ",
+ [s(Functor), i(Arity)], Str2) },
+ io__write_string(Str2),
+ io__write_string("["),
+ io__write_list(Arguments, ", ", io__print),
+ io__write_string("]\n")
+ ;
+ io__write_string("failed\n")
+ ).
+
+:- pred test_deconstruct_limited_deconstruct(T::in, int::in,
+ io__state::di, io__state::uo) is cc_multi.
+
+test_deconstruct_limited_deconstruct(T, Limit) -->
+ { string__format("deconstruct limited deconstruct %d of ",
+ [i(Limit)], Str) },
io__write_string(Str),
io__print(T),
io__write_string("\n"),
- ( { limited_deconstruct(T, Limit, Functor, Arity, Arguments) } ->
+ (
+ { deconstruct__limited_deconstruct(T, include_details_cc,
+ Limit, Functor, Arity, Arguments) }
+ ->
{ string__format("functor %s arity %d ",
[s(Functor), i(Arity)], Str2) },
io__write_string(Str2),
@@ -120,6 +230,10 @@
;
io__write_string("failed\n")
).
+
+%-----------------------------------------------------------------------------%
+
+:- pred newline(io__state::di, io__state::uo) is det.
newline -->
io__write_char('\n').
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.32
diff -u -b -r1.32 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 30 Jan 2002 05:09:12 -0000 1.32
+++ trace/mercury_trace_vars.c 30 Jan 2002 09:32:26 -0000
@@ -1016,7 +1016,7 @@
}
if (MR_arg(typeinfo, value, arg_num, &new_typeinfo,
- &new_value, TRUE, "debugger"))
+ &new_value, MR_NONCANON_CC))
{
typeinfo = new_typeinfo;
value = new_value;
cvs diff: Diffing util
--------------------------------------------------------------------------
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