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_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_trace_get_action(MR_IoActionNum action_number, MR_ConstString *proc_name_ptr, MR_Word *is_func_ptr, MR_Word *arg_list_ptr) { const MR_TableIoDecl *table_io_decl; const MR_ProcLayout *proc_layout; MR_ConstString proc_name; MR_Word is_func; MR_Word arg_list; MR_Word arg; int filtered_arity; int arity; int hv; MR_TrieNode answer_block_trie; MR_Word *answer_block; MR_TypeInfo *type_params; MR_TypeInfo type_info; if (! (MR_io_tabling_start <= action_number && action_number < MR_io_tabling_counter_hwm)) { return MR_FALSE; } MR_TABLE_START_INT(NULL, MR_tabledebug, MR_FALSE, answer_block_trie, (MR_TrieNode) &MR_io_tabling_pointer, MR_io_tabling_start, action_number); answer_block = answer_block_trie->MR_answerblock; if (answer_block == NULL) { return MR_FALSE; } table_io_decl = (const MR_TableIoDecl *) answer_block[0]; proc_layout = table_io_decl->MR_table_io_decl_proc; filtered_arity = table_io_decl->MR_table_io_decl_filtered_arity; MR_generate_proc_name_from_layout(proc_layout, &proc_name, &arity, &is_func); type_params = MR_materialize_answer_block_type_params( table_io_decl->MR_table_io_decl_type_params, answer_block, filtered_arity); MR_restore_transient_hp(); arg_list = MR_list_empty(); MR_save_transient_hp(); for (hv = filtered_arity; hv >= 1; hv--) { type_info = MR_create_type_info(type_params, table_io_decl->MR_table_io_decl_ptis[hv - 1]); MR_restore_transient_hp(); MR_new_univ_on_hp(arg, type_info, answer_block[hv]); arg_list = MR_univ_list_cons(arg, arg_list); MR_save_transient_hp(); } MR_free(type_params); *proc_name_ptr = proc_name; *is_func_ptr = is_func; *arg_list_ptr = arg_list; return MR_TRUE; }
MR_bool MR_trace_get_action(MR_IoActionNum action_number, MR_ConstString *proc_name_ptr, MR_Word *is_func_ptr, MR_bool *have_arg_infos_ptr, MR_Word *arg_list_ptr) { const MR_TableIoEntry *table_io_entry; const MR_ProcLayout *proc_layout; MR_ConstString proc_name; MR_Word is_func; int arity; int hv; MR_TrieNode answer_block_trie; MR_Word *answer_block; if (! (MR_io_tabling_start <= action_number && action_number < MR_io_tabling_counter_hwm)) { return MR_FALSE; } MR_TABLE_START_INT(NULL, MR_tabledebug, MR_FALSE, answer_block_trie, (MR_TrieNode) &MR_io_tabling_pointer, MR_io_tabling_start, action_number); answer_block = answer_block_trie->MR_answerblock; if (answer_block == NULL) { return MR_FALSE; } table_io_entry = (const MR_TableIoEntry *) answer_block[0]; proc_layout = table_io_entry->MR_table_io_entry_proc; MR_generate_proc_name_from_layout(proc_layout, &proc_name, &arity, &is_func); *proc_name_ptr = proc_name; *is_func_ptr = is_func; if (table_io_entry->MR_table_io_entry_have_arg_infos) { int filtered_arity; MR_Word arg_list; MR_Word arg; MR_TypeInfo *type_params; MR_TypeInfo type_info; *have_arg_infos_ptr = MR_TRUE; filtered_arity = table_io_entry->MR_table_io_entry_num_ptis; type_params = MR_materialize_answer_block_type_params( table_io_entry->MR_table_io_entry_type_params, answer_block, filtered_arity); MR_restore_transient_hp(); arg_list = MR_list_empty(); MR_save_transient_hp(); for (hv = filtered_arity; hv >= 1; hv--) { type_info = MR_create_type_info(type_params, table_io_entry->MR_table_io_entry_ptis[hv - 1]); MR_restore_transient_hp(); MR_new_univ_on_hp(arg, type_info, answer_block[hv]); arg_list = MR_univ_list_cons(arg, arg_list); MR_save_transient_hp(); } MR_free(type_params); *arg_list_ptr = arg_list; } else { *have_arg_infos_ptr = MR_FALSE; // *arg_list_ptr is not meaningful when *have_arg_infos_ptr is false, // but setting it to the empty list makes it easier to catch any // caller that ignores that fact. *arg_list_ptr = MR_list_empty(); } 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"); }
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"); }