MR_PseudoTypeInfo
MR_collapse_equivalences_pseudo(MR_PseudoTypeInfo maybe_equiv_pseudo_type_info)
{
MR_TypeCtorInfo type_ctor_info;
if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(maybe_equiv_pseudo_type_info)) {
return maybe_equiv_pseudo_type_info;
}
type_ctor_info = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(
maybe_equiv_pseudo_type_info);
/* Look past equivalences */
while (MR_type_ctor_rep(type_ctor_info) == MR_TYPECTOR_REP_EQUIV_GROUND
|| MR_type_ctor_rep(type_ctor_info) == MR_TYPECTOR_REP_EQUIV)
{
maybe_equiv_pseudo_type_info = MR_create_pseudo_type_info(
MR_PSEUDO_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(
maybe_equiv_pseudo_type_info),
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(maybe_equiv_pseudo_type_info)) {
return maybe_equiv_pseudo_type_info;
}
type_ctor_info = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(
maybe_equiv_pseudo_type_info);
}
return maybe_equiv_pseudo_type_info;
}
MR_TypeInfo
MR_collapse_equivalences(MR_TypeInfo maybe_equiv_type_info)
{
MR_TypeCtorInfo type_ctor_info;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(maybe_equiv_type_info);
/* Look past equivalences */
while (MR_type_ctor_rep(type_ctor_info) == MR_TYPECTOR_REP_EQUIV_GROUND
|| MR_type_ctor_rep(type_ctor_info) == MR_TYPECTOR_REP_EQUIV)
{
maybe_equiv_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(maybe_equiv_type_info),
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(maybe_equiv_type_info);
}
return maybe_equiv_type_info;
}
MR_bool MR_CALL
mercury__builtin__unify_2_p_0(MR_Mercury_Type_Info ti, MR_Box x, MR_Box y)
{
MR_TypeInfo type_info;
MR_TypeCtorInfo type_ctor_info;
MR_TypeCtorRep type_ctor_rep;
int arity;
MR_TypeInfoParams params;
MR_Mercury_Type_Info *args;
MR_ProcAddr unify_pred;
type_info = (MR_TypeInfo) ti;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
// Tuple and higher-order types do not have a fixed arity,
// so they need to be special cased here.
type_ctor_rep = MR_type_ctor_rep(type_ctor_info);
if (type_ctor_rep == MR_TYPECTOR_REP_TUPLE) {
if (MR_special_pred_hooks.MR_unify_tuple_pred != NULL) {
return MR_special_pred_hooks.MR_unify_tuple_pred(ti,
(MR_Word) x, (MR_Word) y);
}
} else if (type_ctor_rep == MR_TYPECTOR_REP_PRED) {
return mercury__builtin____Unify____pred_0_0((MR_Pred) x, (MR_Pred) y);
} else if (type_ctor_rep == MR_TYPECTOR_REP_FUNC) {
return mercury__builtin____Unify____pred_0_0((MR_Pred) x, (MR_Pred) y);
}
arity = type_ctor_info->MR_type_ctor_arity;
params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
args = (MR_Mercury_Type_Info *) params;
unify_pred = type_ctor_info->MR_type_ctor_unify_pred;
// Cast unify_pred to the right type and then call it,
// passing the right number of type_info arguments.
switch (arity) {
case 0:
return ((MR_UnifyFunc_0 *) unify_pred)(x, y);
case 1:
return ((MR_UnifyFunc_1 *) unify_pred)(args[1], x, y);
case 2:
return ((MR_UnifyFunc_2 *) unify_pred)(args[1], args[2], x, y);
case 3:
return ((MR_UnifyFunc_3 *) unify_pred)(args[1], args[2], args[3],
x, y);
case 4:
return ((MR_UnifyFunc_4 *) unify_pred)(args[1], args[2], args[3],
args[4], x, y);
case 5:
return ((MR_UnifyFunc_5 *) unify_pred)(args[1], args[2], args[3],
args[4], args[5], x, y);
default:
MR_fatal_error("unify/2: type arity > 5 not supported");
}
}
void MR_CALL
mercury__builtin__compare_3_p_0(MR_Mercury_Type_Info ti,
MR_Comparison_Result *res, MR_Box x, MR_Box y)
{
MR_TypeInfo type_info;
MR_TypeCtorInfo type_ctor_info;
MR_TypeCtorRep type_ctor_rep;
int arity;
MR_TypeInfoParams params;
MR_Mercury_Type_Info *args;
MR_ProcAddr compare_pred;
type_info = (MR_TypeInfo) ti;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
// Tuple and higher-order types do not have a fixed arity,
// so they need to be special cased here.
type_ctor_rep = MR_type_ctor_rep(type_ctor_info);
if (type_ctor_rep == MR_TYPECTOR_REP_TUPLE) {
if (MR_special_pred_hooks.MR_compare_tuple_pred != NULL) {
MR_special_pred_hooks.MR_compare_tuple_pred(ti, res,
(MR_Word) x, (MR_Word) y);
return;
}
} else if (type_ctor_rep == MR_TYPECTOR_REP_PRED) {
mercury__builtin____Compare____pred_0_0(res, (MR_Pred) x, (MR_Pred) y);
return;
} else if (type_ctor_rep == MR_TYPECTOR_REP_FUNC) {
mercury__builtin____Compare____pred_0_0(res, (MR_Pred) x, (MR_Pred) y);
return;
}
arity = type_ctor_info->MR_type_ctor_arity;
params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
args = (MR_Mercury_Type_Info *) params;
compare_pred = type_ctor_info->MR_type_ctor_compare_pred;
// Cast compare_pre to the right type and then call it,
// passing the right number of type_info arguments.
switch (arity) {
case 0:
((MR_CompareFunc_0 *) compare_pred)(res, x, y);
break;
case 1:
((MR_CompareFunc_1 *) compare_pred)(args[1], res, x, y);
break;
case 2:
((MR_CompareFunc_2 *) compare_pred)(args[1], args[2], res, x, y);
break;
case 3:
((MR_CompareFunc_3 *) compare_pred)(args[1], args[2], args[3],
res, x, y);
break;
case 4:
((MR_CompareFunc_4 *) compare_pred)(args[1], args[2], args[3],
args[4], res, x, y);
break;
case 5:
((MR_CompareFunc_5 *) compare_pred)(args[1], args[2], args[3],
args[4], args[5], res, x, y);
break;
default:
MR_fatal_error("compare/3: type arity > 5 not supported");
}
}
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");
}
int
MR_get_num_functors(MR_TypeInfo type_info)
{
MR_TypeCtorInfo type_ctor_info;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
if (! MR_type_ctor_has_valid_rep(type_ctor_info)) {
MR_fatal_error("MR_get_num_functors: term of unknown representation");
}
switch (MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
case MR_TYPECTOR_REP_RESERVED_ADDR:
case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
case MR_TYPECTOR_REP_DUMMY:
case MR_TYPECTOR_REP_FOREIGN_ENUM:
case MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ:
return MR_type_ctor_num_functors(type_ctor_info);
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
case MR_TYPECTOR_REP_TUPLE:
return 1;
case MR_TYPECTOR_REP_EQUIV_GROUND:
case MR_TYPECTOR_REP_EQUIV:
return MR_get_num_functors(
MR_create_type_info((MR_TypeInfo *) type_info,
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv));
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 -1;
case MR_TYPECTOR_REP_UNKNOWN:
MR_fatal_error("MR_get_num_functors: unknown type_ctor_rep");
}
MR_fatal_error("MR_get_num_functors: unexpected fallthrough");
}
