mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-18 07:15:19 +00:00
Code Issues Projects Releases Wiki Activity
Files
faa18a15bd332b51ec6d6fdae4d999ec2bf3fa82
mercury/runtime/mercury_ml_expand_body.h
Zoltan Somogyi d609181cb9 Consider types of the form 
Estimated hours taken: 30
Branches: main

Consider types of the form

	:- type x ---> f.

to be dummy types, since they contain no information. Optimize them the same
way we currently optimize io.state and store.store.

runtime/mercury_type_info.h:
	Add a new type_ctor_rep for dummy types.

runtime/mercury_tabling.h:
	Add a representation for "tabled" dummy types, which don't actually
	have a level in the trie, so that the runtime system can handle that
	fact.

runtime/mercury_ml_expand_body.h:
	When deconstructing a value of a dummy type, ignore the actual value
	(since it will contain garbage) and instead return the only possible
	value of the type.

runtime/mercury_construct.c:
runtime/mercury_deconstruct.c:
runtime/mercury_deep_copy_body.c:
runtime/mercury_tabling.c:
runtime/mercury_unify_compare_body.h:
library/rtti_implementation.m:
	Handle the type_ctor_rep of dummy types.

runtime/mercury_builtin_types.c:
	Provide a place to record profiling information about unifications and
	comparisons for dummy types.

runtime/mercury_mcpp.h:
java/runtime/TypeCtorRep.java:
library/private_builtin.m:
	Add a new type_ctor_rep for dummy types, and fix some previous
	discrepancies in type_ctor_reps.

mdbcomp/prim_data.m:
	Move a bunch of predicates for manipulating special_pred_ids here from
	the browser and compiler directories.

	Rename the function symbols of the special_pred_id type to avoid the
	need to parenthesize the old `initialise' function symbol.

	Convert to four-space indentation.

mdbcomp/rtti_access.m:
	Don't hardcode the names of special preds: use the predicates in
	prim_data.m.

	Convert to four-space indentation.

browser/declarative_execution.m:
	Delete some predicates whose functionality is now in
	mdbcomp/prim_data.m.

compiler/hlds_data.m:
	Replace the part of du type that says whether a type an enum, which
	used to be a bool, with something that also says whether the type is a
	dummy type.

	Convert to four-space indentation.

compiler/make_tags.m:
	Compute the value for the new field of du type definitions.

compiler/hlds_out.m:
	Write out the new field of du type definitions.

compiler/rtti.m:
	Modify the data structures we use to create type_ctor_infos to allow
	for dummy types.

	Convert to four-space indentation.

compiler/type_ctor_info.m:
	Modify the code that generates type_ctor_infos to handle dummy types.

compiler/type_util.m:
	Provide predicates for recognizing dummy types.

	Convert to four-space indentation.

compiler/unify_proc.m:
	Generate the unify and compare predicates of dummy types using a new
	code scheme that avoids referencing arguments that contain garbage.

	When generating code for unifying or comparing other types, ignore
	any arguments of function symbols that are dummy types.

	Don't use DCG style access predicates.

compiler/higher_order.m:
	Specialize the unification and comparison of values of dummy types.

	Break up an excessively large predicate, and factor out common code
	from the conditions of a chain of if-then-elses.

compiler/llds.m:
	For each input and output of a foreign_proc, include a field saying
	whether the value is of a dummy type.

compiler/pragma_c_gen.m:
	Fill in the new fields in foreign_proc arguments.

compiler/hlds_goal.m:
	Rename some predicates for constructing unifications to avoid
	unnecessary ad-hoc overloading. Clarify their documentation.

	Rename a predicate to make clear the restriction on its use,
	and document the restriction.

	Add a predicate for creating simple tests.

	Add a utility predicate for setting the context of a goal directly.

compiler/modules.m:
	Include dummy types interface files, even if they are private to the
	module. This is necessary because with the MLDS backend, the generated
	code inside the module and outside the module must agree whether a
	function returning a value of the type returns a real value or a void
	value, and this requires them to agree on whether the type is dummy
	or not.

	The impact on interface files is minimal, since very few types are
	dummy types, and changing a type from a dummy type to a non-dummy type
	or vice versa is an ever rarer change.

compiler/hlds_pred.m:
	Provide a representation in the compiler of the trie step for dummy
	types.

compiler/layout_out.m:
	Print the trie step for dummy types.

compiler/table_gen.m:
	Don't table values of dummy types, and record the fact that we don't
	by including a dummy trie step in the list of trie steps.

compiler/add_pragma.m:
compiler/add_special_pred.m:
compiler/add_type.m:
compiler/aditi_builtin_ops.m:
compiler/bytecode.m:
compiler/bytecode_gen.m:
compiler/code_gen.m:
compiler/code_info.m:
compiler/continuation_info.m:
compiler/cse_detection.m:
compiler/det_report.m:
compiler/exception_analysis.m:
compiler/inst_match.m:
compiler/livemap.m:
compiler/llds_out.m:
compiler/llds_out.m:
compiler/middle_rec.m:
compiler/ml_call_gen.m:
compiler/ml_closure_gen.m:
compiler/ml_code_gen.m:
compiler/ml_code_util.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_il.m:
compiler/modecheck_unify.m:
compiler/modes.m:
compiler/opt_util.m:
compiler/post_term_analysis.m:
compiler/post_typecheck.m:
compiler/qual_info.m:
compiler/rl.m:
compiler/rl_exprn.m:
compiler/rl_key.m:
compiler/rtti_out.m:
compiler/simplify.m:
compiler/size_prof.m:
compiler/term_constr_initial.m:
compiler/term_constr_util.m:
compiler/term_norm.m:
compiler/termination.m:
compiler/trace.m:
compiler/typecheck.m:
compiler/unify_gen.m:
	Conform to the changes above.

compiler/export.m:
compiler/exprn_aux.m:
compiler/foreign.m:
compiler/polymorphism.m:
compiler/proc_label.m:
compiler/rtti_to_mlds.m:
compiler/special_pred.m:
compiler/stack_alloc.m:
compiler/stack_layout.m:
compiler/state_var.m:
compiler/switch_util.m:
compiler/trace_params.m:
	Conform to the changes above.

	Convert to four-space indentation.

compiler/mlds_to_java.m:
compiler/var_locn.m:
	Conform to the changes above, which requires threading the module_info
	through the module.

	Convert to four-space indentation.

compiler/mercury_compile.m:
	Pass the module_info to mlds_to_java.m.

compiler/ml_util.m:
compiler/polymorphism.m:
compiler/type_ctor_info.m:
compiler/type_util.m:
	Delete some previously missed references to the temporary types used
	to bootstrap the change to the type_info type's arity.

compiler/polymorphism.m:
	Turn back on an optimization that avoids passing parameters (such as
	type_infos) to foreign_procs if they are not actually referred to.

compiler/prog_data.m:
	Convert to four-space indentation.

library/svvarset.m:
	Add a missing predicate.

trace/mercury_trace.c:
	Delete the unused function that used to check for dummy types.

tests/debugger/field_names.{m,inp,exp}:
	Add to this test case a test of the handling of dummy types. Check that
	their values can be printed out during normal execution, and that the
	debugger doesn't consider them live nondummy variables, just as it
	doesn't consider I/O states live nondummy variables.
2005-10-05 06:34:27 +00:00

1326 lines
52 KiB
C
Raw Blame History

/*
** vim:ts=4 sw=4 expandtab
*/
/*
** Copyright (C) 2001-2005 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_ml_expand_body.h
**
** This file is included several times in runtime/mercury_deconstruct.c. Each
** inclusion defines the body of one of several variants of the old ML_expand
** function, which, given a data word and its type_info, returned its functor,
** arity, argument vector and a type_info vector describing its arguments.
** One variant still does all that. The others perform different subsets of
** this task. The reason for having those specialized variants is that
** executing the full task can be extremely time consuming, especially when
** large arrays are involved. (Simply allocating and filling in an array of
** a million typeinfos can cause a system to start paging.) Therefore we try to
** make sure that in every circumstance we perform the minimum work possible.
**
** The code including this file must define these macros:
**
** EXPAND_FUNCTION_NAME Gives the name of the function being defined.
**
** EXPAND_TYPE_NAME Gives the name of the type of the expand_info
** argument.
**
** The code including this file may define these macros:
**
** EXPAND_FUNCTOR_FIELD If defined, gives the name of the field in the
** expand_info structure that contains the name of the
** functor. This field should be of type
** MR_ConstString. The function will fill in this
** field.
**
** EXPAND_ARGS_FIELD If defined, gives the name of the field in the
** expand_info structure that contains information
** about all the functor's arguments. This field
** should be of type MR_Expand_Args_Fields. The
** function will fill in this field.
**
** EXPAND_CHOSEN_ARG If defined, the function will have an extra
** argument, chosen, which specifies the position of
** the one desired argument (with the first argument
** having position 0), and the function will fill in
** the fields of the MR_Expand_Chosen_Arg_Only
** structure.
**
** EXPAND_NAMED_ARG If defined, the function will have an extra
** argument, chosen_name, which specifies the name
** of the one desired argument, and the function will
** fill in the fields of the MR_Expand_Chosen_Arg_Only
** structure.
**
** EXPAND_APPLY_LIMIT If defined, the function will have an extra
** argument, max_arity. If the number of arguments
** exceeds this limit, the function will store
** MR_FALSE in the limit_reached field of expand_info
** and will not fill in the other fields about the
** arguments.
**
**
** Most combinations are allowed, but
**
** - only one of EXPAND_ARGS_FIELD, EXPAND_CHOSEN_ARG and EXPAND_NAMED_ARG
** may be defined at once, and
** - EXPAND_APPLY_LIMIT should be defined only if EXPAND_ARGS_FIELD is also
** defined.
**
** Each variant of the function will fill in all the fields of the expand_info
** structure passed to it, although the set of fields in that structure will
** be different for different variants. The type in EXPAND_TYPE_NAME must be
** consistent with the set of defined optional macros.
**
** All variants contain the the integer field arity, which will be set to
** the number of arguments the functor has.
**
** The variants that return all the arguments do so in a field of type
** MR_Expand_Args_Fields. Its arg_type_infos subfield will contain a pointer
** to an array of arity MR_TypeInfos, one for each user-visible field of the
** cell. The arg_values field will contain a pointer to a block of
** arity + num_extra_args MR_Words, one for each field of the cell,
** whether user-visible or not. The first num_extra_args words will be
** the type infos and/or typeclass infos added by the implementation to
** describe the types of the existentially typed fields, while the last
** arity words will be the user-visible fields themselves.
**
** If the can_free_arg_type_infos field is true, then the array returned
** in the arg_type_infos field was allocated by this function, and should be
** freed by the caller when it has finished using the information it contains.
** Since the array will have been allocated using MR_GC_malloc(), it should be
** freed with MR_GC_free. (We need to use MR_GC_malloc() rather than
** MR_malloc() or malloc(), since this vector may contain pointers into the
** Mercury heap, and memory allocated with MR_malloc() or malloc() will not be
** traced by the Boehm collector.) The elements of the array should not be
** freed, since they point to previously allocated data, which is either
** on the heap or is in constant storage (e.g. type_ctor_infos).
** If the can_free_arg_type_infos field is false, then the array returned in
** the arg_type_infos field was not allocated by the function (it came from the
** type_info argument passed to it) and must not be freed.
**
** Please note:
** These functions increment the heap pointer; however, on some platforms
** the register windows mean that transient Mercury registers may be lost.
** Before calling these functions, call MR_save_transient_registers(), and
** afterwards, call MR_restore_transient_registers().
**
** If you change this code, you may also have to reflect your changes
** in runtime/mercury_deep_copy_body.h and runtime/mercury_tabling.c.
**
** In several places, we call MR_fatal_error to signal inappropriate
** deconstruction of noncanonical terms. These should all throw exceptions
** instead, but it is not yet safe to throw exceptions across the C interface.
*/
#include <stdio.h>
#include "mercury_library_types.h" /* for MR_ArrayType */
#include "mercury_layout_util.h" /* for MR_materialize_closure_type_params */
#include "mercury_ho_call.h" /* for MR_Closure_Id etc */
#ifdef MR_DEEP_PROFILING
#include "mercury_deep_profiling.h"
#endif
/* set up for recursive calls */
#ifdef EXPAND_APPLY_LIMIT
#define EXTRA_ARG1 max_arity,
#else
#define EXTRA_ARG1
#endif
#ifdef EXPAND_CHOSEN_ARG
#define EXTRA_ARG2 chosen,
#else
#define EXTRA_ARG2
#endif
#ifdef EXPAND_NAMED_ARG
#define EXTRA_ARG3 chosen_name,
#else
#define EXTRA_ARG3
#endif
#define EXTRA_ARGS EXTRA_ARG1 EXTRA_ARG2 EXTRA_ARG3
#if defined(EXPAND_CHOSEN_ARG) || defined(EXPAND_NAMED_ARG)
#define EXPAND_ONE_ARG
#else /* defined(EXPAND_CHOSEN_ARG) || defined(EXPAND_NAMED_ARG) */
#undef EXPAND_ONE_ARG
#endif /* defined(EXPAND_CHOSEN_ARG) || defined(EXPAND_NAMED_ARG) */
/* set up macro for setting field names without #ifdefs */
#ifdef EXPAND_FUNCTOR_FIELD
#define handle_functor_name(name) \
do { \
MR_restore_transient_hp(); \
MR_make_aligned_string(expand_info->EXPAND_FUNCTOR_FIELD,\
name); \
MR_save_transient_hp(); \
} while (0)
#define handle_noncanonical_name(tci) \
do { \
MR_ConstString name; \
\
name = MR_expand_type_name(tci, MR_TRUE); \
MR_restore_transient_hp(); \
MR_make_aligned_string(expand_info->EXPAND_FUNCTOR_FIELD,\
name); \
MR_save_transient_hp(); \
} while (0)
#define handle_type_ctor_name(tci) \
do { \
MR_ConstString name; \
\
name = MR_expand_type_name(tci, MR_FALSE); \
MR_restore_transient_hp(); \
MR_make_aligned_string(expand_info->EXPAND_FUNCTOR_FIELD,\
name); \
MR_save_transient_hp(); \
} while (0)
#else /* EXPAND_FUNCTOR_FIELD */
#define handle_functor_name(name) \
((void) 0)
#define handle_noncanonical_name(tci) \
((void) 0)
#define handle_type_ctor_name(tci) \
((void) 0)
#endif /* EXPAND_FUNCTOR_FIELD */
/* set up macros for the common code handling zero arity terms */
#ifdef EXPAND_ARGS_FIELD
#define handle_zero_arity_all_args() \
do { \
expand_info->EXPAND_ARGS_FIELD.arg_values = NULL; \
expand_info->EXPAND_ARGS_FIELD.arg_type_infos = NULL; \
expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0; \
} while (0)
#else /* EXPAND_ARGS_FIELD */
#define handle_zero_arity_all_args() \
((void) 0)
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_ONE_ARG
#define handle_zero_arity_one_arg() \
do { \
expand_info->chosen_index_exists = MR_FALSE; \
} while (0)
#else /* EXPAND_ONE_ARG */
#define handle_zero_arity_one_arg() \
((void) 0)
#endif /* EXPAND_ONE_ARG */
#define handle_zero_arity_args() \
do { \
expand_info->arity = 0; \
handle_zero_arity_all_args(); \
handle_zero_arity_one_arg(); \
} while (0)
/*
** In hlc grades, closures have a closure_layout field but it is not filled in.
** Since deconstructing closures is not possible without the information in
** this field, we must canonicalize all closures in hlc grades. We do this by
** overriding the test for canonicalization, so it always succeeds.
*/
#ifdef MR_HIGHLEVEL_CODE
#define higher_order_test(test) (MR_TRUE)
#else
#define higher_order_test(test) (test)
#endif
/***********************************************************************/
void
EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
MR_noncanon_handling noncanon,
#ifdef EXPAND_APPLY_LIMIT
int max_arity,
#endif /* EXPAND_APPLY_LIMIT */
#ifdef EXPAND_CHOSEN_ARG
int chosen,
#endif /* EXPAND_CHOSEN_ARG */
#ifdef EXPAND_NAMED_ARG
MR_ConstString chosen_name,
#endif /* EXPAND_NAMED_ARG */
EXPAND_TYPE_NAME *expand_info)
{
MR_TypeCtorInfo type_ctor_info;
MR_DuTypeLayout du_type_layout;
#ifdef EXPAND_NAMED_ARG
/*
** No arm of the switch on type_ctor_rep handles named arguments by
** default. Only those type_ctor_reps that support named arguments
** need have code for searching for argument names. For the rest,
** initializing chosen to -1 ensures that no argument will be returned.
*/
int chosen = -1;
#endif /* EXPAND_NAMED_ARG */
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
#ifdef EXPAND_ARGS_FIELD
expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos = MR_FALSE;
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_APPLY_LIMIT
expand_info->limit_reached = MR_FALSE;
#endif /* EXPAND_APPLY_LIMIT */
if (! MR_type_ctor_has_valid_rep(type_ctor_info)) {
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": term of unknown representation");
}
switch(MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_ENUM_USEREQ:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
} else if (noncanon == MR_NONCANON_ALLOW) {
handle_noncanonical_name(type_ctor_info);
handle_zero_arity_args();
return;
}
/* else fall through */
case MR_TYPECTOR_REP_ENUM:
handle_functor_name(MR_type_ctor_layout(type_ctor_info).
MR_layout_enum[*data_word_ptr]->MR_enum_functor_name);
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_DUMMY:
/*
** We must not refer to the "value" we are asked to deconstruct,
** *data_word_ptr, since it contains garbage.
*/
handle_functor_name(MR_type_ctor_layout(type_ctor_info).
MR_layout_enum[0]->MR_enum_functor_name);
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
} else if (noncanon == MR_NONCANON_ALLOW) {
handle_noncanonical_name(type_ctor_info);
handle_zero_arity_args();
return;
}
/* else fall through */
case MR_TYPECTOR_REP_RESERVED_ADDR:
{
int i;
MR_Word data;
MR_ReservedAddrTypeLayout ra_layout;
ra_layout = MR_type_ctor_layout(type_ctor_info).
MR_layout_reserved_addr;
data = *data_word_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)
{
handle_functor_name(ra_layout->MR_ra_constants[data]->
MR_ra_functor_name);
handle_zero_arity_args();
return;
}
/*
** 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])
{
int offset;
offset = i + ra_layout->MR_ra_num_res_numeric_addrs;
handle_functor_name(ra_layout->
MR_ra_constants[offset]->MR_ra_functor_name);
handle_zero_arity_args();
/* "break" here would just exit the "for" loop */
return;
}
}
/*
** 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:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
} else if (noncanon == MR_NONCANON_ALLOW) {
handle_noncanonical_name(type_ctor_info);
handle_zero_arity_args();
return;
}
/* else fall through */
case MR_TYPECTOR_REP_DU:
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' must be set before
** this code is entered.
*/
du_type:
{
const MR_DuPtagLayout *ptag_layout;
const MR_DuFunctorDesc *functor_desc;
const MR_DuExistInfo *exist_info;
int extra_args;
MR_Word data;
int ptag;
MR_Word sectag;
MR_Word *arg_vector;
data = *data_word_ptr;
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];
arg_vector = (MR_Word *) MR_body(data, ptag);
break;
case MR_SECTAG_LOCAL:
sectag = MR_unmkbody(data);
functor_desc =
ptag_layout->MR_sectag_alternatives[sectag];
arg_vector = NULL;
break;
case MR_SECTAG_REMOTE:
sectag = MR_field(ptag, data, 0);
functor_desc =
ptag_layout->MR_sectag_alternatives[sectag];
arg_vector = (MR_Word *) MR_body(data, ptag) + 1;
break;
case MR_SECTAG_VARIABLE:
if (noncanon != MR_NONCANON_CC) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct variable");
}
handle_functor_name("<<variable>>");
handle_zero_arity_args();
return;
default:
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": invalid sectag_locn");
}
handle_functor_name(functor_desc->MR_du_functor_name);
expand_info->arity = functor_desc->MR_du_functor_orig_arity;
#if defined(EXPAND_ARGS_FIELD) || defined(EXPAND_ONE_ARG)
exist_info = functor_desc->MR_du_functor_exist_info;
if (exist_info != NULL) {
extra_args = exist_info->MR_exist_typeinfos_plain
+ exist_info->MR_exist_tcis;
} else {
extra_args = 0;
}
#endif /* defined(EXPAND_ARGS_FIELD) || defined(EXPAND_ONE_ARG) */
#ifdef EXPAND_ARGS_FIELD
#ifdef EXPAND_APPLY_LIMIT
if (expand_info->arity > max_arity) {
expand_info->limit_reached = MR_TRUE;
} else
#endif /* EXPAND_APPLY_LIMIT */
{
int i;
expand_info->EXPAND_ARGS_FIELD.num_extra_args = extra_args;
expand_info->EXPAND_ARGS_FIELD.arg_values = arg_vector;
expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos =
MR_TRUE;
expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
MR_GC_NEW_ARRAY(MR_TypeInfo, expand_info->arity);
for (i = 0; i < expand_info->arity; i++) {
if (MR_arg_type_may_contain_var(functor_desc, i)) {
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[i] =
MR_create_type_info_maybe_existq(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(
type_info),
functor_desc->MR_du_functor_arg_types[i],
arg_vector, functor_desc);
} else {
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[i] =
MR_pseudo_type_info_is_ground(
functor_desc->MR_du_functor_arg_types[i]);
}
}
}
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_ONE_ARG
#ifdef EXPAND_NAMED_ARG
{
int i;
for (i = 0; i < expand_info->arity; i++) {
if (functor_desc->MR_du_functor_arg_names != NULL
&& functor_desc->MR_du_functor_arg_names[i] != NULL
&& MR_streq(
functor_desc->MR_du_functor_arg_names[i],
chosen_name))
{
chosen = i;
break;
}
}
}
#endif /* EXPAND_NAMED_ARG */
if (0 <= chosen && chosen < expand_info->arity) {
expand_info->chosen_index_exists = MR_TRUE;
expand_info->chosen_value_ptr =
&arg_vector[extra_args + chosen];
if (MR_arg_type_may_contain_var(functor_desc, chosen)) {
expand_info->chosen_type_info =
MR_create_type_info_maybe_existq(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(
type_info),
functor_desc->MR_du_functor_arg_types[chosen],
arg_vector, functor_desc);
} else {
expand_info->chosen_type_info =
MR_pseudo_type_info_is_ground(
functor_desc->MR_du_functor_arg_types[chosen]);
}
} else {
expand_info->chosen_index_exists = MR_FALSE;
}
#endif /* EXPAND_ONE_ARG */
}
return;
case MR_TYPECTOR_REP_NOTAG_USEREQ:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
} else if (noncanon == MR_NONCANON_ALLOW) {
handle_noncanonical_name(type_ctor_info);
handle_zero_arity_args();
return;
}
/* else fall through */
case MR_TYPECTOR_REP_NOTAG:
expand_info->arity = 1;
handle_functor_name(MR_type_ctor_layout(type_ctor_info).
MR_layout_notag->MR_notag_functor_name);
#ifdef EXPAND_ARGS_FIELD
expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
expand_info->EXPAND_ARGS_FIELD.arg_values = data_word_ptr;
expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos = MR_TRUE;
expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
MR_GC_NEW_ARRAY(MR_TypeInfo, 1);
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[0] =
MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
MR_notag_functor_arg_type);
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_ONE_ARG
#ifdef EXPAND_NAMED_ARG
if (MR_type_ctor_layout(type_ctor_info).MR_layout_notag
->MR_notag_functor_arg_name != NULL
&& MR_streq(chosen_name, MR_type_ctor_layout(type_ctor_info).
MR_layout_notag->MR_notag_functor_arg_name))
{
chosen = 0;
}
#endif /* EXPAND_NAMED_ARG */
if (chosen == 0) {
expand_info->chosen_index_exists = MR_TRUE;
expand_info->chosen_value_ptr = data_word_ptr;
expand_info->chosen_type_info =
MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
MR_notag_functor_arg_type);
} else {
expand_info->chosen_index_exists = MR_FALSE;
}
#endif /* EXPAND_ONE_ARG */
return;
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
} else if (noncanon == MR_NONCANON_ALLOW) {
handle_noncanonical_name(type_ctor_info);
handle_zero_arity_args();
return;
}
/* else fall through */
case MR_TYPECTOR_REP_NOTAG_GROUND:
expand_info->arity = 1;
handle_functor_name(MR_type_ctor_layout(type_ctor_info).
MR_layout_notag->MR_notag_functor_name);
#ifdef EXPAND_ARGS_FIELD
expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
expand_info->EXPAND_ARGS_FIELD.arg_values = data_word_ptr;
expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos = MR_TRUE;
expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
MR_GC_NEW_ARRAY(MR_TypeInfo, 1);
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[0] =
MR_pseudo_type_info_is_ground(
MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
MR_notag_functor_arg_type);
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_ONE_ARG
#ifdef EXPAND_NAMED_ARG
if (MR_type_ctor_layout(type_ctor_info).MR_layout_notag
->MR_notag_functor_arg_name != NULL
&& MR_streq(chosen_name, MR_type_ctor_layout(type_ctor_info).
MR_layout_notag->MR_notag_functor_arg_name))
{
chosen = 0;
}
#endif /* EXPAND_NAMED_ARG */
if (chosen == 0) {
expand_info->chosen_index_exists = MR_TRUE;
expand_info->chosen_value_ptr = data_word_ptr;
expand_info->chosen_type_info =
MR_pseudo_type_info_is_ground(
MR_type_ctor_layout(type_ctor_info).MR_layout_notag
->MR_notag_functor_arg_type);
} else {
expand_info->chosen_index_exists = MR_FALSE;
}
#endif /* EXPAND_ONE_ARG */
return;
case MR_TYPECTOR_REP_EQUIV:
{
MR_TypeInfo eqv_type_info;
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);
EXPAND_FUNCTION_NAME(eqv_type_info, data_word_ptr, noncanon,
EXTRA_ARGS expand_info);
}
return;
case MR_TYPECTOR_REP_EQUIV_GROUND:
EXPAND_FUNCTION_NAME(MR_pseudo_type_info_is_ground(
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv),
data_word_ptr, noncanon, EXTRA_ARGS expand_info);
return;
case MR_TYPECTOR_REP_INT:
#ifdef EXPAND_FUNCTOR_FIELD
{
MR_Word data_word;
char buf[500];
char *str;
data_word = *data_word_ptr;
sprintf(buf, "%ld", (long) data_word);
MR_make_aligned_string_copy_saved_hp(str, buf);
expand_info->EXPAND_FUNCTOR_FIELD = str;
}
#endif /* EXPAND_FUNCTOR_FIELD */
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_CHAR:
#ifdef EXPAND_FUNCTOR_FIELD
{
/* XXX should escape characters correctly */
char buf[8];
MR_Word data_word;
char *str;
data_word = *data_word_ptr;
sprintf(buf, "\'%c\'", (char) data_word);
MR_make_aligned_string_copy_saved_hp(str, buf);
expand_info->EXPAND_FUNCTOR_FIELD = str;
}
#endif /* EXPAND_FUNCTOR_FIELD */
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_FLOAT:
#ifdef EXPAND_FUNCTOR_FIELD
{
MR_Word data_word;
char buf[MR_SPRINTF_FLOAT_BUF_SIZE];
MR_Float f;
char *str;
data_word = *data_word_ptr;
f = MR_word_to_float(data_word);
MR_sprintf_float(buf, f);
MR_make_aligned_string_copy_saved_hp(str, buf);
expand_info->EXPAND_FUNCTOR_FIELD = str;
}
#endif /* EXPAND_FUNCTOR_FIELD */
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_STRING:
#ifdef EXPAND_FUNCTOR_FIELD
{
/* XXX should escape characters correctly */
MR_Word data_word;
char *str;
data_word = *data_word_ptr;
MR_make_aligned_string_copy_saved_hp_quote(str,
(MR_String) data_word);
expand_info->EXPAND_FUNCTOR_FIELD = str;
}
#endif /* EXPAND_FUNCTOR_FIELD */
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_FUNC:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
} else if (higher_order_test(noncanon == MR_NONCANON_ALLOW)) {
handle_functor_name("<<function>>");
handle_zero_arity_args();
return;
} else {
goto predfunc;
}
case MR_TYPECTOR_REP_PRED:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
} else if (higher_order_test(noncanon == MR_NONCANON_ALLOW)) {
handle_functor_name("<<predicate>>");
handle_zero_arity_args();
return;
} else {
goto predfunc;
}
/*
** This label handles the MR_NONCANON_CC case of both predicates
** and functions.
*/
predfunc:
{
MR_Closure *closure;
MR_Closure_Layout *closure_layout;
MR_Proc_Id *proc_id;
MR_User_Proc_Id *user_proc_id;
MR_UCI_Proc_Id *uci_proc_id;
MR_ConstString name;
int num_args;
int i;
closure = (MR_Closure *) *data_word_ptr;
closure_layout = closure->MR_closure_layout;
num_args = closure->MR_closure_num_hidden_args;
expand_info->arity = num_args;
#ifdef EXPAND_FUNCTOR_FIELD
proc_id = &closure_layout->MR_closure_id->MR_closure_proc_id;
if (proc_id->MR_proc_user.MR_user_arity < 0) {
name = "dynlink_proc"; /* XXX */
} else if (MR_PROC_ID_IS_UCI(*proc_id)) {
name = proc_id->MR_proc_uci.MR_uci_pred_name;
} else {
name = proc_id->MR_proc_user.MR_user_name;
}
handle_functor_name(name);
#endif /* EXPAND_FUNCTOR_FIELD */
#ifdef EXPAND_ARGS_FIELD
#ifdef EXPAND_APPLY_LIMIT
if (num_args > max_arity) {
expand_info->limit_reached = MR_TRUE;
} else
#endif /* EXPAND_APPLY_LIMIT */
{
MR_TypeInfo *type_params;
type_params =
MR_materialize_closure_type_params(closure);
expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
expand_info->EXPAND_ARGS_FIELD.arg_values = &closure->
MR_closure_hidden_args_0[0];
expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
MR_GC_NEW_ARRAY(MR_TypeInfo, num_args);
expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos =
MR_TRUE;
for (i = 0; i < num_args ; i++) {
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[i] =
MR_create_type_info(type_params,
closure_layout->
MR_closure_arg_pseudo_type_info[i]);
}
if (type_params != NULL) {
MR_free(type_params);
}
}
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_CHOSEN_ARG
if (0 <= chosen && chosen < num_args) {
MR_TypeInfo *type_params;
expand_info->chosen_index_exists = MR_TRUE;
expand_info->chosen_value_ptr =
&closure->MR_closure_hidden_args_0[chosen];
/* the following code could be improved */
type_params = MR_materialize_closure_type_params(closure);
expand_info->chosen_type_info =
MR_create_type_info(type_params,
closure_layout->
MR_closure_arg_pseudo_type_info[chosen]);
if (type_params != NULL) {
MR_free(type_params);
}
} else {
expand_info->chosen_index_exists = MR_FALSE;
}
#endif /* EXPAND_CHOSEN_ARG */
#ifdef EXPAND_NAMED_ARG
expand_info->chosen_index_exists = MR_FALSE;
#endif /* EXPAND_NAMED_ARG */
}
return;
case MR_TYPECTOR_REP_TUPLE:
expand_info->arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
handle_functor_name("{}");
#ifdef EXPAND_ARGS_FIELD
#ifdef EXPAND_APPLY_LIMIT
if (expand_info->arity > max_arity) {
expand_info->limit_reached = MR_TRUE;
} else
#endif /* EXPAND_APPLY_LIMIT */
{
expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
expand_info->EXPAND_ARGS_FIELD.arg_values =
(MR_Word *) *data_word_ptr;
/*
** Type-infos are normally counted from one, but
** the users of this vector count from zero.
*/
expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info) + 1;
}
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_ONE_ARG
if (0 <= chosen && chosen < expand_info->arity) {
MR_Word *arg_vector;
arg_vector = (MR_Word *) *data_word_ptr;
expand_info->chosen_index_exists = MR_TRUE;
expand_info->chosen_value_ptr = &arg_vector[chosen];
expand_info->chosen_type_info =
MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[chosen + 1];
} else {
expand_info->chosen_index_exists = MR_FALSE;
}
#endif /* EXPAND_ONE_ARG */
return;
case MR_TYPECTOR_REP_SUBGOAL:
#if MR_USE_MINIMAL_MODEL_STACK_COPY
if (noncanon == MR_NONCANON_CC) {
handle_functor_name(MR_subgoal_addr_name(
(MR_SubgoalPtr) *data_word_ptr));
} else {
handle_functor_name("<<subgoal>>");
}
#else
handle_functor_name("<<subgoal>>");
#endif
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_VOID:
/*
** There's no way to create values of type `void',
** so this should never happen.
*/
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": cannot expand void types");
case MR_TYPECTOR_REP_C_POINTER:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
}
handle_functor_name("<<c_pointer>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_STABLE_C_POINTER:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
}
handle_functor_name("<<stable_c_pointer>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_TYPEINFO:
case MR_TYPECTOR_REP_TYPEDESC:
{
MR_TypeInfo data_type_info;
MR_TypeCtorInfo data_type_ctor_info;
MR_Word *arg_type_infos;
int num_args;
/*
** Most changes here should also be made in the code for
** MR_TYPECTOR_REP_PSEUDOTYPEDESC below.
*/
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
}
/*
** The only source of noncanonicality in type_infos is due
** to type equivalences, so we can eliminate noncanonicality
** by expanding out equivalences.
*/
data_type_info = (MR_TypeInfo) *data_word_ptr;
if (noncanon == MR_NONCANON_ALLOW) {
data_type_info = MR_collapse_equivalences(data_type_info);
}
data_type_ctor_info =
MR_TYPEINFO_GET_TYPE_CTOR_INFO(data_type_info);
handle_functor_name(MR_type_ctor_name(data_type_ctor_info));
if (MR_type_ctor_has_variable_arity(data_type_ctor_info)) {
num_args = MR_TYPEINFO_GET_VAR_ARITY_ARITY(data_type_info);
arg_type_infos = (MR_Word *)
MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(data_type_info);
} else {
num_args = data_type_ctor_info->MR_type_ctor_arity;
arg_type_infos = (MR_Word *)
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(data_type_info);
}
expand_info->arity = num_args;
/* switch from 1-based to 0-based array indexing */
arg_type_infos++;
#ifdef EXPAND_ARGS_FIELD
#ifdef EXPAND_APPLY_LIMIT
if (num_args > max_arity) {
expand_info->limit_reached = MR_TRUE;
} else
#endif /* EXPAND_APPLY_LIMIT */
{
int i;
expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
expand_info->EXPAND_ARGS_FIELD.arg_values = arg_type_infos;
expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
MR_GC_NEW_ARRAY(MR_TypeInfo, num_args);
expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos =
MR_TRUE;
for (i = 0; i < num_args ; i++) {
/*
** The arguments of a type_info are themselves of type
** ``type_info''.
*/
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[i] =
type_info;
}
}
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_ONE_ARG
if (0 <= chosen && chosen < expand_info->arity) {
MR_Word *arg_vector;
arg_vector = (MR_Word *) data_type_info;
expand_info->chosen_index_exists = MR_TRUE;
expand_info->chosen_value_ptr = &arg_type_infos[chosen];
expand_info->chosen_type_info = type_info;
} else {
expand_info->chosen_index_exists = MR_FALSE;
}
#endif /* EXPAND_ONE_ARG */
}
return;
case MR_TYPECTOR_REP_PSEUDOTYPEDESC:
{
MR_PseudoTypeInfo data_pseudo_type_info;
MR_TypeCtorInfo data_type_ctor_info;
MR_Word *arg_type_infos;
int num_args;
/*
** Most changes here should also be made in the code for
** MR_TYPECTOR_REP_TYPEDESC above.
*/
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
}
/*
** The only source of noncanonicality in pseudo_type_infos
** is due to type equivalences, so we can eliminate
** noncanonicality by expanding out equivalences.
*/
data_pseudo_type_info = (MR_PseudoTypeInfo) *data_word_ptr;
if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(data_pseudo_type_info)) {
#ifdef EXPAND_FUNCTOR_FIELD
{
char buf[500];
char *str;
sprintf(buf, "tvar%ld", (long) data_pseudo_type_info);
MR_make_aligned_string_copy_saved_hp(str, buf);
expand_info->EXPAND_FUNCTOR_FIELD = str;
}
#endif /* EXPAND_FUNCTOR_FIELD */
handle_zero_arity_args();
return;
}
if (noncanon == MR_NONCANON_ALLOW) {
data_pseudo_type_info = MR_collapse_equivalences_pseudo(
data_pseudo_type_info);
}
data_type_ctor_info = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(
data_pseudo_type_info);
handle_functor_name(MR_type_ctor_name(data_type_ctor_info));
if (MR_type_ctor_has_variable_arity(data_type_ctor_info)) {
num_args = MR_PSEUDO_TYPEINFO_GET_VAR_ARITY_ARITY(
data_pseudo_type_info);
arg_type_infos = (MR_Word *)
MR_PSEUDO_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(
data_pseudo_type_info);
} else {
num_args = data_type_ctor_info->MR_type_ctor_arity;
arg_type_infos = (MR_Word *)
MR_PSEUDO_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(
data_pseudo_type_info);
}
expand_info->arity = num_args;
/* switch from 1-based to 0-based array indexing */
arg_type_infos++;
#ifdef EXPAND_ARGS_FIELD
#ifdef EXPAND_APPLY_LIMIT
if (num_args > max_arity) {
expand_info->limit_reached = MR_TRUE;
} else
#endif /* EXPAND_APPLY_LIMIT */
{
int i;
expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
expand_info->EXPAND_ARGS_FIELD.arg_values = arg_type_infos;
expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
MR_GC_NEW_ARRAY(MR_TypeInfo, num_args);
expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos =
MR_TRUE;
for (i = 0; i < num_args ; i++) {
/*
** The arguments of a pseudo_type_info are themselves
** of type ``pseudo_type_info''.
*/
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[i] =
type_info;
}
}
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_ONE_ARG
if (0 <= chosen && chosen < expand_info->arity) {
MR_Word *arg_vector;
arg_vector = (MR_Word *) data_pseudo_type_info;
expand_info->chosen_index_exists = MR_TRUE;
expand_info->chosen_value_ptr = &arg_type_infos[chosen];
expand_info->chosen_type_info = type_info;
} else {
expand_info->chosen_index_exists = MR_FALSE;
}
#endif /* EXPAND_ONE_ARG */
}
return;
case MR_TYPECTOR_REP_TYPECTORINFO:
{
MR_TypeCtorInfo data_type_ctor_info;
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
}
data_type_ctor_info = (MR_TypeCtorInfo) *data_word_ptr;
handle_type_ctor_name(data_type_ctor_info);
handle_zero_arity_args();
}
return;
case MR_TYPECTOR_REP_TYPECTORDESC:
{
MR_TypeCtorDesc data_type_ctor_desc;
MR_TypeCtorInfo data_type_ctor_info;
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
}
data_type_ctor_desc = (MR_TypeCtorDesc) *data_word_ptr;
if (MR_TYPECTOR_DESC_IS_VARIABLE_ARITY(data_type_ctor_desc)) {
handle_functor_name(MR_TYPECTOR_DESC_GET_VA_NAME(
data_type_ctor_desc));
} else {
data_type_ctor_info =
MR_TYPECTOR_DESC_GET_FIXED_ARITY_TYPE_CTOR_INFO(
data_type_ctor_desc);
handle_type_ctor_name(data_type_ctor_info);
}
handle_zero_arity_args();
}
return;
case MR_TYPECTOR_REP_TYPECLASSINFO:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
}
handle_functor_name("<<typeclassinfo>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_BASETYPECLASSINFO:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
}
handle_functor_name("<<basetypeclassinfo>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_ARRAY:
{
MR_ArrayType *array;
array = (MR_ArrayType *) *data_word_ptr;
expand_info->arity = array->size;
handle_functor_name("<<array>>");
#ifdef EXPAND_ARGS_FIELD
#ifdef EXPAND_APPLY_LIMIT
if (expand_info->arity > max_arity) {
expand_info->limit_reached = MR_TRUE;
} else
#endif /* EXPAND_APPLY_LIMIT */
{
MR_TypeInfoParams params;
int i;
params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
expand_info->EXPAND_ARGS_FIELD.arg_values =
&array->elements[0];
expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos =
MR_TRUE;
expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
MR_GC_NEW_ARRAY(MR_TypeInfo, array->size);
for (i = 0; i < array->size; i++) {
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[i] =
params[1];
}
}
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_ONE_ARG
if (0 <= chosen && chosen < array->size) {
MR_TypeInfoParams params;
params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
expand_info->chosen_value_ptr = &array->elements[chosen];
expand_info->chosen_type_info = params[1];
expand_info->chosen_index_exists = MR_TRUE;
} else {
expand_info->chosen_index_exists = MR_FALSE;
}
#endif /* EXPAND_ONE_ARG */
}
return;
case MR_TYPECTOR_REP_SUCCIP:
handle_functor_name("<<succip>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_HP:
handle_functor_name("<<hp>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_CURFR:
handle_functor_name("<<curfr>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_MAXFR:
handle_functor_name("<<maxfr>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_REDOFR:
handle_functor_name("<<redofr>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_REDOIP:
handle_functor_name("<<redoip>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_TRAIL_PTR:
handle_functor_name("<<trail_ptr>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_TICKET:
handle_functor_name("<<ticket>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_FOREIGN:
handle_functor_name("<<foreign>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_STABLE_FOREIGN:
handle_functor_name("<<stable_foreign>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_REFERENCE:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": attempt to deconstruct noncanonical term");
return;
}
handle_functor_name("<<reference>>");
handle_zero_arity_args();
return;
case MR_TYPECTOR_REP_UNKNOWN: /* fallthru */
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": cannot expand -- unknown data type");
}
MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
": unexpected fallthrough");
}
#undef EXTRA_ARG1
#undef EXTRA_ARG2
#undef EXTRA_ARG3
#undef EXTRA_ARGS
#undef EXPAND_ONE_ARG
#undef handle_functor_name
#undef handle_noncanonical_name
#undef handle_type_ctor_name
#undef handle_zero_arity_args
#undef handle_zero_arity_all_args
#undef handle_zero_arity_one_arg
#undef higher_order_test
Reference in New Issue View Git Blame Copy Permalink