void MR_type_ctor_and_args(MR_TypeInfo 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 (collapse_equivalences) { type_info = MR_collapse_equivalences(type_info); } type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info); type_ctor_desc = MR_make_type_ctor_desc(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_type_params_vector_to_list(arity, MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)); } else { arity = type_ctor_info->MR_type_ctor_arity; *arg_type_info_list_ptr = MR_type_params_vector_to_list(arity, MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info)); } }
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_typecheck_arguments(MR_TypeInfo type_info, int arity, MR_Word arg_list, const MR_PseudoTypeInfo *arg_pseudo_type_infos) { MR_TypeInfo arg_type_info; MR_TypeInfo list_arg_type_info; int comp; int i; // Type check the list of arguments. for (i = 0; i < arity; i++) { if (MR_list_is_empty(arg_list)) { return MR_FALSE; } list_arg_type_info = (MR_TypeInfo) MR_field(MR_UNIV_TAG, MR_list_head(arg_list), MR_UNIV_OFFSET_FOR_TYPEINFO); if (MR_TYPE_CTOR_INFO_IS_TUPLE( MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info))) { arg_type_info = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[i + 1]; } else { arg_type_info = MR_create_type_info( MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info), arg_pseudo_type_infos[i]); } comp = MR_compare_type_info(list_arg_type_info, arg_type_info); if (comp != MR_COMPARE_EQUAL) { return MR_FALSE; } arg_list = MR_list_tail(arg_list); } // List should now be empty. return MR_list_is_empty(arg_list); }
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; }