MR_Word
MR_pseudo_type_info_vector_to_pseudo_type_info_list(int arity,
MR_TypeInfoParams type_params,
const MR_PseudoTypeInfo *arg_pseudo_type_infos)
{
MR_PseudoTypeInfo pseudo;
MR_PseudoTypeInfo arg_pseudo_type_info;
MR_Word pseudo_type_info_list;
MR_restore_transient_registers();
pseudo_type_info_list = MR_list_empty();
while (--arity >= 0) {
/* Get the argument type_info */
pseudo = arg_pseudo_type_infos[arity];
if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pseudo) &&
MR_TYPE_VARIABLE_IS_EXIST_QUANT(pseudo))
{
arg_pseudo_type_info = pseudo;
} else {
MR_save_transient_registers();
arg_pseudo_type_info =
MR_create_pseudo_type_info(
(MR_PseudoTypeInfoParams) type_params, pseudo);
MR_restore_transient_registers();
MR_save_transient_registers();
arg_pseudo_type_info =
MR_collapse_equivalences_pseudo(arg_pseudo_type_info);
MR_restore_transient_registers();
}
pseudo_type_info_list = MR_pseudo_type_info_list_cons(
(MR_Word) arg_pseudo_type_info, pseudo_type_info_list);
}
MR_save_transient_registers();
return pseudo_type_info_list;
}
MR_bool
MR_pseudo_type_ctor_and_args(MR_PseudoTypeInfo pseudo_type_info,
MR_bool collapse_equivalences, MR_TypeCtorDesc *type_ctor_desc_ptr,
MR_Word *arg_type_info_list_ptr)
{
MR_TypeCtorInfo type_ctor_info;
MR_TypeCtorDesc type_ctor_desc;
MR_Integer arity;
if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pseudo_type_info)) {
return MR_FALSE;
}
if (collapse_equivalences) {
pseudo_type_info = MR_collapse_equivalences_pseudo(pseudo_type_info);
}
if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pseudo_type_info)) {
return MR_FALSE;
}
type_ctor_info = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(pseudo_type_info);
type_ctor_desc = MR_make_type_ctor_desc_pseudo(pseudo_type_info,
type_ctor_info);
*type_ctor_desc_ptr = type_ctor_desc;
if (MR_type_ctor_has_variable_arity(type_ctor_info)) {
arity = MR_TYPECTOR_DESC_GET_VA_ARITY(type_ctor_desc);
*arg_type_info_list_ptr = MR_pseudo_type_params_vector_to_list(arity,
MR_PSEUDO_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(pseudo_type_info));
} else {
arity = type_ctor_info->MR_type_ctor_arity;
*arg_type_info_list_ptr = MR_pseudo_type_params_vector_to_list(arity,
MR_PSEUDO_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(pseudo_type_info));
}
return MR_TRUE;
}
MR_bool
MR_unify_pseudo_type_info(MR_PseudoTypeInfo pti1, MR_PseudoTypeInfo pti2)
{
MR_TypeCtorInfo tci1;
MR_TypeCtorInfo tci2;
MR_PseudoTypeInfo *arg_vector_1;
MR_PseudoTypeInfo *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 (pti1 == pti2) {
return MR_TRUE;
}
/*
** Otherwise, we need to expand equivalence types, if any.
*/
pti1 = MR_collapse_equivalences_pseudo(pti1);
pti2 = MR_collapse_equivalences_pseudo(pti2);
/*
** Perhaps they are equal now...
*/
if (pti1 == pti2) {
return MR_TRUE;
}
/*
** Handle the comparison if either pseudo_type_info is a variable.
** Any non-variable is greater than a variable.
*/
if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pti1) &&
MR_PSEUDO_TYPEINFO_IS_VARIABLE(pti2))
{
if ((MR_Integer) pti1 != (MR_Integer) pti2) {
return MR_FALSE;
} else {
return MR_TRUE;
}
}
if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pti1)) {
return MR_FALSE;
}
if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pti2)) {
return MR_FALSE;
}
/*
** Otherwise find the type_ctor_infos, and compare those.
*/
tci1 = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(pti1);
tci2 = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(pti2);
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_PSEUDO_TYPEINFO_GET_VAR_ARITY_ARITY(pti1);
num_arg_types_2 = MR_PSEUDO_TYPEINFO_GET_VAR_ARITY_ARITY(pti2);
/* Check arity */
if (num_arg_types_1 != num_arg_types_2) {
return MR_FALSE;
}
arg_vector_1 = MR_PSEUDO_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(pti1);
arg_vector_2 = MR_PSEUDO_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(pti2);
} else {
num_arg_types_1 = tci1->MR_type_ctor_arity;
arg_vector_1 = MR_PSEUDO_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(pti1);
arg_vector_2 = MR_PSEUDO_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(pti2);
}
/* compare the argument types */
for (i = 1; i <= num_arg_types_1; i++) {
if (! MR_unify_pseudo_type_info(arg_vector_1[i], arg_vector_2[i])) {
return MR_FALSE;
}
}
return MR_TRUE;
}
