[m-rev.] for review: generalize the deconstruction predicates

Zoltan Somogyi zs at cs.mu.OZ.AU
Mon Feb 4 14:39:07 AEDT 2002


On 31-Jan-2002, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> > +MCFLAGS-deconstruct = --no-halt-at-warn
> > +MCFLAGS-std_util = --no-halt-at-warn
> 
> Why do you need MCFLAGS-deconstruct = --no-halt-at-warn?
> Doesn't the warning only occur when compiling other modules
> that import deconstruct, not when compiling deconstruct itself?
> When compiling deconstruct itself, the compiler shouldn't
> read deconstruct.opt.

You are right. And after the other changes you asked for, there no need
for the other --no-halt-at-warn either.

> > +	;	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).
> 
> I don't think the last sentence should be included in the library
> reference manual.

I have deleted it.

> > +	%	  For types with user-defined equality, the functor will be
> > +	%	  <<noncanonical>>/0 except with include_details_cc.
> 
> IMHO it would be better to make the functor be the name of the type,
> e.g. '<<var:var/1>>'/0.

I have done so, but the cost is memory allocation at runtime.

> >  	%	- for arrays, the string <<array>>
> > +	%	- for type_infos, the string <<typeinfo>>
> > +	%	- for type_ctor_infos, the string <<typectorinfo>>
> 
> What are type_infos and type_ctor_infos?  Those are not documented
> anywhere in the language or library reference manual.

I have deleted the references.

> It should instead document here what happens for type_descs and
> type_ctor_descs.

Actually, we don't do anything useful for type_descs and type_ctor_descs yet,
and until we do, they shouldn't be documented.

> (However, changing it to use that behaviour can be a separate change.)

I agree.

> It might also be useful to allow the handling of noncanonical types
> to be determined at runtime, i.e. adding a mode
> 
> 	:- mode functor(in, in, out, out) is cc_multi.

Done, both for deconstruct.m and io.m. The simplest way to do it was to
replace the mode-specific foreign_procs in deconstruct.m with separate
predicates, each with one mode.

> > +% The predicates univ_arg/4 and univ_named_arg/4 are used only to work around
> > +% the typechecking bug reported on 30 Jan, 2002.
> 
> Hmm... readers may not easily know which bug that was.
> Log the bug on SourceForge, and then include the bug URL in the comment.
> Likewise for the other places in this diff where you refer to that bug.

What URL? I included the bug id.

> "NYI" is quite cryptic.
> It would be better to use sorry/1 from private_builtin.m,
> or something along those lines.

Done; it required exporting sorry/1.

> > +% XXX
> > +% deconstruct(Term::in, Functor::out, Arity::out, Arguments::out) :-
> > +% 	rtti_implementation__deconstruct(Term, Functor, Arity, Arguments).
> 
> This should be explained or deleted.

Ah, that was a reminder to myself (which did not work) to put back the code
for implementing the low-level functions using rtti_implementation.m.
I have now done so.

> > Index: library/type_desc.m
> ...
> > +	% 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.
> 
> This is essentially the same as typed_unify in private_builtin.m.
> 
> As far as the interface goes, I think using a pred named typed_unify/2
> makes for clearer code than using a semidet function.

Thanks; I did not know about typed_unify.

> > Index: tests/hard_coded/deconstruct_arg.m
> > +set_to_sorted_list(Set) =
> > +	promise_only_solution((pred(Sorted::out) is cc_multi :-
> > +		Set = set_rep(Unsorted),
> > +		list__sort(Unsorted, Sorted)
> > +	)).
> 
> Shouldn't that be list__sort_and_remove_duplicates?

Yes, However, I only needed a typeclass and did not care what it was,
so copied it from the myset.m test case, which has exactly that definition.
You wrote myset.m, so the bug is actually yours ...

I have followed your other suggestions too. The updated log and the relative
diff follow.

Zoltan.

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.

The descriptions of the changes:

library/deconstruct.m:
	Implement the changes discussed above. Work around a bug by making
	the foreign_procs return a univ from which we later extract the value;
	this inefficiency should be fixed later, when the typechecker has been
	fixed to allow different clauses to return existentially typed values.

library/std_util.m:
	Reimplement the forwarding predicates that call deconstruct.m in terms
	of its new interface.

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.

library/private_builtin.m:
	Export the `sorry' predicate for use in deconstruct.m and elsewhere.

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:
extras/trailed_update/tr_store.m:
	Conform to the new interfaces of some functions in the updated files
	in the runtime.

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

diff -u library/Mmakefile library/Mmakefile
--- library/Mmakefile
+++ library/Mmakefile
@@ -22,15 +22,6 @@
 VPATH=.
 
 #-----------------------------------------------------------------------------#
-#
-# 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-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
diff -u library/deconstruct.m library/deconstruct.m
--- library/deconstruct.m
+++ library/deconstruct.m
@@ -17,25 +17,31 @@
 
 :- import_module std_util, list.
 
+	% Values of type noncanon_handling are intended to control how
+	% predicates that deconstruct terms behave when they find that
+	% the term they are about to deconstruct is of a noncanonical type,
+	% i.e. of a type in which a single logical value may have more than one
+	% concrete representation.
+	%
+	% The value `do_not_allow' means that in such circumstances the
+	% predicate should abort.
+	%
+	% The value `canonicalize' means that in such circumstances the
+	% predicate should return a constant giving the identity of the type,
+	% regardless of the actual value of the term.
+	%
+	% The value `include_details_cc' means that in such circumstances
+	% the predicate should proceed as if the term were of a canonical type.
+	% Use of this option requires a committed choice context.
+
 :- 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).
+	--->	do_not_allow
+	;	canonicalize
 	;	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).
+
+:- inst do_not_allow ---> do_not_allow.
+:- inst canonicalize ---> canonicalize.
+:- inst include_details_cc ---> include_details_cc.
 
 	% functor, argument and deconstruct and their variants take any type
 	% (including univ), and return representation information for that type.
@@ -48,7 +54,8 @@
 	% 	  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.
+	%	  a constant of the form <<module:type/arity>>/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,
@@ -60,8 +67,6 @@
 	%	- 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:
 	%
@@ -74,7 +79,6 @@
 	%	  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, NonCanon, Functor, Arity)
 	%
@@ -86,6 +90,7 @@
 :- 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.
+:- mode functor(in, in, out, out) is cc_multi.
 
 	% arg(Data, NonCanon, Index, Argument)
 	%
@@ -99,6 +104,7 @@
 :- mode arg(in, in(do_not_allow), in, out) is semidet.
 :- mode arg(in, in(canonicalize), in, out) is semidet.
 :- mode arg(in, in(include_details_cc), in, out) is cc_nondet.
+:- mode arg(in, in, in, out) is cc_nondet.
 
 	% named_arg(Data, NonCanon, Name, Argument)
 	%
@@ -110,6 +116,7 @@
 :- 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.
+:- mode named_arg(in, in, in, out) is cc_nondet.
 
 	% det_arg(Data, NonCanon, Index, Argument)
 	%
@@ -120,6 +127,7 @@
 :- 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.
+:- mode det_arg(in, in, in, out) is cc_multi.
 
 	% det_named_arg(Data, NonCanon, Name, Argument)
 	%
@@ -130,6 +138,7 @@
 :- 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.
+:- mode det_named_arg(in, in, in, out) is cc_multi.
 
 	% deconstruct(Data, NonCanon, Functor, Arity, Arguments)
 	%
@@ -150,6 +159,7 @@
 :- 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.
+:- mode deconstruct(in, in, out, out, out) is cc_multi.
 
 	% limited_deconstruct(Data, NonCanon, MaxArity,
 	%	Functor, Arity, Arguments)
@@ -166,6 +176,7 @@
 	is semidet.
 :- mode limited_deconstruct(in, in(include_details_cc), in, out, out, out)
 	is cc_nondet.
+:- mode limited_deconstruct(in, in, in, out, out, out) is cc_nondet.
 
 :- implementation.
 :- interface.
@@ -200,16 +211,6 @@
 
 :- 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", "
@@ -221,46 +222,130 @@
 
 %-----------------------------------------------------------------------------%
 
-% 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
+% XXX 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(arg/4).
+:- pragma no_inline(named_arg/4).
 :- pragma no_inline(deconstruct/5).
 :- pragma no_inline(limited_deconstruct/6).
 
 %-----------------------------------------------------------------------------%
 
+functor(Term, NonCanon, Functor, Arity) :-
+	(
+		NonCanon = do_not_allow,
+		functor_dna(Term, Functor, Arity)
+	;
+		NonCanon = canonicalize,
+		functor_can(Term, Functor, Arity)
+	;
+		NonCanon = include_details_cc,
+		functor_idcc(Term, Functor, Arity)
+	).
+
 arg(Term, NonCanon, Index, Argument) :-
-	univ_arg(Term, NonCanon, Index, Univ),
+	(
+		NonCanon = do_not_allow,
+		univ_arg_dna(Term, Index, Univ)
+	;
+		NonCanon = canonicalize,
+		univ_arg_can(Term, Index, Univ)
+	;
+		NonCanon = include_details_cc,
+		univ_arg_idcc(Term, Index, Univ)
+	),
 	Argument = univ_value(Univ).
 
 named_arg(Term, NonCanon, Name, Argument) :-
-	univ_named_arg(Term, NonCanon, Name, Univ),
+	(
+		NonCanon = do_not_allow,
+		univ_named_arg_dna(Term, Name, Univ)
+	;
+		NonCanon = canonicalize,
+		univ_named_arg_can(Term, Name, Univ)
+	;
+		NonCanon = include_details_cc,
+		univ_named_arg_idcc(Term, Name, Univ)
+	),
 	Argument = univ_value(Univ).
 
+det_arg(Term, NonCanon, Index, Argument) :-
+	(
+		(
+			NonCanon = do_not_allow,
+			univ_arg_dna(Term, Index, Univ)
+		;
+			NonCanon = canonicalize,
+			univ_arg_can(Term, Index, Univ)
+		;
+			NonCanon = include_details_cc,
+			univ_arg_idcc(Term, Index, Univ)
+		)
+	->
+		Argument = univ_value(Univ)
+	;
+		error("det_arg: argument number out of range")
+	).
+
+det_named_arg(Term, NonCanon, Name, Argument) :-
+	(
+		(
+			NonCanon = do_not_allow,
+			univ_named_arg_dna(Term, Name, Univ)
+		;
+			NonCanon = canonicalize,
+			univ_named_arg_can(Term, Name, Univ)
+		;
+			NonCanon = include_details_cc,
+			univ_named_arg_idcc(Term, Name, Univ)
+		)
+	->
+		Argument = univ_value(Univ)
+	;
+		error("det_named_arg: no argument with that name")
+	).
+
+deconstruct(Term, NonCanon, Functor, Arity, Arguments) :-
+	(
+		NonCanon = do_not_allow,
+		deconstruct_dna(Term, Functor, Arity, Arguments)
+	;
+		NonCanon = canonicalize,
+		deconstruct_can(Term, Functor, Arity, Arguments)
+	;
+		NonCanon = include_details_cc,
+		deconstruct_idcc(Term, Functor, Arity, Arguments)
+	).
+
+limited_deconstruct(Term, NonCanon, MaxArity, Functor, Arity, Arguments) :-
+	(
+		NonCanon = do_not_allow,
+		limited_deconstruct_dna(Term, MaxArity,
+			Functor, Arity, Arguments)
+	;
+		NonCanon = canonicalize,
+		limited_deconstruct_can(Term, MaxArity,
+			Functor, Arity, Arguments)
+	;
+		NonCanon = include_details_cc,
+		limited_deconstruct_idcc(Term, MaxArity,
+			Functor, Arity, Arguments)
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- pred functor_dna(T::in, string::out, int::out) is det.
+:- pred functor_can(T::in, string::out, int::out) is det.
+:- pred functor_idcc(T::in, string::out, int::out) is cc_multi.
+
 :- pragma foreign_proc("C",
-	functor(Term::in, NonCanon::in(do_not_allow), Functor::out,
-		Arity::out),
+	functor_dna(Term::in, 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
@@ -275,11 +360,9 @@
 }").
 
 :- pragma foreign_proc("C",
-	functor(Term::in, NonCanon::in(canonicalize), Functor::out,
-		Arity::out),
+	functor_can(Term::in, 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
@@ -294,11 +377,9 @@
 }").
 
 :- pragma foreign_proc("C",
-	functor(Term::in, NonCanon::in(include_details_cc), Functor::out,
-		Arity::out),
+	functor_idcc(Term::in, 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
@@ -312,17 +393,31 @@
 #undef	NONCANON
 }").
 
-/*
-** N.B. any modifications to arg/2 might also require similar
-** changes to store__arg_ref in store.m.
-*/
+functor_dna(_Term::in, _Functor::out, _Arity::out) :-
+	sorry("deconstruct__functor_dna/3").
+functor_can(Term::in, Functor::out, Arity::out) :-
+	rtti_implementation__deconstruct(Term, Functor, Arity, _Arguments).
+functor_idcc(_Term::in, _Functor::out, _Arity::out) :-
+	sorry("deconstruct__functor_idcc/3").
+
+%-----------------------------------------------------------------------------%
+
+% XXX These predicates return univs instead of existentially typed arguments
+% in order to work around the typechecking bug reported on 30 Jan, 2002
+% to the mercury-bugs mailing list, and which has sourceforge bug id 512581.
+
+:- pred univ_arg_dna(T::in, int::in, univ::out) is semidet.
+:- pred univ_arg_can(T::in, int::in, univ::out) is semidet.
+:- pred univ_arg_idcc(T::in, int::in, univ::out) is cc_nondet.
+
+:- pred univ_named_arg_dna(T::in, string::in, univ::out) is semidet.
+:- pred univ_named_arg_can(T::in, string::in, univ::out) is semidet.
+:- pred univ_named_arg_idcc(T::in, string::in, univ::out) is cc_nondet.
 
 :- pragma foreign_proc("C",
-	univ_arg(Term::in, NonCanon::in(do_not_allow), Index::in,
-		Argument::out),
+	univ_arg_dna(Term::in, Index::in, Argument::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	SELECTOR_ARG		Index
@@ -339,11 +434,9 @@
 }").
 
 :- pragma foreign_proc("C",
-	univ_arg(Term::in, NonCanon::in(canonicalize), Index::in,
-		Argument::out),
+	univ_arg_can(Term::in, Index::in, Argument::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	SELECTOR_ARG		Index
@@ -360,11 +453,9 @@
 }").
 
 :- pragma foreign_proc("C",
-	univ_arg(Term::in, NonCanon::in(include_details_cc), Index::in,
-		Argument::out),
+	univ_arg_idcc(Term::in, Index::in, Argument::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	SELECTOR_ARG		Index
@@ -381,11 +472,9 @@
 }").
 
 :- pragma foreign_proc("C",
-	univ_named_arg(Term::in, NonCanon::in(do_not_allow),
-		Name::in, Argument::out),
+	univ_named_arg_dna(Term::in, Name::in, Argument::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	SELECTOR_ARG		(MR_ConstString) Name
@@ -404,11 +493,9 @@
 }").
 
 :- pragma foreign_proc("C",
-	univ_named_arg(Term::in, NonCanon::in(canonicalize),
-		Name::in, Argument::out),
+	univ_named_arg_can(Term::in, Name::in, Argument::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	SELECTOR_ARG		(MR_ConstString) Name
@@ -427,11 +514,9 @@
 }").
 
 :- pragma foreign_proc("C",
-	univ_named_arg(Term::in, NonCanon::in(include_details_cc),
-		Name::in, Argument::out),
+	univ_named_arg_idcc(Term::in, Name::in, Argument::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	SELECTOR_ARG		(MR_ConstString) Name
@@ -449,12 +534,39 @@
 #undef	SELECT_BY_NAME
 }").
 
+univ_arg_dna(_Term::in, _Index::in, _Arg::out) :-
+	sorry("deconstruct__univ_arg_dna/3").
+univ_arg_can(Term::in, Index::in, Arg::out) :-
+	rtti_implementation__deconstruct(Term, _Functor, _Arity, Arguments),
+	list__index0(Arguments, Index, Arg).
+univ_arg_idcc(_Term::in, _Index::in, _Arg::out) :-
+	sorry("deconstruct__univ_arg_idcc/3").
+
+univ_named_arg_dna(_Term::in, _Name::in, _Arg::out) :-
+	sorry("deconstruct__univ_named_arg_dna/3").
+univ_named_arg_can(_Term::in, _Name::in, _Arg::out) :-
+	sorry("deconstruct__univ_named_arg_can/3").
+univ_named_arg_idcc(_Term::in, _Name::in, _Arg::out) :-
+	sorry("deconstruct__univ_named_arg_idcc/3").
+
+%-----------------------------------------------------------------------------%
+
+:- pred deconstruct_dna(T::in, string::out, int::out, list(univ)::out) is det.
+:- pred deconstruct_can(T::in, string::out, int::out, list(univ)::out) is det.
+:- pred deconstruct_idcc(T::in, string::out, int::out, list(univ)::out)
+	is cc_multi.
+
+:- pred limited_deconstruct_dna(T::in, int::in,
+	string::out, int::out, list(univ)::out) is semidet.
+:- pred limited_deconstruct_can(T::in, int::in,
+	string::out, int::out, list(univ)::out) is semidet.
+:- pred limited_deconstruct_idcc(T::in, int::in,
+	string::out, int::out, list(univ)::out) is cc_nondet.
+
 :- pragma foreign_proc("C", 
-	deconstruct(Term::in, NonCanon::in(do_not_allow),
-		Functor::out, Arity::out, Arguments::out),
+	deconstruct_dna(Term::in, 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
@@ -475,11 +587,9 @@
 }").
 
 :- pragma foreign_proc("C", 
-	deconstruct(Term::in, NonCanon::in(canonicalize),
-		Functor::out, Arity::out, Arguments::out),
+	deconstruct_can(Term::in, 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
@@ -500,11 +610,9 @@
 }").
 
 :- pragma foreign_proc("C", 
-	deconstruct(Term::in, NonCanon::in(include_details_cc),
-		Functor::out, Arity::out, Arguments::out),
+	deconstruct_idcc(Term::in, 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
@@ -525,11 +633,10 @@
 }").
 
 :- pragma foreign_proc("C", 
-	limited_deconstruct(Term::in, NonCanon::in(do_not_allow),
-		MaxArity::in, Functor::out, Arity::out, Arguments::out),
+	limited_deconstruct_dna(Term::in, MaxArity::in,
+		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_Limit_Info
 #define	EXPAND_INFO_CALL	MR_expand_functor_args_limit
 #define	TYPEINFO_ARG		TypeInfo_for_T
@@ -552,11 +659,10 @@
 }").
 
 :- pragma foreign_proc("C", 
-	limited_deconstruct(Term::in, NonCanon::in(canonicalize),
-		MaxArity::in, Functor::out, Arity::out, Arguments::out),
+	limited_deconstruct_can(Term::in, MaxArity::in,
+		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_Limit_Info
 #define	EXPAND_INFO_CALL	MR_expand_functor_args_limit
 #define	TYPEINFO_ARG		TypeInfo_for_T
@@ -579,11 +685,10 @@
 }").
 
 :- pragma foreign_proc("C", 
-	limited_deconstruct(Term::in, NonCanon::in(include_details_cc),
-		MaxArity::in, Functor::out, Arity::out, Arguments::out),
+	limited_deconstruct_idcc(Term::in, MaxArity::in,
+		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_Limit_Info
 #define	EXPAND_INFO_CALL	MR_expand_functor_args_limit
 #define	TYPEINFO_ARG		TypeInfo_for_T
@@ -605,89 +710,23 @@
 #undef	NONCANON
 }").
 
-%-----------------------------------------------------------------------------%
-
-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).
+deconstruct_dna(_Term::in, _Functor::out, _Arity::out, _Arguments::out) :-
+	sorry("deconstuct__deconstruct_dna/4").
+deconstruct_can(Term::in, Functor::out, Arity::out, Arguments::out) :-
+	rtti_implementation__deconstruct(Term, Functor, Arity, Arguments).
+deconstruct_idcc(_Term::in, _Functor::out, _Arity::out, _Arguments::out) :-
+	sorry("deconstuct__deconstruct_idcc/4").
 
-limited_deconstruct(_Term::in, _NonCanon::in(do_not_allow), _MaxArity::in,
+limited_deconstruct_dna(_Term::in, _MaxArity::in,
 		_Functor::out, _Arity::out, _Arguments::out) :-
-	error("NYI: deconstuct__limited_deconstruct/6").
-limited_deconstruct(_Term::in, _NonCanon::in(canonicalize), _MaxArity::in,
+	sorry("deconstuct__limited_deconstruct_dna/5").
+limited_deconstruct_can(Term::in, MaxArity::in,
+		Functor::out, Arity::out, Arguments::out) :-
+	rtti_implementation__deconstruct(Term, Functor, Arity, Arguments),
+	Arity =< MaxArity.
+limited_deconstruct_idcc(_Term::in, _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").
-
-%-----------------------------------------------------------------------------%
-
-% 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_named_arg(Type, NonCanon, Name, Argument) :-
-	( deconstruct__univ_named_arg(Type, NonCanon, Name, Argument0) ->
-		Argument = univ_value(Argument0)
-	;
-		error("det_named_arg: no argument with that name")
-	).
+	sorry("deconstuct__limited_deconstruct_idcc/5").
 
 %-----------------------------------------------------------------------------%
 
diff -u library/io.m library/io.m
--- library/io.m
+++ library/io.m
@@ -323,11 +323,12 @@
 :- pred io__print(io__output_stream, T, io__state, io__state).
 :- mode io__print(in, in, di, uo) is det.
 
-:- pred io__print(io__output_stream, noncanon_handling, T,
+:- pred io__print(io__output_stream, deconstruct__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.
+:- mode io__print(in, in(canonicalize), in, di, uo) is det.
+:- mode io__print(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__print(in, in, in, di, uo) is cc_multi.
 
 %		io__print/5 writes its third argument to the specified output
 %		stream in a format that is intended to be human readable. 
@@ -352,11 +353,12 @@
 :- 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,
+:- pred io__write(io__output_stream, deconstruct__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.
+:- mode io__write(in, in(canonicalize), in, di, uo) is det.
+:- mode io__write(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__write(in, in, in, di, uo) is cc_multi.
 
 %		io__write/3 writes its argument to the current output stream.
 %		io__write/4 writes its argument to the specified output stream.
@@ -2194,12 +2196,12 @@
 
 %-----------------------------------------------------------------------------%
 
-:- 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").
+:- pragma export(io__print(in, in(canonicalize), in, di, uo),
+	"ML_io_print_can_to_stream").
+:- pragma export(io__print(in, in(include_details_cc), in, di, uo),
+	"ML_io_print_cc_to_stream").
 
 io__print(Stream, NonCanon, Term) -->
 	io__set_output_stream(Stream, OrigStream),
@@ -2218,10 +2220,11 @@
 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.
+:- pred io__do_print(deconstruct__noncanon_handling, T, io__state, io__state).
 :- mode io__do_print(in(do_not_allow), in, di, uo) is det.
+:- mode io__do_print(in(canonicalize), in, di, uo) is det.
+:- mode io__do_print(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__do_print(in, in, di, uo) is cc_multi.
 
 io__do_print(NonCanon, Term) -->
 	% `string', `char' and `univ' are special cases for io__print
@@ -2236,10 +2239,12 @@
 		io__print_quoted(NonCanon, Term)
 	).
 
-:- 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.
+:- pred io__print_quoted(deconstruct__noncanon_handling, T,
+	io__state, io__state).
 :- mode io__print_quoted(in(do_not_allow), in, di, uo) is det.
+:- mode io__print_quoted(in(canonicalize), in, di, uo) is det.
+:- mode io__print_quoted(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__print_quoted(in, in, di, uo) is cc_multi.
 
 io__print_quoted(NonCanon, Term) -->
 	io__do_write(NonCanon, Term).
@@ -2275,10 +2280,11 @@
 	{ 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.
+:- pred io__do_write(deconstruct__noncanon_handling, T, io__state, io__state).
 :- mode io__do_write(in(do_not_allow), in, di, uo) is det.
+:- mode io__do_write(in(canonicalize), in, di, uo) is det.
+:- mode io__do_write(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__do_write(in, in, di, uo) is cc_multi.
 
 io__do_write(NonCanon, Term) -->
 	{ type_to_univ(Term, Univ) },
@@ -2289,20 +2295,23 @@
 	io__get_op_table(OpTable),
 	io__do_write_univ(canonicalize, Univ, ops__max_priority(OpTable) + 1).
 
-:- 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.
+:- pred io__do_write_univ(deconstruct__noncanon_handling, univ,
+	io__state, io__state).
 :- mode io__do_write_univ(in(do_not_allow), in, di, uo) is det.
+:- mode io__do_write_univ(in(canonicalize), in, di, uo) is det.
+:- mode io__do_write_univ(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__do_write_univ(in, in, di, uo) is cc_multi.
 
 io__do_write_univ(NonCanon, Univ) -->
 	io__get_op_table(OpTable),
 	io__do_write_univ(NonCanon, Univ, ops__max_priority(OpTable) + 1).
 
-:- pred io__do_write_univ(noncanon_handling, univ, ops__priority,
+:- pred io__do_write_univ(deconstruct__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.
+:- mode io__do_write_univ(in(canonicalize), in, in, di, uo) is det.
+:- mode io__do_write_univ(in(include_details_cc), in, in, di, uo) is cc_multi.
+:- mode io__do_write_univ(in, in, in, di, uo) is cc_multi.
 
 io__do_write_univ(NonCanon, Univ, Priority) -->
 	%
@@ -2383,12 +2392,13 @@
 :- 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).
+:- pred io__write_ordinary_term(deconstruct__noncanon_handling, univ,
+	ops__priority, io__state, io__state).
+:- mode io__write_ordinary_term(in(do_not_allow), in, in, di, uo) is det.
+:- mode io__write_ordinary_term(in(canonicalize), in, in, di, uo) is det.
 :- 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.
+:- mode io__write_ordinary_term(in, in, in, di, uo) is cc_multi.
 
 io__write_ordinary_term(NonCanon, Univ, Priority) -->
 	{ univ_value(Univ) = Term },
@@ -2518,10 +2528,12 @@
 adjust_priority(Priority, y, Priority).
 adjust_priority(Priority, x, Priority - 1).
 
-:- 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.
+:- pred io__write_list_tail(deconstruct__noncanon_handling, univ,
+	io__state, io__state).
 :- mode io__write_list_tail(in(do_not_allow), in, di, uo) is det.
+:- mode io__write_list_tail(in(canonicalize), in, di, uo) is det.
+:- mode io__write_list_tail(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__write_list_tail(in, in, di, uo) is cc_multi.
 
 io__write_list_tail(NonCanon, Univ) -->
 	{ Term = univ_value(Univ) },
@@ -2537,11 +2549,12 @@
 		io__do_write_univ(NonCanon, Univ)
 	).
 
-:- pred io__write_term_args(noncanon_handling, list(univ),
+:- pred io__write_term_args(deconstruct__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.
+:- mode io__write_term_args(in(canonicalize), in, di, uo) is det.
+:- mode io__write_term_args(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__write_term_args(in, in, di, uo) is cc_multi.
 
 	% write the remaining arguments
 io__write_term_args(_, []) --> [].
@@ -2550,10 +2563,12 @@
 	io__write_arg(NonCanon, X),
 	io__write_term_args(NonCanon, Xs).
 
-:- 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.
+:- pred io__write_arg(deconstruct__noncanon_handling, univ,
+	io__state, io__state).
 :- mode io__write_arg(in(do_not_allow), in, di, uo) is det.
+:- mode io__write_arg(in(canonicalize), in, di, uo) is det.
+:- mode io__write_arg(in(include_details_cc), in, di, uo) is cc_multi.
+:- mode io__write_arg(in, in, di, uo) is cc_multi.
 
 io__write_arg(NonCanon, X) -->
 	arg_priority(ArgPriority),
diff -u library/std_util.m library/std_util.m
--- library/std_util.m
+++ library/std_util.m
@@ -1454,11 +1454,11 @@
 
 arg(Term, Index) = Argument :-
 	deconstruct__arg(Term, canonicalize, Index, Argument0),
-	Argument = same_type(Argument0).
+	private_builtin__typed_unify(Argument0, Argument).
 
 arg_cc(Term, Index, Argument) :-
 	deconstruct__arg(Term, include_details_cc, Index, Argument0),
-	( Argument1 = same_type(Argument0) ->
+	( private_builtin__typed_unify(Argument0, Argument1) ->
 		Argument = Argument1
 	;
 		error("arg_cc: argument has wrong type")
@@ -1499,7 +1499,7 @@
 
 det_arg(Type, Index) = Argument :-
 	deconstruct__det_arg(Type, canonicalize, Index, Argument0),
-	( Argument1 = same_type(Argument0) ->
+	( private_builtin__typed_unify(Argument0, Argument1) ->
 		Argument = Argument1
 	;
 		error("det_arg: argument has wrong type")
@@ -1507,7 +1507,7 @@
 
 det_arg_cc(Type, Index, Argument) :-
 	deconstruct__det_arg(Type, include_details_cc, Index, Argument0),
-	( Argument1 = same_type(Argument0) ->
+	( private_builtin__typed_unify(Argument0, Argument1) ->
 		Argument = Argument1
 	;
 		error("det_arg_cc: argument has wrong type")
reverted:
--- library/type_desc.m	31 Jan 2002 08:26:56 -0000
+++ library/type_desc.m	30 Jan 2002 05:08:56 -0000	1.1
@@ -46,12 +46,6 @@
 	% 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.
@@ -158,7 +152,6 @@
 #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""
 ").
 
@@ -413,28 +406,6 @@
 "
 	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").
diff -u runtime/mercury_deconstruct.c runtime/mercury_deconstruct.c
--- runtime/mercury_deconstruct.c
+++ runtime/mercury_deconstruct.c
@@ -18,6 +18,8 @@
 #include "mercury_deconstruct.h"
 #include "mercury_deconstruct_macros.h"
 
+static  MR_ConstString  MR_expand_type_name(MR_TypeCtorInfo tci);
+
 #define EXPAND_FUNCTION_NAME        MR_expand_functor_args
 #define EXPAND_TYPE_NAME            MR_Expand_Functor_Args_Info
 #define EXPAND_FUNCTOR_FIELD        functor
@@ -72,6 +74,12 @@
 #undef  EXPAND_TYPE_NAME
 #undef  EXPAND_NAMED_ARG
 
+/*
+** N.B. any modifications to the signature of this function will require
+** changes not only to library/deconstruct.m, but also to library/store.m
+** and extras/trailed_update/tr_store.m.
+*/
+
 bool
 MR_arg(MR_TypeInfo type_info, MR_Word *term_ptr, int arg_index,
     MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr,
@@ -250,4 +258,37 @@
         default:
             return FALSE;
     }
+}
+
+static MR_ConstString
+MR_expand_type_name(MR_TypeCtorInfo tci)
+{
+    MR_String   str;
+    int         len;
+
+    len = 0;
+    len += 2;   /* << */
+    len += strlen(tci->MR_type_ctor_module_name);
+    len += 1;   /* : */
+    len += strlen(tci->MR_type_ctor_name);
+    len += 1;   /* / */
+    len += 4;   /* arity; we do not support arities above 1024 */
+    len += 2;   /* >> */
+    len += 1;   /* NULL */
+
+    if (tci->MR_type_ctor_arity > 9999) {
+        MR_fatal_error("MR_expand_type_name: arity > 9999");
+    }
+
+    MR_restore_transient_hp();
+    MR_allocate_aligned_string_msg(str, len, "MR_expand_type_name");
+    MR_save_transient_hp();
+
+    sprintf(str, "<<%s:%s/%d>>",
+        tci->MR_type_ctor_module_name,
+        tci->MR_type_ctor_name,
+        tci->MR_type_ctor_arity);
+
+
+   return (MR_ConstString) str;
 }
diff -u runtime/mercury_ml_expand_body.h runtime/mercury_ml_expand_body.h
--- runtime/mercury_ml_expand_body.h
+++ runtime/mercury_ml_expand_body.h
@@ -110,7 +110,9 @@
 **  If you change this code, you may also have to reflect your changes
 **  in runtime/mercury_deep_copy_body.h and runtime/mercury_tabling.c.
 **
-**  We use 4 space tabs here (sw=4 ts=4) because of the level of indenting.
+**  In several places, we call MR_fatal_error to signal inappropriate
+**  deconstruction of noncanonical terms. These should all throw exceptions
+**  instead, but it is not yet safe to throw exceptions across the C interface.
 */
 
 #include    <stdio.h>
@@ -151,9 +153,21 @@
                 MR_make_aligned_string(expand_info->EXPAND_FUNCTOR_FIELD,\
                     name);                                              \
             } while (0)
+  #define handle_noncanonical_name(tci)                                 \
+            do {                                                        \
+                MR_ConstString  name;                                   \
+                                                                        \
+                MR_restore_transient_hp();                              \
+                name = MR_expand_type_name(tci);                        \
+                MR_save_transient_hp();                                 \
+                MR_make_aligned_string(expand_info->EXPAND_FUNCTOR_FIELD,\
+                    name);                                              \
+            } while (0)
 #else   /* EXPAND_FUNCTOR_FIELD */
   #define handle_functor_name(name)                                     \
             ((void) 0)
+  #define handle_noncanonical_name(tci)                                 \
+            ((void) 0)
 #endif  /* EXPAND_FUNCTOR_FIELD */
 
 /* set up macros for the common code handling zero arity terms */
@@ -227,11 +241,12 @@
 
         case MR_TYPECTOR_REP_ENUM_USEREQ:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 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_noncanonical_name(type_ctor_info);
                 handle_zero_arity_args();
                 break;
             }
@@ -245,11 +260,12 @@
 
         case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 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_noncanonical_name(type_ctor_info);
                 handle_zero_arity_args();
                 break;
             }
@@ -305,11 +321,12 @@
 
         case MR_TYPECTOR_REP_DU_USEREQ:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 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_noncanonical_name(type_ctor_info);
                 handle_zero_arity_args();
                 break;
             }
@@ -358,6 +375,7 @@
                         break;
                     case MR_SECTAG_VARIABLE:
                         if (noncanon != MR_NONCANON_CC) {
+                            /* XXX should throw an exception */
                             MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
                                 ": attempt to deconstruct variable");
                             break;
@@ -456,11 +474,12 @@
 
         case MR_TYPECTOR_REP_NOTAG_USEREQ:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 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_noncanonical_name(type_ctor_info);
                 handle_zero_arity_args();
                 break;
             }
@@ -468,8 +487,8 @@
 
         case MR_TYPECTOR_REP_NOTAG:
             expand_info->arity = 1;
-            handle_functor_name(MR_type_ctor_layout(type_ctor_info).layout_notag
-				->MR_notag_functor_name);
+            handle_functor_name(MR_type_ctor_layout(type_ctor_info).
+                layout_notag->MR_notag_functor_name);
 
 #ifdef  EXPAND_ARGS_FIELD
             expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
@@ -488,8 +507,8 @@
   #ifdef    EXPAND_NAMED_ARG
             if (MR_type_ctor_layout(type_ctor_info).layout_notag
                     ->MR_notag_functor_arg_name != NULL
-               && streq(chosen_name, MR_type_ctor_layout(type_ctor_info).layout_notag
-                    ->MR_notag_functor_arg_name))
+               && streq(chosen_name, MR_type_ctor_layout(type_ctor_info).
+                    layout_notag->MR_notag_functor_arg_name))
             {
                 chosen = 0;
             }
@@ -511,11 +530,12 @@
 
         case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 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_noncanonical_name(type_ctor_info);
                 handle_zero_arity_args();
                 break;
             }
@@ -659,6 +679,7 @@
 
         case MR_TYPECTOR_REP_FUNC:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
                     ": attempt to deconstruct noncanonical term");
                 break;
@@ -670,6 +691,7 @@
 
         case MR_TYPECTOR_REP_PRED:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
                     ": attempt to deconstruct noncanonical term");
                 break;
@@ -744,6 +766,7 @@
 
         case MR_TYPECTOR_REP_C_POINTER:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
                     ": attempt to deconstruct noncanonical term");
                 break;
@@ -755,6 +778,7 @@
 
         case MR_TYPECTOR_REP_TYPEINFO:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
                     ": attempt to deconstruct noncanonical term");
                 break;
@@ -766,6 +790,7 @@
 
         case MR_TYPECTOR_REP_TYPECTORINFO:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
                     ": attempt to deconstruct noncanonical term");
                 break;
@@ -777,6 +802,7 @@
 
         case MR_TYPECTOR_REP_TYPECLASSINFO:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
                     ": attempt to deconstruct noncanonical term");
                 break;
@@ -788,6 +814,7 @@
 
         case MR_TYPECTOR_REP_BASETYPECLASSINFO:
             if (noncanon == MR_NONCANON_ABORT) {
+                /* XXX should throw an exception */
                 MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
                     ": attempt to deconstruct noncanonical term");
                 break;
@@ -900,6 +927,7 @@
 #undef  EXTRA_ARGS
 #undef  EXPAND_ONE_ARG
 #undef  handle_functor_name
+#undef  handle_noncanonical_name
 #undef  handle_zero_arity_args
 #undef  handle_zero_arity_all_args
 #undef  handle_zero_arity_one_arg
diff -u tests/hard_coded/deconstruct_arg.exp tests/hard_coded/deconstruct_arg.exp
--- tests/hard_coded/deconstruct_arg.exp
+++ tests/hard_coded/deconstruct_arg.exp
@@ -185,21 +185,21 @@
 deconstruct limited deconstruct 3 of ["hi! I\'m a univ!"]
 functor univ_cons arity 1 [["hi! I\'m a univ!"]]
 
-std_util    functor: noncanonical/0
+std_util    functor: <<deconstruct_arg:set/1>>/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
+std_util    argument 0 of '<<deconstruct_arg:set/1>>' doesn't exist
+deconstruct argument 0 of '<<deconstruct_arg:set/1>>' is [1, 2, 3, 3]
+std_util    argument 1 of '<<deconstruct_arg:set/1>>' doesn't exist
+deconstruct argument 1 of '<<deconstruct_arg:set/1>>' doesn't exist
+std_util    argument 2 of '<<deconstruct_arg:set/1>>' doesn't exist
+deconstruct argument 2 of '<<deconstruct_arg:set/1>>' doesn't exist
+std_util    deconstruct: functor <<deconstruct_arg:set/1>> 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
+std_util    limited deconstruct 3 of '<<deconstruct_arg:set/1>>'
+functor <<deconstruct_arg:set/1>> arity 0 []
+deconstruct limited deconstruct 3 of '<<deconstruct_arg:set/1>>'
 functor set_rep arity 1 [[1, 2, 3, 3]]
 
 std_util    functor: <<predicate>>/0
diff -u tests/hard_coded/deconstruct_arg.m tests/hard_coded/deconstruct_arg.m
--- tests/hard_coded/deconstruct_arg.m
+++ tests/hard_coded/deconstruct_arg.m
@@ -45,7 +45,7 @@
 set_to_sorted_list(Set) =
 	promise_only_solution((pred(Sorted::out) is cc_multi :-
 		Set = set_rep(Unsorted),
-		list__sort(Unsorted, Sorted)
+		list__sort_and_remove_dups(Unsorted, Sorted)
 	)).
 
 :- pred set_equal(set(T)::in, set(T)::in) is semidet.
only in patch2:
--- library/private_builtin.m	2002/01/30 12:47:07	1.90
+++ library/private_builtin.m	2002/01/31 11:35:43
@@ -1220,6 +1220,14 @@
 :- 	  mode nonvar(in) is det.
 :- 	  mode nonvar(unused) is failure.
 
+% sorry/1 is used to apologize about the fact that we have not implemented
+% some predicate or function in the library for a given back end. The argument
+% should give the name of the predicate or function.
+
+:- pred sorry(string::in) is erroneous.
+
+%-----------------------------------------------------------------------------%
+
 :- implementation.
 
 var(_::ui) :- fail.
@@ -1230,9 +1238,6 @@
 nonvar(_::in) :- true.
 nonvar(_::unused) :- fail.
 
-%-----------------------------------------------------------------------------%
-
-:- pred sorry(string::in) is erroneous.
 sorry(PredName) :-
 	error("sorry, `" ++ PredName ++ "' not implemented\n" ++
 		"for this target language (or compiler back-end).").
only in patch2:
--- extras/trailed_update/tr_store.m	2002/01/09 06:41:30	1.9
+++ extras/trailed_update/tr_store.m	2002/01/31 11:13:45
@@ -214,7 +214,7 @@
 	MR_save_transient_registers();
 
 	if (!MR_arg((MR_TypeInfo) TypeInfo_for_T, (MR_Word *) Ref, ArgNum,
-		&arg_type_info, &arg_ref, FALSE, ""arg_ref/5""))
+		&arg_type_info, &arg_ref, MR_NONCANON_ALLOW))
 	{
 		MR_fatal_error(""tr_store__arg_ref: ""
 			""argument number out of range"");
@@ -241,7 +241,7 @@
 	MR_save_transient_registers();
 
 	if (!MR_arg((MR_TypeInfo) TypeInfo_for_T, (MR_Word *) &Val, ArgNum,
-		&arg_type_info, &arg_ref, FALSE, ""new_arg_ref/5""))
+		&arg_type_info, &arg_ref, MR_NONCANON_ALLOW))
 	{
 		MR_fatal_error(""tr_store__new_arg_ref: ""
 			""argument number out of range"");
--------------------------------------------------------------------------
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