[m-dev.] for review: cleanup of type_ctor_infos, part 3
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Feb 25 16:10:30 AEDT 2000
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing library
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.179
diff -u -b -r1.179 std_util.m
--- library/std_util.m 2000/02/17 06:38:10 1.179
+++ library/std_util.m 2000/02/24 03:30:21
@@ -370,28 +370,33 @@
% type constructor of the type specified by TypeInfo, or -1
% if the type is not a discriminated union type.
%
+ % The functors of a discriminated union type are numbered from
+ % zero to N-1, where N is the value returned by num_functors.
+ % The functors are numbered in lexicographic order. If two
+ % functors have the same name, the one with the lower arity
+ % will have the lower number.
+ %
:- func num_functors(type_info) = int.
- % get_functor(Type, N, Functor, Arity, ArgTypes)
+ % get_functor(Type, I, Functor, Arity, ArgTypes)
%
- % Binds Functor and Arity to the name and arity of the Nth
- % functor for the specified type (starting at zero), and binds
- % ArgTypes to the type_infos for the types of the arguments of
- % that functor. Fails if the type is not a discriminated union
- % type, or if N is out of range.
+ % Binds Functor and Arity to the name and arity of functor number I
+ % for the specified type, and binds ArgTypes to the type_infos for
+ % the types of the arguments of that functor. Fails if the type
+ % is not a discriminated union type, or if I is out of range.
%
:- pred get_functor(type_info::in, int::in, string::out, int::out,
list(type_info)::out) is semidet.
- % construct(TypeInfo, N, Args) = Term
+ % construct(TypeInfo, I, Args) = Term
%
% Returns a term of the type specified by TypeInfo whose functor
- % is the Nth functor of TypeInfo (starting at zero), and whose
+ % is functor number I of the type given by TypeInfo, and whose
% arguments are given by Args. Fails if the type is not a
- % discriminated union type, or if N is out of range, or if the
- % number of arguments doesn't match the arity of the Nth functor
- % of the type, or if the types of the arguments doesn't match
- % the expected argument types for that functor.
+ % discriminated union type, or if I is out of range, or if the
+ % number of arguments supplied doesn't match the arity of the selected
+ % functor, or if the types of the arguments do not match
+ % the expected argument types of that functor.
%
:- func construct(type_info, int, list(univ)) = univ.
:- mode construct(in, in, in) = out is semidet.
@@ -1164,25 +1169,40 @@
:- pragma c_header_code("
+ /*
+ ** Many of these fields are valid either only with version 3
+ ** type_ctor_infos, or only with version 4 type_ctor_infos.
+ ** the type_ctor_version field records which kind of type_ctor_info
+ ** the construct_info is derived from, and therefore which fields
+ ** are valid.
+ */
+
typedef struct ML_Construct_Info_Struct {
+ ConstString functor_name;
int arity;
- Word *functor_descriptor;
Word *argument_vector;
- Word primary_tag;
- Word secondary_tag;
- ConstString functor_name;
+ Word primary_tag; /* version 3 */
+ Word secondary_tag; /* version 3 */
+ int type_ctor_version;
+ MR_TypeCtorRep type_ctor_rep;
+ union {
+ Word *functor_descriptor; /* version 3 */
+ MR_EnumFunctorDesc *enum_functor_desc; /* version 4 */
+ MR_NotagFunctorDesc *notag_functor_desc; /* version 4 */
+ MR_DuFunctorDesc *du_functor_desc; /* version 4 */
+ } functor_info;
} ML_Construct_Info;
-int ML_get_num_functors(Word type_info);
-Word ML_copy_argument_typeinfos(int arity, Word type_info,
+extern int ML_get_num_functors(Word type_info);
+extern Word ML_copy_argument_typeinfos(int arity, Word type_info,
Word *arg_vector);
-bool ML_get_functors_check_range(int functor_number, Word type_info,
- ML_Construct_Info *info);
-void ML_copy_arguments_from_list_to_vector(int arity, Word arg_list,
+extern bool ML_get_functors_check_range(int functor_number, Word type_info,
+ ML_Construct_Info *construct_info);
+extern void ML_copy_arguments_from_list_to_vector(int arity, Word arg_list,
Word term_vector);
-bool ML_typecheck_arguments(Word type_info, int arity,
+extern bool ML_typecheck_arguments(Word type_info, int arity,
Word arg_list, Word* arg_vector);
-Word ML_make_type(int arity, MR_TypeCtorInfo type_ctor_info,
+extern Word ML_make_type(int arity, MR_TypeCtorInfo type_ctor_info,
Word arg_type_list);
").
@@ -1363,7 +1383,6 @@
type_info + OFFSET_FOR_ARG_TYPE_INFOS);
}
restore_transient_registers();
-
}
").
@@ -1452,8 +1471,15 @@
MR_TYPECTOR_GET_HOT_NAME(type_ctor);
TypeCtorArity = MR_TYPECTOR_GET_HOT_ARITY(type_ctor);
} else {
- TypeCtorModuleName = type_ctor->type_ctor_module_name;
- TypeCtorName = type_ctor->type_ctor_name;
+ /*
+ ** We cast away the const-ness of the module and type names,
+ ** because String is defined as char *, not const char *.
+ */
+
+ TypeCtorModuleName =
+ (String) (Integer) type_ctor->type_ctor_module_name;
+ TypeCtorName =
+ (String) (Integer) type_ctor->type_ctor_name;
TypeCtorArity = MR_TYPE_CTOR_INFO_GET_TYPE_ARITY(type_ctor);
}
}
@@ -1472,18 +1498,18 @@
FunctorName::out, Arity::out, TypeInfoList::out),
will_not_call_mercury, "
{
- ML_Construct_Info info;
+ ML_Construct_Info construct_info;
bool success;
/*
** Get information for this functor number and
- ** store in info. If this is a discriminated union
+ ** store in construct_info. If this is a discriminated union
** type and if the functor number is in range, we
** succeed.
*/
save_transient_registers();
success = ML_get_functors_check_range(FunctorNumber,
- TypeInfo, &info);
+ TypeInfo, &construct_info);
restore_transient_registers();
/*
@@ -1493,11 +1519,11 @@
if (success) {
MR_make_aligned_string(FunctorName, (String) (Word)
- info.functor_name);
- Arity = info.arity;
+ construct_info.functor_name);
+ Arity = construct_info.arity;
save_transient_registers();
TypeInfoList = ML_copy_argument_typeinfos((int) Arity,
- TypeInfo, info.argument_vector);
+ TypeInfo, construct_info.argument_vector);
restore_transient_registers();
}
SUCCESS_INDICATOR = success;
@@ -1508,8 +1534,10 @@
(Term::out), will_not_call_mercury, "
{
MR_TypeCtorInfo type_ctor_info;
- Word layout_entry, new_data, term_vector;
- ML_Construct_Info info;
+ Word layout_entry;
+ Word new_data;
+ Word term_vector;
+ ML_Construct_Info construct_info;
bool success;
/*
@@ -1518,9 +1546,9 @@
*/
save_transient_registers();
success =
- ML_get_functors_check_range(FunctorNumber, TypeInfo, &info) &&
- ML_typecheck_arguments(TypeInfo, info.arity, ArgList,
- info.argument_vector);
+ ML_get_functors_check_range(FunctorNumber, TypeInfo, &construct_info)
+ && ML_typecheck_arguments(TypeInfo, construct_info.arity, ArgList,
+ construct_info.argument_vector);
restore_transient_registers();
/*
@@ -1532,30 +1560,38 @@
*/
if (success) {
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(
- (Word *) TypeInfo);
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) TypeInfo);
+ if (type_ctor_info->type_ctor_rep != construct_info.type_ctor_rep) {
+ fatal_error(""std_util:construct: type_ctor_rep mismatch"");
+ }
- if (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_ENUM
- || type_ctor_info->type_ctor_rep ==
- MR_TYPECTOR_REP_ENUM_USEREQ) {
+ if (type_ctor_info->type_ctor_version !=
+ construct_info.type_ctor_version)
+ {
+ fatal_error(""std_util:construct: type_ctor_version mismatch"");
+ }
+
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
+ if (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_ENUM ||
+ type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_ENUM_USEREQ)
+ {
/*
** Enumerations don't have tags or arguments,
** just the enumeration value.
*/
- new_data = (Word) info.secondary_tag;
+ new_data = (Word) construct_info.secondary_tag;
} else {
layout_entry = type_ctor_info->type_ctor_layout[
- info.primary_tag];
+ construct_info.primary_tag];
/*
** It must be some sort of tagged functor.
*/
- if (type_ctor_info->type_ctor_rep ==
- MR_TYPECTOR_REP_NOTAG ||
+ if (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_NOTAG ||
type_ctor_info->type_ctor_rep ==
- MR_TYPECTOR_REP_NOTAG_USEREQ) {
-
+ MR_TYPECTOR_REP_NOTAG_USEREQ)
+ {
/*
** We set term_vector to point to
** new_data so that the argument filling
@@ -1572,22 +1608,22 @@
** secondary tag, and the term_vector will
** be the rest of the words.
*/
- incr_hp_msg(new_data, info.arity + 1,
+ incr_hp_msg(new_data, construct_info.arity + 1,
MR_PROC_LABEL, ""<unknown type from ""
""std_util:construct/3>"");
MR_field(MR_mktag(0), new_data, 0)
- = info.secondary_tag;
+ = construct_info.secondary_tag;
term_vector = (Word) (new_data + sizeof(Word));
- } else if (MR_tag(layout_entry) == TYPE_CTOR_LAYOUT_CONST_TAG) {
-
+ } else if (MR_tag(layout_entry) == TYPE_CTOR_LAYOUT_CONST_TAG)
+ {
/*
** If it's a du, and this tag is
** constant, it must be a shared local
** tag.
*/
- new_data = MR_mkbody(info.secondary_tag);
+ new_data = MR_mkbody(construct_info.secondary_tag);
term_vector = (Word) NULL;
} else {
@@ -1597,7 +1633,7 @@
** create arguments.
*/
- incr_hp_msg(new_data, info.arity,
+ incr_hp_msg(new_data, construct_info.arity,
MR_PROC_LABEL, ""<unknown type from ""
""std_util:construct/3>"");
term_vector = (Word) new_data;
@@ -1607,16 +1643,106 @@
** Copy arguments.
*/
- ML_copy_arguments_from_list_to_vector(info.arity,
+ ML_copy_arguments_from_list_to_vector(construct_info.arity,
ArgList, term_vector);
/*
** Add tag to new_data.
*/
- new_data = (Word) MR_mkword(MR_mktag(info.primary_tag),
- new_data);
+ new_data = (Word) MR_mkword(MR_mktag(
+ construct_info.primary_tag), new_data);
+ }
+ } else {
+ /* CHECKME XXXX */
+ switch (type_ctor_info->type_ctor_rep) {
+ case MR_TYPECTOR_REP_ENUM:
+ case MR_TYPECTOR_REP_ENUM_USEREQ:
+ new_data = construct_info.functor_info.enum_functor_desc->
+ MR_enum_functor_ordinal;
+ break;
+
+ case MR_TYPECTOR_REP_NOTAG:
+ case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ if (MR_list_is_empty(ArgList)) {
+ fatal_error(""notag arg list is empty"");
}
+ if (! MR_list_is_empty(MR_list_tail(ArgList))) {
+ fatal_error(""notag arg list is too long"");
+ }
+
+ new_data = MR_field(MR_mktag(0), MR_list_head(ArgList),
+ UNIV_OFFSET_FOR_DATA);
+ break;
+
+ case MR_TYPECTOR_REP_DU:
+ case MR_TYPECTOR_REP_DU_USEREQ:
+ {
+ MR_DuFunctorDesc *functor_desc;
+ Word arg_list;
+ int ptag;
+ int arity;
+ int i;
+
+ functor_desc = construct_info.functor_info.du_functor_desc;
+ if (functor_desc->MR_du_functor_exist_info != NULL) {
+ fatal_error(""not yet implemented: construction ""
+ ""of terms containing existentially types"");
+ }
+
+ arg_list = ArgList;
+ ptag = functor_desc->MR_du_functor_primary;
+ switch (functor_desc->MR_du_functor_sectag_locn) {
+ case MR_SECTAG_LOCAL:
+ new_data = (Word) MR_mkword(ptag,
+ MR_mkbody(functor_desc->MR_du_functor_secondary));
+ break;
+ case MR_SECTAG_REMOTE:
+ arity = functor_desc->MR_du_functor_orig_arity;
+
+ tag_incr_hp_msg(new_data, ptag, arity + 1,
+ MR_PROC_LABEL,
+ ""<created by std_util:construct/3>"");
+
+ MR_field(ptag, new_data, 0) =
+ functor_desc->MR_du_functor_secondary;
+ for (i = 0; i < arity; i++) {
+ MR_field(ptag, new_data, i + 1) =
+ MR_field(MR_mktag(0), MR_list_head(arg_list),
+ UNIV_OFFSET_FOR_DATA);
+ arg_list = MR_list_tail(arg_list);
+ }
+
+ break;
+ case MR_SECTAG_NONE:
+ arity = functor_desc->MR_du_functor_orig_arity;
+
+ tag_incr_hp_msg(new_data, ptag, arity,
+ MR_PROC_LABEL,
+ ""<created by std_util:construct/3>"");
+
+ for (i = 0; i < arity; i++) {
+ MR_field(ptag, new_data, i) =
+ MR_field(MR_mktag(0), MR_list_head(arg_list),
+ UNIV_OFFSET_FOR_DATA);
+ arg_list = MR_list_tail(arg_list);
+ }
+
+ break;
+ }
+
+ if (! MR_list_is_empty(arg_list)) {
+ fatal_error(""excess arguments in ""
+ ""std_util:construct"");
+ }
+ }
+ break;
+
+ default:
+ fatal_error(""bad type_ctor_rep in std_util:construct"");
+ }
+ }
+
/*
** Create a univ.
*/
@@ -1639,7 +1765,7 @@
*/
static int ML_get_functor_info(Word type_info, int functor_number,
- ML_Construct_Info *info);
+ ML_Construct_Info *construct_info);
/*
** ML_get_functor_info:
@@ -1654,72 +1780,139 @@
static int
ML_get_functor_info(Word type_info, int functor_number,
- ML_Construct_Info *info)
+ ML_Construct_Info *construct_info)
{
MR_TypeCtorInfo type_ctor_info;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) type_info);
+ construct_info->type_ctor_version = type_ctor_info->type_ctor_version;
+ construct_info->type_ctor_rep = type_ctor_info->type_ctor_rep;
switch(type_ctor_info->type_ctor_rep) {
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
- info->functor_descriptor =
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
+ construct_info->functor_info.functor_descriptor =
MR_TYPE_CTOR_FUNCTORS_DU_FUNCTOR_N(
type_ctor_info->type_ctor_functors,
functor_number);
- info->arity = MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(
- info->functor_descriptor);
- info->argument_vector =
+ construct_info->arity =
+ MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(
+ construct_info->functor_info.functor_descriptor);
+ construct_info->argument_vector =
MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARGS(
- info->functor_descriptor);
- info->primary_tag = MR_tag(
+ construct_info->functor_info.functor_descriptor);
+ construct_info->primary_tag = MR_tag(
MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_TAG(
- info->functor_descriptor));
- info->secondary_tag = MR_unmkbody(
+ construct_info->functor_info.functor_descriptor));
+ construct_info->secondary_tag = MR_unmkbody(
MR_body(MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_TAG(
- info->functor_descriptor), info->primary_tag));
- info->functor_name =
+ construct_info->functor_info.functor_descriptor),
+ construct_info->primary_tag));
+ construct_info->functor_name =
MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_FUNCTOR_NAME(
- info->functor_descriptor);
+ construct_info->functor_info.functor_descriptor);
+ } else {
+ MR_DuFunctorDesc *functor_desc;
+
+ if (functor_number < 0 ||
+ functor_number >= type_ctor_info->type_ctor_num_functors)
+ {
+ fatal_error(""ML_get_functor_info: ""
+ ""du functor_number out of range"");
+ }
+
+ functor_desc = type_ctor_info->type_functors.
+ 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->argument_vector = (Word *)
+ functor_desc->MR_du_functor_arg_types;
+ }
break;
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
- info->functor_descriptor = MR_TYPE_CTOR_FUNCTORS_ENUM_VECTOR(
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
+ construct_info->functor_info.functor_descriptor =
+ MR_TYPE_CTOR_FUNCTORS_ENUM_VECTOR(
type_ctor_info->type_ctor_functors);
- info->arity = 0;
- info->argument_vector = NULL;
- info->primary_tag = 0;
- info->secondary_tag = functor_number;
- info->functor_name =
+ construct_info->arity = 0;
+ construct_info->argument_vector = NULL;
+ construct_info->primary_tag = 0;
+ construct_info->secondary_tag = functor_number;
+ construct_info->functor_name =
MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
- info->functor_descriptor, functor_number);
+ construct_info->functor_info.functor_descriptor,
+ functor_number);
+ } else {
+ MR_EnumFunctorDesc *functor_desc;
+
+ if (functor_number < 0 ||
+ functor_number >= type_ctor_info->type_ctor_num_functors)
+ {
+ fatal_error(""ML_get_functor_info: ""
+ ""enum functor_number out of range"");
+ }
+
+ functor_desc = type_ctor_info->type_functors.
+ 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->argument_vector = NULL;
+ }
break;
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
- info->functor_descriptor =
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
+ construct_info->functor_info.functor_descriptor =
MR_TYPE_CTOR_FUNCTORS_NO_TAG_FUNCTOR(
type_ctor_info->type_ctor_functors);
- info->arity = 1;
- info->argument_vector = MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_ARGS(
- info->functor_descriptor);
- info->primary_tag = 0;
- info->secondary_tag = 0;
- info->functor_name = MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_FUNCTOR_NAME(
- info->functor_descriptor);
+ construct_info->arity = 1;
+ construct_info->argument_vector =
+ MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_ARGS(
+ construct_info->functor_info.functor_descriptor);
+ construct_info->primary_tag = 0;
+ construct_info->secondary_tag = 0;
+ construct_info->functor_name =
+ MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_FUNCTOR_NAME(
+ construct_info->functor_info.functor_descriptor);
+ } else {
+ MR_NotagFunctorDesc *functor_desc;
+
+ if (functor_number != 0) {
+ fatal_error(""ML_get_functor_info: ""
+ ""notag functor_number out of range"");
+ }
+
+ functor_desc = type_ctor_info->type_functors.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->argument_vector = (Word *)
+ &functor_desc->MR_notag_functor_arg_type;
+ }
break;
case MR_TYPECTOR_REP_EQUIV_VAR:
- case MR_TYPECTOR_REP_EQUIV: {
+ case MR_TYPECTOR_REP_EQUIV:
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
Word *equiv_type;
equiv_type = (Word *) MR_TYPE_CTOR_FUNCTORS_EQUIV_TYPE(
type_ctor_info->type_ctor_functors);
return ML_get_functor_info((Word)
- MR_create_type_info((Word *) type_info,
- equiv_type),
- functor_number, info);
+ MR_create_type_info((Word *) type_info, equiv_type),
+ functor_number, construct_info);
+ } else {
+ Word *equiv_type;
+ equiv_type = (Word *) type_ctor_info->type_layout.layout_equiv;
+ return ML_get_functor_info((Word)
+ MR_create_type_info((Word *) type_info, equiv_type),
+ functor_number, construct_info);
}
case MR_TYPECTOR_REP_INT:
@@ -1889,7 +2082,7 @@
bool
ML_get_functors_check_range(int functor_number, Word type_info,
- ML_Construct_Info *info)
+ ML_Construct_Info *construct_info)
{
/*
** Check range of functor_number, get functors
@@ -1897,7 +2090,7 @@
*/
return functor_number < ML_get_num_functors(type_info) &&
functor_number >= 0 &&
- ML_get_functor_info(type_info, functor_number, info);
+ ML_get_functor_info(type_info, functor_number, construct_info);
}
/*
@@ -1964,14 +2157,32 @@
switch(type_ctor_info->type_ctor_rep) {
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
- functors = MR_TYPE_CTOR_FUNCTORS_DU_NUM_FUNCTORS(
+ if (type_ctor_info->type_ctor_version
+ <= MR_RTTI_VERSION__USEREQ)
+ {
+ functors =
+ MR_TYPE_CTOR_FUNCTORS_DU_NUM_FUNCTORS(
type_ctor_info->type_ctor_functors);
+ } else
+ {
+ functors =
+ type_ctor_info->type_ctor_num_functors;
+ }
break;
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
- functors = MR_TYPE_CTOR_FUNCTORS_ENUM_NUM_FUNCTORS(
+ if (type_ctor_info->type_ctor_version
+ <= MR_RTTI_VERSION__USEREQ)
+ {
+ functors =
+ MR_TYPE_CTOR_FUNCTORS_DU_NUM_FUNCTORS(
type_ctor_info->type_ctor_functors);
+ } else
+ {
+ functors =
+ type_ctor_info->type_ctor_num_functors;
+ }
break;
case MR_TYPECTOR_REP_NOTAG:
@@ -1980,16 +2191,29 @@
break;
case MR_TYPECTOR_REP_EQUIV_VAR:
- case MR_TYPECTOR_REP_EQUIV: {
+ case MR_TYPECTOR_REP_EQUIV:
+ if (type_ctor_info->type_ctor_version
+ <= MR_RTTI_VERSION__USEREQ)
+ {
Word *equiv_type;
equiv_type = (Word *)
MR_TYPE_CTOR_FUNCTORS_EQUIV_TYPE(
- type_ctor_info->type_ctor_functors);
+ type_ctor_info->
+ type_ctor_functors);
functors = ML_get_num_functors((Word)
- MR_create_type_info((Word *)
- type_info, equiv_type));
- break;
+ MR_create_type_info(
+ (Word *) type_info,
+ equiv_type));
+ } else {
+ Word *equiv_type;
+ equiv_type = (Word *) type_ctor_info->
+ type_layout.layout_equiv;
+ functors = ML_get_num_functors((Word)
+ MR_create_type_info(
+ (Word *) type_info,
+ equiv_type));
}
+ break;
case MR_TYPECTOR_REP_INT:
case MR_TYPECTOR_REP_CHAR:
@@ -2068,10 +2292,11 @@
/* Prototypes */
-void ML_expand(Word* type_info, Word *data_word_ptr, ML_Expand_Info *info);
+extern void ML_expand(Word* type_info, Word *data_word_ptr,
+ ML_Expand_Info *expand_info);
/* NB. ML_arg() is also used by store__arg_ref in store.m */
-bool ML_arg(Word term_type_info, Word *term, Word argument_index,
+extern bool ML_arg(Word term_type_info, Word *term, Word argument_index,
Word *arg_type_info, Word **argument_ptr);
").
@@ -2085,7 +2310,7 @@
** Expand the given data using its type_info, find its
** functor, arity, argument vector and type_info vector.
**
-** The info.type_info_vector is allocated using MR_GC_malloc().
+** The expand_info.type_info_vector is allocated using MR_GC_malloc().
** (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
@@ -2115,59 +2340,78 @@
*/
void
-ML_expand(Word* type_info, Word *data_word_ptr, ML_Expand_Info *info)
+ML_expand(Word* type_info, Word *data_word_ptr, ML_Expand_Info *expand_info)
{
MR_TypeCtorInfo type_ctor_info;
+
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+ expand_info->non_canonical_type = ( type_ctor_info->compare_pred ==
+ ENTRY(mercury__builtin_compare_non_canonical_type_3_0) );
+
+ switch(type_ctor_info->type_ctor_rep) {
+
+ case MR_TYPECTOR_REP_ENUM:
+ case MR_TYPECTOR_REP_ENUM_USEREQ:
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
MR_TypeCtorLayout type_ctor_layout;
- MR_TypeCtorFunctors type_ctor_functors;
- Code *compare_pred;
- Word layout_for_tag;
- Word layout_vector_for_tag;
Word data_value;
Word data_word;
int data_tag;
- MR_DiscUnionTagRepresentation tag_rep;
-
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
- type_ctor_layout = type_ctor_info->type_ctor_layout;
- type_ctor_functors = type_ctor_info->type_ctor_functors;
-
- compare_pred = type_ctor_info->compare_pred;
- info->non_canonical_type = ( compare_pred ==
- ENTRY(mercury__builtin_compare_non_canonical_type_3_0) );
+ Word layout_for_tag;
+ Word layout_vector_for_tag;
data_word = *data_word_ptr;
data_tag = MR_tag(data_word);
data_value = MR_body(data_word, data_tag);
-
- switch(type_ctor_info->type_ctor_rep) {
- case MR_TYPECTOR_REP_ENUM:
- case MR_TYPECTOR_REP_ENUM_USEREQ:
+ type_ctor_layout = type_ctor_info->type_ctor_layout;
layout_for_tag = type_ctor_layout[data_tag];
layout_vector_for_tag = MR_strip_tag(layout_for_tag);
- info->functor = MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
+ expand_info->functor =
+ MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
layout_vector_for_tag, data_word);
- info->arity = 0;
- info->num_extra_args = 0;
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ } else {
+ expand_info->functor = type_ctor_info->type_layout.layout_enum
+ [*data_word_ptr]->MR_enum_functor_name;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ }
break;
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
+ MR_TypeCtorLayout type_ctor_layout;
+ Word data_value;
+ Word data_word;
+ int data_tag;
+ Word layout_for_tag;
+ Word layout_vector_for_tag;
+
+ data_word = *data_word_ptr;
+ data_tag = MR_tag(data_word);
+ data_value = MR_body(data_word, data_tag);
+
+ type_ctor_layout = type_ctor_info->type_ctor_layout;
layout_for_tag = type_ctor_layout[data_tag];
layout_vector_for_tag = MR_strip_tag(layout_for_tag);
- tag_rep = MR_get_tag_representation((Word) layout_for_tag);
- switch (tag_rep) {
+
+ switch (MR_get_tag_representation((Word) layout_for_tag)) {
case MR_DISCUNIONTAG_SHARED_LOCAL:
data_value = MR_unmkbody(data_value);
- info->functor = MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
+ expand_info->functor =
+ MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
layout_vector_for_tag, data_value);
- info->arity = 0;
- info->num_extra_args = 0;
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
break;
case MR_DISCUNIONTAG_SHARED_REMOTE: {
@@ -2190,201 +2434,354 @@
case MR_DISCUNIONTAG_UNSHARED: /* fallthru */
{
int i;
- Word * functor_descriptor = (Word *) layout_vector_for_tag;
+ Word *functor_descriptor;
+ functor_descriptor = (Word *) layout_vector_for_tag;
- info->arity =
- MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(functor_descriptor);
+ expand_info->arity =
+ MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(
+ functor_descriptor);
- info->num_extra_args =
- MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_EXIST_VARCOUNT(functor_descriptor);
+ expand_info->num_extra_args =
+ MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_EXIST_VARCOUNT(
+ functor_descriptor);
- if (info->need_functor) {
- MR_make_aligned_string(info->functor,
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor,
MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_FUNCTOR_NAME(
functor_descriptor));
}
- if (info->need_args) {
- info->argument_vector = (Word *) data_value;
+ if (expand_info->need_args) {
+ expand_info->argument_vector = (Word *) data_value;
- info->type_info_vector = MR_GC_NEW_ARRAY(Word,
- info->arity);
+ expand_info->type_info_vector =
+ MR_GC_NEW_ARRAY(Word, expand_info->arity);
- for (i = 0; i < info->arity ; i++) {
+ for (i = 0; i < expand_info->arity ; i++) {
Word *arg_pseudo_type_info;
arg_pseudo_type_info = (Word *)
MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARGS(
functor_descriptor)[i];
- info->type_info_vector[i] =
+ expand_info->type_info_vector[i] =
(Word) MR_create_type_info_maybe_existq(
type_info, arg_pseudo_type_info,
(Word *) data_value,
+ type_ctor_info->type_ctor_version,
+ (const MR_DuFunctorDesc *)
functor_descriptor);
}
}
break;
}
}
+ } else {
+ const MR_DuPtagLayout *ptag_layout;
+ const MR_DuFunctorDesc *functor_desc;
+ const MR_DuExistInfo *exist_info;
+ int data;
+ int ptag;
+ int sectag;
+ Word *arg_vector;
+
+ data = *data_word_ptr;
+ ptag = MR_tag(data);
+ ptag_layout = type_ctor_info->type_layout.layout_du[ptag];
+
+ switch (ptag_layout->MR_sectag_locn) {
+ case MR_SECTAG_NONE:
+ functor_desc = ptag_layout->MR_sectag_alternatives[0];
+ arg_vector = (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 = (Word *) MR_body(data, ptag) + 1;
+ break;
+ }
+
+ expand_info->arity = functor_desc->MR_du_functor_orig_arity;
+
+ exist_info = functor_desc->MR_du_functor_exist_info;
+ if (exist_info != NULL) {
+ expand_info->num_extra_args =
+ exist_info->MR_exist_typeinfos_plain
+ + exist_info->MR_exist_tcis;
+ } else {
+ expand_info->num_extra_args = 0;
+ }
+
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor,
+ functor_desc->MR_du_functor_name);
+ }
+
+ if (expand_info->need_args) {
+ int i;
+
+ expand_info->argument_vector = arg_vector;
+ expand_info->type_info_vector = MR_GC_NEW_ARRAY(Word,
+ expand_info->arity);
+
+ for (i = 0; i < expand_info->arity; i++) {
+ expand_info->type_info_vector[i] =
+ (Word) MR_create_type_info_maybe_existq(
+ type_info, (Word *)
+ functor_desc->MR_du_functor_arg_types[i],
+ (Word *) MR_body(data, ptag),
+ type_ctor_info->type_ctor_version,
+ (const MR_DuFunctorDesc *) functor_desc);
+ }
+ }
+ }
break;
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
- {
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
+ MR_TypeCtorLayout type_ctor_layout;
+ Word data_value;
+ Word data_word;
+ int data_tag;
+ Word layout_for_tag;
+ Word layout_vector_for_tag;
+ Word *functor_descriptor;
int i;
- Word * functor_descriptor;
+ data_word = *data_word_ptr;
+ data_tag = MR_tag(data_word);
+ data_value = MR_body(data_word, data_tag);
+
+ type_ctor_layout = type_ctor_info->type_ctor_layout;
layout_for_tag = type_ctor_layout[data_tag];
layout_vector_for_tag = MR_strip_tag(layout_for_tag);
functor_descriptor = (Word *) layout_vector_for_tag;
data_value = (Word) data_word_ptr;
- info->arity = MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(
+ expand_info->arity =
+ MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(
functor_descriptor);
- info->num_extra_args = 0;
+ expand_info->num_extra_args = 0;
- if (info->need_functor) {
- MR_make_aligned_string(info->functor,
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor,
MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_FUNCTOR_NAME(
functor_descriptor));
}
- if (info->need_args) {
+ if (expand_info->need_args) {
/*
* A NO_TAG is much like UNSHARED, but we use the
* data_word_ptr here to simulate an argument
* vector.
*/
- info->argument_vector = (Word *) data_word_ptr;
+ expand_info->argument_vector = (Word *) data_word_ptr;
- info->type_info_vector = MR_GC_NEW_ARRAY(Word,
- info->arity);
+ expand_info->type_info_vector = MR_GC_NEW_ARRAY(Word,
+ expand_info->arity);
- for (i = 0; i < info->arity ; i++) {
+ for (i = 0; i < expand_info->arity ; i++) {
Word *arg_pseudo_type_info;
arg_pseudo_type_info = (Word *)
MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARGS(
functor_descriptor)[i];
- info->type_info_vector[i] =
+ expand_info->type_info_vector[i] =
(Word) MR_create_type_info_maybe_existq(
type_info, arg_pseudo_type_info,
(Word *) data_value,
- functor_descriptor);
+ type_ctor_info->type_ctor_version,
+ (const MR_DuFunctorDesc *) functor_descriptor);
}
}
- break;
+ } else {
+ expand_info->arity = 1;
+ expand_info->num_extra_args = 0;
+
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor,
+ type_ctor_info->type_layout.layout_notag
+ ->MR_notag_functor_name);
+ }
+
+ if (expand_info->need_args) {
+ expand_info->argument_vector = data_word_ptr;
+ expand_info->type_info_vector = MR_GC_NEW_ARRAY(Word, 1);
+ expand_info->type_info_vector[0] =
+ (Word) MR_create_type_info(
+ type_info, (Word *) type_ctor_info->type_layout.
+ layout_notag->MR_notag_functor_arg_type);
+ }
}
- case MR_TYPECTOR_REP_EQUIV: {
+ break;
+
+ case MR_TYPECTOR_REP_EQUIV:
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
+ MR_TypeCtorLayout type_ctor_layout;
+ Word data_value;
+ Word data_word;
+ int data_tag;
+ Word layout_for_tag;
+ Word layout_vector_for_tag;
Word *equiv_type_info;
+ data_word = *data_word_ptr;
+ data_tag = MR_tag(data_word);
+ data_value = MR_body(data_word, data_tag);
+
+ type_ctor_layout = type_ctor_info->type_ctor_layout;
layout_for_tag = type_ctor_layout[data_tag];
layout_vector_for_tag = MR_strip_tag(layout_for_tag);
equiv_type_info = MR_create_type_info(type_info, (Word *)
MR_TYPE_CTOR_LAYOUT_EQUIV_TYPE(layout_vector_for_tag));
- ML_expand(equiv_type_info, data_word_ptr, info);
- break;
+ ML_expand(equiv_type_info, data_word_ptr, expand_info);
+ } else {
+ Word *eqv_type_info;
+
+ eqv_type_info = MR_create_type_info(type_info,
+ (Word *) type_ctor_info->type_layout.layout_equiv);
+ ML_expand(eqv_type_info, data_word_ptr, expand_info);
}
- case MR_TYPECTOR_REP_EQUIV_VAR: {
+ break;
+
+ case MR_TYPECTOR_REP_EQUIV_VAR:
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
+ MR_TypeCtorLayout type_ctor_layout;
+ Word data_value;
+ Word data_word;
+ int data_tag;
+ Word layout_for_tag;
+ Word layout_vector_for_tag;
Word *equiv_type_info;
+ data_word = *data_word_ptr;
+ data_tag = MR_tag(data_word);
+ data_value = MR_body(data_word, data_tag);
+
+ type_ctor_layout = type_ctor_info->type_ctor_layout;
layout_for_tag = type_ctor_layout[data_tag];
layout_vector_for_tag = MR_strip_tag(layout_for_tag);
equiv_type_info = MR_create_type_info(type_info,
(Word *) layout_vector_for_tag);
- ML_expand(equiv_type_info, data_word_ptr, info);
- break;
+ ML_expand(equiv_type_info, data_word_ptr, expand_info);
+ } else {
+ /*
+ ** The current version of the RTTI gives all equivalence types
+ ** the EQUIV type_ctor_rep, not EQUIV_VAR.
+ */
+ fatal_error(""unexpected EQUIV_VAR type_ctor_rep"");
}
+ break;
+
case MR_TYPECTOR_REP_INT:
- if (info->need_functor) {
+ if (expand_info->need_functor) {
+ Word data_word;
char buf[500];
char *str;
+ data_word = *data_word_ptr;
sprintf(buf, ""%ld"", (long) data_word);
incr_saved_hp_atomic(LVALUE_CAST(Word, str),
(strlen(buf) + sizeof(Word)) / sizeof(Word));
strcpy(str, buf);
- info->functor = str;
+ expand_info->functor = str;
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_CHAR:
/* XXX should escape characters correctly */
- if (info->need_functor) {
+ if (expand_info->need_functor) {
+ Word data_word;
char *str;
+ data_word = *data_word_ptr;
incr_saved_hp_atomic(LVALUE_CAST(Word, str),
(3 + sizeof(Word)) / sizeof(Word));
sprintf(str, ""\'%c\'"", (char) data_word);
- info->functor = str;
+ expand_info->functor = str;
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_FLOAT:
- if (info->need_functor) {
+ if (expand_info->need_functor) {
+ Word data_word;
char buf[500];
Float f;
char *str;
+ data_word = *data_word_ptr;
f = word_to_float(data_word);
sprintf(buf, ""%#.15g"", f);
incr_saved_hp_atomic(LVALUE_CAST(Word, str),
(strlen(buf) + sizeof(Word)) / sizeof(Word));
strcpy(str, buf);
- info->functor = str;
+ expand_info->functor = str;
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_STRING:
/* XXX should escape characters correctly */
- if (info->need_functor) {
+ if (expand_info->need_functor) {
+ Word data_word;
char *str;
+ data_word = *data_word_ptr;
incr_saved_hp_atomic(LVALUE_CAST(Word, str),
(strlen((String) data_word) + 2 + sizeof(Word))
/ sizeof(Word));
sprintf(str, ""%c%s%c"", '""', (String) data_word, '""');
- info->functor = str;
+ expand_info->functor = str;
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_PRED:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<predicate>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor,
+ ""<<predicate>>"");
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
- case MR_TYPECTOR_REP_UNIV:
+ case MR_TYPECTOR_REP_UNIV: {
+ Word data_word;
/*
* Univ is a two word structure, containing
* type_info and data.
*/
+ data_word = *data_word_ptr;
ML_expand((Word *)
((Word *) data_word)[UNIV_OFFSET_FOR_TYPEINFO],
- &((Word *) data_word)[UNIV_OFFSET_FOR_DATA], info);
+ &((Word *) data_word)[UNIV_OFFSET_FOR_DATA], expand_info);
break;
+ }
case MR_TYPECTOR_REP_VOID:
/*
@@ -2394,126 +2791,128 @@
fatal_error(""ML_expand: cannot expand void types"");
case MR_TYPECTOR_REP_C_POINTER:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<c_pointer>>"");
- }
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor,
+ ""<<c_pointer>>"");
+ }
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_TYPEINFO:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<typeinfo>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor, ""<<typeinfo>>"");
}
/* XXX should we return the arguments here? */
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_TYPECLASSINFO:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<typeclassinfo>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor,
+ ""<<typeclassinfo>>"");
}
/* XXX should we return the arguments here? */
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_ARRAY:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<array>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor, ""<<array>>"");
}
/* XXX should we return the arguments here? */
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_SUCCIP:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<succip>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor, ""<<succip>>"");
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_HP:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<hp>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor, ""<<hp>>"");
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_CURFR:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<curfr>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor, ""<<curfr>>"");
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_MAXFR:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<maxfr>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor, ""<<maxfr>>"");
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_REDOFR:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<redofr>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor, ""<<redofr>>"");
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_REDOIP:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<redoip>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor, ""<<redoip>>"");
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_TRAIL_PTR:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<trail_ptr>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor, ""<<trail_ptr>>"");
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_TICKET:
- if (info->need_functor) {
- MR_make_aligned_string(info->functor, ""<<ticket>>"");
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor, ""<<ticket>>"");
}
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- info->num_extra_args = 0;
+ expand_info->argument_vector = NULL;
+ expand_info->type_info_vector = NULL;
+ expand_info->arity = 0;
+ expand_info->num_extra_args = 0;
break;
case MR_TYPECTOR_REP_UNKNOWN: /* fallthru */
@@ -2533,14 +2932,14 @@
ML_arg(Word term_type_info, Word *term_ptr, Word argument_index,
Word *arg_type_info, Word **argument_ptr)
{
- ML_Expand_Info info;
+ ML_Expand_Info expand_info;
Word arg_pseudo_type_info;
bool success;
- info.need_functor = FALSE;
- info.need_args = TRUE;
+ expand_info.need_functor = FALSE;
+ expand_info.need_args = TRUE;
- ML_expand((Word *) term_type_info, term_ptr, &info);
+ ML_expand((Word *) term_type_info, term_ptr, &expand_info);
/*
** Check for attempts to deconstruct a non-canonical type:
@@ -2550,16 +2949,16 @@
** (There ought to be a cc_multi version of arg/2
** that allows this.)
*/
- if (info.non_canonical_type) {
+ if (expand_info.non_canonical_type) {
fatal_error(""called argument/2 for a type with a ""
""user-defined equality predicate"");
}
/* Check range */
- success = (argument_index >= 0 && argument_index < info.arity);
+ success = (argument_index >= 0 && argument_index < expand_info.arity);
if (success) {
/* figure out the type of the argument */
- arg_pseudo_type_info = info.type_info_vector[argument_index];
+ arg_pseudo_type_info = expand_info.type_info_vector[argument_index];
if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info)) {
*arg_type_info =
((Word *) term_type_info)[arg_pseudo_type_info];
@@ -2567,14 +2966,14 @@
*arg_type_info = arg_pseudo_type_info;
}
- *argument_ptr = &info.argument_vector[argument_index];
+ *argument_ptr = &expand_info.argument_vector[argument_index];
}
/*
** Free the allocated type_info_vector, since we just copied
** the stuff we want out of it.
*/
- MR_GC_free(info.type_info_vector);
+ MR_GC_free(expand_info.type_info_vector);
return success;
}
@@ -2588,14 +2987,14 @@
:- pragma c_code(functor(Term::in, Functor::out, Arity::out),
will_not_call_mercury, "
{
- ML_Expand_Info info;
+ ML_Expand_Info expand_info;
- info.need_functor = TRUE;
- info.need_args = FALSE;
+ expand_info.need_functor = TRUE;
+ expand_info.need_args = FALSE;
save_transient_registers();
- ML_expand((Word *) TypeInfo_for_T, &Term, &info);
+ ML_expand((Word *) TypeInfo_for_T, &Term, &expand_info);
restore_transient_registers();
@@ -2607,16 +3006,16 @@
** (There ought to be a cc_multi version of functor/2
** that allows this.)
*/
- if (info.non_canonical_type) {
+ if (expand_info.non_canonical_type) {
fatal_error(""called functor/2 for a type with a ""
""user-defined equality predicate"");
}
/* Copy functor onto the heap */
MR_make_aligned_string(LVALUE_CAST(ConstString, Functor),
- info.functor);
+ expand_info.functor);
- Arity = info.arity;
+ Arity = expand_info.arity;
}").
/*
@@ -2706,17 +3105,17 @@
:- pragma c_code(deconstruct(Term::in, Functor::out, Arity::out,
Arguments::out), will_not_call_mercury, "
{
- ML_Expand_Info info;
+ ML_Expand_Info expand_info;
Word arg_pseudo_type_info;
Word Argument, tmp;
int i;
- info.need_functor = TRUE;
- info.need_args = TRUE;
+ expand_info.need_functor = TRUE;
+ expand_info.need_args = TRUE;
save_transient_registers();
- ML_expand((Word *) TypeInfo_for_T, &Term, &info);
+ ML_expand((Word *) TypeInfo_for_T, &Term, &expand_info);
restore_transient_registers();
@@ -2728,21 +3127,21 @@
** (There ought to be a cc_multi version of deconstruct/4
** that allows this.)
*/
- if (info.non_canonical_type) {
+ if (expand_info.non_canonical_type) {
fatal_error(""called deconstruct/4 for a type with a ""
""user-defined equality predicate"");
}
/* Get functor */
MR_make_aligned_string(LVALUE_CAST(ConstString, Functor),
- info.functor);
+ expand_info.functor);
/* Get arity */
- Arity = info.arity;
+ Arity = expand_info.arity;
/* Build argument list */
Arguments = MR_list_empty_msg(MR_PROC_LABEL);
- i = info.arity;
+ i = expand_info.arity;
while (--i >= 0) {
@@ -2754,7 +3153,7 @@
MR_PROC_LABEL);
/* Fill in the arguments */
- arg_pseudo_type_info = info.type_info_vector[i];
+ arg_pseudo_type_info = expand_info.type_info_vector[i];
if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info)) {
@@ -2771,14 +3170,14 @@
}
/* Fill in the data */
MR_field(MR_mktag(0), Argument, UNIV_OFFSET_FOR_DATA) =
- info.argument_vector[i + info.num_extra_args];
+ expand_info.argument_vector[i + expand_info.num_extra_args];
}
/* Free the allocated type_info_vector, since we just copied
* all its arguments onto the heap.
*/
- MR_GC_free(info.type_info_vector);
+ MR_GC_free(expand_info.type_info_vector);
}").
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list