int
MR_compare_type_ctor_desc(MR_TypeCtorDesc tcd1, MR_TypeCtorDesc tcd2)
{
MR_TypeCtorInfo tci1;
MR_TypeCtorInfo tci2;
int arity1;
int arity2;
int result;
// We use this algorithm to get comparison results that are
// consistent with MR_compare_type_ctor_info.
tci1 = MR_TYPECTOR_DESC_GET_TYPE_CTOR_INFO(tcd1);
tci2 = MR_TYPECTOR_DESC_GET_TYPE_CTOR_INFO(tcd2);
result = MR_compare_type_ctor_info(tci1, tci2);
if (result != MR_COMPARE_EQUAL) {
return result;
}
if (MR_TYPECTOR_DESC_IS_VARIABLE_ARITY(tcd1)) {
// We already know that the two type_ctor_descs refer to
// the same variable-arity type constructor, so they can differ
// only in the arity.
arity1 = MR_TYPECTOR_DESC_GET_VA_ARITY(tcd1);
arity2 = MR_TYPECTOR_DESC_GET_VA_ARITY(tcd2);
if (arity1 < arity2) {
return MR_COMPARE_LESS;
} else if (arity1 > arity2) {
return MR_COMPARE_GREATER;
} else {
return MR_COMPARE_EQUAL;
}
} else {
return result;
}
}
int
MR_compare_type_info(MR_TypeInfo ti1, MR_TypeInfo ti2)
{
MR_TypeCtorInfo tci1;
MR_TypeCtorInfo tci2;
MR_TypeInfo *arg_vector_1;
MR_TypeInfo *arg_vector_2;
int num_arg_types_1;
int num_arg_types_2;
int i;
int comp;
/*
** Try to optimize a common case:
** If type_info addresses are equal, they must represent the
** same type.
*/
if (ti1 == ti2) {
return MR_COMPARE_EQUAL;
}
/*
** Otherwise, we need to expand equivalence types, if any.
*/
ti1 = MR_collapse_equivalences(ti1);
ti2 = MR_collapse_equivalences(ti2);
/*
** Perhaps they are equal now...
*/
if (ti1 == ti2) {
return MR_COMPARE_EQUAL;
}
/*
** Otherwise find the type_ctor_infos, and compare those.
*/
tci1 = MR_TYPEINFO_GET_TYPE_CTOR_INFO(ti1);
tci2 = MR_TYPEINFO_GET_TYPE_CTOR_INFO(ti2);
comp = MR_compare_type_ctor_info(tci1, tci2);
if (comp != MR_COMPARE_EQUAL) {
return comp;
}
/*
** If the type_ctor_infos are equal, we don't need to compare
** the arity of the types - they must be the same - unless they are
** higher-order (which are all mapped to pred/0 or func/0) or tuples
** (which are all mapped to tuple/0), in which cases we must compare
** the arities before we can check the argument types.
*/
if (MR_type_ctor_has_variable_arity(tci1)) {
num_arg_types_1 = MR_TYPEINFO_GET_VAR_ARITY_ARITY(ti1);
num_arg_types_2 = MR_TYPEINFO_GET_VAR_ARITY_ARITY(ti2);
/* Check arity */
if (num_arg_types_1 < num_arg_types_2) {
return MR_COMPARE_LESS;
} else if (num_arg_types_1 > num_arg_types_2) {
return MR_COMPARE_GREATER;
}
arg_vector_1 = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(ti1);
arg_vector_2 = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(ti2);
} else {
num_arg_types_1 = tci1->MR_type_ctor_arity;
arg_vector_1 = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(ti1);
arg_vector_2 = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(ti2);
}
/* compare the argument types */
for (i = 1; i <= num_arg_types_1; i++) {
comp = MR_compare_type_info(arg_vector_1[i], arg_vector_2[i]);
if (comp != MR_COMPARE_EQUAL) {
return comp;
}
}
return MR_COMPARE_EQUAL;
}
