MR_TypeCtorDesc
MR_make_type_ctor_desc(MR_TypeInfo type_info, MR_TypeCtorInfo type_ctor_info)
{
MR_TypeCtorDesc type_ctor_desc;
if (MR_TYPE_CTOR_INFO_IS_HO_PRED(type_ctor_info)) {
type_ctor_desc = MR_TYPECTOR_DESC_MAKE_PRED(
MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info));
if (! MR_TYPECTOR_DESC_IS_VARIABLE_ARITY(type_ctor_desc)) {
MR_fatal_error("MR_make_type_ctor_desc - arity out of range.");
}
} else if (MR_TYPE_CTOR_INFO_IS_HO_FUNC(type_ctor_info)) {
type_ctor_desc = MR_TYPECTOR_DESC_MAKE_FUNC(
MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info));
if (! MR_TYPECTOR_DESC_IS_VARIABLE_ARITY(type_ctor_desc)) {
MR_fatal_error("MR_make_type_ctor_desc - arity out of range.");
}
} else if (MR_TYPE_CTOR_INFO_IS_TUPLE(type_ctor_info)) {
type_ctor_desc = MR_TYPECTOR_DESC_MAKE_TUPLE(
MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info));
if (! MR_TYPECTOR_DESC_IS_VARIABLE_ARITY(type_ctor_desc)) {
MR_fatal_error("MR_make_type_ctor_desc - arity out of range.");
}
} else {
type_ctor_desc = MR_TYPECTOR_DESC_MAKE_FIXED_ARITY(type_ctor_info);
}
return type_ctor_desc;
}
void
MR_print_type(FILE *fp, MR_TypeInfo type_info)
{
MR_TypeCtorInfo tci;
MR_TypeInfo *arg_vector;
int arity;
int i;
tci = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
if (MR_type_ctor_has_variable_arity(tci)) {
arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
arg_vector = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info);
} else {
arity = tci->MR_type_ctor_arity;
arg_vector = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
}
fprintf(fp, "%s.%s",
tci->MR_type_ctor_module_name, tci->MR_type_ctor_name);
if (arity > 0) {
fprintf(fp, "(");
for (i = 1; i <= arity; i++) {
MR_print_type(fp, arg_vector[i]);
if (i < arity) {
fprintf(fp, ", ");
}
}
fprintf(fp, ")");
}
}
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;
}
static int
MR_get_functor_info(MR_TypeInfo type_info, int functor_number,
MR_Construct_Info *construct_info)
{
MR_TypeCtorInfo type_ctor_info;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
construct_info->type_ctor_rep = MR_type_ctor_rep(type_ctor_info);
if (! MR_type_ctor_has_valid_rep(type_ctor_info)) {
MR_fatal_error("MR_get_functor_info: term of unknown representation");
}
switch (MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_RESERVED_ADDR:
case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
{
const MR_DuFunctorDesc *functor_desc;
if (functor_number < 0 ||
functor_number >= MR_type_ctor_num_functors(type_ctor_info))
{
MR_fatal_error("MR_get_functor_info: "
"du functor_number out of range");
}
functor_desc = MR_type_ctor_functors(type_ctor_info).
MR_functors_du[functor_number];
construct_info->functor_info.du_functor_desc = functor_desc;
construct_info->functor_name = functor_desc->MR_du_functor_name;
construct_info->arity = functor_desc->MR_du_functor_orig_arity;
construct_info->arg_pseudo_type_infos =
functor_desc->MR_du_functor_arg_types;
construct_info->arg_names =
functor_desc->MR_du_functor_arg_names;
}
return MR_TRUE;
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
case MR_TYPECTOR_REP_DUMMY:
{
const MR_EnumFunctorDesc *functor_desc;
if (functor_number < 0 ||
functor_number >= MR_type_ctor_num_functors(type_ctor_info))
{
MR_fatal_error("MR_get_functor_info: "
"enum functor_number out of range");
}
functor_desc = MR_type_ctor_functors(type_ctor_info).
MR_functors_enum[functor_number];
construct_info->functor_info.enum_functor_desc = functor_desc;
construct_info->functor_name = functor_desc->MR_enum_functor_name;
construct_info->arity = 0;
construct_info->arg_pseudo_type_infos = NULL;
construct_info->arg_names = NULL;
}
return MR_TRUE;
case MR_TYPECTOR_REP_FOREIGN_ENUM:
case MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ:
{
const MR_ForeignEnumFunctorDesc *functor_desc;
if (functor_number < 0 ||
functor_number >= MR_type_ctor_num_functors(type_ctor_info))
{
MR_fatal_error("MR_get_functor_info: "
"foreign enum functor_number out of range");
}
functor_desc = MR_type_ctor_functors(type_ctor_info).
MR_functors_foreign_enum[functor_number];
construct_info->functor_info.foreign_enum_functor_desc
= functor_desc;
construct_info->functor_name =
functor_desc->MR_foreign_enum_functor_name;
construct_info->arity = 0;
construct_info->arg_pseudo_type_infos = NULL;
construct_info->arg_names = NULL;
}
return MR_TRUE;
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
{
const MR_NotagFunctorDesc *functor_desc;
if (functor_number != 0) {
MR_fatal_error("MR_get_functor_info: "
"notag functor_number out of range");
}
functor_desc = MR_type_ctor_functors(type_ctor_info).
MR_functors_notag;
construct_info->functor_info.notag_functor_desc = functor_desc;
construct_info->functor_name = functor_desc->MR_notag_functor_name;
construct_info->arity = 1;
construct_info->arg_pseudo_type_infos =
&functor_desc->MR_notag_functor_arg_type;
construct_info->arg_names =
&functor_desc->MR_notag_functor_arg_name;
}
return MR_TRUE;
case MR_TYPECTOR_REP_EQUIV_GROUND:
case MR_TYPECTOR_REP_EQUIV:
return MR_get_functor_info(
MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv),
functor_number, construct_info);
case MR_TYPECTOR_REP_TUPLE:
construct_info->functor_name = "{}";
construct_info->arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
// Tuple types don't have pseudo-type_infos for the functors.
construct_info->arg_pseudo_type_infos = NULL;
construct_info->arg_names = NULL;
return MR_TRUE;
case MR_TYPECTOR_REP_INT:
case MR_TYPECTOR_REP_UINT:
case MR_TYPECTOR_REP_CHAR:
case MR_TYPECTOR_REP_FLOAT:
case MR_TYPECTOR_REP_STRING:
case MR_TYPECTOR_REP_BITMAP:
case MR_TYPECTOR_REP_FUNC:
case MR_TYPECTOR_REP_PRED:
case MR_TYPECTOR_REP_SUBGOAL:
case MR_TYPECTOR_REP_VOID:
case MR_TYPECTOR_REP_C_POINTER:
case MR_TYPECTOR_REP_STABLE_C_POINTER:
case MR_TYPECTOR_REP_TYPEINFO:
case MR_TYPECTOR_REP_TYPECTORINFO:
case MR_TYPECTOR_REP_PSEUDOTYPEDESC:
case MR_TYPECTOR_REP_TYPEDESC:
case MR_TYPECTOR_REP_TYPECTORDESC:
case MR_TYPECTOR_REP_TYPECLASSINFO:
case MR_TYPECTOR_REP_BASETYPECLASSINFO:
case MR_TYPECTOR_REP_ARRAY:
case MR_TYPECTOR_REP_SUCCIP:
case MR_TYPECTOR_REP_HP:
case MR_TYPECTOR_REP_CURFR:
case MR_TYPECTOR_REP_MAXFR:
case MR_TYPECTOR_REP_REDOFR:
case MR_TYPECTOR_REP_REDOIP:
case MR_TYPECTOR_REP_TRAIL_PTR:
case MR_TYPECTOR_REP_TICKET:
case MR_TYPECTOR_REP_FOREIGN:
case MR_TYPECTOR_REP_STABLE_FOREIGN:
case MR_TYPECTOR_REP_REFERENCE:
return MR_FALSE;
case MR_TYPECTOR_REP_UNKNOWN:
MR_fatal_error("MR_get_functor_info: unknown type_ctor_rep");
}
MR_fatal_error("MR_get_functor_info: unexpected fallthrough");
}
