Files
mercury/runtime/mercury_deconstruct.c
Zoltan Somogyi 941be20e27 Type_desc__get_functor looks up the types of the arguments of a function
Estimated hours taken: 16
Branches: main

Type_desc__get_functor looks up the types of the arguments of a function
symbol. This predicate used to abort when an argument has an existential
type. This diff makes type_desc__get_functor work even in that case.
However, since in such cases the type of an argument is not a ground type,
this diff has to add the concept of a pseudo_type_desc, a descriptor for
a not necessarily ground type. Pseudo_type_descs are implemented as
MR_PseudoTypeInfos.

runtime/mercury_type_info.[ch]:
	Add new macros to operate on pseudo_type_infos. Most have a structure
	modelled on corresponding macros operating on type_infos.

	Provide versions of MR_get_arg_type_info, MR_compare_type_info,
	MR_unify_type_info, MR_collapse_equivalences,
	MR_type_params_vector_to_list, MR_create_type_info and
	MR_create_type_info_maybe_existq that work on pseudo_type_infos,
	not type_infos.

	Change MR_pseudo_type_info_vector_to_type_info_list, which implements
	the core of get_functor, to return pseudo_type_infos instead of
	type_infos, and rename it to reflect this fact.

	Change to four-space indentation to reduce the number of lines
	that have to be wrapped.

runtime/mercury_make_type_info_body.h:
	Generalize the code for creating type_infos to also be handle
	pseudo_type_infos.

	Change to four-space indentation to reduce the number of lines
	that have to be wrapped.

runtime/mercury_type_desc.[ch]:
	Provide versions of MR_make_type_ctor_desc and MR_type_ctor_and_args
	that work on pseudo_type_infos, not type_infos.

	Change to four-space indentation to reduce the number of lines
	that have to be wrapped.

runtime/mercury_builtin_types.[ch]:
runtime/mercury_builtin_types_proc_layouts.h:
runtime/mercury_hlc_types.h:
runtime/mercury_unify_compare_body.h:
	Add the C types, global variables and functions necessary for the
	new builtin Mercury type pseudo_type_desc. This type must be builtin,
	because its structure (MR_PseudoTypeInfo) is defined in C, and as such
	cannot be unified, compared, deconstructed etc without hand-written
	C code.

runtime/mercury_deep_copy.c:
runtime/mercury_deep_copy_body.h:
	Handle the copying of pseudo_type_infos/pseudo_type_descs. This code
	is almost the same as the code to copy type_infos, but must of course
	handle type variables, and the arguments are themselves copied as
	pseudo_type_infos, not type_infos.

runtime/mercury_types.h:
	Since deep copy needs to create pseudo_type_infos, provide a version
	of the MR_PseudoTypeInfo type without const.

runtime/mercury_construct.c:
runtime/mercury_deconstruct.c:
	Handle pseudo_type_descs just as we handle type_descs: neither can be
	constructed, nor do they have function symbols with named arguments.

runtime/mercury_ml_expand_body.c:
	Provide code to deconstruct pseudo_type_descs. This code is almost
	the same as the code to deconstruct type_descs, but must of course
	handle type variables, and the arguments are themselves
	pseudo_type_descs, not type_descs.

runtime/mercury_tabling.c:
	Catch attempts to table pseudo_type_infos.

runtime/mercury_tags.h:
	Add macros for constructing lists of
	pseudo_type_infos/pseudo_type_descs.

runtime/mercury_wrapper.[ch]:
	Define global variables holding the addresses of the typeinfos for
	describing pseudo_type_descs and lists of pseudo_type_descs.

runtime/mercury_init.c:
	Add the extern declarations required by new code in mkinit.c.

util/mkinit.c:
	Make the addresses of the typeinfos for describing pseudo_type_descs
	and lists of pseudo_type_descs, defined in the library, known to the
	runtime.

library/type_desc.m:
	Add a new builtin type, pseudo_type_desc, for describing possibly
	nonground types.

	Add utility predicates for operating on pseudo_type_descs.

library/private_builtin.m:
	Handle the new builtin type.

	Add builtin typeinfos for describing pseudo_type_descs and lists of
	pseudo_type_descs, since some functions in the runtime need them
	for memory profiling.

library/rtti_implementation.m:
	Handle the new builtin type, mostly by ignoring it, since the backends
	that use this module do not have any notion of pseudo_type_infos.

	Bring the module up to date with our formatting guidelines.

library/construct.m:
	Make get_functor return a list of pseudo_type_descs instead of
	type_descs.

	Change the name of the version of get_functor that returns argument
	names, to distinguish it from the base version by more than just the
	arity.

	Make the order of predicates more logical.

library/std_util.m:
	Change the name of the version of get_functor that returns argument
	names, to distinguish it from the base version by more than just the
	arity.

	However, this name change is effectively the only change: both
	get_functor and get_functor_with_names still return lists of
	type_descs. This means that they will throw exceptions in the presence
	of existential types, but code using them need no algorithmic changes.

library/term.m:
library/term_to_xml.m:
	Add module qualifiers as necessary; no algorithmic changes.

library/list.m:
	Add two general-purpose predicates, all_true and all_false,
	for use in the other library modules.

compiler/ml_util.m:
compiler/mlds_to_gcc.m:
compiler/rtti.m:
compiler/type_ctor_info.m:
	Make sure we handle the new builtin type as a builtin type, and not
	try to have the compiler create a type_ctor_info for it.

deep_profiler/canonical.m:
	Delete the local definition of all_true.

tests/hard_coded/construct_test.{m,exp}:
	Update this test case to test the ability to retrieve the names of the
	fields of function symbols with existential types.

	Add module qualifications as necessary.

tests/hard_coded/construct_test_exist.{m,exp}:
	Add a tougher test case to print the types of the arguments of
	function symbols with existential types.

tests/hard_coded/Mmakefile:
	Add the new test case, and sort the names of the tests.
2004-12-14 01:07:32 +00:00

339 lines
11 KiB
C

/*
** vim:ts=4 sw=4 expandtab
*/
/*
** Copyright (C) 2002-2004 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
/*
** mercury_deconstruct.c
**
** This file provides utility functions for deconstructing terms, for use by
** the standard library.
*/
#include "mercury_imp.h"
#include "mercury_deconstruct.h"
#include "mercury_deconstruct_macros.h"
#include "mercury_type_desc.h"
#include "mercury_minimal_model.h"
static MR_ConstString MR_expand_type_name(MR_TypeCtorInfo tci, MR_bool);
#define EXPAND_FUNCTION_NAME MR_expand_functor_args
#define EXPAND_TYPE_NAME MR_Expand_Functor_Args_Info
#define EXPAND_FUNCTOR_FIELD functor
#define EXPAND_ARGS_FIELD args
#include "mercury_ml_expand_body.h"
#undef EXPAND_FUNCTION_NAME
#undef EXPAND_TYPE_NAME
#undef EXPAND_FUNCTOR_FIELD
#undef EXPAND_ARGS_FIELD
#define EXPAND_FUNCTION_NAME MR_expand_functor_args_limit
#define EXPAND_TYPE_NAME MR_Expand_Functor_Args_Limit_Info
#define EXPAND_FUNCTOR_FIELD functor
#define EXPAND_ARGS_FIELD args
#define EXPAND_APPLY_LIMIT
#include "mercury_ml_expand_body.h"
#undef EXPAND_FUNCTION_NAME
#undef EXPAND_TYPE_NAME
#undef EXPAND_FUNCTOR_FIELD
#undef EXPAND_ARGS_FIELD
#undef EXPAND_APPLY_LIMIT
#define EXPAND_FUNCTION_NAME MR_expand_functor_only
#define EXPAND_TYPE_NAME MR_Expand_Functor_Only_Info
#define EXPAND_FUNCTOR_FIELD functor_only
#include "mercury_ml_expand_body.h"
#undef EXPAND_FUNCTION_NAME
#undef EXPAND_TYPE_NAME
#undef EXPAND_FUNCTOR_FIELD
#define EXPAND_FUNCTION_NAME MR_expand_args_only
#define EXPAND_TYPE_NAME MR_Expand_Args_Only_Info
#define EXPAND_ARGS_FIELD args_only
#include "mercury_ml_expand_body.h"
#undef EXPAND_FUNCTION_NAME
#undef EXPAND_TYPE_NAME
#undef EXPAND_ARGS_FIELD
#define EXPAND_FUNCTION_NAME MR_expand_chosen_arg_only
#define EXPAND_TYPE_NAME MR_Expand_Chosen_Arg_Only_Info
#define EXPAND_CHOSEN_ARG
#include "mercury_ml_expand_body.h"
#undef EXPAND_FUNCTION_NAME
#undef EXPAND_TYPE_NAME
#undef EXPAND_CHOSEN_ARG
#define EXPAND_FUNCTION_NAME MR_expand_named_arg_only
#define EXPAND_TYPE_NAME MR_Expand_Chosen_Arg_Only_Info
#define EXPAND_NAMED_ARG
#include "mercury_ml_expand_body.h"
#undef EXPAND_FUNCTION_NAME
#undef EXPAND_TYPE_NAME
#undef EXPAND_NAMED_ARG
/*
** N.B. any modifications to the signature of this function will require
** changes not only to library/deconstruct.m, but also to library/store.m
** and extras/trailed_update/tr_store.m.
*/
MR_bool
MR_arg(MR_TypeInfo type_info, MR_Word *term_ptr, int arg_index,
MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr,
MR_noncanon_handling noncanon)
{
MR_Expand_Chosen_Arg_Only_Info expand_info;
MR_expand_chosen_arg_only(type_info, term_ptr, noncanon, arg_index,
&expand_info);
/* Check range */
if (expand_info.chosen_index_exists) {
*arg_type_info_ptr = expand_info.chosen_type_info;
*arg_ptr = expand_info.chosen_value_ptr;
return MR_TRUE;
}
return MR_FALSE;
}
MR_bool
MR_named_arg(MR_TypeInfo type_info, MR_Word *term_ptr, MR_ConstString arg_name,
MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr,
MR_noncanon_handling noncanon)
{
MR_Expand_Chosen_Arg_Only_Info expand_info;
MR_expand_named_arg_only(type_info, term_ptr, noncanon, arg_name,
&expand_info);
/* Check range */
if (expand_info.chosen_index_exists) {
*arg_type_info_ptr = expand_info.chosen_type_info;
*arg_ptr = expand_info.chosen_value_ptr;
return MR_TRUE;
}
return MR_FALSE;
}
MR_bool
MR_named_arg_num(MR_TypeInfo type_info, MR_Word *term_ptr,
const char *arg_name, int *arg_num_ptr)
{
MR_TypeCtorInfo type_ctor_info;
MR_DuTypeLayout du_type_layout;
const MR_DuPtagLayout *ptag_layout;
const MR_DuFunctorDesc *functor_desc;
const MR_NotagFunctorDesc *notag_functor_desc;
MR_Word data;
int ptag;
MR_Word sectag;
MR_TypeInfo eqv_type_info;
int i;
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_named_arg_num: term of unknown representation");
}
switch (MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
case MR_TYPECTOR_REP_RESERVED_ADDR:
{
MR_ReservedAddrTypeLayout ra_layout;
ra_layout = MR_type_ctor_layout(type_ctor_info).
MR_layout_reserved_addr;
data = *term_ptr;
/*
** First check if this value is one of
** the numeric reserved addresses.
*/
if ((MR_Unsigned) data <
(MR_Unsigned) ra_layout->MR_ra_num_res_numeric_addrs)
{
/*
** If so, it must be a constant, and constants never have
** any arguments.
*/
return MR_FALSE;
}
/*
** Next check if this value is one of the
** the symbolic reserved addresses.
*/
for (i = 0; i < ra_layout->MR_ra_num_res_symbolic_addrs; i++) {
if (data == (MR_Word) ra_layout->MR_ra_res_symbolic_addrs[i]) {
return MR_FALSE;
}
}
/*
** Otherwise, it is not one of the reserved addresses,
** so handle it like a normal DU type.
*/
du_type_layout = ra_layout->MR_ra_other_functors;
goto du_type;
}
case MR_TYPECTOR_REP_DU_USEREQ:
case MR_TYPECTOR_REP_DU:
data = *term_ptr;
du_type_layout = MR_type_ctor_layout(type_ctor_info).MR_layout_du;
/* fall through */
/*
** This label handles both the DU case and the second half of the
** RESERVED_ADDR case. `du_type_layout' and `data' must both be
** set before this code is entered.
*/
du_type:
ptag = MR_tag(data);
ptag_layout = &du_type_layout[ptag];
switch (ptag_layout->MR_sectag_locn) {
case MR_SECTAG_NONE:
functor_desc = ptag_layout->MR_sectag_alternatives[0];
break;
case MR_SECTAG_LOCAL:
sectag = MR_unmkbody(data);
functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
break;
case MR_SECTAG_REMOTE:
sectag = MR_field(ptag, data, 0);
functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
break;
case MR_SECTAG_VARIABLE:
MR_fatal_error("MR_named_arg_num(): unexpected variable");
default:
MR_fatal_error("MR_named_arg_num(): invalid sectag_locn");
}
if (functor_desc->MR_du_functor_arg_names == NULL) {
return MR_FALSE;
}
for (i = 0; i < functor_desc->MR_du_functor_orig_arity; i++) {
if (functor_desc->MR_du_functor_arg_names[i] != NULL
&& MR_streq(arg_name,
functor_desc->MR_du_functor_arg_names[i]))
{
*arg_num_ptr = i;
return MR_TRUE;
}
}
return MR_FALSE;
case MR_TYPECTOR_REP_EQUIV:
eqv_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
return MR_named_arg_num(eqv_type_info, term_ptr, arg_name,
arg_num_ptr);
case MR_TYPECTOR_REP_EQUIV_GROUND:
eqv_type_info = MR_pseudo_type_info_is_ground(
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
return MR_named_arg_num(eqv_type_info, term_ptr, arg_name,
arg_num_ptr);
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
notag_functor_desc = MR_type_ctor_functors(type_ctor_info).
MR_functors_notag;
if (notag_functor_desc->MR_notag_functor_arg_name != NULL
&& MR_streq(arg_name,
notag_functor_desc->MR_notag_functor_arg_name))
{
*arg_num_ptr = 0;
return MR_TRUE;
}
return MR_FALSE;
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
case MR_TYPECTOR_REP_INT:
case MR_TYPECTOR_REP_FLOAT:
case MR_TYPECTOR_REP_CHAR:
case MR_TYPECTOR_REP_STRING:
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_TYPEDESC:
case MR_TYPECTOR_REP_TYPECTORDESC:
case MR_TYPECTOR_REP_PSEUDOTYPEDESC:
case MR_TYPECTOR_REP_TYPECLASSINFO:
case MR_TYPECTOR_REP_BASETYPECLASSINFO:
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_TICKET:
case MR_TYPECTOR_REP_TRAIL_PTR:
case MR_TYPECTOR_REP_REFERENCE:
case MR_TYPECTOR_REP_TUPLE:
case MR_TYPECTOR_REP_ARRAY:
case MR_TYPECTOR_REP_FOREIGN:
case MR_TYPECTOR_REP_STABLE_FOREIGN:
case MR_TYPECTOR_REP_UNKNOWN:
return MR_FALSE;
}
MR_fatal_error("MR_named_arg_num: unexpected fallthrough");
}
static MR_ConstString
MR_expand_type_name(MR_TypeCtorInfo tci, MR_bool wrap)
{
MR_String str;
int len;
len = 0;
len += strlen(tci->MR_type_ctor_module_name);
len += 1; /* '.' */
len += strlen(tci->MR_type_ctor_name);
len += 1; /* '/' */
len += 4; /* arity; we do not support arities above 1024 */
if (wrap) {
len += 4; /* <<>> */
}
len += 1; /* NULL */
if (tci->MR_type_ctor_arity > 9999) {
MR_fatal_error("MR_expand_type_name: arity > 9999");
}
MR_restore_transient_hp();
MR_allocate_aligned_string_msg(str, len, "MR_expand_type_name");
MR_save_transient_hp();
sprintf(str, wrap? "<<%s.%s/%d>>" : "%s.%s/%d",
tci->MR_type_ctor_module_name,
tci->MR_type_ctor_name,
tci->MR_type_ctor_arity);
return (MR_ConstString) str;
}