MR_bool MR_unify_type_ctor_desc(MR_TypeCtorDesc tcd1, MR_TypeCtorDesc tcd2) { MR_TypeCtorInfo tci1; MR_TypeCtorInfo tci2; int arity1; int arity2; // We use this algorithm to get comparison results that are // consistent with MR_unify_type_ctor_info. tci1 = MR_TYPECTOR_DESC_GET_TYPE_CTOR_INFO(tcd1); tci2 = MR_TYPECTOR_DESC_GET_TYPE_CTOR_INFO(tcd2); if (! MR_unify_type_ctor_info(tci1, tci2)) { return MR_FALSE; } 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_TRUE; } else { return MR_FALSE; } } else { return MR_TRUE; } }
MR_bool MR_unify_pseudo_type_info_float(MR_PseudoTypeInfo pti) { MR_TypeCtorInfo tci1; MR_TypeCtorInfo tci2; if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pti)) { return MR_FALSE; } tci1 = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(pti); tci2 = (MR_TypeCtorInfo) MR_FLOAT_CTOR_ADDR; return MR_unify_type_ctor_info(tci1, tci2); }
MR_bool MR_unify_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_TRUE; } /* ** 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_TRUE; } /* ** 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); if (! MR_unify_type_ctor_info(tci1, tci2)) { return MR_FALSE; } /* ** 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_FALSE; } 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++) { if (! MR_unify_type_info(arg_vector_1[i], arg_vector_2[i])) { return MR_FALSE; } } return MR_TRUE; }