[m-dev.] for review: MR_TypeInfo cleanup, part 3 (of 3)

Zoltan Somogyi zs at cs.mu.OZ.AU
Wed Mar 22 20:39:37 AEDT 2000


Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.33
diff -u -b -r1.33 mercury_type_info.c
--- runtime/mercury_type_info.c	2000/03/10 13:38:15	1.33
+++ runtime/mercury_type_info.c	2000/03/22 06:39:41
@@ -15,234 +15,81 @@
 
 /*---------------------------------------------------------------------------*/
 
-static Word *
-MR_get_arg_type_info(const Word *term_type_info, 
-	const Word *arg_pseudo_type_info, const Word *data_value, 
-	int rtti_version, const MR_DuFunctorDesc *functor_desc);
+static MR_TypeInfo
+MR_get_arg_type_info(const MR_TypeInfoParams type_info_params, 
+	const MR_PseudoTypeInfo pseudo_type_info, const Word *data_value, 
+	const MR_DuFunctorDesc *functor_desc);
 
 /*---------------------------------------------------------------------------*/
 
 extern	struct MR_TypeCtorInfo_struct	mercury_data___type_ctor_info_pred_0;
 extern	struct MR_TypeCtorInfo_struct	mercury_data___type_ctor_info_func_0;
 
-	/* 
-	** MR_create_type_info():
-	**
-	** Given a type_info `term_type_info' which contains a
-	** type_ctor_info pointer and possibly other type_infos
-	** giving the values of the type parameters of this type,
-	** and given a pseudo-type_info `arg_pseudo_type_info', which contains
-	** a type_ctor_info pointer and possibly other type_infos
-	** giving EITHER
-	** 	- the values of the type parameters of this type
-	** or	- an indication of the type parameter of the
-	** 	  term_type_info that should be substituted here,
-	** this returns a fully instantiated type_info, a version of the
-	** arg_pseudo_type_info with all the type variables filled in.
-	**
-	** We allocate memory for a new type_info on the Mercury heap,
-	** copy the necessary information, and return a pointer to the
-	** new type_info.  You need to wrap save_transient_hp()
-	** and restore_transient_hp() around calls to this function.
-	**
-	** In the case where the argument's pseudo_type_info is a
-	** type_ctor_info with no arguments, we don't copy the
-	** type_ctor_info - we just return a pointer to it - no memory
-	** is allocated. The caller can check this by looking at the
-	** first cell of the returned pointer - if it is zero, this is a
-	** type_ctor_info. Otherwise, it is an allocated copy of a
-	** type_info.
-	**
-	** If arg_pseudo_type_info does not contain any type variables,
-	** then it is OK for term_type_info to be NULL.
-	**
-	** NOTE: If you are changing this code, you might also need
-	** to change the code in MR_make_type_info in this module 
-	** which does much the same thing, only allocating using MR_GC_malloc()
-	** instead of on the Mercury heap.
-	**
-	** The rtti version number we pass in the call below is a placeholder;
-	** its value does not matter because the functor_desc we pass, whose
-	** format it describes, is NULL.
-	*/
-
-Word * 
-MR_create_type_info(const Word *term_type_info, const Word *arg_pseudo_type_info)
-{
-	return MR_create_type_info_maybe_existq(term_type_info, 
-		arg_pseudo_type_info, NULL,
-		MR_RTTI_VERSION__CLEAN_LAYOUT, NULL);
-}
-
-	/*
-	** MR_create_type_info_maybe_existq():
-	**
-	** The same as MR_create_type_info except that the type-info being
-	** created may be for an existentially typed argument of a constructor.
-	** In order to handle this, it also takes the data value from which
-	** the values whose pseudo type-info we are looking at was taken, as
-	** well as the functor descriptor for that functor.
-	**
-	** If the term_type_info has a NULL type_ctor_info,
-	** or if the arg_pseudo_type_info does not contain any
-	** existentially typed type variables, then it is OK
-	** for the data_value and functor_desc to be NULL.
-	**
-	** XXX The rtti_version argument is only temporary; it should not be
-	** needed once we have bootstrapped the CLEAN_LAYOUT change and
-	** dropped support for older type_ctor_info versions.
-	*/
-
-Word * 
-MR_create_type_info_maybe_existq(const Word *term_type_info, 
-	const Word *arg_pseudo_type_info, const Word *data_value, 
-	int rtti_version, const MR_DuFunctorDesc *functor_desc)
+#define	usual_func		MR_make_type_info
+#define	exist_func		MR_make_type_info_maybe_existq
+#define	exist_func_string	"MR_make_type_info_maybe_existq"
+#define	MAYBE_DECLARE_ALLOC_ARG	, MR_MemoryList *allocated
+#define	MAYBE_PASS_ALLOC_ARG	, allocated
+#define	ALLOCATE_WORDS(target, size)					      \
+				do {					      \
+					MR_MemoryList node;		      \
+					(target) = MR_GC_NEW_ARRAY(Word,      \
+						(size));		      \
+					node = MR_GC_malloc(sizeof(*node));   \
+					node->data = (target);		      \
+					node->next = *allocated;	      \
+					*allocated = node;		      \
+				} while (0)
+					
+#include "mercury_make_type_info_body.h"
+#undef	usual_func
+#undef	exist_func
+#undef	exist_func_string
+#undef	MAYBE_DECLARE_ALLOC_ARG
+#undef	MAYBE_PASS_ALLOC_ARG
+#undef	ALLOCATE_WORDS
+
+#define	usual_func		MR_create_type_info
+#define	exist_func		MR_create_type_info_maybe_existq
+#define	exist_func_string	"MR_create_type_info_maybe_existq"
+#define	MAYBE_DECLARE_ALLOC_ARG
+#define	MAYBE_PASS_ALLOC_ARG
+#define	ALLOCATE_WORDS(target, size)					      \
+				incr_saved_hp(LVALUE_CAST(Word, (target)),    \
+					(size))
+#include "mercury_make_type_info_body.h"
+#undef	usual_func
+#undef	exist_func
+#undef	exist_func_string
+#undef	MAYBE_DECLARE_ALLOC_ARG
+#undef	MAYBE_PASS_ALLOC_ARG
+#undef	ALLOCATE_WORDS
+
+static MR_TypeInfo
+MR_get_arg_type_info(const MR_TypeInfoParams type_info_params, 
+	const MR_PseudoTypeInfo pseudo_type_info, const Word *data_value, 
+	const MR_DuFunctorDesc *functor_desc)
 {
-	MR_TypeCtorInfo	type_ctor_info;
-	Word		*arg_type_info;
-	Word		*type_info;
-	int		arity;
-	int		extra_args;
-	int		i;
-
-	/* 
-	** The arg_pseudo_type_info might be a polymorphic variable.
-	** If so, then substitute it's value, and then we're done.
-	*/
-	if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info)) {
-
-		arg_type_info = MR_get_arg_type_info(term_type_info, 
-			arg_pseudo_type_info, data_value,
-			rtti_version, functor_desc);
-
-		if (TYPEINFO_IS_VARIABLE(arg_type_info)) {
-			fatal_error("MR_create_type_info: "
-					"unbound type variable");
-		}
-
-		return arg_type_info;
-	}
-
-	type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(arg_pseudo_type_info);
-
-	/* no arguments - optimise common case */
-	if ((Word) type_ctor_info == (Word) arg_pseudo_type_info) {
-		return (Word *) arg_pseudo_type_info;
-	}
-
-	if (MR_TYPE_CTOR_INFO_IS_HO(type_ctor_info)) {
-		arity = MR_TYPEINFO_GET_HIGHER_ARITY(arg_pseudo_type_info);
-		extra_args = 2;
-	} else {
-		arity = MR_TYPE_CTOR_INFO_GET_TYPE_ARITY(type_ctor_info);
-		extra_args = 1;
-	}
-
-	/*
-	** Iterate over the arguments, figuring out whether we
-	** need to make any substitutions.
-	** If so, copy the resulting argument type-infos into
-	** a new type_info.
-	*/
-	type_info = NULL;
-	for (i = extra_args; i < arity + extra_args; i++) {
-		arg_type_info = MR_create_type_info_maybe_existq(term_type_info,
-				(Word *) arg_pseudo_type_info[i],
-				data_value, rtti_version, functor_desc);
-		if (TYPEINFO_IS_VARIABLE(arg_type_info)) {
-			fatal_error("MR_create_type_info_maybe_existq: "
-				"unbound type variable");
-		}
-		if (arg_type_info != (Word *) arg_pseudo_type_info[i]) {
-			/*
-			** We made a substitution.
-			** We need to allocate a new type_info,
-			** if we haven't done so already.
-			*/
-			if (type_info == NULL) {
-				incr_saved_hp(LVALUE_CAST(Word, type_info),
-					arity + extra_args);
-				memcpy(type_info, arg_pseudo_type_info,
-					(arity + extra_args) * sizeof(Word));
-			}
-			type_info[i] = (Word) arg_type_info;
-		}
-	}
-	if (type_info == NULL) {
-		return (Word *) arg_pseudo_type_info;
-	} else {
-		return type_info;
-	}
-}
-
-static Word *
-MR_get_arg_type_info(const Word *term_type_info, 
-	const Word *arg_pseudo_type_info, const Word *data_value, 
-	int rtti_version, const MR_DuFunctorDesc *functor_desc)
-{
-	Word		*arg_type_info;
 	Unsigned	arg_num;
+	const MR_DuExistInfo	*exist_info;
+	MR_DuExistLocn		exist_locn;
+	int			exist_varnum;
+	int			slot;
+	int			offset;
 
-	arg_num = (Unsigned) arg_pseudo_type_info;
+	arg_num = (Unsigned) pseudo_type_info;
 
 	if (MR_TYPE_VARIABLE_IS_UNIV_QUANT(arg_num)) {
 		/*
-		** This is a universally quantified type variable
+		** This is a universally quantified type variable.
 		*/
-		return (Word *) term_type_info[arg_num];
+		return type_info_params[arg_num];
 	}
 
 	/*
-	** This is an existentially quantified type variable
+	** This is an existentially quantified type variable.
 	*/
 
-	if (rtti_version <= MR_RTTI_VERSION__USEREQ) {
-		const Word	*functor_descriptor;
-		Word		*type_info_locns;
-		Word		type_info_locn;
-
-		functor_descriptor = (Word *) functor_desc;
-		type_info_locns = (Word *) 
-			MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_TYPE_INFO_LOCNS(
-				functor_descriptor);
-		type_info_locn = type_info_locns[arg_num
-				- MR_PSEUDOTYPEINFO_EXIST_VAR_BASE - 1];
-
-		if (MR_TYPE_INFO_LOCN_IS_INDIRECT(type_info_locn)) {
-			/*
-			** This is indirect; the type-info
-			** is inside a typeclass-info 
-			*/
-
-			int typeinfo_number;
-			int arg_number;
-
-			typeinfo_number =
-				MR_TYPE_INFO_LOCN_INDIRECT_GET_TYPEINFO_NUMBER(
-					type_info_locn);
-			arg_number =
-				MR_TYPE_INFO_LOCN_INDIRECT_GET_ARG_NUMBER(
-					type_info_locn);
-			arg_type_info = (Word *) MR_typeclass_info_type_info(
-				data_value[arg_number], typeinfo_number);
-		} else {
-			/*
-			** This is direct
-			*/
-			int typeinfo_number;
-
-			typeinfo_number =
-				MR_TYPE_INFO_LOCN_DIRECT_GET_TYPEINFO_NUMBER(
-					type_info_locn);
-			arg_type_info = (Word *) data_value[typeinfo_number];
-		}
-	} else {
-		const MR_DuExistInfo	*exist_info;
-		MR_DuExistLocn		exist_locn;
-		int			exist_varnum;
-		int			slot;
-		int			offset;
-
 		exist_info = functor_desc->MR_du_functor_exist_info;
 		if (exist_info == NULL) {
 			fatal_error("MR_get_arg_type_info: no exist_info");
@@ -253,14 +100,11 @@
 		slot = exist_locn.MR_exist_arg_num;
 		offset = exist_locn.MR_exist_offset_in_tci;
 		if (offset < 0) {
-			arg_type_info = (Word *) data_value[slot];
+		return (MR_TypeInfo) data_value[slot];
 		} else {
-			arg_type_info = (Word *) MR_typeclass_info_type_info(
+		return (MR_TypeInfo) MR_typeclass_info_type_info(
 					data_value[slot], offset);
 		}
-	}
-
-	return arg_type_info;
 }
 
 /*
@@ -275,12 +119,14 @@
 */
 
 int
-MR_compare_type_info(Word t1, Word t2)
+MR_compare_type_info(MR_TypeInfo t1, MR_TypeInfo t2)
 {
-	Word		*type_info_1;
-	Word		*type_info_2;
+	MR_TypeInfo	type_info_1;
+	MR_TypeInfo	type_info_2;
 	MR_TypeCtorInfo	type_ctor_info_1;
 	MR_TypeCtorInfo	type_ctor_info_2;
+	MR_TypeInfo	*arg_vector_1;
+	MR_TypeInfo	*arg_vector_2;
 	int		num_arg_types;
 	int		i;
 
@@ -289,21 +135,24 @@
 	** If type_info addresses are equal, they must represent the
 	** same type.
 	*/
+
 	if (t1 == t2) {
-		return COMPARE_EQUAL;
+		return MR_COMPARE_EQUAL;
 	}
 
 	/* 
 	** Otherwise, we need to expand equivalence types, if any.
 	*/
-	type_info_1 = (Word *) MR_collapse_equivalences(t1);
-	type_info_2 = (Word *) MR_collapse_equivalences(t2);
+
+	type_info_1 = MR_collapse_equivalences(t1);
+	type_info_2 = MR_collapse_equivalences(t2);
 
 	/* 
 	** Perhaps they are equal now...
 	*/
+
 	if (type_info_1 == type_info_2) {
-		return COMPARE_EQUAL;
+		return MR_COMPARE_EQUAL;
 	}
 
 	/*
@@ -318,13 +167,14 @@
 	** The casts to (Word) here are in the hope of increasing
 	** the chance that this will work on a segmented architecture.
 	*/
+
 	type_ctor_info_1 = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info_1);
 	type_ctor_info_2 = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info_2);
-	if ((Word) type_ctor_info_1 < (Word) type_ctor_info_2) {
-		return COMPARE_LESS;
-	}
-	if ((Word) type_ctor_info_1 > (Word) type_ctor_info_2) {
-		return COMPARE_GREATER;
+
+	if ((Unsigned) type_ctor_info_1 < (Unsigned) type_ctor_info_2) {
+		return MR_COMPARE_LESS;
+	} else if ((Unsigned) type_ctor_info_1 > (Unsigned) type_ctor_info_2) {
+		return MR_COMPARE_GREATER;
 	}
 
 	/*
@@ -335,49 +185,48 @@
 	** But we need to recursively compare the argument types, if any.
 	*/
 		/* Check for higher order */
-	if (MR_TYPE_CTOR_INFO_IS_HO(type_ctor_info_1)) 
+	if (type_ctor_info_1->type_ctor_rep == MR_TYPECTOR_REP_PRED) 
 	{
 		int	num_arg_types_2;
 
 			/* Get number of arguments from type_info */
-		num_arg_types = MR_field(MR_mktag(0), type_info_1, 
-			TYPEINFO_OFFSET_FOR_PRED_ARITY);
+		num_arg_types = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(
+				type_info_1);
+		num_arg_types_2 = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(
+				type_info_2);
 
-		num_arg_types_2 = MR_field(MR_mktag(0), type_info_2, 
-			TYPEINFO_OFFSET_FOR_PRED_ARITY);
-
 			/* Check arity */
 		if (num_arg_types < num_arg_types_2) {
-			return COMPARE_LESS;
-		}
-		if (num_arg_types > num_arg_types_2) {
-			return COMPARE_GREATER;
+			return MR_COMPARE_LESS;
+		} else if (num_arg_types > num_arg_types_2) {
+			return MR_COMPARE_GREATER;
 		}
 
 			/*
 			** Increment, so arguments are at the
 			** expected offset.
 			*/
-		type_info_1++;
-		type_info_2++;
+		arg_vector_1 = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(
+				type_info_1);
+		arg_vector_2 = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(
+				type_info_2);
 	} else {
-		num_arg_types = MR_field(MR_mktag(0), type_ctor_info_1,
-				OFFSET_FOR_COUNT);
+		num_arg_types = type_ctor_info_1->arity;
+		arg_vector_1 = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
+				type_info_1);
+		arg_vector_2 = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
+				type_info_2);
 	}
 
 		/* compare the argument types */
-	for (i = 0; i < num_arg_types; i++) {
-		Word arg_type_info_1 = MR_field(MR_mktag(0), type_info_1,
-			OFFSET_FOR_ARG_TYPE_INFOS + i);
-		Word arg_type_info_2 = MR_field(MR_mktag(0), type_info_2,
-			OFFSET_FOR_ARG_TYPE_INFOS + i);
+	for (i = 1; i <= num_arg_types; i++) {
 		int comp = MR_compare_type_info(
-				arg_type_info_1, arg_type_info_2);
-		if (comp != COMPARE_EQUAL)
+				arg_vector_1[i], arg_vector_2[i]);
+		if (comp != MR_COMPARE_EQUAL)
 			return comp;
 	}
 
-	return COMPARE_EQUAL;
+	return MR_COMPARE_EQUAL;
 }
 
 	/*
@@ -391,38 +240,25 @@
 	** calls to this function.
 	*/
 
-Word
-MR_collapse_equivalences(Word maybe_equiv_type_info) 
+MR_TypeInfo
+MR_collapse_equivalences(MR_TypeInfo maybe_equiv_type_info) 
 {
 	MR_TypeCtorInfo	type_ctor_info;
-	Word		equiv_type_info;
 	
-	type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) 
-					maybe_equiv_type_info);
+	type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(maybe_equiv_type_info);
 
 		/* Look past equivalences */
 	while (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_EQUIV_GROUND
-		|| type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_EQUIV_VAR
 		|| type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_EQUIV)
 	{
-		if (type_ctor_info->type_ctor_version <=
-			MR_RTTI_VERSION__USEREQ)
-		{
-			equiv_type_info = (Word)
-				MR_TYPE_CTOR_FUNCTORS_EQUIV_TYPE(
-				type_ctor_info->type_ctor_functors);
-		} else {
-			equiv_type_info = (Word) type_ctor_info->type_layout.
-				layout_equiv;
-		}
 
-		equiv_type_info = (Word) MR_create_type_info(
-				(Word *) maybe_equiv_type_info, 
-				(Word *) equiv_type_info);
+		maybe_equiv_type_info = MR_create_type_info(
+				MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
+					maybe_equiv_type_info),
+				type_ctor_info->type_layout.layout_equiv);
 
-		maybe_equiv_type_info = equiv_type_info;
 		type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(
-				(Word *) maybe_equiv_type_info);
+				maybe_equiv_type_info);
 	}
 
 	return maybe_equiv_type_info;
@@ -442,173 +278,3 @@
 		allocated = next;
 	}
 }
-
-	/* 
-	** Given a type_info `term_type_info' which contains a
-	** type_ctor_info pointer and possibly other type_infos
-	** giving the values of the type parameters of this type,
-	** and given a pseudo-type_info `arg_pseudo_type_info', which contains
-	** a type_ctor_info pointer and possibly other type_infos
-	** giving EITHER
-	** 	- the values of the type parameters of this type,
-	** or	- an indication of the type parameter of the
-	** 	  term_type_info that should be substituted here,
-	** this returns a fully instantiated type_info, a version of the
-	** arg_pseudo_type_info with all the type variables filled in.
-	**
-	** If there are no type variables to fill in, we return the
-	** arg_pseudo_type_info, unchanged. Otherwise, we allocate
-	** memory using MR_GC_malloc().  Any such memory allocated will be
-	** inserted into the list of allocated memory cells.
-	** It is the caller's responsibility to free these cells
-	** by calling MR_deallocate() on the list when they are no longer
-	** needed.
-	**
-	** If arg_pseudo_type_info does not contain any type variables,
-	** then it is OK for term_type_info to be NULL.
-	**
-	** This code could be tighter. In general, we want to
-	** handle our own allocations rather than using MR_GC_malloc().
-	** (Note: we need to use MR_GC_malloc() rather than malloc()
-	** or MR_malloc() because the Boehm collector doesn't trace memory
-	** allocated with malloc() or MR_malloc().)
-	**
-	** NOTE: If you are changing this code, you might also need
-	** to change the code in MR_create_type_info (defined above),
-	** which does much the same thing, only allocating on the 
-	** Mercury heap instead of using MR_GC_malloc().
-	*/
-
-Word *
-MR_make_type_info(const Word *term_type_info, const Word *arg_pseudo_type_info,
-	MR_MemoryList *allocated) 
-{
-	return MR_make_type_info_maybe_existq(term_type_info, 
-		arg_pseudo_type_info, NULL,
-		MR_RTTI_VERSION__CLEAN_LAYOUT, NULL, allocated);
-}
-
-	/*
-	** The same as MR_make_type_info except that the type-info being
-	** created may be for an existentially typed argument of a constructor.
-	** In order to handle this, it also takes the data value from which
-	** the values whose pseudo type-info we are looking at was taken, as
-	** well as the functor descriptor for that functor.
-	*/
-
-Word *
-MR_make_type_info_maybe_existq(const Word *term_type_info, 
-	const Word *arg_pseudo_type_info, const Word *data_value, 
-	int rtti_version, const MR_DuFunctorDesc *functor_desc,
-	MR_MemoryList *allocated) 
-{
-	MR_TypeCtorInfo	type_ctor_info;
-	Word		*arg_type_info;
-	Word		*type_info;
-	int		extra_args;
-	int		arity;
-	int		i;
-
-	/* 
-	** The arg_pseudo_type_info might be a polymorphic variable.
-	** If so, then substitute its value, and then we're done.
-	*/
-	if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info)) {
-
-		arg_type_info = MR_get_arg_type_info(term_type_info, 
-			arg_pseudo_type_info, data_value, rtti_version,
-			functor_desc);
-
-		if (TYPEINFO_IS_VARIABLE(arg_type_info)) {
-			fatal_error("make_type_info: "
-				"unbound type variable");
-		}
-		return arg_type_info;
-	}
-
-	type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(arg_pseudo_type_info);
-
-	/* no arguments - optimise common case */
-	if ((Word) type_ctor_info == (Word) arg_pseudo_type_info) {
-		return (Word *) type_ctor_info;
-	} 
-
-	if (MR_TYPE_CTOR_INFO_IS_HO(type_ctor_info)) {
-		arity = MR_TYPEINFO_GET_HIGHER_ARITY(arg_pseudo_type_info);
-		extra_args = 2;
-	} else {
-		arity = MR_TYPE_CTOR_INFO_GET_TYPE_ARITY(type_ctor_info);
-		extra_args = 1;
-	}
-
-	/*
-	** Iterate over the arguments, figuring out whether we
-	** need to make any substitutions.
-	** If so, copy the resulting argument type-infos into
-	** a new type_info.
-	*/
-	type_info = NULL;
-	for (i = extra_args; i < arity + extra_args; i++) {
-		arg_type_info = MR_make_type_info(term_type_info,
-			(Word *) arg_pseudo_type_info[i], allocated);
-		if (TYPEINFO_IS_VARIABLE(arg_type_info)) {
-			fatal_error("MR_make_type_info: "
-				"unbound type variable");
-		}
-		if (arg_type_info != (Word *) arg_pseudo_type_info[i]) {
-			/*
-			** We made a substitution.
-			** We need to allocate a new type_info,
-			** if we haven't done so already.
-			*/
-			if (type_info == NULL) {
-				MR_MemoryList node;
-				/*
-				** allocate a new type_info and copy the
-				** data across from arg_pseudo_type_info
-				*/
-				type_info = MR_GC_NEW_ARRAY(Word,
-					arity + extra_args);
-				memcpy(type_info, arg_pseudo_type_info,
-					(arity + extra_args) * sizeof(Word));
-				/*
-				** insert this type_info cell into the linked
-				** list of allocated memory cells, so we can
-				** free it later on
-				*/
-				node = MR_GC_malloc(sizeof(*node));
-				node->data = type_info;
-				node->next = *allocated;
-				*allocated = node;
-			}
-
-			type_info[i] = (Word) arg_type_info;
-		}
-	}
-
-	if (type_info == NULL) {
-		return (Word *) (Word) arg_pseudo_type_info;
-	} else {
-		return type_info;
-	}
-
-} /* end MR_make_type_info() */
-
-/*---------------------------------------------------------------------------*/
-
-enum MR_DiscUnionTagRepresentation
-MR_get_tag_representation(Word layout_entry)
-{
-	switch ((int) MR_tag(layout_entry)) {
-		case TYPE_CTOR_LAYOUT_UNSHARED_TAG:
-			return MR_DISCUNIONTAG_UNSHARED;
-		case TYPE_CTOR_LAYOUT_SHARED_REMOTE_TAG:
-			return MR_DISCUNIONTAG_SHARED_REMOTE;
-		case TYPE_CTOR_LAYOUT_CONST_TAG:
-			return MR_DISCUNIONTAG_SHARED_LOCAL;
-		default:
-		fatal_error("MR_get_tag_representation: unknown tag representation");
-	}
-}
-
-/*---------------------------------------------------------------------------*/
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.40
diff -u -b -r1.40 mercury_type_info.h
--- runtime/mercury_type_info.h	2000/03/10 13:38:16	1.40
+++ runtime/mercury_type_info.h	2000/03/22 08:45:12
@@ -52,15 +52,14 @@
 
 /*
 ** The version of the RTTI data structures -- useful for bootstrapping.
-** MR_RTTI_VERSION sets the version number in the handwritten
-** type_ctor_infos.
+** MR_RTTI_VERSION sets the version number in the handwritten type_ctor_infos.
 ** If you write runtime code that checks this version number and
 ** can at least handle the previous version of the data
 ** structure, it makes it easier to bootstrap changes to the data
 ** structures used for RTTI.
 **
 ** This number should be kept in sync with type_ctor_info_rtti_version in
-** compiler/base_type_info.m.
+** compiler/type_ctor_info.m.
 */
 
 #define MR_RTTI_VERSION 		MR_RTTI_VERSION__CLEAN_LAYOUT
@@ -77,20 +76,41 @@
 */
 
 #define MR_TYPE_CTOR_INFO_CHECK_RTTI_VERSION_RANGE(typector)	\
-	assert(MR_RTTI_VERSION__USEREQ <= typector->type_ctor_version \
-	&& typector->type_ctor_version <= MR_RTTI_VERSION__CLEAN_LAYOUT)
+    assert(typector->type_ctor_version == MR_RTTI_VERSION__CLEAN_LAYOUT)
+
+/*---------------------------------------------------------------------------*/
+
+/* Forward declarations */
+
+typedef struct MR_TypeCtorInfo_Struct       *MR_TypeCtorInfo;
+typedef struct MR_TypeInfo_Almost_Struct    *MR_TypeInfo;
+typedef struct MR_PseudoTypeInfo_Almost_Struct  *MR_PseudoTypeInfo;
 
 /*---------------------------------------------------------------------------*/
 
 /*
-** For now, we don't give a C definition of the structures of typeinfos
-** and pseudotypeinfos. We may change this later.
+** The C structures of typeinfos and pseudotypeinfos are sort of lies,
+** for two reasons. First, we want one C type that can describe both first
+** order and higher order (pseudo-) typeinfos, and they have different
+** structures (higher order (pseudo-) typeinfos have an extra word, the arity,
+** between the type_ctor_info and the argument (pseudo-) typeinfos). Second,
+** we can't rely on the C compiler having a mechanism for the declaration
+** of dynamically sized vectors embedded in structures.
+**
+** Instead, the types MR_TypeInfo and MR_PseudoTypeInfo are designed as
+** error-detection devices. Values of these types should be manipulated
+** only through the macros defined below; the fields of the structures should
+** not be accessed directly, and there should be no casts involving such
+** values, except in the interface between code written in Mercury and code
+** written in C, in which case casts to MR_(Pseudo)TypeInfo and back to Word
+** may be required. If this discipline is followed, the macros should catch
+** most errors, such as passing pseudo typeinfos where typeinfos are expected.
 **
-** A pseudotypeinfo is the same as a typeinfo (see polymorphism.m) but
+** A pseudo typeinfo is the same as a typeinfo (see polymorphism.m) but
 ** may also store free type variables, represented as small integers:
 ** 1 to 512 represent universally quantified type variables
 ** and 513 to 1024 represent existentially quantified type variables.
-** (We do not use zero to represent any type variable, for two reasons.
+** We do not use zero to represent any type variable, for two reasons.
 ** First, variable numbering starts at one inside the compiler. Second,
 ** starting at one allows us to use universally quantified type variable
 ** numbers to be used directly as the offset into a (non-higher-order)
@@ -109,57 +129,94 @@
 ** and with the default value of MR_VARIABLE_SIZED in mercury_conf_params.h.
 */
 
-typedef	Word	MR_TypeInfo;
-typedef	Word	MR_PseudoTypeInfo;
+struct MR_TypeInfo_Almost_Struct {
+    MR_TypeCtorInfo     MR_ti_type_ctor_info;
+    Integer             MR_ti_higher_order_arity;
+    MR_TypeInfo         MR_ti_first_ho_arg_typeinfo;
+};
+
+struct MR_PseudoTypeInfo_Almost_Struct {
+    MR_TypeCtorInfo     MR_pti_type_ctor_info;
+    Integer             MR_pti_higher_order_arity;
+    MR_PseudoTypeInfo   MR_pti_first_ho_arg_pseudo_typeinfo;
+};
 
+/*
+** When converting a MR_PseudoTypeInfo to a MR_TypeInfo, we need the
+** MR_TypeInfos corresponding to the type variables in the MR_PseudoTypeInfo.
+** A MR_TypeInfoParams array serves this purpose. Because type variables
+** start at one, MR_TypeInfoParams arrays also start at one.
+*/
+
+typedef MR_TypeInfo     *MR_TypeInfoParams;
+
 #define MR_PSEUDOTYPEINFO_EXIST_VAR_BASE	512
 #define MR_PSEUDOTYPEINFO_MAX_VAR		1024
 
-#define TYPEINFO_IS_VARIABLE(T)	( (Unsigned) T <= MR_PSEUDOTYPEINFO_MAX_VAR )
+#define MR_PSEUDO_TYPEINFO_IS_VARIABLE(T)                           \
+    ( (Unsigned) T <= MR_PSEUDOTYPEINFO_MAX_VAR )
 
 #define MR_TYPE_VARIABLE_IS_EXIST_QUANT(T)	\
 	( (Word) (T) > MR_PSEUDOTYPEINFO_EXIST_VAR_BASE )
 #define MR_TYPE_VARIABLE_IS_UNIV_QUANT(T)	\
 	( (Word) (T) <= MR_PSEUDOTYPEINFO_EXIST_VAR_BASE )
 
-/*---------------------------------------------------------------------------*/
+#define MR_pseudo_type_info_is_ground(pseudo_type_info)             \
+    ((MR_TypeInfo) &pseudo_type_info->MR_pti_type_ctor_info)
 
-/*
-** Define offsets of fields in the type_ctor_info or type_info structure.
-** See polymorphism.m for explanation of these offsets and how the
-** type_info and type_ctor_info structures are laid out.
-**
-** ANY CHANGES HERE MUST BE MATCHED BY CORRESPONDING CHANGES
-** TO THE DOCUMENTATION IN compiler/polymorphism.m.
-**
-** The current type_info representation *depends* on OFFSET_FOR_COUNT being 0.
-*/
+    /*
+    ** Macros for retrieving things from type_infos and pseudo_type_infos.
+    */
 
-#define OFFSET_FOR_COUNT			0
-#define OFFSET_FOR_UNIFY_PRED			1
-#define OFFSET_FOR_INDEX_PRED			2
-#define OFFSET_FOR_COMPARE_PRED			3
-#define OFFSET_FOR_TYPE_CTOR_REPRESENTATION	4
-#define OFFSET_FOR_BASE_TYPE_FUNCTORS		5
-#define OFFSET_FOR_BASE_TYPE_LAYOUT		6
-#define OFFSET_FOR_TYPE_MODULE_NAME		7
-#define OFFSET_FOR_TYPE_NAME			8
+#define MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info)                   \
+    (((type_info)->MR_ti_type_ctor_info != NULL)                    \
+        ? (type_info)->MR_ti_type_ctor_info                         \
+        : (MR_TypeCtorInfo) (type_info))
 
-/*
-** Define offsets of fields in the type_info structure.
-*/
+#define MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(pseudo_type_info)     \
+    (((pseudo_type_info)->MR_pti_type_ctor_info != NULL)            \
+        ? (pseudo_type_info)->MR_pti_type_ctor_info                 \
+        : (MR_TypeCtorInfo) (pseudo_type_info))
 
-#define OFFSET_FOR_ARG_TYPE_INFOS 1
+#define MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(type_info)               \
+    ((type_info)->MR_ti_higher_order_arity)
 
-/*
-** Where the predicate arity and args are stored in the type_info.
-** They are stored in the type_info (*not* the type_ctor_info).
-** This is brought about by higher-order predicates all using the
-** same type_ctor_info - pred/0.
-*/
+#define MR_PSEUDO_TYPEINFO_GET_HIGHER_ORDER_ARITY(pseudo_type_info) \
+    ((pseudo_type_info)->MR_pti_higher_order_arity)
+
+#define MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(type_info)          \
+    ((MR_TypeInfoParams)                                            \
+        &(type_info)->MR_ti_higher_order_arity)
+
+#define MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info)           \
+    ((MR_TypeInfoParams) &(type_info)->MR_ti_type_ctor_info)
+
+    /*
+    ** Macros for creating type_infos.
+    */
+
+#define MR_first_order_type_info_size(arity)                        \
+    (1 + (arity))
+
+#define MR_higher_order_type_info_size(arity)                       \
+    (2 + (arity))
 
-#define TYPEINFO_OFFSET_FOR_PRED_ARITY 1
-#define TYPEINFO_OFFSET_FOR_PRED_ARGS 2
+#define MR_fill_in_first_order_type_info(arena, type_ctor_info, vector) \
+    do {                                                            \
+        MR_TypeInfo new_ti;                                         \
+        new_ti = (MR_TypeInfo) arena;                               \
+        new_ti->MR_ti_type_ctor_info = (type_ctor_info);            \
+        vector = (MR_TypeInfoParams) &new_ti->MR_ti_type_ctor_info; \
+    } while (0)
+
+#define MR_fill_in_higher_order_type_info(arena, type_ctor_info, arity, vector)\
+    do {                                                            \
+        MR_TypeInfo new_ti;                                         \
+        new_ti = (MR_TypeInfo) arena;                               \
+        new_ti->MR_ti_type_ctor_info = (type_ctor_info);            \
+        new_ti->MR_ti_higher_order_arity = (arity);                 \
+        vector = (MR_TypeInfoParams) &new_ti->MR_ti_higher_order_arity;\
+    } while (0)
 
 /*---------------------------------------------------------------------------*/
 
@@ -212,81 +269,7 @@
 
 /*---------------------------------------------------------------------------*/
 
-/*
-** Tags in type_layout structures.
-**
-** These definitions are intended for use in handwritten
-** C code.
-**
-** Some of the type-layout tags are shared.
-**
-** XXX This stuff is part of USEREQ type_ctor_infos and is obsolete;
-** it is needed now only for bootstrapping.
-*/
-
-#define TYPE_CTOR_LAYOUT_CONST_TAG		0
-#define TYPE_CTOR_LAYOUT_SHARED_LOCAL_TAG	0
-#define TYPE_CTOR_LAYOUT_UNSHARED_TAG		1
-#define TYPE_CTOR_LAYOUT_SHARED_REMOTE_TAG	2
-#define TYPE_CTOR_LAYOUT_EQUIV_TAG		3
-#define TYPE_CTOR_LAYOUT_NO_TAG			3
-
-/*
-** This constant is also used for other information - for
-** ctor infos a small integer is used for higher order types.
-** Even integers represent preds, odd represent functions.
-** The arity of the pred or function can be found by dividing by
-** two (integer division).
-*/
-
-#define MR_TYPE_CTOR_INFO_HO_PRED				\
-	((MR_TypeCtorInfo) &mercury_data___type_ctor_info_pred_0)
-#define MR_TYPE_CTOR_INFO_HO_FUNC				\
-	((MR_TypeCtorInfo) &mercury_data___type_ctor_info_func_0)
-#define MR_TYPE_CTOR_INFO_IS_HO_PRED(T)				\
-	(T == MR_TYPE_CTOR_INFO_HO_PRED)
-#define MR_TYPE_CTOR_INFO_IS_HO_FUNC(T)				\
-	(T == MR_TYPE_CTOR_INFO_HO_FUNC)
-#define MR_TYPE_CTOR_INFO_IS_HO(T)				\
-	(T == MR_TYPE_CTOR_INFO_HO_FUNC || T == MR_TYPE_CTOR_INFO_HO_PRED)
-
-#define MR_TYPECTOR_IS_HIGHER_ORDER(T)				\
-	( (Word) T <= MR_PSEUDOTYPEINFO_MAX_VAR )
-#define MR_TYPECTOR_MAKE_PRED(Arity)				\
-	( (Word) ((Integer) (Arity) * 2) )
-#define MR_TYPECTOR_MAKE_FUNC(Arity)				\
-	( (Word) ((Integer) (Arity) * 2 + 1) )
-#define MR_TYPECTOR_GET_HOT_ARITY(T)				\
-	((Integer) (T) / 2 )
-#define MR_TYPECTOR_GET_HOT_NAME(T)				\
-	((ConstString) ( ( ((Integer) (T)) % 2 ) ? "func" : "pred" ))
-#define MR_TYPECTOR_GET_HOT_MODULE_NAME(T)				\
-	((ConstString) "builtin")
-#define MR_TYPECTOR_GET_HOT_TYPE_CTOR_INFO(T)			\
-	((Word) ( ( ((Integer) (T)) % 2 ) ?		\
-		(const Word *) &mercury_data___type_ctor_info_func_0 :	\
-		(const Word *) &mercury_data___type_ctor_info_pred_0 ))
-
-/*
-** Offsets into the type_layout structure for functors and arities.
-**
-** Constant and enumeration values start at 0, so the functor
-** is at OFFSET + const/enum value.
-**
-** Functors for unshared tags are at OFFSET + arity (the functor is
-** stored after all the argument info.
-**
-*/
 
-#define TYPE_CTOR_LAYOUT_CONST_FUNCTOR_OFFSET		2
-#define TYPE_CTOR_LAYOUT_ENUM_FUNCTOR_OFFSET		2
-#define TYPE_CTOR_LAYOUT_UNSHARED_FUNCTOR_OFFSET	1
-
-#define TYPE_CTOR_LAYOUT_UNSHARED_ARITY_OFFSET  	0
-#define TYPE_CTOR_LAYOUT_UNSHARED_ARGS_OFFSET       	1
-
-/*---------------------------------------------------------------------------*/
-
 /*
 ** Offsets for dealing with `univ' types.
 **
@@ -300,377 +283,11 @@
 
 /*---------------------------------------------------------------------------*/
 
-/*
-** Code for dealing with the static code addresses stored in
-** type_ctor_infos.
-*/
-
-/*
-** Definitions for initialization of type_ctor_infos. If
-** MR_STATIC_CODE_ADDRESSES are not available, we need to initialize
-** the special predicates in the type_ctor_infos.
-*/
-
-/*
-** A fairly generic static code address initializer - at least for entry
-** labels.
-*/
-#define MR_INIT_CODE_ADDR(Base, PredAddr, Offset)			\
-	do {								\
-		Declare_entry(PredAddr);				\
-		((Word *) (Word) &Base)[Offset]	= (Word) ENTRY(PredAddr);\
-	} while (0)
-			
-#define MR_SPECIAL_PRED_INIT(Base, TypeId, Offset, Pred)	\
-	MR_INIT_CODE_ADDR(Base, mercury____##Pred##___##TypeId, Offset)
-
-/*
-** Macros are provided here to initialize type_ctor_infos, both for
-** builtin types (such as in library/builtin.m) and user
-** defined C types (like library/array.m). Also, the automatically
-** generated code uses these initializers.
-**
-** Examples of use:
-**
-** MR_INIT_BUILTIN_TYPE_CTOR_INFO(
-** 	mercury_data__type_ctor_info_string_0, _string_);
-**
-** note we use _string_ to avoid the redefinition of string via #define
-**
-** MR_INIT_TYPE_CTOR_INFO(
-** 	mercury_data_group__type_ctor_info_group_1, group__group_1_0);
-**
-** MR_INIT_TYPE_CTOR_INFO_WITH_PRED(
-** 	mercury_date__type_ctor_info_void_0, mercury__unused_0_0);
-**
-** This will initialize a type_ctor_info with a single code address.
-*/
-
-#ifndef MR_STATIC_CODE_ADDRESSES
-
-  #define MR_MAYBE_STATIC_CODE(X)	((Integer) 0)
-
-  #define MR_STATIC_CODE_CONST
-
-  #define	MR_INIT_BUILTIN_TYPE_CTOR_INFO(B, T)			\
-  do {									\
-	MR_INIT_CODE_ADDR(B, mercury__builtin_unify##T##2_0, 		\
-		OFFSET_FOR_UNIFY_PRED);					\
-	MR_INIT_CODE_ADDR(B, mercury__builtin_index##T##2_0, 		\
-		OFFSET_FOR_INDEX_PRED);					\
-	MR_INIT_CODE_ADDR(B, mercury__builtin_compare##T##3_0, 		\
-		OFFSET_FOR_COMPARE_PRED);				\
-  } while (0)
-
-  #define	MR_INIT_TYPE_CTOR_INFO_WITH_PRED(B, P)			\
-  do {									\
-	MR_INIT_CODE_ADDR(B, P, OFFSET_FOR_UNIFY_PRED);			\
-	MR_INIT_CODE_ADDR(B, P, OFFSET_FOR_INDEX_PRED);			\
-	MR_INIT_CODE_ADDR(B, P, OFFSET_FOR_COMPARE_PRED);		\
-  } while (0)
-
-  #define	MR_INIT_TYPE_CTOR_INFO(B, T)				\
-  do {									\
-	MR_SPECIAL_PRED_INIT(B, T, OFFSET_FOR_UNIFY_PRED, Unify);	\
-	MR_SPECIAL_PRED_INIT(B, T, OFFSET_FOR_INDEX_PRED, Index);	\
-	MR_SPECIAL_PRED_INIT(B, T, OFFSET_FOR_COMPARE_PRED, Compare);	\
-  } while (0)
-
-#else	/* MR_STATIC_CODE_ADDRESSES */
-
-  #define MR_MAYBE_STATIC_CODE(X)	(X)
-
-  #define MR_STATIC_CODE_CONST const
-
-  #define MR_INIT_BUILTIN_TYPE_CTOR_INFO(B, T) \
-	do { } while (0)
-
-  #define MR_INIT_TYPE_CTOR_INFO_WITH_PRED(B, P) \
-	do { } while (0)
-
-  #define MR_INIT_TYPE_CTOR_INFO(B, T) \
-	do { } while (0)
-
-#endif /* MR_STATIC_CODE_ADDRESSES */
-
-/*---------------------------------------------------------------------------*/
-
-/*
-** Macros and defintions for defining and dealing with
-** type_ctor_functors.
-**
-** XXX This stuff is part of USEREQ type_ctor_infos and is obsolete;
-** it is needed now only for bootstrapping.
-*/
-
-/*
-** All type_functors have an indicator.
-*/
-
-#define MR_TYPE_CTOR_FUNCTORS_OFFSET_FOR_INDICATOR	((Integer) 0)
-
-#define MR_TYPE_CTOR_FUNCTORS_INDICATOR(functors)			\
-	((functors)[MR_TYPE_CTOR_FUNCTORS_OFFSET_FOR_INDICATOR])
-
-/*
-** Values that the indicator can take.
-*/
-
-#define MR_TYPE_CTOR_FUNCTORS_DU	((Integer) 0)
-#define MR_TYPE_CTOR_FUNCTORS_ENUM	((Integer) 1)
-#define MR_TYPE_CTOR_FUNCTORS_EQUIV	((Integer) 2)
-#define MR_TYPE_CTOR_FUNCTORS_SPECIAL	((Integer) 3)
-#define MR_TYPE_CTOR_FUNCTORS_NO_TAG	((Integer) 4)
-#define MR_TYPE_CTOR_FUNCTORS_UNIV	((Integer) 5)
-
-	/*
-	** Macros to access the data in a discriminated union
-	** type_functors, the number of functors, and the functor descriptor
-	** for functor number N (where N starts at 1).
-	*/
-
-#define MR_TYPE_CTOR_FUNCTORS_DU_OFFSET_FOR_NUM_FUNCTORS	((Integer) 1)
-#define MR_TYPE_CTOR_FUNCTORS_DU_OFFSET_FOR_FUNCTOR_DESCRIPTORS	((Integer) 2)
-
-#define MR_TYPE_CTOR_FUNCTORS_DU_NUM_FUNCTORS(Functors)			\
-	((Functors)[MR_TYPE_CTOR_FUNCTORS_DU_OFFSET_FOR_NUM_FUNCTORS])
-
-#define MR_TYPE_CTOR_FUNCTORS_DU_FUNCTOR_N(Functor, N)			\
-	((Word *) ((Functor)[						\
-		MR_TYPE_CTOR_FUNCTORS_DU_OFFSET_FOR_FUNCTOR_DESCRIPTORS + N]))
-
-	/*
-	** Macros to access the data in a enumeration type_functors, the
-	** number of functors, and the enumeration vector.
-	*/
-
-#define MR_TYPE_CTOR_FUNCTORS_ENUM_OFFSET_FOR_ENUM_VECTOR	\
-		((Integer) 1)
-
-#define MR_TYPE_CTOR_FUNCTORS_ENUM_NUM_FUNCTORS(Functors)		\
-	MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_NUM_FUNCTORS(			\
-		MR_TYPE_CTOR_FUNCTORS_ENUM_VECTOR((Functors)))
-
-#define MR_TYPE_CTOR_FUNCTORS_ENUM_VECTOR(Functor)			\
-	((Word *) ((Functor)						\
-		[MR_TYPE_CTOR_FUNCTORS_ENUM_OFFSET_FOR_ENUM_VECTOR]))
-
-	/*
-	** Macros to access the data in a no_tag type_functors, the
-	** functor descriptor for the functor (there can only be one functor
-	** with no_tags).
-	*/
-
-#define MR_TYPE_CTOR_FUNCTORS_NO_TAG_OFFSET_FOR_FUNCTOR_DESCRIPTOR \
-	((Integer) 1)
-
-#define MR_TYPE_CTOR_FUNCTORS_NO_TAG_FUNCTOR(Functors)			\
-	((Word *) ((Functors)						\
-		[MR_TYPE_CTOR_FUNCTORS_NO_TAG_OFFSET_FOR_FUNCTOR_DESCRIPTOR]))
-
-	/*
-	** Macros to access the data in an equivalence type_functors,
-	** the equivalent type of this type.
-	*/
-
-#define MR_TYPE_CTOR_FUNCTORS_EQUIV_OFFSET_FOR_TYPE	((Integer) 1)
-
-#define MR_TYPE_CTOR_FUNCTORS_EQUIV_TYPE(Functors)			\
-	((Functors)[MR_TYPE_CTOR_FUNCTORS_EQUIV_OFFSET_FOR_TYPE])
-
-/*---------------------------------------------------------------------------*/
-
 /*
-** Macros and defintions for defining and dealing with the data structures
-** created by type_ctor_layouts (these are the same vectors referred to
-** by type_ctor_functors)
-** 	- the functor descriptor, describing a single functor
-** 	- the enum_vector, describing an enumeration
-** 	- the no_tag_vector, describing a single functor
-**
-** XXX This stuff is part of USEREQ type_ctor_infos and is obsolete;
-** it is needed now only for bootstrapping.
+** Definitions for accessing the representation of the
+** Mercury typeclass_info.
 */
 
-	/*
-	** Macros for dealing with enum vectors.
-	*/
-
-typedef struct {
-	int enum_or_comp_const;
-	Word num_sharers;		
-	ConstString functor1;
-/* other functors follow, num_sharers of them.
-** 	ConstString functor2;
-** 	...
-*/
-} MR_TypeLayout_EnumVector;
-
-#define MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_IS_ENUM(Vector)			\
-	((MR_TypeLayout_EnumVector *) (Vector))->enum_or_comp_const
-
-#define MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_NUM_FUNCTORS(Vector)		\
-	((MR_TypeLayout_EnumVector *) (Vector))->num_sharers
-
-#define MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_FUNCTOR_NAME(Vector, N)		\
-	( (&((MR_TypeLayout_EnumVector *)(Vector))->functor1) [N] )
-
-	/*
-	** Macros for dealing with functor descriptors.
-	**
-	** XXX we might like to re-organize this structure so the
-	**     variable length component isn't such a pain.
-	*/
-
-typedef struct {
-	Integer		arity;
-	Word		arg1;		
-/* other functors follow, arity of them.
-** 	Word		arg2;
-** 	...
-**	ConstString	functorname;
-**	Word		tagbits;
-**	Integer		num_extra_args; 	for exist quant args
-**	Word		locn1;			type info locations
-**	...
-*/
-} MR_TypeLayout_FunctorDescriptor;
-
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_ARITY	\
-	((Integer) 0)
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_ARGS	((Integer) 1)
-	/* Note, these offsets are from the end of the args */
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_FUNCTOR_NAME	\
-		((Integer) 1)
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_FUNCTOR_TAG	\
-		((Integer) 2)
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_EXIST_TYPEINFO_VARCOUNT \
-		((Integer) 3)
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_EXIST_TYPECLASSINFO_VARCOUNT \
-		((Integer) 4)
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_TYPE_INFO_LOCNS \
-		((Integer) 5)
-
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(V)			\
-		((V)[MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_ARITY])
-
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARGS(V)			\
-		(V + MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_ARGS)
-
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_FUNCTOR_NAME(V)		\
-	((String) ((V)[MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(V) + \
-	    MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_FUNCTOR_NAME]))
-
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_TAG(V)			\
-	((Word) ((V)[MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(V) +	\
-		MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_FUNCTOR_TAG]))
-
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_EXIST_TYPEINFO_VARCOUNT(V)	\
-	((Word) ((V)[MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(V) +	\
-		MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_EXIST_TYPEINFO_VARCOUNT]))
-
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_EXIST_TYPECLASSINFO_VARCOUNT(V)	\
-	((Word) ((V)[MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(V) +	\
-		MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_EXIST_TYPECLASSINFO_VARCOUNT]))
-
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_EXIST_VARCOUNT(V)	\
-		MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_EXIST_TYPEINFO_VARCOUNT(V) + MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_EXIST_TYPECLASSINFO_VARCOUNT(V)
-
-#define MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_TYPE_INFO_LOCNS(V)	  \
-	(((Word *)V) + 							  \
-		MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY((Word *)V) + \
-		MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_OFFSET_FOR_TYPE_INFO_LOCNS)
-
-	/*
-	** Macros for handling type info locations
-	*/
-#define MR_TYPE_INFO_LOCN_IS_INDIRECT(t) ((t) & (Unsigned) 1)
-#define MR_TYPE_INFO_LOCN_INDIRECT_GET_TYPEINFO_NUMBER(t) (int) ((t) >> 7)
-#define MR_TYPE_INFO_LOCN_INDIRECT_GET_ARG_NUMBER(t) \
-	(int) (((t) >> 1) & (Unsigned) 63)
-#define MR_TYPE_INFO_LOCN_DIRECT_GET_TYPEINFO_NUMBER(t) (int) ((t) >> 1)
-
-	/*
-	** Macros for dealing with shared remote vectors.
-	*/
-
-typedef struct {
-	Word num_sharers;		
-	Word functor_descriptor1;
-/* other functor descriptors follow, num_sharers of them.
-**	Word functor_descriptor2;
-** 	...
-*/
-} MR_TypeLayout_SharedRemoteVector;
-
-#define MR_TYPE_CTOR_LAYOUT_SHARED_REMOTE_VECTOR_NUM_SHARERS(Vector) 	\
-	(((MR_TypeLayout_SharedRemoteVector *) (Vector))->num_sharers)
-
-#define MR_TYPE_CTOR_LAYOUT_SHARED_REMOTE_VECTOR_GET_FUNCTOR_DESCRIPTOR( \
-		Vector, N)						 \
-	( (Word *) MR_strip_tag((&((MR_TypeLayout_SharedRemoteVector *)	 \
-		(Vector))->functor_descriptor1) [N]) )
-		
-	/*
-	** Macros for dealing with no_tag vectors
-	**
-	** (Note, we know the arity is 1).
-	*/
-
-typedef struct {
-	int		is_no_tag;
-	Word		arg;
-	ConstString	name;
-} MR_TypeLayout_NoTagVector;
-
-#define MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_IS_NO_TAG(Vector)		\
-		((MR_TypeLayout_NoTagVector *) (Vector))->is_no_tag
-
-#define MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_ARITY(Vector)			\
-		(1)
-
-#define MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_ARGS(Vector)			\
-		&(((MR_TypeLayout_NoTagVector *) (Vector))->arg)
-		
-#define MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_FUNCTOR_NAME(Vector)		\
-		((MR_TypeLayout_NoTagVector *) (Vector))->name
-
-	/*
-	** Macros for dealing with equivalent vectors
-	*/	
-
-typedef struct {
-	int	is_no_tag;		/* might be a no_tag */
-	Word	equiv_type;
-} MR_TypeLayout_EquivVector;
-
-#define MR_TYPE_CTOR_LAYOUT_EQUIV_OFFSET_FOR_TYPE	((Integer) 1)
-
-#define MR_TYPE_CTOR_LAYOUT_EQUIV_IS_EQUIV(Vector)			\
-		(!((MR_TypeLayout_EquivVector *) (Vector))->is_no_tag)
-
-#define MR_TYPE_CTOR_LAYOUT_EQUIV_TYPE(Vector)				\
-		((MR_TypeLayout_EquivVector *) (Vector))->equiv_type
-
-/*---------------------------------------------------------------------------*/
-
-	/*
-	** Macros for retreiving things from type_infos.
-	*/
-
-#define MR_TYPEINFO_GET_TYPE_CTOR_INFO(TypeInfo)			\
-	((MR_TypeCtorInfo) ((*(TypeInfo)) ? *(TypeInfo) : (Word) (TypeInfo)))
-
-#define MR_TYPEINFO_GET_HIGHER_ARITY(TypeInfo)				\
-	((Integer) (Word *) (TypeInfo)[TYPEINFO_OFFSET_FOR_PRED_ARITY])
-
-/*---------------------------------------------------------------------------*/
-
-/*
-** definitions for accessing the representation of the
-** Mercury typeclass_info
-*/
-
 #define	MR_typeclass_info_instance_arity(tci) \
 	((Integer)(*(Word **)(tci))[0])
 #define	MR_typeclass_info_num_superclasses(tci) \
@@ -684,11 +301,12 @@
 #define	MR_typeclass_info_arg_typeclass_info(tci, n) \
 	(((Word *)(tci))[(n)])
 
-	/*
-	** The following have the same definitions. This is because
-	** the call to MR_typeclass_info_type_info must already have the
-	** number of superclass_infos for the class added to it
-	*/
+/*
+** The following have the same definitions. This is because
+** the call to MR_typeclass_info_type_info must already have the
+** number of superclass_infos for the class added to it.
+*/
+
 #define	MR_typeclass_info_superclass_info(tci, n) \
 	(((Word *)(tci))[MR_typeclass_info_instance_arity(tci) + (n)])
 #define	MR_typeclass_info_type_info(tci, n) \
@@ -795,42 +413,8 @@
 	|| ((rep) == MR_TYPECTOR_REP_NOTAG_GROUND)			\
 	|| ((rep) == MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ))
 
-/*
-** If the MR_TypeCtorRep is MR_TYPE_CTOR_REP_DU{,_USEREQ},
-** we have a discriminated union type which is not a no-tag type or
-** an enumeration. Each tag may have a different representation.
-*/
-
-typedef enum MR_DiscUnionTagRepresentation {
-	MR_DISCUNIONTAG_SHARED_LOCAL,
-	MR_DISCUNIONTAG_UNSHARED,
-	MR_DISCUNIONTAG_SHARED_REMOTE
-} MR_DiscUnionTagRepresentation;
-
-/*
-** Return the tag representation used by the data with the given
-** entry in the type_ctor_layout table.
-*/
-
-MR_DiscUnionTagRepresentation MR_get_tag_representation(Word layout_entry);
-
 /*---------------------------------------------------------------------------*/
 
-typedef	Word *	MR_TypeCtorFunctors;
-typedef	Word *	MR_TypeCtorLayout;
-
-	/*
-	** Macros for retrieving things from type_ctor_infos.
-	**
-	** XXX zs: these macros should be deleted; the code using them
-	** would be clearer if it referred to TypeCtorInfo fields directly.
-	*/
-
-#define MR_TYPE_CTOR_INFO_GET_TYPE_ARITY(TypeCtorInfo)			\
-	((TypeCtorInfo)->arity)
-
-/*---------------------------------------------------------------------------*/
-
 /*
 ** The argument number gives the offset in the cell (in a form in which
 ** it can be given to the MR_field macro directly) of either of the typeinfo
@@ -1010,7 +594,7 @@
 typedef	struct {
 	MR_int_least32_t	MR_sectag_sharers;
 	MR_Sectag_Locn		MR_sectag_locn;
-	MR_DuFunctorDesc	**MR_sectag_alternatives;
+    const MR_DuFunctorDesc  **MR_sectag_alternatives;
 } MR_DuPtagLayout;
 
 typedef	MR_DuPtagLayout		*MR_DuTypeLayout;
@@ -1125,17 +709,8 @@
 	Code				*index_pred;
 	Code				*compare_pred;
 	MR_TypeCtorRep			type_ctor_rep;
-/*
-** The type_ctor_functors and type_ctor_layout fields have been replaced
-** by the type_ctor_num_functors, type_functors and type_layout fields.
-** They are present only for backward compatibility. Once that is not needed
-** anymore, those two slots will contain stuff for HAL:
-**
-**	Code				*solver_pred;
-**	Code				*init_pred;
-*/
-	MR_TypeCtorFunctors		type_ctor_functors;
-	MR_TypeCtorLayout		type_ctor_layout;
+    Code                *solver_pred;
+    Code                *init_pred;
 	ConstString			type_ctor_module_name;
 	ConstString			type_ctor_name;
 	Integer				type_ctor_version;
@@ -1151,8 +726,6 @@
 */
 };
 
-typedef struct MR_TypeCtorInfo_Struct *MR_TypeCtorInfo;
-
 /*---------------------------------------------------------------------------*/
 
 /*
@@ -1173,8 +746,8 @@
 		cr,							\
 		NULL,							\
 		NULL,							\
-		MR_string_const(MR_STRINGIFY(m), sizeof(MR_STRINGIFY(m))-1),\
-		MR_string_const(MR_STRINGIFY(n), sizeof(MR_STRINGIFY(n))-1),\
+        MR_string_const(MR_STRINGIFY(m), sizeof(MR_STRINGIFY(m))-1),    \
+        MR_string_const(MR_STRINGIFY(n), sizeof(MR_STRINGIFY(n))-1),    \
 		MR_RTTI_VERSION,					\
 		{ 0 },							\
 		{ 0 },							\
@@ -1198,23 +771,152 @@
 		mercury__unused_0_0)
 
 /*---------------------------------------------------------------------------*/
+
+/*
+** Code for dealing with the static code addresses stored in
+** type_ctor_infos.
+*/
+
+/*
+** Definitions for initialization of type_ctor_infos. If
+** MR_STATIC_CODE_ADDRESSES are not available, we need to initialize
+** the special predicates in the type_ctor_infos.
+*/
+
+/*
+** Macros are provided here to initialize type_ctor_infos, both for
+** builtin types (such as in library/builtin.m) and user
+** defined C types (like library/array.m). Also, the automatically
+** generated code uses these initializers.
+**
+** Examples of use:
+**
+** MR_INIT_BUILTIN_TYPE_CTOR_INFO(
+**  mercury_data__type_ctor_info_string_0, _string_);
+**
+** note we use _string_ to avoid the redefinition of string via #define
+**
+** MR_INIT_TYPE_CTOR_INFO(
+**  mercury_data_group__type_ctor_info_group_1, group__group_1_0);
+**
+** MR_INIT_TYPE_CTOR_INFO_WITH_PRED(
+**  mercury_date__type_ctor_info_void_0, mercury__unused_0_0);
+**
+** This will initialize a type_ctor_info with a single code address.
+*/
+
+#ifndef MR_STATIC_CODE_ADDRESSES
+
+  #define MR_MAYBE_STATIC_CODE(X)   ((Integer) 0)
+
+  #define MR_STATIC_CODE_CONST
+
+  #define   MR_INIT_BUILTIN_TYPE_CTOR_INFO(B, T)            \
+  do {                                                      \
+    B->unify_pred = mercury__builtin_unify##T##2_0;         \
+    B->index_pred = mercury__builtin_index##T##2_0;         \
+    B->compare_pred = mercury__builtin_compare##T##3_0;     \
+  } while (0)
+
+  #define   MR_INIT_TYPE_CTOR_INFO_WITH_PRED(B, P)          \
+  do {                                                      \
+    B->unify_pred = P;                                      \
+    B->index_pred = P;                                      \
+    B->compare_pred = P;                                    \
+  } while (0)
+
+  #define   MR_INIT_TYPE_CTOR_INFO(B, T)                    \
+  do {                                                      \
+    B->unify_pred = mercury____##Unify##___##T;             \
+    B->index_pred = mercury____##Index##___##T;             \
+    B->compare_pred = mercury____##Compare##___##T;         \
+  } while (0)
+
+#else   /* MR_STATIC_CODE_ADDRESSES */
+
+  #define MR_MAYBE_STATIC_CODE(X)   (X)
+
+  #define MR_STATIC_CODE_CONST const
+
+  #define MR_INIT_BUILTIN_TYPE_CTOR_INFO(B, T)              \
+    do { } while (0)
+
+  #define MR_INIT_TYPE_CTOR_INFO_WITH_PRED(B, P)            \
+    do { } while (0)
+
+  #define MR_INIT_TYPE_CTOR_INFO(B, T)                      \
+    do { } while (0)
+
+#endif /* MR_STATIC_CODE_ADDRESSES */
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** MR_compare_type_info returns MR_COMPARE_GREATER, MR_COMPARE_EQUAL, or
+** MR_COMPARE_LESS, depending on whether t1 is greater than , equal to,
+** or less than t2.
+*/
 
-extern	int	MR_compare_type_info(Word, Word);
-extern	Word	MR_collapse_equivalences(Word);
+extern  int     MR_compare_type_info(MR_TypeInfo t1, MR_TypeInfo t2);
 
 /*
-** Functions for creating type_infos from pseudo_type_infos.
-** See mercury_type_info.c for documentation on these.
+** MR_collapse_equivalences expands out all the top-level equivalences in
+** the argument typeinfo. It guarantees that the returned typeinfo's
+** type_ctor_info will not have a MR_TYPE_CTOR_REP_EQUIV* representation.
+** However, since it only works on the top level type constructor,
+** this is not guaranteed for the typeinfos of the type constructor's
+** arguments.
 */
+
+extern  MR_TypeInfo MR_collapse_equivalences(MR_TypeInfo type_info);
 
-extern	Word	*MR_create_type_info(const Word * term_type_info,
-			const Word *arg_pseudo_type_info);
-extern	Word	*MR_create_type_info_maybe_existq(const Word *term_type_info,
-			const Word *arg_pseudo_type_info,
-			const Word *data_value, int rtti_version,
+/* 
+** MR_create_type and MR_make_type_info both turn a pseudo typeinfo into
+** a typeinfo, looking up the typeinfos associated with the type variables
+** in the pseudointo typeinfo in the supplied vector of type parameters.
+**
+** The two functions differ in how they allocate memory. MR_create_type_info
+** allocates memory for a new type_info on the Mercury heap. Since this
+** may modify MR_hp, you need to wrap save_transient_hp() and
+** restore_transient_hp() around calls to MR_create_type_info.
+** MR_make_type_info allocates memory using MR_GC_malloc, and inserts
+** the address of the cells allocated into the list of allocations
+** represented by its last argument; it is the caller's responsibility
+** to call MR_deallocate() on the list after they have finished using
+** the returned typeinfo.
+**
+** MR_create_type_info and MR_make_type_info both assume that all type
+** variables inside the given pseudo typeinfo are universally quantified.
+** Their maybe_existq variants do not make this assumption; they also work
+** if the pseudo typeinfo contains existentially quantified arguments.
+** This can happen only when the pseudo typeinfo describes the type of
+** an argument of a function symbol from a MR_TYPE_CTOR_REP_DU* type.
+** These functions also take two extra arguments: the address of the cell,
+** which (directly or indirectly) contains the typeinfos of the existentially
+** quantified type variables, and the descriptor of the function symbol,
+** which describes how those typeinfos can be found in the cell. The cell
+** address is supposed to point past the remote secondary tag, if any;
+** it should point to the first argument, whether it is a user visible argument
+** or a typeinfo/typeclass_info inserted into the cell by the compiler.
+**
+** All these functions guarantee that if the pseudo typeinfo argument refers
+** to a type constructor with no arguments, then they return a one-cell
+** typeinfo, and do not require any memory allocation.
+**
+** These functions should only be called if the pseudo typeinfo may have
+** some type variables in it. Otherwise, the pseudo typeinfo should be
+** cast to a typeinfo directly, using the macro MR_pseudo_type_info_is_ground.
+*/
+
+extern  MR_TypeInfo MR_create_type_info(
+                const MR_TypeInfoParams type_info_params,
+                const MR_PseudoTypeInfo pseudo_type_info);
+extern  MR_TypeInfo MR_create_type_info_maybe_existq(
+                const MR_TypeInfoParams type_info_params,
+                const MR_PseudoTypeInfo pseudo_type_info,
+                const Word *data_value,
 			const MR_DuFunctorDesc *functor_descriptor);
 
-/* for MR_make_type_info(), we keep a list of allocated memory cells */
 struct MR_MemoryCellNode {
 	void				*data;
 	struct MR_MemoryCellNode	*next;
@@ -1222,14 +924,16 @@
 
 typedef struct MR_MemoryCellNode *MR_MemoryList;
 
-extern	Word	*MR_make_type_info(const Word *term_type_info,
-			const Word *arg_pseudo_type_info,
+extern  MR_TypeInfo MR_make_type_info(
+                        const MR_TypeInfoParams type_info_params,
+                        const MR_PseudoTypeInfo pseudo_type_info,
 			MR_MemoryList *allocated);
-extern	Word	*MR_make_type_info_maybe_existq(const Word *term_type_info,
-			const Word *arg_pseudo_type_info,
-			const Word *data_value, int rtti_version,
+extern  MR_TypeInfo MR_make_type_info_maybe_existq(
+                        const MR_TypeInfoParams type_info_params,
+                        const MR_PseudoTypeInfo pseudo_type_info,
+                        const Word *data_value,
 			const MR_DuFunctorDesc *functor_descriptor,
-			MR_MemoryList *allocated) ;
+                        MR_MemoryList *allocated);
 extern	void	MR_deallocate(MR_MemoryList allocated_memory_cells);
 
 /*---------------------------------------------------------------------------*/
Index: runtime/mercury_unify_compare_body.h
===================================================================
RCS file: mercury_unify_compare_body.h
diff -N mercury_unify_compare_body.h
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ mercury_unify_compare_body.h	Wed Mar 22 12:59:20 2000
@@ -0,0 +1,428 @@
+/*
+** Copyright (C) 2000 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** This file contains a piece of code that is included by mercury_ho_call.c
+** three times:
+** 
+** - as the body of the mercury__unify_2_0 Mercury procedure,
+** - as the body of the mercury__compare_3_3 Mercury procedure, and
+** - as the body of the MR_generic_compare C function.
+**
+** The inclusions are surrounded by #defines and #undefs of the macros
+** that personalize each copy of the code.
+**
+** The reason why the unify and compare Mercury procedures share code is
+** that unify is mostly just a special case of comparison; it differs only
+** by treating "less than" and "greater than" the same way, and returning
+** its result slightly differently.
+**
+** The reason why there is both a Mercury procedure and a C function for
+** comparisons is that the Mercury procedure needs a mechanism that allows it
+** to compare each argument of a function symbol, and doing it with a loop body
+** that calls C function is significantly easier to program, and probably
+** more efficient, than using recursion in Mercury. The Mercury procedure and
+** C function share code because they implement the same task.
+**
+** There is no C function for unification, since the C function for comparison
+** is sufficient for programming the Mercury procedure for unification.
+*/
+
+    DECLARE_LOCALS
+    initialize();
+
+start_label:
+    type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+
+#ifdef  MR_CTOR_REP_STATS
+    ctor_rep_stats_array[type_ctor_info->type_ctor_rep]++;
+#endif
+
+    switch (type_ctor_info->type_ctor_rep) {
+
+#ifdef  MR_COMPARE_BY_RTTI
+
+        case MR_TYPECTOR_REP_EQUIV:
+            save_transient_hp();
+            type_info = MR_create_type_info(
+                MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+                type_ctor_info->type_layout.layout_equiv);
+            restore_transient_hp();
+            goto start_label;
+
+        case MR_TYPECTOR_REP_EQUIV_GROUND:
+            type_info = (MR_TypeInfo) type_ctor_info->type_layout.layout_equiv;
+            goto start_label;
+
+        case MR_TYPECTOR_REP_EQUIV_VAR:
+            fatal_error("found type_ctor_rep MR_TYPECTOR_REP_EQUIV_VAR");
+
+        case MR_TYPECTOR_REP_NOTAG:
+            save_transient_hp();
+            type_info = MR_create_type_info(
+                MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+                type_ctor_info->type_layout.layout_notag->
+                MR_notag_functor_arg_type);
+            restore_transient_hp();
+            goto start_label;
+
+        case MR_TYPECTOR_REP_NOTAG_GROUND:
+            type_info = (MR_TypeInfo) type_ctor_info->type_layout.
+                layout_notag->MR_notag_functor_arg_type;
+            goto start_label;
+
+        case MR_TYPECTOR_REP_DU:
+            {
+                const MR_DuFunctorDesc  *x_functor_desc;
+                const MR_DuFunctorDesc  *y_functor_desc;
+                Word                    *x_data_value;
+                Word                    *y_data_value;
+                const MR_DuExistInfo    *exist_info;
+                int                     result;
+                int                     cur_slot;
+                int                     arity;
+                int                     i;
+
+#define MR_find_du_functor_desc(data, data_value, functor_desc)               \
+                do {                                                          \
+                    MR_DuPtagLayout         *ptaglayout;                      \
+                    int                     ptag;                             \
+                    int                     sectag;                           \
+                                                                              \
+                    ptag = MR_tag(data);                                      \
+                    ptaglayout = &type_ctor_info->type_layout.layout_du[ptag];\
+                    data_value = (Word *) MR_body(data, ptag);                \
+                                                                              \
+                    switch (ptaglayout->MR_sectag_locn) {                     \
+                        case MR_SECTAG_LOCAL:                                 \
+                            sectag = MR_unmkbody(data_value);                 \
+                            break;                                            \
+                        case MR_SECTAG_REMOTE:                                \
+                            sectag = data_value[0];                           \
+                            break;                                            \
+                        case MR_SECTAG_NONE:                                  \
+                            sectag = 0;                                       \
+                            break;                                            \
+                    }                                                         \
+                                                                              \
+                    functor_desc = ptaglayout->MR_sectag_alternatives[sectag];\
+                } while (0)
+
+                MR_find_du_functor_desc(x, x_data_value, x_functor_desc);
+                MR_find_du_functor_desc(y, y_data_value, y_functor_desc);
+
+#undef MR_find_du_functor_desc
+
+                if (x_functor_desc->MR_du_functor_ordinal !=
+                    y_functor_desc->MR_du_functor_ordinal)
+                {
+#ifdef  select_compare_code
+                    if (x_functor_desc->MR_du_functor_ordinal <
+                        y_functor_desc->MR_du_functor_ordinal)
+                    {
+                        return_answer(MR_COMPARE_LESS);
+                    } else {
+                        return_answer(MR_COMPARE_GREATER);
+                    }
+#else
+                    return_answer(FALSE);
+#endif
+                }
+
+                /* x_functor_desc and y_functor_desc must be the same */
+                if (x_functor_desc->MR_du_functor_sectag_locn ==
+                    MR_SECTAG_REMOTE)
+                {
+                    cur_slot = 1;
+                } else {
+                    cur_slot = 0;
+                }
+
+                arity = x_functor_desc->MR_du_functor_orig_arity;
+                exist_info = x_functor_desc->MR_du_functor_exist_info;
+
+                if (exist_info != NULL) {
+                    int                     num_ti_plain;
+                    int                     num_ti_in_tci;
+                    int                     num_tci;
+                    const MR_DuExistLocn    *locns;
+                    MR_TypeInfo             x_ti;
+                    MR_TypeInfo             y_ti;
+
+                    num_ti_plain = exist_info->MR_exist_typeinfos_plain;
+                    num_ti_in_tci = exist_info->MR_exist_typeinfos_in_tci;
+                    num_tci = exist_info->MR_exist_tcis;
+                    locns = exist_info->MR_exist_typeinfo_locns;
+
+                    for (i = 0; i < num_ti_plain + num_ti_in_tci; i++) {
+                        if (locns[i].MR_exist_offset_in_tci < 0) {
+                            x_ti = (MR_TypeInfo)
+                                x_data_value[locns[i].MR_exist_arg_num];
+                            y_ti = (MR_TypeInfo)
+                                y_data_value[locns[i].MR_exist_arg_num];
+                        } else {
+                            x_ti = (MR_TypeInfo) MR_typeclass_info_type_info(
+                                x_data_value[locns[i].MR_exist_arg_num],
+                                locns[i].MR_exist_offset_in_tci);
+                            y_ti = (MR_TypeInfo) MR_typeclass_info_type_info(
+                                y_data_value[locns[i].MR_exist_arg_num],
+                                locns[i].MR_exist_offset_in_tci);
+                        }
+                        result = MR_compare_type_info(x_ti, y_ti);
+                        if (result != MR_COMPARE_EQUAL) {
+#ifdef  select_compare_code
+                            return_answer(result);
+#else
+                            return_answer(FALSE);
+#endif
+                        }
+                    }
+
+                    cur_slot += num_ti_plain + num_tci;
+                }
+
+                for (i = 0; i < arity; i++) {
+                    MR_TypeInfo arg_type_info;
+
+                    if (MR_arg_type_may_contain_var(x_functor_desc, i)) {
+                        arg_type_info = MR_create_type_info_maybe_existq(
+                            MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+                            x_functor_desc->MR_du_functor_arg_types[i],
+                            x_data_value, x_functor_desc);
+                    } else {
+                        arg_type_info = (MR_TypeInfo)
+                            x_functor_desc->MR_du_functor_arg_types[i];
+                    }
+                    result = MR_generic_compare(arg_type_info,
+                        x_data_value[cur_slot], y_data_value[cur_slot]);
+                        if (result != MR_COMPARE_EQUAL) {
+#ifdef  select_compare_code
+                            return_answer(result);
+#else
+                            return_answer(FALSE);
+#endif
+                        }
+                    cur_slot++;
+                }
+
+#ifdef  select_compare_code
+                return_answer(MR_COMPARE_EQUAL);
+#else
+                return_answer(TRUE);
+#endif
+            }
+
+            break;
+
+#else
+
+        case MR_TYPECTOR_REP_EQUIV:
+        case MR_TYPECTOR_REP_EQUIV_GROUND:
+        case MR_TYPECTOR_REP_EQUIV_VAR:
+        case MR_TYPECTOR_REP_NOTAG:
+        case MR_TYPECTOR_REP_NOTAG_GROUND:
+        case MR_TYPECTOR_REP_DU:
+            /* fall through */
+
+#endif
+
+        case MR_TYPECTOR_REP_ENUM_USEREQ:
+        case MR_TYPECTOR_REP_DU_USEREQ:
+        case MR_TYPECTOR_REP_NOTAG_USEREQ:
+        case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
+        case MR_TYPECTOR_REP_ARRAY:
+
+            /*
+            ** We call the type-specific compare routine as
+            ** `CompPred(...ArgTypeInfos..., Result, X, Y)' is det.
+            ** The ArgTypeInfo arguments are input, and are passed
+            ** in r1, r2, ... rN. The X and Y arguments are also
+            ** input, and are passed in rN+1 and rN+2.
+            ** The Result argument is output in r1.
+            **
+            ** We specialize the case where the type_ctor arity
+            ** is zero, since in this case we don't need the loop.
+            ** We could also specialize other arities; 1 and 2
+            ** may be worthwhile.
+            */
+
+            if (type_ctor_info->arity == 0) {
+                r1 = x;
+                r2 = y;
+            }
+#ifdef  MR_UNIFY_COMPARE_BY_CTOR_REP_SPEC_1
+            else if (type_ctor_info->arity == 1) {
+                Word    *args_base;
+
+                args_base = (Word *)
+                    MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+                r1 = args_base[1];
+                r2 = x;
+                r3 = y;
+            }
+#endif
+#ifdef  MR_UNIFY_COMPARE_BY_CTOR_REP_SPEC_2
+            else if (type_ctor_info->arity == 2) {
+                Word    *args_base;
+
+                args_base = (Word *)
+                    MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+                r1 = args_base[1];
+                r2 = args_base[2];
+                r3 = x;
+                r4 = y;
+            }
+#endif
+            else {
+                int     i;
+                int     type_arity;
+                Word    *args_base;
+
+                type_arity = type_ctor_info->arity;
+                args_base = (Word *)
+                    MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+                save_registers();
+
+                /* CompPred(...ArgTypeInfos..., Res, X, Y) * */
+                for (i = 1; i <= type_arity; i++) {
+                    virtual_reg(i) = args_base[i];
+                }
+                virtual_reg(type_arity + 1) = x;
+                virtual_reg(type_arity + 2) = y;
+
+                restore_registers();
+            }
+
+            tailcall_user_pred();
+
+        case MR_TYPECTOR_REP_ENUM:
+        case MR_TYPECTOR_REP_INT:
+        case MR_TYPECTOR_REP_CHAR:
+#ifdef  select_compare_code
+            if ((Integer) x == (Integer) y) {
+                return_answer(MR_COMPARE_EQUAL);
+            } else if ((Integer) x < (Integer) y) {
+                return_answer(MR_COMPARE_LESS);
+            } else {
+                return_answer(MR_COMPARE_GREATER);
+            }
+#else
+            return_answer((Integer) x == (Integer) y);
+#endif
+
+        case MR_TYPECTOR_REP_FLOAT:
+            {
+                Float   fx, fy;
+
+                fx = word_to_float(x);
+                fy = word_to_float(y);
+#ifdef  select_compare_code
+                if (fx == fy) {
+                    return_answer(MR_COMPARE_EQUAL);
+                } else if (fx < fy) {
+                    return_answer(MR_COMPARE_LESS);
+                } else {
+                    return_answer(MR_COMPARE_GREATER);
+                }
+#else
+                return_answer(fx == fy);
+#endif
+            }
+
+        case MR_TYPECTOR_REP_STRING:
+            {
+                int result;
+
+                result = strcmp((char *) x, (char *) y);
+
+#ifdef  select_compare_code
+                if (result == 0) {
+                    return_answer(MR_COMPARE_EQUAL);
+                } else if (result < 0) {
+                    return_answer(MR_COMPARE_LESS);
+                } else {
+                    return_answer(MR_COMPARE_GREATER);
+                }
+#else
+                return_answer(result == 0);
+#endif
+            }
+
+        case MR_TYPECTOR_REP_UNIV:
+            {
+                MR_TypeInfo type_info_x, type_info_y;
+                int         result;
+
+                /* First compare the type_infos */
+                type_info_x = (MR_TypeInfo) MR_field(MR_mktag(0), x,
+                        UNIV_OFFSET_FOR_TYPEINFO);
+                type_info_y = (MR_TypeInfo) MR_field(MR_mktag(0), y,
+                        UNIV_OFFSET_FOR_TYPEINFO);
+                save_transient_registers();
+                result = MR_compare_type_info(type_info_x, type_info_y);
+                restore_transient_registers();
+                if (result != MR_COMPARE_EQUAL) {
+#ifdef  select_compare_code
+                    return_answer(result);
+#else
+                    return_answer(FALSE);
+#endif
+                }
+
+                /*
+                ** If the types are the same, then recurse on
+                ** the unwrapped args.
+                */
+
+                type_info = type_info_x;
+                x = MR_field(MR_mktag(0), x, UNIV_OFFSET_FOR_DATA);
+                y = MR_field(MR_mktag(0), y, UNIV_OFFSET_FOR_DATA);
+                goto start_label;
+            }
+
+        case MR_TYPECTOR_REP_C_POINTER:
+#ifdef	select_compare_code
+            if ((void *) x == (void *) y) {
+                return_answer(MR_COMPARE_EQUAL);
+            } else if ((void *) x < (void *) y) {
+                return_answer(MR_COMPARE_LESS);
+            } else {
+                return_answer(MR_COMPARE_GREATER);
+            }
+#else
+	        return_answer((void *) x == (void *) y);
+#endif
+
+        case MR_TYPECTOR_REP_TYPEINFO:
+            {
+                int result;
+
+                save_transient_registers();
+                result = MR_compare_type_info(
+                    (MR_TypeInfo) x, (MR_TypeInfo) y);
+                restore_transient_registers();
+#ifdef	select_compare_code
+                return_answer(result);
+#else
+                return_answer(result == MR_COMPARE_EQUAL);
+#endif
+            }
+
+        case MR_TYPECTOR_REP_VOID:
+            fatal_error(attempt_msg "terms of type `void'");
+
+        case MR_TYPECTOR_REP_PRED:
+            fatal_error(attempt_msg "higher-order terms");
+
+        case MR_TYPECTOR_REP_TYPECLASSINFO:
+            fatal_error(attempt_msg "typeclass_infos");
+
+        case MR_TYPECTOR_REP_UNKNOWN:
+            fatal_error(attempt_msg "terms of unknown type");
+
+        default:
+            fatal_error(attempt_msg "terms of unknown representation");
+    }
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
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/hard_coded
Index: tests/hard_coded/construct.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/construct.m,v
retrieving revision 1.2
diff -u -b -r1.2 construct.m
--- tests/hard_coded/construct.m	1997/04/28 15:52:20	1.2
+++ tests/hard_coded/construct.m	2000/03/22 01:54:42
@@ -20,8 +20,8 @@
 
 :- pred newline(io__state::di, io__state::uo) is det.
 
-:- pred test_num_functors(type_info::in, io__state::di, io__state::uo) is det.
-:- pred test_nth_functor(type_info::in, io__state::di, io__state::uo) is det.
+:- pred test_num_functors(type_desc::in, io__state::di, io__state::uo) is det.
+:- pred test_nth_functor(type_desc::in, io__state::di, io__state::uo) is det.
 :- pred test_all(T::in, io__state::di, io__state::uo) is det.
 
 
@@ -96,7 +96,7 @@
 		[One, Bye]).
 
 	
-:- pred test_construct_2(type_info::in, string::in, int::in, list(univ)::in,
+:- pred test_construct_2(type_desc::in, string::in, int::in, list(univ)::in,
 	io__state::di, io__state::uo) is det.
 test_construct_2(TypeInfo, FunctorName, Arity, Args) -->
 	{ find_functor(TypeInfo, FunctorName, Arity, FunctorNumber) },
@@ -115,12 +115,12 @@
 		io__write_string("Construction failed.\n")
 	).
 
-:- pred find_functor(type_info::in, string::in, int::in, int::out) is det.
+:- pred find_functor(type_desc::in, string::in, int::in, int::out) is det.
 find_functor(TypeInfo, Functor, Arity, FunctorNumber) :-
 	N = num_functors(TypeInfo),
 	find_functor2(TypeInfo, Functor, Arity, N, FunctorNumber).
 	
-:- pred find_functor2(type_info::in, string::in, int::in, int::in, 
+:- pred find_functor2(type_desc::in, string::in, int::in, int::in, 
 	int::out) is det.
 find_functor2(TypeInfo, Functor, Arity, Num, FunctorNumber) :-
 	(
@@ -158,7 +158,7 @@
 	test_all_functors(TypeInfo, N - 1).
 
 
-:- pred test_all_functors(type_info::in, int::in, 
+:- pred test_all_functors(type_desc::in, int::in, 
 		io__state::di, io__state::uo) is det.
 
 test_all_functors(TypeInfo, N) -->
Index: tests/hard_coded/existential_rtti.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/existential_rtti.exp,v
retrieving revision 1.2
diff -u -b -r1.2 existential_rtti.exp
--- tests/hard_coded/existential_rtti.exp	2000/03/10 13:38:21	1.2
+++ tests/hard_coded/existential_rtti.exp	2000/03/20 12:59:01
@@ -39,5 +39,28 @@
 f2(9, "hello", u("hello"), 432.100000000000, u("world"), 42)
 multi(10, "multiparameter")
 multi2(11, "multiparameter", 42.0000000000000)
-Writing a deconstructed term:
+Writing deconstructed terms:
+myf/1
+univ(1 : int)
+f/3
+univ(1 : int), univ("hello" : string), univ(42 : int)
+f/3
+univ(2 : int), univ('w' : character), univ(42 : int)
+f/3
+univ(3 : int), univ(goo : existential_rtti:goo), univ(42 : int)
+f/3
+univ(4 : int), univ(g("hello") : existential_rtti:g), univ(42 : int)
+f/3
+univ(5 : int), univ(g2(12) : existential_rtti:g2), univ(42 : int)
+f/3
+univ(6 : int), univ(foo("hello", "world") : existential_rtti:foo), univ(42 : int)
+g/3
+univ(7.00000000000000 : float), univ(g("hello") : existential_rtti:g), univ(42.0000000000000 : float)
+f/3
 univ(8 : int), univ(u("hello") : existential_rtti:u(string)), univ(42 : int)
+f2/6
+univ(9 : int), univ("hello" : string), univ(u("hello") : existential_rtti:u(string)), univ(432.100000000000 : float), univ(u("world") : existential_rtti:u(string)), univ(42 : int)
+multi/2
+univ(10 : int), univ("multiparameter" : string)
+multi2/3
+univ(11 : int), univ("multiparameter" : string), univ(42.0000000000000 : float)
Index: tests/hard_coded/existential_rtti.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/existential_rtti.m,v
retrieving revision 1.2
diff -u -b -r1.2 existential_rtti.m
--- tests/hard_coded/existential_rtti.m	2000/03/10 13:38:21	1.2
+++ tests/hard_coded/existential_rtti.m	2000/03/19 13:48:30
@@ -127,7 +127,27 @@
 	io__write(KCopy), io__nl,
 	io__write(LCopy), io__nl,
 
-	io__write_string("Writing a deconstructed term:\n"),
-	{ deconstruct(I, _Functor, _Arity, IArgs) },
-	io__write_list(IArgs, ", ", io__write),
+	io__write_string("Writing deconstructed terms:\n"),
+	deconstruct_test(A),
+	deconstruct_test(B),
+	deconstruct_test(C),
+	deconstruct_test(D),
+	deconstruct_test(E),
+	deconstruct_test(F),
+	deconstruct_test(G),
+	deconstruct_test(H),
+	deconstruct_test(I),
+	deconstruct_test(J),
+	deconstruct_test(K),
+	deconstruct_test(L).
+
+:- pred deconstruct_test(T::in, io__state::di, io__state::uo) is det.
+
+deconstruct_test(Term) -->
+	{ deconstruct(Term, Functor, Arity, Args) },
+	io__write_string(Functor),
+	io__write_string("/"),
+	io__write_int(Arity),
+	io__nl,
+	io__write_list(Args, ", ", io__write),
 	io__nl.
Index: tests/hard_coded/existential_types_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/existential_types_test.m,v
retrieving revision 1.3
diff -u -b -r1.3 existential_types_test.m
--- tests/hard_coded/existential_types_test.m	1999/10/28 16:29:20	1.3
+++ tests/hard_coded/existential_types_test.m	2000/03/22 01:55:00
@@ -14,7 +14,7 @@
 
 :- some [T] func my_exist_t = T.
 
-:- some [T] pred has_type(T::unused, type_info::in) is det.
+:- some [T] pred has_type(T::unused, type_desc::in) is det.
 
 :- import_module io.
 
Index: tests/hard_coded/higher_order_type_manip.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/higher_order_type_manip.exp,v
retrieving revision 1.3
diff -u -b -r1.3 higher_order_type_manip.exp
--- tests/hard_coded/higher_order_type_manip.exp	1999/07/19 04:51:43	1.3
+++ tests/hard_coded/higher_order_type_manip.exp	2000/03/21 10:08:20
@@ -1,5 +1,5 @@
-func(std_util:type_info) = string
-pred(std_util:type_info, std_util:type_info, list:list(std_util:type_info))
+func(std_util:type_desc) = string
+pred(std_util:type_desc, std_util:type_desc, list:list(std_util:type_desc))
 int
 higher_order_type_manip:container(list:list(int))
 higher_order_type_manip:container(pred(io:state, io:state))
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/misc_tests
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_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.18
diff -u -b -r1.18 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c	2000/02/22 10:46:53	1.18
+++ trace/mercury_trace_declarative.c	2000/03/19 08:20:27
@@ -915,25 +915,25 @@
 	int				i;
 	const MR_Stack_Layout_Vars	*vars;
 	int				arg_count;
-	Word				*type_params;
+	MR_TypeInfoParams		type_params;
 	const MR_Stack_Layout_Entry	*entry = layout->MR_sll_entry;
 
 	MR_trace_init_point_vars(layout, saved_regs, port);
 
 	name = MR_decl_atom_name(entry);
 	if (MR_ENTRY_LAYOUT_COMPILER_GENERATED(layout->MR_sll_entry)) {
-		arity = (Word) entry->MR_sle_comp.MR_comp_arity;
+		arity = entry->MR_sle_comp.MR_comp_arity;
 	} else {
-		arity = (Word) entry->MR_sle_user.MR_user_arity;
+		arity = entry->MR_sle_user.MR_user_arity;
 	}
 	MR_TRACE_CALL_MERCURY(
-		atom = MR_DD_construct_trace_atom((String) name, arity);
+		atom = MR_DD_construct_trace_atom((String) name, (Word) arity);
 	);
 
 	arg_count = MR_trace_var_count();
 	for (i = 1; i <= arg_count; i++) {
 		Word		arg;
-		Word		arg_type;
+		MR_TypeInfo	arg_type;
 		Word		arg_value;
 		int		arg_pos;
 		const char	*problem;
@@ -953,7 +953,7 @@
 			tag_incr_hp(arg, MR_mktag(0), 2);
 		);
 		MR_field(MR_mktag(0), arg, UNIV_OFFSET_FOR_TYPEINFO) =
-				arg_type;
+				(Word) arg_type;
 		MR_field(MR_mktag(0), arg, UNIV_OFFSET_FOR_DATA) =
 				arg_value;
 
@@ -974,14 +974,14 @@
 	if (MR_ENTRY_LAYOUT_HAS_PROC_ID(entry)) {
 		if (MR_ENTRY_LAYOUT_COMPILER_GENERATED(entry)) {
 			MR_TRACE_USE_HP(
-				make_aligned_string(name, "<<internal>>");
+				MR_make_aligned_string(name, "<<internal>>");
 			);
 		} else {
 			name = entry->MR_sle_proc_id.MR_proc_user.MR_user_name;
 		}
 	} else {
 		MR_TRACE_USE_HP(
-			make_aligned_string(name, "<<unknown>>");
+			MR_make_aligned_string(name, "<<unknown>>");
 		);
 	}
 
Index: trace/mercury_trace_external.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_external.c,v
retrieving revision 1.36
diff -u -b -r1.36 mercury_trace_external.c
--- trace/mercury_trace_external.c	2000/02/04 03:45:42	1.36
+++ trace/mercury_trace_external.c	2000/03/19 08:21:50
@@ -1083,7 +1083,7 @@
 	const char	*problem;
 	int		var_count;
 	int		i;
-	Word		type_info;
+	MR_TypeInfo	type_info;
 	Word		value;
 	Word		univ;
 	Word		var_list;
@@ -1106,7 +1106,7 @@
 		);
 
 		MR_field(MR_mktag(0), univ, UNIV_OFFSET_FOR_TYPEINFO)
-			= type_info;
+			= (Word) type_info;
 		MR_field(MR_mktag(0), univ, UNIV_OFFSET_FOR_DATA) = value;
 
 		MR_TRACE_USE_HP(
@@ -1169,7 +1169,7 @@
 	const char	*problem;
 	int		var_count;
 	int		i;
-	Word		type_info;
+	MR_TypeInfo	type_info;
 	String		type_info_string;
 	Word		type_list;
 
@@ -1186,7 +1186,7 @@
 		}
 
 		MR_TRACE_CALL_MERCURY(
-			type_info_string = ML_type_name(type_info);
+			type_info_string = ML_type_name((Word) type_info);
 		);
 	        MR_TRACE_USE_HP(
 			type_list = MR_list_cons(type_info_string, type_list);
@@ -1206,7 +1206,7 @@
 {
 	const char	*problem;
 	int		var_number;
-	Word		type_info;
+	MR_TypeInfo	type_info;
 	Word		value;
 	Word		univ;
 
@@ -1221,7 +1221,7 @@
 			&type_info, &value);
 	if (problem == NULL) {
 		MR_field(MR_mktag(0), univ, UNIV_OFFSET_FOR_TYPEINFO)
-			= type_info;
+			= (Word) type_info;
 		MR_field(MR_mktag(0), univ, UNIV_OFFSET_FOR_DATA) = value;
 	} else {
 		/*
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.12
diff -u -b -r1.12 mercury_trace_vars.c
--- trace/mercury_trace_vars.c	2000/02/22 10:46:55	1.12
+++ trace/mercury_trace_vars.c	2000/03/19 07:56:41
@@ -55,7 +55,7 @@
 	bool				MR_var_is_headvar;
 	bool				MR_var_is_ambiguous;
 	int				MR_var_hlds_number;
-	Word				MR_var_type;
+	MR_TypeInfo			MR_var_type;
 	Word				MR_var_value;
 } MR_Var_Details;
 
@@ -105,7 +105,7 @@
 	MR_Var_Details			*MR_point_vars;
 } MR_Point;
 
-static	bool	MR_trace_type_is_ignored(Word type_info);
+static	bool	MR_trace_type_is_ignored(MR_TypeInfo type_info);
 static	int	MR_trace_compare_var_details(const void *arg1,
 			const void *arg2);
 static	void	MR_trace_browse_var(FILE *out, MR_Var_Details *var,
@@ -125,69 +125,71 @@
 ** do not export them. The types are a lie, but a safe lie.
 */
 
-extern	Word	mercury_data_private_builtin__type_ctor_info_type_info_1;
-extern	Word	mercury_data_private_builtin__type_ctor_info_type_ctor_info_1;
-extern	Word	mercury_data_private_builtin__type_ctor_info_typeclass_info_1;
-extern	Word	mercury_data_private_builtin__type_ctor_info_base_typeclass_info_1;
-extern	Word	mercury_data___type_ctor_info_func_0;
-extern	Word	mercury_data___type_ctor_info_pred_0;
-extern	Word	mercury_data___type_ctor_info_void_0;
+extern	struct MR_TypeCtorInfo_Struct
+	mercury_data_private_builtin__type_ctor_info_type_info_1;
+extern	struct MR_TypeCtorInfo_Struct
+	mercury_data_private_builtin__type_ctor_info_type_ctor_info_1;
+extern	struct MR_TypeCtorInfo_Struct
+	mercury_data_private_builtin__type_ctor_info_typeclass_info_1;
+extern	struct MR_TypeCtorInfo_Struct
+	mercury_data_private_builtin__type_ctor_info_base_typeclass_info_1;
+extern	struct MR_TypeCtorInfo_Struct
+	mercury_data_std_util__type_ctor_info_type_desc_0;
+extern	struct MR_TypeCtorInfo_Struct
+	mercury_data_std_util__type_ctor_info_type_ctor_desc_0;
+extern	struct MR_TypeCtorInfo_Struct	mercury_data___type_ctor_info_func_0;
+extern	struct MR_TypeCtorInfo_Struct	mercury_data___type_ctor_info_pred_0;
+extern	struct MR_TypeCtorInfo_Struct	mercury_data___type_ctor_info_void_0;
 
 #ifdef	NATIVE_GC
-extern	Word	mercury_data___type_ctor_info_succip_0;
-extern	Word	mercury_data___type_ctor_info_hp_0;
-extern	Word	mercury_data___type_ctor_info_curfr_0;
-extern	Word	mercury_data___type_ctor_info_maxfr_0;
-extern	Word	mercury_data___type_ctor_info_redoip_0;
-extern	Word	mercury_data___type_ctor_info_redofr_0;
+extern	struct MR_TypeCtorInfo_Struct	mercury_data___type_ctor_info_succip_0;
+extern	struct MR_TypeCtorInfo_Struct	mercury_data___type_ctor_info_hp_0;
+extern	struct MR_TypeCtorInfo_Struct	mercury_data___type_ctor_info_curfr_0;
+extern	struct MR_TypeCtorInfo_Struct	mercury_data___type_ctor_info_maxfr_0;
+extern	struct MR_TypeCtorInfo_Struct	mercury_data___type_ctor_info_redoip_0;
+extern	struct MR_TypeCtorInfo_Struct	mercury_data___type_ctor_info_redofr_0;
 #endif
 
-static	Word *
+static	MR_TypeCtorInfo
 MR_trace_ignored_type_ctors[] =
 {
 	/* we ignore these until the debugger can handle their varying arity */
-	(Word *) &mercury_data_private_builtin__type_ctor_info_type_info_1,
-	(Word *) &mercury_data_private_builtin__type_ctor_info_type_ctor_info_1,
-	(Word *) &mercury_data_private_builtin__type_ctor_info_typeclass_info_1,
-	(Word *) &mercury_data_private_builtin__type_ctor_info_base_typeclass_info_1,
+	&mercury_data_private_builtin__type_ctor_info_type_info_1,
+	&mercury_data_private_builtin__type_ctor_info_type_ctor_info_1,
+	&mercury_data_private_builtin__type_ctor_info_typeclass_info_1,
+	&mercury_data_private_builtin__type_ctor_info_base_typeclass_info_1,
+	&mercury_data_std_util__type_ctor_info_type_desc_0,
+	&mercury_data_std_util__type_ctor_info_type_ctor_desc_0,
 
 	/* we ignore these until the debugger can print higher-order terms */
-	(Word *) &mercury_data___type_ctor_info_func_0,
-	(Word *) &mercury_data___type_ctor_info_pred_0,
+	&mercury_data___type_ctor_info_func_0,
+	&mercury_data___type_ctor_info_pred_0,
 
 	/* we ignore these because they should never be needed */
-	(Word *) &mercury_data___type_ctor_info_void_0,
+	&mercury_data___type_ctor_info_void_0,
 
 #ifdef	NATIVE_GC
 	/* we ignore these because they are not interesting */
-	(Word *) &mercury_data___type_ctor_info_succip_0,
-	(Word *) &mercury_data___type_ctor_info_hp_0,
-	(Word *) &mercury_data___type_ctor_info_curfr_0,
-	(Word *) &mercury_data___type_ctor_info_maxfr_0,
-	(Word *) &mercury_data___type_ctor_info_redoip_0,
-	(Word *) &mercury_data___type_ctor_info_redofr_0,
+	&mercury_data___type_ctor_info_succip_0,
+	&mercury_data___type_ctor_info_hp_0,
+	&mercury_data___type_ctor_info_curfr_0,
+	&mercury_data___type_ctor_info_maxfr_0,
+	&mercury_data___type_ctor_info_redoip_0,
+	&mercury_data___type_ctor_info_redofr_0,
 #endif
 };
 
 static bool
-MR_trace_type_is_ignored(Word type_info_as_word)
+MR_trace_type_is_ignored(MR_TypeInfo type_info)
 {
-	Word	*type_info;
-	Word	*type_ctor_info;
+	MR_TypeCtorInfo	type_ctor_info;
 	int	ignore_type_ctor_count;
 	int	i;
 
-	type_info = (Word *) type_info_as_word;
+	type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+	ignore_type_ctor_count =
+		sizeof(MR_trace_ignored_type_ctors) / sizeof(Word *);
 
-	if (type_info[OFFSET_FOR_COUNT] == 0) {
-		type_ctor_info = type_info;
-	} else {
-		type_ctor_info = (Word *) type_info[0];
-	}
-
-	ignore_type_ctor_count = sizeof(MR_trace_ignored_type_ctors)
-					/ sizeof(Word *);
-
 	for (i = 0; i < ignore_type_ctor_count; i++) {
 		if (type_ctor_info == MR_trace_ignored_type_ctors[i]) {
 			return TRUE;
@@ -221,9 +223,9 @@
 	const MR_Var_Name		*var_info;
 	Word				*valid_saved_regs;
 	int				var_count;
-	Word				*type_params;
+	MR_TypeInfo			*type_params;
 	Word				value;
-	Word				type_info;
+	MR_TypeInfo			type_info;
 	int				i;
 	int				slot;
 	int				slot_max;
@@ -559,7 +561,7 @@
 
 const char *
 MR_trace_return_var_info(int var_number, const char **name_ptr,
-	Word *type_info_ptr, Word *value_ptr)
+	MR_TypeInfo *type_info_ptr, Word *value_ptr)
 {
 	const MR_Var_Details	*details;
 	const char		*problem;
@@ -717,7 +719,7 @@
 		fflush(out);
 	}
 
-	(*browser)(var->MR_var_type, var->MR_var_value);
+	(*browser)((Word) var->MR_var_type, var->MR_var_value);
 }
 
 static int
Index: trace/mercury_trace_vars.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.h,v
retrieving revision 1.6
diff -u -b -r1.6 mercury_trace_vars.h
--- trace/mercury_trace_vars.h	2000/02/22 10:46:55	1.6
+++ trace/mercury_trace_vars.h	2000/03/19 07:55:59
@@ -83,7 +83,7 @@
 */
 
 extern	const char	*MR_trace_return_var_info(int n, const char **name_ptr,
-				Word *type_info_ptr, Word *value_ptr);
+				MR_TypeInfo *type_info_ptr, Word *value_ptr);
 
 /*
 ** If the variable specified by n is a head variable, then store
cvs diff: Diffing trial
cvs diff: Diffing util
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list