[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