[m-dev.] for review: cleanup of type_ctor_infos, part 0
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Feb 25 16:09:13 AEDT 2000
For review by Tyson.
The new data structures are not as compact as they could be. I have discussed
some techniques for compressing tnem with Tyson, and will implement those
techniques before this change is checked in, since this will avoid the
otherwise onerous requirement for bootstrapping again, but I will make
a relative diff available before then.
The diff to mercury_type_info.h is first, followed by the completely
rewritten base_type_{info,layout}.m (the new code for those two modules
is *way* smaller than their diffs).
Estimated hours taken: 60
Cleanup of the type_ctor_infos and their components, to achieve two goals.
First, the new data structure is defined in strongly typed C, with only
two unions, whereas the old data structure was defined by a bunch of macros
that used casts all over the place. The new design should therefore make it
significantly easier to debug code that uses RTTI, and to get it right in
the first place. Second, the new data structures are logically organized,
whereas the old ones had several bad features (such as fixed fields coming
after variable-length arrays in "structures") required by backward
compatibility.
For the time being, the runtime system will be able to handle type_ctor_infos
using both the old and the new data structures, which are distinguished by
the type_ctor_info's version number.
This change does not impact the structures of typeinfos, base_typeclass_infos
or typeclass_infos.
runtime/mercury_type_info.h:
Define the C types for the new type_ctor_info components.
Update the C type for type_ctor_infos themselves, and the macros
that act on it.
Centralize the list of files that depend on type info representation
here.
Make the names of the two macros that give the number of (all kinds of)
type info vars and the number of existential type info vars consistent.
runtime/mercury_std.h:
Change a comment to refer to one of these renamed macros by its new
name.
compiler/rtti.m:
compiler/rtti_out.m:
New files: rtti.m defines new types that allow us to construct
Mercury representations of the C structures we want to emit,
and rtti_out.m converts those representations to C definitions.
These files are intended to be independent of whether the backend
is LLDS or MLDS. At the moment, there are several vestiges that
tie them to LLDS, mostly due to (a) the lack of a shared common
infrastructure between llds_out.m and mlds_to_c.m, and (b)
the continued use of the old representation of (pseudo-) typeinfos
as rvals. These concerns will be addressed later.
compiler/llds.m:
Update the definition of the comp_gen_c_data and data_addr types
to account for the new RTTI structures.
compiler/llds_out.m:
Update the code to output comp_gen_c_data and data_addr values
to account for the new RTTI structures.
Make some parts of the code more modular, so that rtti_out.m
can use what used to be selected parts of predicates.
Export several predicates for use by rtti_out.m. Some of these
should later be moved to a file for infrastructure shared by
llds_out.m and mlds_to_*.m. Others should be made internal again
when the representation of typeinfos is made independent of the LLDS.
Rename some predicates to better reflect their purpose.
compiler/base_type_layout.m:
Complete rewrite for the new data structure; significantly smaller
than before.
Now invoked from base_type_info for the types for which layout info
is pertinent, whereas in the old design it was invoked from
mercury_compile on all types, even types not defined in Mercury.
compiler/base_type_info.m:
Significant rewrite for the new data structure.
Invoke base_type_layout.m as necessary, since the structures it creates
are parts of the type_ctor_infos.
Do not invoke base_typeclass_info.m, since the structures it creates
are not parts of the type_ctor_infos.
compiler/ml_base_type_info.m:
Comment out obsolete unfinished code. It should be replaced by
calls to base_type_info, once base_type_info's dependence on LLDS
has been eliminated.
compiler/hlds_module.m:
Rename the data structure from which type_ctor_infos are generated.
Delete the data structure from which type_ctor_layouts were generated,
since it is redundant.
Switch to using field names.
compiler/make_tags.m:
compiler/hlds_data.m:
make_tags.m had code that duplicated much of the the functionality
of an existing predicate in hlds_data.m. This change moves that
predicate to hlds_data where it belongs, and gives it an appropriate
name.
compiler/mercury_compile.m:
Do not invoke base_type_layouts directly; let base_type_infos do it
for the types for which it is appropriate.
Do invoke base_typeclass_info directly.
compiler/dead_proc_elim.m:
compiler/llds_common.m:
compiler/opt_debug.m:
compiler/stack_layout.m:
compiler/unify_gen.m:
Trivial changes to conform to the changes in the representation of
compiler-generated C data.
runtime/mercury_deep_copy_body.h:
runtime/mercury_tabling.c:
runtime/mercury_type_info.c:
Provide alternate implementations of functionality that used the
old functors and layout structures, to use the new ones instead
if the relevant type_ctor_info's version number calls for it.
In many cases, doing this cleanly required reducing the scopes of
variables.
runtime/mercury_tabling.[ch]:
Note where additional work on tabling of typeclass infos is needed,
but do not do the work yet, since it would conflict with DJ's coming
change.
library/std_util.m:
Provide alternate implementations of functionality that used the
old functors and layout structures, to use the new ones instead
if the relevant type_ctor_info's version number calls for it.
In many cases, doing this cleanly required reducing the scopes of
variables.
The predicates get_functor and construct take an integer argument
that identifies a functor of a du type. The integer used to be
the functor's ordinal number in the type definition, but this
was not documented. It is now the functor's position in the list
of the type's functors sorted first on name and then on arity.
This functionality is potentially more useful, since io__read
could do binary instead of linear search when looking for a given
functor. This is an incompatibility, but a very minor one.
Rename the two different kinds of variables named "info" so that
one can tell them apart.
tests/hard_coded/construct.exp:
Update the expected output of this test based on the new definition
of the meaning of functor numbers in the get_functor and construct
predicates in std_util.
tests/hard_coded/existential_rtti.{m,exp}:
Make the test case print out results as it goes along, to make it
easier which subtask a core dump is coming from. Update the expected
output accordingly.
Zoltan.
Index: mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.39
diff -u -b -r1.39 mercury_type_info.h
--- mercury_type_info.h 2000/01/19 09:45:23 1.39
+++ mercury_type_info.h 2000/02/25 04:52:14
@@ -10,12 +10,19 @@
** type_functors tables generated by the Mercury compiler.
** Also contains definitions for accessing the Mercury `univ' type.
**
-** Changes here may also require changes in:
+** Changes to the structures of type_infos and pseudo_type_infos
+** may also require changes in:
**
-** compiler/base_type_info.m
-** compiler/base_type_layout.m
** compiler/polymorphism.m
** compiler/higher_order.m
+** compiler/base_type_layout.m
+**
+** Changes to the structures of type_ctor_infos may require changes in:
+**
+** compiler/base_type_info.m
+** compiler/base_type_layout.m
+** compiler/rtti.m
+** compiler/rtti_out.m
** (for updating the compiler-generated RTTI
** structures)
**
@@ -24,9 +31,16 @@
** library/private_builtin.m
** library/std_util.m
** runtime/mercury_bootstrap.c
-** runtime/mercury_type_info.c
** (for updating the hand-written RTTI
** structures)
+**
+** Both kinds of changes will of course also require changes to the code
+** that traverses type_infos and type_ctor_infos:
+**
+** runtime/mercury_deep_copy*.[ch]
+** runtime/mercury_tabling.c
+** runtime/mercury_type_info.c
+** library/std_util.m
*/
#ifndef MERCURY_TYPE_INFO_H
@@ -46,13 +60,14 @@
** structure, it makes it easier to bootstrap changes to the data
** structures used for RTTI.
**
-** This number should be kept in sync with type_ctor_info_version in
+** This number should be kept in sync with type_ctor_info_rtti_version in
** compiler/base_type_info.m.
*/
-#define MR_RTTI_VERSION MR_RTTI_VERSION__USEREQ
+#define MR_RTTI_VERSION MR_RTTI_VERSION__CLEAN_LAYOUT
#define MR_RTTI_VERSION__INITIAL 2
#define MR_RTTI_VERSION__USEREQ 3
+#define MR_RTTI_VERSION__CLEAN_LAYOUT 4
/*
** Check that the RTTI version is in a sensible range.
@@ -64,18 +79,49 @@
#define MR_TYPE_CTOR_INFO_CHECK_RTTI_VERSION_RANGE(typector) \
assert(MR_RTTI_VERSION__USEREQ <= typector->type_ctor_version \
- && typector->type_ctor_version <= MR_RTTI_VERSION__USEREQ)
+ && typector->type_ctor_version <= MR_RTTI_VERSION__CLEAN_LAYOUT)
/*---------------------------------------------------------------------------*/
/*
** For now, we don't give a C definition of the structures of typeinfos
** and pseudotypeinfos. We may change this later.
+**
+** A pseudotypeinfo is the same as a typeinfo (see polymorphism.m) but
+** may also store free type variables, represented as small integers:
+** 1 to 512 represent universally quantified type variables
+** and 513 to 1024 represent existentially quantified type variables.
+** (We do not use zero to, for two reasons. First, variable numbering
+** starts at one inside the compiler. Second, starting at one allows us
+** to use universally quantified type variable numbers to be used directly
+** as the offset into a (non-higher-order) typeinfo.
+**
+** This scheme relies on the bit patterns of these integers corresponding
+** to memory that is either inaccessible (due to the first page of virtual
+** memory being invalid) or is guaranteed to contains something other than
+** type_ctor_info structures (such as the code of the program).
+**
+** MR_PSEUDOTYPEINFO_EXIST_VAR_BASE should be kept in sync with
+** base_type_layout__pseudo_typeinfo_min_exist_var in base_type_layout.m.
+**
+** MR_PSEUDOTYPEINFO_MAX_VAR should be kept in sync with
+** base_type_layout__pseudo_typeinfo_max_var in base_type_layout.m,
+** and with the default value of MR_VARIABLE_SIZED in mercury_conf_params.h.
*/
typedef Word MR_TypeInfo;
typedef Word MR_PseudoTypeInfo;
+#define MR_PSEUDOTYPEINFO_EXIST_VAR_BASE 512
+#define MR_PSEUDOTYPEINFO_MAX_VAR 1024
+
+#define TYPEINFO_IS_VARIABLE(T) ( (Unsigned) T <= MR_PSEUDOTYPEINFO_MAX_VAR )
+
+#define MR_TYPE_VARIABLE_IS_EXIST_QUANT(T) \
+ ( (Word) (T) > MR_PSEUDOTYPEINFO_EXIST_VAR_BASE )
+#define MR_TYPE_VARIABLE_IS_UNIV_QUANT(T) \
+ ( (Word) (T) <= MR_PSEUDOTYPEINFO_EXIST_VAR_BASE )
+
/*---------------------------------------------------------------------------*/
/*
@@ -137,6 +183,8 @@
** is intended for handwritten code. Compiler generated
** code can (and does) just create two rvals instead of one.
**
+** XXX This stuff is part of USEREQ type_ctor_infos and is obsolete;
+** it is needed now only for bootstrapping.
*/
/*
@@ -160,7 +208,7 @@
#define MR_DECLARE_STRUCT(T) \
extern const struct T##_struct T
#define MR_DECLARE_TYPE_CTOR_INFO_STRUCT(T) \
- extern const struct MR_TypeCtorInfo_struct T
+ extern const struct MR_TypeCtorInfo_Struct T
/*---------------------------------------------------------------------------*/
@@ -171,6 +219,9 @@
** C code.
**
** Some of the type-layout tags are shared.
+**
+** XXX This stuff is part of USEREQ type_ctor_infos and is obsolete;
+** it is needed now only for bootstrapping.
*/
#define TYPE_CTOR_LAYOUT_CONST_TAG 0
@@ -192,8 +243,8 @@
** Changes in this type may need to be reflected in
** compiler/base_type_layout.m.
**
-** XXX Much of the information in this type is now stored in TypeCtorRep;
-** it is here only temporarily.
+** XXX This stuff is part of USEREQ type_ctor_infos and is obsolete;
+** it is needed now only for bootstrapping.
*/
enum MR_TypeLayoutValue {
@@ -214,33 +265,6 @@
};
/*
-** Highest allowed type variable number
-** (corresponds with argument number of type parameter).
-**
-** Should be kept in sync with the default value of MR_VARIABLE_SIZED
-** in mercury_conf_params.h.
-*/
-
-#define TYPE_CTOR_LAYOUT_MAX_VARINT 1024
-
-#define TYPEINFO_IS_VARIABLE(T) ( (Word) T <= TYPE_CTOR_LAYOUT_MAX_VARINT )
-
-/*
-** The number above or equal to which a type variable is considered to be
-** existentially quantified.
-**
-** Should be kept in sync with existential_var_base in
-** compiler/base_type_layout.m
-*/
-
-#define MR_EXISTENTIAL_VAR_BASE 512
-
-#define MR_TYPE_VARIABLE_IS_EXIST_QUANT(T) \
- ( (Word) (T) > MR_EXISTENTIAL_VAR_BASE )
-#define MR_TYPE_VARIABLE_IS_UNIV_QUANT(T) \
- ( (Word) (T) <= MR_EXISTENTIAL_VAR_BASE )
-
-/*
** This constant is also used for other information - for
** ctor infos a small integer is used for higher order types.
** Even integers represent preds, odd represent functions.
@@ -260,7 +284,7 @@
(T == MR_TYPE_CTOR_INFO_HO_FUNC || T == MR_TYPE_CTOR_INFO_HO_PRED)
#define MR_TYPECTOR_IS_HIGHER_ORDER(T) \
- ( (Word) T <= TYPE_CTOR_LAYOUT_MAX_VARINT )
+ ( (Word) T <= MR_PSEUDOTYPEINFO_MAX_VAR )
#define MR_TYPECTOR_MAKE_PRED(Arity) \
( (Word) ((Integer) (Arity) * 2) )
#define MR_TYPECTOR_MAKE_FUNC(Arity) \
@@ -409,6 +433,9 @@
/*
** Macros and defintions for defining and dealing with
** type_ctor_functors.
+**
+** XXX This stuff is part of USEREQ type_ctor_infos and is obsolete;
+** it is needed now only for bootstrapping.
*/
/*
@@ -495,6 +522,9 @@
** - the functor descriptor, describing a single functor
** - the enum_vector, describing an enumeration
** - the no_tag_vector, describing a single functor
+**
+** XXX This stuff is part of USEREQ type_ctor_infos and is obsolete;
+** it is needed now only for bootstrapping.
*/
/*
@@ -701,36 +731,7 @@
/*---------------------------------------------------------------------------*/
-int MR_compare_type_info(Word, Word);
-Word MR_collapse_equivalences(Word);
-
/*
-** Functions for creating type_infos from pseudo_type_infos.
-** See mercury_type_info.c for documentation on these.
-*/
-
-Word * MR_create_type_info(const Word *, const Word *);
-Word * MR_create_type_info_maybe_existq(const Word *, const Word *,
- const Word *, const Word *);
-
-/* for MR_make_type_info(), we keep a list of allocated memory cells */
-struct MR_MemoryCellNode {
- void *data;
- struct MR_MemoryCellNode *next;
-};
-
-typedef struct MR_MemoryCellNode *MR_MemoryList;
-
-Word * MR_make_type_info(const Word *term_type_info,
- const Word *arg_pseudo_type_info, MR_MemoryList *allocated);
-Word * MR_make_type_info_maybe_existq(const Word *term_type_info,
- const Word *arg_pseudo_type_info, const Word *data_value,
- const Word *functor_descriptor, MR_MemoryList *allocated) ;
-void MR_deallocate(MR_MemoryList allocated_memory_cells);
-
-/*---------------------------------------------------------------------------*/
-
-/*
** Definitions and functions for categorizing data representations.
*/
@@ -740,12 +741,9 @@
** MR_TYPE_CTOR_REP_DU_USEREQ, the exact representation depends on the tag
** value -- lookup the tag value in type_ctor_layout to find out this
** information.
-**
-** This enum should be kept in sync with base_type_info__type_ctor_rep_to_int
-** in compiler/base_type_info.m.
*/
-typedef enum MR_TypeCtorRepresentation {
+typedef enum {
MR_TYPECTOR_REP_ENUM,
MR_TYPECTOR_REP_ENUM_USEREQ,
MR_TYPECTOR_REP_DU,
@@ -778,7 +776,7 @@
** MR_CTOR_REP_STATS depends on this.
*/
MR_TYPECTOR_REP_UNKNOWN
-} MR_TypeCtorRepresentation;
+} MR_TypeCtorRep;
#define MR_type_ctor_rep_is_basically_du(rep) \
( ((rep) == MR_TYPECTOR_REP_ENUM) \
@@ -789,7 +787,7 @@
|| ((rep) == MR_TYPECTOR_REP_NOTAG_USEREQ) )
/*
-** If the MR_TypeCtorRepresentation is MR_TYPE_CTOR_REP_DU{,_USEREQ},
+** If the MR_TypeCtorRep is MR_TYPE_CTOR_REP_DU{,_USEREQ},
** we have a discriminated union type which is not a no-tag type or
** an enumeration. Each tag may have a different representation.
*/
@@ -809,11 +807,260 @@
/*---------------------------------------------------------------------------*/
-/* XXX these typedefs should include const [zs, 14 Sep 1999] */
typedef Word * MR_TypeCtorFunctors;
typedef Word * MR_TypeCtorLayout;
/*
+ ** Macros for retrieving things from type_ctor_infos.
+ **
+ ** XXX zs: these macros should be deleted; the code using them
+ ** would be clearer if it referred to TypeCtorInfo fields directly.
+ */
+
+#define MR_TYPE_CTOR_INFO_GET_TYPE_ARITY(TypeCtorInfo) \
+ ((TypeCtorInfo)->arity)
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** XXX The sizes of the Integers below requires more thought;
+** 16 bits may be enough for some fields, and 32 for the others.
+*/
+
+/*
+** The argument number gives the offset in the cell (in a form in which
+** it can be given to the MR_field macro directly) of either of the typeinfo
+** itself or of the typeclassinfo containing the typeinfo. If the former,
+** the offset field will be negative; otherwise, it will be an integer
+** which can be given as a second argument to the MR_typeclass_info_type_info
+** macro.
+*/
+
+typedef struct {
+ MR_int_least16_t MR_exist_arg_num;
+ MR_int_least16_t MR_exist_offset_in_tci;
+} MR_DuExistLocn;
+
+/*
+** This structure contains information about the typeinfos of the
+** existentially quantified type variables occurring in the types of some
+** of the arguments of a functor in a du type.
+**
+** The num_typeinfos_plain gives the number of typeinfos directly inserted
+** at the start of the memory cell of the functor, while the num_tcis field
+** gives the number of typeclassinfos inserted after them. The arguments
+** visible to the programmer start after these two blocks, which means that
+** when accessing them, one must add the sum of num_typeinfos_plain and
+** num_tcis to the visible argument number in order to arrive at an offset
+** in the cell.
+**
+** It is possible for a typeclassinfo to contain more than one type variable.
+** The num_typeinfos_in_tci field contains the total number of typeinfos stored
+** inside the typeclassinfos of the cell.
+**
+** The typeinfo_locns field points to an array of MR_ExistTypeInfoLocns.
+** This array has num_typeinfos_plain + num_typeinfos_in_tci elements,
+** each one of which describes the location (directly in the cell or indirectly
+** inside a typeclassinfo) of the typeinfo for an existentially quantified
+** type variable. The typeinfo for type variable N will be at the offset
+** N - MR_PSEUDOTYPEINFO_EXIST_VAR_BASE - 1. (The one is subtracted to convert
+** from type var numbering, which starts at 1, to array offset numbering).
+*/
+
+typedef struct {
+ Integer MR_exist_typeinfos_plain;
+ Integer MR_exist_typeinfos_in_tci;
+ Integer MR_exist_tcis;
+ const MR_DuExistLocn *MR_exist_typeinfo_locns;
+} MR_DuExistInfo;
+
+/*
+** This type describes the implementation of a function symbol
+** from a (proper) discriminated union type, whether it has standard
+** or user-defined-equality.
+**
+** Functor descriptors are reachable from both the layout and functor tables.
+** They all the information one may need about the function symbol, even
+** though some of this information may be redundant along some access paths.
+**
+** The fields that you are likely to be interested in when you arrive at the
+** functor descriptor through the functor table are clustered at the front,
+** the fields that you are likely to be interested in when you arrive at the
+** functor descriptor through the layout table are clustered at the back.
+** This is an attempt to optimize cache effectiveness.
+**
+** The primary and secondary fields give the corresponding tag values, and
+** the sectag_locn field gives the location of the secondary tag.
+**
+** The ordinal field gives the position of the function symbol in the
+** list of function symbols of the type; one function symbol compares
+** as less than another iff its ordinal number is smaller.
+**
+** The orig_arity field records the visible arity of the functor, without
+** the typeinfos and/or typeclass_infos added for existentially typed
+** arguments.
+**
+** The arg_types field points to an array of pseudo typeinfos, one for each
+** visible argument.
+**
+** The arg_name field points to an array of field names, one for each
+** visible argument. If no argument has a name, this field will be NULL.
+**
+** If the functor has any arguments whose types include existentially
+** quantified type variables, the exist_info field will point to information
+** about those type variable; otherwise, the exist_info field will be NULL.
+*/
+
+typedef enum {
+ MR_SECTAG_NONE,
+ MR_SECTAG_LOCAL,
+ MR_SECTAG_REMOTE
+} MR_Sectag_Locn;
+
+typedef struct {
+ ConstString MR_du_functor_name;
+ Integer MR_du_functor_primary;
+ Integer MR_du_functor_secondary;
+ MR_Sectag_Locn MR_du_functor_sectag_locn;
+ Integer MR_du_functor_ordinal;
+ Integer MR_du_functor_orig_arity;
+ MR_PseudoTypeInfo *MR_du_functor_arg_types;
+ const ConstString *MR_du_functor_arg_names;
+ const MR_DuExistInfo *MR_du_functor_exist_info;
+} MR_DuFunctorDesc;
+
+/*---------------------------------------------------------------------------*/
+
+typedef struct {
+ ConstString MR_enum_functor_name;
+ Integer MR_enum_functor_ordinal;
+} MR_EnumFunctorDesc;
+
+/*---------------------------------------------------------------------------*/
+
+typedef struct {
+ ConstString MR_notag_functor_name;
+ MR_PseudoTypeInfo MR_notag_functor_arg_type;
+} MR_NotagFunctorDesc;
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** This type describes the function symbols that share the same primary tag.
+** The sharers field gives their number, and thus also the size
+** of the array of pointers to functor descriptors pointed to by the
+** alternatives field.
+**
+** The intention is that if you have a word in a DU type that you want to
+** interpret, you compute its primary tag and find its MR_DuPtagLayout.
+** You then look at the locn field. If it is MR_SECTAG_NONE, you index
+** the alternatives field with zero; if it is MR_SECTAG_{LOCAL,REMOTE}, you
+** compute the secondary tag and index the alternatives field with that.
+**
+** A value of type MR_DuTypeLayout points to an array of size MR_PTAG_VALUES,
+** each element of which points to the MR_DuPtagLayout structure for the
+** ptag value given by the index.
+**
+** XXX maybe the array should contain the structures themselves, not pointers.
+*/
+
+typedef struct {
+ Integer MR_sectag_sharers;
+ MR_Sectag_Locn MR_sectag_locn;
+ MR_DuFunctorDesc **MR_sectag_alternatives;
+} MR_DuPtagLayout;
+
+#define MR_PTAG_VALUES (1 << LOW_TAG_BITS)
+
+typedef MR_DuPtagLayout **MR_DuTypeLayout;
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** This type describes the function symbols in an enum type.
+**
+** An MR_EnumLayout points to an array of pointers to functor descriptors.
+** There is one pointer for each function symbol, and thus the size of
+** the array is given by the num_functors field of the type_ctor_info.
+** The array is ordered on the integer value by which the functor is
+** represented.
+**
+** The intention is that if you have a word in an enum type that you want to
+** interpret, you index into the array with the word.
+*/
+
+typedef MR_EnumFunctorDesc **MR_EnumTypeLayout;
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** This type describes the single function symbol in a notag type.
+**
+** An MR_NotagLayout points to the one functor descriptor of the type.
+**
+** The intention is that if you have a word in a notag type that you want to
+** interpret, you look at the given functor descriptor.
+*/
+
+typedef MR_NotagFunctorDesc *MR_NotagTypeLayout;
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** This type describes the identity of the type that an equivalence type
+** is equivalent to, and hence its layout.
+**
+** An MR_NotagLayout gives the pseudo typeinfo of the type that this type
+** is equivalent to.
+**
+** The intention is that if you have a word in an equivalence type that you
+** want to interpret, you expand the pseudo typeinfo into a real typeinfo,
+** use that to interpret the word.
+*/
+
+typedef MR_PseudoTypeInfo MR_EquivLayout;
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** This type describes the layout in any kind of discriminated union
+** type: du, enum and notag. In an equivalence type, it gives the identity
+** of the equivalent-to type.
+*/
+
+typedef union {
+ Integer layout_init;
+ MR_DuTypeLayout layout_du;
+ MR_EnumTypeLayout layout_enum;
+ MR_NotagTypeLayout layout_notag;
+ MR_EquivLayout layout_equiv;
+} MR_TypeLayout;
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** This type describes the function symbols in any kind of discriminated union
+** type: du, enum and notag.
+**
+** The pointer points to an array of pointers to functor descriptors.
+** There is one pointer for each function symbol, and thus the size of
+** the array is given by the num_alternatives field of the type_ctor_info.
+** The array is ordered on the name of the function symbol, and then on arity.
+**
+** The intention is that if you have a function symbol you want to represent,
+** you can do binary search on the array for the symbol name and arity.
+*/
+
+typedef union {
+ Integer functors_init;
+ MR_DuFunctorDesc **functors_du;
+ MR_EnumFunctorDesc **functors_enum;
+ MR_NotagFunctorDesc *functors_notag;
+} MR_TypeFunctors;
+
+/*---------------------------------------------------------------------------*/
+
+ /*
** Structs defining the structure of type_ctor_infos.
** A type_ctor_info describes the structure of a particular
** type constructor. One of these is generated for every
@@ -822,56 +1069,50 @@
** The offsets of the fields in this structure must match the
** offset macros defines near the top of this file.
*/
+
+#define MR_TypeCtorInfo_struct MR_TypeCtorInfo_Struct
-struct MR_TypeCtorInfo_struct {
+struct MR_TypeCtorInfo_Struct {
Integer arity;
Code *unify_pred;
Code *index_pred;
Code *compare_pred;
- /*
- ** The representation that is used for this type
- ** constructor -- e.g. an enumeration, or a builtin
- ** type, or a no-tag type, etc.
- */
- MR_TypeCtorRepresentation type_ctor_rep;
- /*
- ** The names, arity and argument types of all the
- ** functors of this type if it is some sort of
- ** discriminated union.
- */
+ MR_TypeCtorRep type_ctor_rep;
+/*
+** The type_ctor_functors and type_ctor_layout fields have been replaced
+** by the type_ctor_num_functors, type_functors and type_layout fields.
+** They are present only for backward compatibility. Once that is not needed
+** anymore, those two slots will contain stuff for HAL:
+**
+** Code *solver_pred;
+** Code *init_pred;
+*/
MR_TypeCtorFunctors type_ctor_functors;
- /*
- ** The meanings of the primary tags of this type,
- ** if it is a discriminated union.
- */
MR_TypeCtorLayout type_ctor_layout;
- String type_ctor_module_name;
- String type_ctor_name;
+ ConstString type_ctor_module_name;
+ ConstString type_ctor_name;
Integer type_ctor_version;
+ Integer type_ctor_num_functors;
+ MR_TypeFunctors type_functors;
+ MR_TypeLayout type_layout;
+ union MR_TableNode_Union **type_std_table;
+ Code *prettyprinter;
};
-typedef struct MR_TypeCtorInfo_struct *MR_TypeCtorInfo;
-
- /*
- ** Macros for retrieving things from type_ctor_infos.
- **
- ** XXX zs: these macros should be deleted; the code using them
- ** would be clearer if it referred to TypeCtorInfo fields directly.
- */
+typedef struct MR_TypeCtorInfo_Struct *MR_TypeCtorInfo;
-#define MR_TYPE_CTOR_INFO_GET_TYPE_ARITY(TypeCtorInfo) \
- ((TypeCtorInfo)->arity)
+/*---------------------------------------------------------------------------*/
- /*
- ** Macros to help the runtime and the library create type_ctor_info
- ** structures for builtin and special types.
- */
+/*
+** Macros to help the runtime and the library create type_ctor_info
+** structures for builtin and special types.
+*/
#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(m, cm, n, a, cr, u, i, c) \
Declare_entry(u); \
Declare_entry(i); \
Declare_entry(c); \
- MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_struct \
+ MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct \
MR_PASTE6(mercury_data_, cm, __type_ctor_info_, n, _, a) = { \
a, \
MR_MAYBE_STATIC_CODE(ENTRY(u)), \
@@ -882,7 +1123,12 @@
NULL, \
MR_string_const(MR_STRINGIFY(m), sizeof(MR_STRINGIFY(m))-1),\
MR_string_const(MR_STRINGIFY(n), sizeof(MR_STRINGIFY(n))-1),\
- MR_RTTI_VERSION \
+ MR_RTTI_VERSION, \
+ -1, \
+ { 0 }, \
+ { 0 }, \
+ NULL, \
+ NULL \
}
#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(m, n, a, cr, u, i, c) \
@@ -899,5 +1145,42 @@
mercury__unused_0_0, \
mercury__unused_0_0, \
mercury__unused_0_0)
+
+/*---------------------------------------------------------------------------*/
+
+extern int MR_compare_type_info(Word, Word);
+extern Word MR_collapse_equivalences(Word);
+
+/*
+** Functions for creating type_infos from pseudo_type_infos.
+** See mercury_type_info.c for documentation on these.
+*/
+
+extern Word *MR_create_type_info(const Word * term_type_info,
+ const Word *arg_pseudo_type_info);
+extern Word *MR_create_type_info_maybe_existq(const Word *term_type_info,
+ const Word *arg_pseudo_type_info,
+ const Word *data_value, int rtti_version,
+ const MR_DuFunctorDesc *functor_descriptor);
+
+/* for MR_make_type_info(), we keep a list of allocated memory cells */
+struct MR_MemoryCellNode {
+ void *data;
+ struct MR_MemoryCellNode *next;
+};
+
+typedef struct MR_MemoryCellNode *MR_MemoryList;
+
+extern Word *MR_make_type_info(const Word *term_type_info,
+ const Word *arg_pseudo_type_info,
+ MR_MemoryList *allocated);
+extern Word *MR_make_type_info_maybe_existq(const Word *term_type_info,
+ const Word *arg_pseudo_type_info,
+ const Word *data_value, int rtti_version,
+ const MR_DuFunctorDesc *functor_descriptor,
+ MR_MemoryList *allocated) ;
+extern void MR_deallocate(MR_MemoryList allocated_memory_cells);
+
+/*---------------------------------------------------------------------------*/
#endif /* not MERCURY_TYPEINFO_H */
%---------------------------------------------------------------------------%
% Copyright (C) 1996-2000 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: base_type_info.m.
% Author: zs.
%
% This module is responsible for the generation of the static type_ctor_info
% structures of the types defined by the current module.
%
% Since it is possible for the type_ctor_info of a type local to the module
% not to be referred to anywhere in the module (and therefore, not to be
% referred to anywhere in the program), this module works in two stages.
% In the first stage, it inserts type_ctor_gen_info structures describing the
% type_ctor_infos of all the locally-defined types into the HLDS; some of
% these type_ctor_gen_infos are later eliminated by dead_proc_elim.m. The
% second stage then generates LLDS descriptions of type_ctor_infos from the
% surviving type_ctor_gen_infos.
%
% XXX See polymorphism.m for a description of the various ways to represent
% type information, including a description of the type_ctor_info structures.
%
% WARNING: if you change this module, you will probably need to also
% change ml_base_type_info.m, which does the same thing for the MLDS
% back-end.
%
%---------------------------------------------------------------------------%
:- module base_type_info.
:- interface.
:- import_module hlds_module, llds.
:- import_module list.
:- pred base_type_info__generate_hlds(module_info::in, module_info::out)
is det.
:- pred base_type_info__generate_llds(module_info::in, module_info::out,
list(comp_gen_c_data)::out) is det.
:- implementation.
:- import_module rtti, base_type_layout.
:- import_module prog_data, prog_util, prog_out.
:- import_module hlds_data, hlds_pred, hlds_out.
:- import_module code_util, special_pred, type_util, globals, options.
:- import_module bool, string, map, std_util, require.
%---------------------------------------------------------------------------%
base_type_info__generate_hlds(ModuleInfo0, ModuleInfo) :-
module_info_name(ModuleInfo0, ModuleName),
module_info_types(ModuleInfo0, TypeTable),
map__keys(TypeTable, TypeIds),
base_type_info__gen_type_ctor_gen_infos(TypeIds, TypeTable, ModuleName,
ModuleInfo0, TypeCtorGenInfos),
module_info_set_type_ctor_gen_infos(ModuleInfo0, TypeCtorGenInfos,
ModuleInfo).
% Given a list of the ids of all the types in the type table,
% find the types defined in this module, and return a type_ctor_gen_info
% for each.
:- pred base_type_info__gen_type_ctor_gen_infos(list(type_id)::in,
type_table::in, module_name::in, module_info::in,
list(type_ctor_gen_info)::out) is det.
base_type_info__gen_type_ctor_gen_infos([], _, _, _, []).
base_type_info__gen_type_ctor_gen_infos([TypeId | TypeIds], TypeTable,
ModuleName, ModuleInfo, TypeCtorGenInfos) :-
base_type_info__gen_type_ctor_gen_infos(TypeIds, TypeTable, ModuleName,
ModuleInfo, TypeCtorGenInfos1),
TypeId = SymName - TypeArity,
(
SymName = qualified(TypeModuleName, TypeName),
(
TypeModuleName = ModuleName,
map__lookup(TypeTable, TypeId, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, TypeBody),
TypeBody \= abstract_type,
\+ type_id_has_hand_defined_rtti(TypeId)
->
base_type_info__gen_type_ctor_gen_info(TypeId,
TypeName, TypeArity, TypeDefn,
ModuleName, ModuleInfo, TypeCtorGenInfo),
TypeCtorGenInfos = [TypeCtorGenInfo | TypeCtorGenInfos1]
;
TypeCtorGenInfos = TypeCtorGenInfos1
)
;
SymName = unqualified(TypeName),
string__append_list(["unqualified type ", TypeName,
"found in type_ctor_info"], Msg),
error(Msg)
).
:- pred base_type_info__gen_type_ctor_gen_info(type_id::in, string::in,
int::in, hlds_type_defn::in, module_name::in, module_info::in,
type_ctor_gen_info::out) is det.
base_type_info__gen_type_ctor_gen_info(TypeId, TypeName, TypeArity, TypeDefn,
ModuleName, ModuleInfo, TypeCtorGenInfo) :-
hlds_data__get_type_defn_status(TypeDefn, Status),
module_info_get_special_pred_map(ModuleInfo, SpecMap),
map__lookup(SpecMap, unify - TypeId, UnifyPredId),
special_pred_mode_num(unify, UnifyProcInt),
proc_id_to_int(UnifyProcId, UnifyProcInt),
MaybeUnify = yes(proc(UnifyPredId, UnifyProcId)),
map__lookup(SpecMap, index - TypeId, IndexPredId),
special_pred_mode_num(index, IndexProcInt),
proc_id_to_int(IndexProcId, IndexProcInt),
MaybeIndex = yes(proc(IndexPredId, IndexProcId)),
map__lookup(SpecMap, compare - TypeId, ComparePredId),
special_pred_mode_num(compare, CompareProcInt),
proc_id_to_int(CompareProcId, CompareProcInt),
MaybeCompare = yes(proc(ComparePredId, CompareProcId)),
TypeCtorGenInfo = type_ctor_gen_info(TypeId, ModuleName,
TypeName, TypeArity, Status, TypeDefn,
MaybeUnify, MaybeIndex, MaybeCompare,
no, no, no).
%---------------------------------------------------------------------------%
base_type_info__generate_llds(ModuleInfo0, ModuleInfo, Tables) :-
module_info_type_ctor_gen_infos(ModuleInfo0, TypeCtorGenInfos),
base_type_info__construct_type_ctor_infos(TypeCtorGenInfos,
ModuleInfo0, ModuleInfo, [], Dynamic0, [], Static0),
list__map(llds__wrap_rtti_data, Dynamic0, Dynamic),
list__map(llds__wrap_rtti_data, Static0, Static),
list__append(Dynamic, Static, Tables).
:- pred base_type_info__construct_type_ctor_infos(
list(type_ctor_gen_info)::in, module_info::in, module_info::out,
list(rtti_data)::in, list(rtti_data)::out,
list(rtti_data)::in, list(rtti_data)::out) is det.
base_type_info__construct_type_ctor_infos([], ModuleInfo, ModuleInfo,
Dynamic, Dynamic, Static, Static).
base_type_info__construct_type_ctor_infos(
[TypeCtorGenInfo | TypeCtorGenInfos], ModuleInfo0, ModuleInfo,
Dynamic0, Dynamic, Static0, Static) :-
base_type_info__construct_type_ctor_info(TypeCtorGenInfo,
ModuleInfo0, ModuleInfo1, TypeCtorCModule, TypeCtorTables),
Dynamic1 = [TypeCtorCModule | Dynamic0],
list__append(TypeCtorTables, Static0, Static1),
base_type_info__construct_type_ctor_infos(TypeCtorGenInfos,
ModuleInfo1, ModuleInfo, Dynamic1, Dynamic, Static1, Static).
:- pred base_type_info__construct_type_ctor_info(type_ctor_gen_info::in,
module_info::in, module_info::out,
rtti_data::out, list(rtti_data)::out) is det.
base_type_info__construct_type_ctor_info(TypeCtorGenInfo,
ModuleInfo0, ModuleInfo, TypeCtorData, TypeCtorTables) :-
TypeCtorGenInfo = type_ctor_gen_info(_TypeId, ModuleName, TypeName,
TypeArity, _Status, HldsDefn,
MaybeUnify, MaybeIndex, MaybeCompare,
MaybeSolver, MaybeInit, MaybePretty),
base_type_info__make_pred_addr(MaybeUnify, ModuleInfo, Unify),
base_type_info__make_pred_addr(MaybeIndex, ModuleInfo, Index),
base_type_info__make_pred_addr(MaybeCompare, ModuleInfo, Compare),
base_type_info__make_pred_addr(MaybeSolver, ModuleInfo, Solver),
base_type_info__make_pred_addr(MaybeInit, ModuleInfo, Init),
base_type_info__make_pred_addr(MaybePretty, ModuleInfo, Pretty),
module_info_globals(ModuleInfo0, Globals),
globals__lookup_bool_option(Globals, type_layout, TypeLayoutOption),
( TypeLayoutOption = yes ->
base_type_layout__gen_layout_info(ModuleName,
TypeName, TypeArity, HldsDefn, ModuleInfo0, ModuleInfo,
TypeCtorRep, NumFunctors, MaybeFunctors, MaybeLayout,
TypeCtorTables)
;
% This is for measuring code size only; if this path
% is ever taken, the resulting executable will not
% work.
TypeCtorRep = unknown,
NumFunctors = -1,
MaybeFunctors = no_functors,
MaybeLayout = no_layout,
TypeCtorTables = [],
ModuleInfo = ModuleInfo0
),
Version = type_ctor_info_rtti_version,
RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity),
TypeCtorData = type_ctor_info(RttiTypeId, Unify, Index, Compare,
TypeCtorRep, Solver, Init, Version, NumFunctors,
MaybeFunctors, MaybeLayout, no, Pretty).
:- pred base_type_info__make_pred_addr(maybe(pred_proc_id)::in,
module_info::in, maybe(code_addr)::out) is det.
base_type_info__make_pred_addr(no, _ModuleInfo, no).
base_type_info__make_pred_addr(yes(PredProcId), ModuleInfo, yes(PredAddr)) :-
PredProcId = proc(PredId, ProcId),
code_util__make_entry_label(ModuleInfo, PredId, ProcId, no, PredAddr).
%---------------------------------------------------------------------------%
% The version of the RTTI data structures -- useful for bootstrapping.
% If you write runtime code that checks this version number and
% can at least handle the previous version of the data
% structure, it makes it easier to bootstrap changes to the data
% structures used for RTTI.
%
% This number should be kept in sync with MR_RTTI_VERSION in
% runtime/mercury_type_info.h. This means you need to update
% the handwritten type_ctor_info structures and the code in the
% runtime that uses RTTI to conform to whatever changes the new
% version introduces.
:- func type_ctor_info_rtti_version = int.
type_ctor_info_rtti_version = 4.
%---------------------------------------------------------------------------%
% Copyright (C) 1996-2000 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% This module generates the compiler's internal representation of the
% RTTI data structures that describe the representation of each type.
% These structures form the type_ctor_rep, type_num_functors, type_functors
% and type_layout fields of a type_ctor_info. This RTTI information is
% used for several purposes: examples include deep copy, tabling, and functor,
% arg and their cousins.
%
% The representation we build is designed to be independent of whether
% the compiler is generating LLDS or MLDS. However, at the moment, we
% still generate some LLDS rvals to represent typeinfos and pseudotypeinfos.
% These `create' rvals are expected to be removed by llds_common.m to
% create static structures.
%
% The documentation of the data structures built in this module is in
% runtime/mercury_type_info.h; that file also contains a list of all
% the files that depend on these data structures.
%
% Authors: trd, zs.
%
%---------------------------------------------------------------------------%
:- module base_type_layout.
:- interface.
:- import_module rtti, hlds_module, hlds_data, llds, prog_data.
:- import_module list.
% base_type_layout__construct_typed_pseudo_type_info(Type,
% NumUnivQTvars, ExistQVars, Rval, LldsType, LabelNum0, LabelNum)
%
% Given a Mercury type (`Type'), this predicate returns an rval (`Rval')
% giving the pseudo type info for that type, plus the llds_type
% (`LldsType') of that rval. NumUnivQTvars is the number of universally
% quantified type variables of the enclosing type and ExistQVars is the
% list of existentially quantified type variables of the constructor in
% question.
% The int arguments (`LabelNum0' and `LabelNum') are label numbers for
% generating `create' rvals with.
:- pred base_type_layout__construct_typed_pseudo_type_info((type)::in,
int::in, existq_tvars::in,
rval::out, llds_type::out, int::in, int::out) is det.
% Maximum value of an integer representation of a variable.
:- pred base_type_layout__pseudo_typeinfo_max_var(int::out) is det.
% Generate RTTI layout information for the named type.
:- pred base_type_layout__gen_layout_info(module_name::in,
string::in, int::in, hlds_type_defn::in,
module_info::in, module_info::out, type_ctor_rep::out, int::out,
type_ctor_functors_info::out, type_ctor_layout_info::out,
list(rtti_data)::out) is det.
:- implementation.
:- import_module hlds_data, hlds_pred, hlds_out, builtin_ops, type_util.
:- import_module make_tags, code_util, globals, options, prog_util.
:- import_module assoc_list, bool, string, int, map, std_util, require.
:- import_module term.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred base_type_layout__construct_pseudo_type_info((type)::in,
int::in, existq_tvars::in, rval::out, int::in, int::out) is det.
base_type_layout__construct_pseudo_type_info(Type, NumUnivQTvars,
ExistQTvars, Pseudo, CNum0, CNum) :-
base_type_layout__construct_typed_pseudo_type_info(Type, NumUnivQTvars,
ExistQTvars, Pseudo, _LldsType, CNum0, CNum).
base_type_layout__construct_typed_pseudo_type_info(Type, NumUnivQTvars,
ExistQTvars, Pseudo, LldsType, CNum0, CNum) :-
(
type_to_type_id(Type, TypeId, TypeArgs0)
->
(
% The argument to typeclass_info types is not
% a type - it encodes the class constraint.
mercury_private_builtin_module(PrivateBuiltin),
TypeId = qualified(PrivateBuiltin, TName) - _,
( TName = "typeclass_info"
; TName = "base_typeclass_info"
)
->
TypeArgs = []
;
TypeArgs = TypeArgs0
),
(
% For higher order types: they all refer to the
% defined pred_0 type_ctor_info, have an extra
% argument for their real arity, and then type
% arguments according to their types.
% polymorphism.m has a detailed explanation.
% XXX polymorphism.m does not have a
% detailed explanation.
type_is_higher_order(Type, _PredFunc,
_EvalMethod, _TypeArgs)
->
TypeModule = unqualified(""),
TypeName = "pred",
Arity = 0,
TypeId = _QualTypeName - RealArity,
RealArityArg = [yes(const(int_const(RealArity)))]
;
TypeId = QualTypeName - Arity,
unqualify_name(QualTypeName, TypeName),
sym_name_get_module_name(QualTypeName, unqualified(""),
TypeModule),
RealArityArg = []
),
RttiTypeId = rtti_type_id(TypeModule, TypeName, Arity),
DataAddr = rtti_addr(RttiTypeId, type_ctor_info),
Pseudo0 = yes(const(data_addr_const(DataAddr))),
LldsType = data_ptr,
CNum1 = CNum0 + 1,
% generate args, but remove one level of create()s.
list__map_foldl((pred(T::in, P::out, C0::in, C::out) is det :-
base_type_layout__construct_pseudo_type_info(
T, NumUnivQTvars, ExistQTvars, P, C0, C)
), TypeArgs, PseudoArgs0, CNum1, CNum),
list__map(base_type_layout__remove_create,
PseudoArgs0, PseudoArgs1),
list__append(RealArityArg, PseudoArgs1, PseudoArgs),
Reuse = no,
Pseudo = create(0, [Pseudo0 | PseudoArgs], uniform(no),
must_be_static, CNum1, "type_layout", Reuse)
;
type_util__var(Type, Var)
->
% In the case of a type variable, we need to assign a
% variable number *for this constructor*, i.e. taking
% only the existentially quantified variables of
% this constructor (and not those of other functors in
% the same type) into account.
% XXX term__var_to_int doesn't guarantee anything
% about the ints returned (other than that they be
% distinct for different variables), but we are relying
% on more here.
term__var_to_int(Var, VarInt0),
(
VarInt0 =< NumUnivQTvars
->
% This is a universally quantified variable.
VarInt = VarInt0
;
% It is existentially quantified.
(
list__nth_member_search(ExistQTvars,
Var, ExistNum0)
->
VarInt = ExistNum0 +
base_type_layout__pseudo_typeinfo_exist_var_base
;
error("base_type_layout: var not in list")
)
),
base_type_layout__pseudo_typeinfo_max_var(MaxVarInt),
require(VarInt < MaxVarInt,
"type_ctor_layout: type variable representation exceeds limit"),
Pseudo = const(int_const(VarInt)),
LldsType = integer,
CNum = CNum0
;
error("type_ctor_layout: type neither var nor non-var")
).
% Remove a create() from an rval, if present.
:- pred base_type_layout__remove_create(rval::in, maybe(rval)::out) is det.
base_type_layout__remove_create(Rval0, MaybeRval) :-
( Rval0 = create(_, [PTI], _, _, _, _, _) ->
MaybeRval = PTI
;
MaybeRval = yes(Rval0)
).
%---------------------------------------------------------------------------%
base_type_layout__pseudo_typeinfo_max_var(1024).
% The base number from which we count existentially quantified
% variables. Note that this number must be kept in synch with
% MR_PSEUDOTYPEINFO_EXIST_VAR_BASE in runtime/mercury_type_info.h
:- func base_type_layout__pseudo_typeinfo_exist_var_base = int.
base_type_layout__pseudo_typeinfo_exist_var_base = 512.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
base_type_layout__gen_layout_info(ModuleName, TypeName, TypeArity, HldsDefn,
ModuleInfo0, ModuleInfo, TypeCtorRep, NumFunctors,
FunctorsInfo, LayoutInfo, TypeTables) :-
hlds_data__get_type_defn_body(HldsDefn, TypeBody),
module_info_get_cell_count(ModuleInfo0, CellNumber0),
(
TypeBody = uu_type(_Alts),
error("type_ctor_layout: sorry, undiscriminated union unimplemented\n")
;
TypeBody = abstract_type,
TypeCtorRep = unknown,
NumFunctors = -1,
FunctorsInfo = no_functors,
LayoutInfo = no_layout,
TypeTables = [],
CellNumber = CellNumber0
;
TypeBody = eqv_type(Type),
TypeCtorRep = equiv,
NumFunctors = -1,
UnivTvars = TypeArity,
% There can be no existentially typed args to an
% equivalence.
ExistTvars = [],
base_type_layout__construct_pseudo_type_info(Type,
UnivTvars, ExistTvars, Rval, CellNumber0, CellNumber),
FunctorsInfo = no_functors,
LayoutInfo = equiv_layout(Rval),
TypeTables = []
;
TypeBody = du_type(Ctors, ConsTagMap, Enum, EqualityPred),
(
EqualityPred = yes(_),
EqualityAxioms = user_defined
;
EqualityPred = no,
EqualityAxioms = standard
),
list__length(Ctors, NumFunctors),
RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity),
(
Enum = yes,
TypeCtorRep = enum(EqualityAxioms),
base_type_layout__make_enum_tables(Ctors, ConsTagMap,
RttiTypeId, TypeTables,
FunctorsInfo, LayoutInfo),
CellNumber = CellNumber0
;
Enum = no,
( type_is_no_tag_type(Ctors, Name, ArgType) ->
TypeCtorRep = notag(EqualityAxioms),
base_type_layout__make_notag_tables(Name,
ArgType, RttiTypeId,
CellNumber0, CellNumber,
TypeTables, FunctorsInfo, LayoutInfo)
;
module_info_globals(ModuleInfo0, Globals),
globals__lookup_int_option(Globals,
num_tag_bits, NumTagBits),
int__pow(2, NumTagBits, NumTags),
MaxPtag = NumTags - 1,
TypeCtorRep = du(EqualityAxioms),
base_type_layout__make_du_tables(Ctors,
ConsTagMap, MaxPtag, RttiTypeId,
ModuleInfo0, CellNumber0, CellNumber,
TypeTables, FunctorsInfo, LayoutInfo)
)
)
),
module_info_set_cell_count(ModuleInfo0, CellNumber, ModuleInfo).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred base_type_layout__make_notag_tables(sym_name::in, (type)::in,
rtti_type_id::in, int::in, int::out, list(rtti_data)::out,
type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
base_type_layout__make_notag_tables(SymName, ArgType, RttiTypeId,
CellNumber0, CellNumber,
TypeTables, FunctorsInfo, LayoutInfo) :-
unqualify_name(SymName, FunctorName),
RttiTypeId = rtti_type_id(_, _, UnivTvars),
% There can be no existentially typed args to the functor
% in a notag type.
ExistTvars = [],
base_type_layout__construct_pseudo_type_info(ArgType,
UnivTvars, ExistTvars, Rval, CellNumber0, CellNumber),
FunctorDesc = notag_functor_desc(RttiTypeId, FunctorName, Rval),
FunctorRttiName = notag_functor_desc,
FunctorsInfo = notag_functors(FunctorRttiName),
LayoutInfo = notag_layout(FunctorRttiName),
TypeTables = [FunctorDesc].
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- type name_sort_info == assoc_list(pair(string, int), rtti_name).
:- pred base_type_layout__make_enum_tables(list(constructor)::in,
cons_tag_values::in, rtti_type_id::in, list(rtti_data)::out,
type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
base_type_layout__make_enum_tables(Ctors, ConsTagMap, RttiTypeId,
TypeTables, FunctorInfo, LayoutInfo) :-
base_type_layout__make_enum_functor_tables(Ctors, 0, ConsTagMap,
RttiTypeId, FunctorDescs, OrdinalOrderRttiNames, SortInfo0),
list__sort(SortInfo0, SortInfo),
assoc_list__values(SortInfo, NameOrderedRttiNames),
NameOrderedTable = enum_name_ordered_table(RttiTypeId,
NameOrderedRttiNames),
NameOrderedTableRttiName = enum_name_ordered_table,
FunctorInfo = enum_functors(NameOrderedTableRttiName),
ValueOrderedTable = enum_value_ordered_table(RttiTypeId,
OrdinalOrderRttiNames),
ValueOrderedTableRttiName = enum_value_ordered_table,
LayoutInfo = enum_layout(ValueOrderedTableRttiName),
TypeTables = [NameOrderedTable, ValueOrderedTable | FunctorDescs].
:- pred base_type_layout__make_enum_functor_tables(list(constructor)::in,
int::in, cons_tag_values::in, rtti_type_id::in,
list(rtti_data)::out, list(rtti_name)::out,
name_sort_info::out) is det.
base_type_layout__make_enum_functor_tables([], _, _, _, [], [], []).
base_type_layout__make_enum_functor_tables([Functor | Functors], NextOrdinal0,
ConsTagMap, RttiTypeId,
FunctorDescs, RttiNames, SortInfo) :-
Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs),
require(unify(ExistTvars, []),
"existential arguments in functor in enum"),
require(unify(Constraints, []),
"class constraints on functor in enum"),
list__length(FunctorArgs, Arity),
require(unify(Arity, 0),
"functor in enum has nonzero arity"),
make_cons_id_from_qualified_sym_name(SymName, FunctorArgs, ConsId),
map__lookup(ConsTagMap, ConsId, ConsTag),
require(unify(ConsTag, int_constant(NextOrdinal0)),
"mismatch on constant assigned to functor in enum"),
unqualify_name(SymName, FunctorName),
FunctorDesc = enum_functor_desc(RttiTypeId, FunctorName, NextOrdinal0),
RttiName = enum_functor_desc(NextOrdinal0),
FunctorSortInfo = (FunctorName - 0) - RttiName,
base_type_layout__make_enum_functor_tables(Functors, NextOrdinal0 + 1,
ConsTagMap, RttiTypeId, FunctorDescs1, RttiNames1, SortInfo1),
FunctorDescs = [FunctorDesc | FunctorDescs1],
RttiNames = [RttiName | RttiNames1],
SortInfo = [FunctorSortInfo | SortInfo1].
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- type tag_map == map(int, pair(sectag_locn, map(int, rtti_name))).
:- type tag_list == assoc_list(int, pair(sectag_locn, map(int, rtti_name))).
:- pred base_type_layout__make_du_tables(list(constructor)::in,
cons_tag_values::in, int::in, rtti_type_id::in, module_info::in,
int::in, int::out, list(rtti_data)::out, type_ctor_functors_info::out,
type_ctor_layout_info::out) is det.
base_type_layout__make_du_tables(Ctors, ConsTagMap, MaxPtag, RttiTypeId,
ModuleInfo, CellNumber0, CellNumber,
TypeTables, FunctorInfo, LayoutInfo) :-
map__init(TagMap0),
base_type_layout__make_du_functor_tables(Ctors, 0, ConsTagMap,
RttiTypeId, ModuleInfo, CellNumber0, CellNumber,
FunctorDescs, SortInfo0, TagMap0, TagMap),
list__sort(SortInfo0, SortInfo),
assoc_list__values(SortInfo, NameOrderedRttiNames),
NameOrderedTable = du_name_ordered_table(RttiTypeId,
NameOrderedRttiNames),
NameOrderedTableRttiName = du_name_ordered_table,
FunctorInfo = du_functors(NameOrderedTableRttiName),
base_type_layout__make_du_ptag_ordered_table(TagMap, MaxPtag,
RttiTypeId, ValueOrderedTableRttiName, ValueOrderedTables),
LayoutInfo = du_layout(ValueOrderedTableRttiName),
list__append([NameOrderedTable | FunctorDescs], ValueOrderedTables,
TypeTables).
:- pred base_type_layout__make_du_functor_tables(list(constructor)::in,
int::in, cons_tag_values::in, rtti_type_id::in, module_info::in,
int::in, int::out, list(rtti_data)::out, name_sort_info::out,
tag_map::in, tag_map::out) is det.
base_type_layout__make_du_functor_tables([], _, _, _, _,
CellNumber, CellNumber, [], [], TagMap, TagMap).
base_type_layout__make_du_functor_tables([Functor | Functors], Ordinal,
ConsTagMap, RttiTypeId, ModuleInfo, CellNumber0, CellNumber,
Tables, SortInfo, TagMap0, TagMap) :-
Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs),
list__length(FunctorArgs, Arity),
unqualify_name(SymName, FunctorName),
RttiName = du_functor_desc(Ordinal),
make_cons_id_from_qualified_sym_name(SymName, FunctorArgs, ConsId),
map__lookup(ConsTagMap, ConsId, ConsTag),
( ConsTag = unshared_tag(ConsPtag) ->
Locn = sectag_none,
Ptag = ConsPtag,
Stag = 0,
base_type_layout__update_tag_info(Ptag, Stag, Locn, RttiName,
TagMap0, TagMap1)
; ConsTag = shared_local_tag(ConsPtag, ConsStag) ->
Locn = sectag_local,
Ptag = ConsPtag,
Stag = ConsStag,
base_type_layout__update_tag_info(Ptag, Stag, Locn, RttiName,
TagMap0, TagMap1)
; ConsTag = shared_remote_tag(ConsPtag, ConsStag) ->
Locn = sectag_remote,
Ptag = ConsPtag,
Stag = ConsStag,
base_type_layout__update_tag_info(Ptag, Stag, Locn, RttiName,
TagMap0, TagMap1)
;
error("unexpected cons_tag for du function symbol")
),
base_type_layout__generate_pseudotypeinfo_vector(ModuleInfo,
RttiTypeId, Ordinal, FunctorArgs, ExistTvars,
CellNumber0, CellNumber1, MaybeArgNames,
ArgPseudoTypeInfoVector, FieldTables),
( ExistTvars = [] ->
MaybeExistInfo = no,
ExistTables = []
;
module_info_classes(ModuleInfo, ClassTable),
base_type_layout__generate_type_info_locns(ExistTvars,
Constraints, ClassTable, RttiTypeId, Ordinal,
ExistInfo, ExistTables),
MaybeExistInfo = yes(ExistInfo)
),
list__append(FieldTables, ExistTables, SubTables),
FunctorDesc = du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag,
Locn, Ordinal, Arity, ArgPseudoTypeInfoVector, MaybeArgNames,
MaybeExistInfo),
FunctorSortInfo = (FunctorName - Arity) - RttiName,
base_type_layout__make_du_functor_tables(Functors, Ordinal + 1,
ConsTagMap, RttiTypeId, ModuleInfo, CellNumber1, CellNumber,
Tables1, SortInfo1, TagMap1, TagMap),
list__append([FunctorDesc | SubTables], Tables1, Tables),
SortInfo = [FunctorSortInfo | SortInfo1].
:- pred base_type_layout__generate_pseudotypeinfo_vector(module_info::in,
rtti_type_id::in, int::in, list(constructor_arg)::in, existq_tvars::in,
int::in, int::out, maybe(rtti_name)::out, rval::out,
list(rtti_data)::out) is det.
base_type_layout__generate_pseudotypeinfo_vector(
ModuleInfo, RttiTypeId, Ordinal,
Args, ExistTvars, CellNumber0, CellNumber,
MaybeFieldNamesRttiName, Vector, Tables) :-
RttiTypeId = rtti_type_id(_TypeModule, _TypeName, TypeArity),
base_type_layout__generate_pseudotypeinfos(Args, TypeArity, ExistTvars,
ModuleInfo, CellNumber0, CellNumber1,
MaybeArgNames, LldsTypes, MaybePseudoTypeInfos),
list__filter((lambda([MaybeName::in] is semidet, MaybeName = yes(_))),
MaybeArgNames, FieldNames),
(
FieldNames = [],
MaybeFieldNamesRttiName = no,
Tables = []
;
FieldNames = [_|_],
FieldNameTable = field_names(RttiTypeId, Ordinal,
MaybeArgNames),
FieldNamesRttiName = field_names(Ordinal),
MaybeFieldNamesRttiName = yes(FieldNamesRttiName),
Tables = [FieldNameTable]
),
base_type_layout__get_next_cell_number(CellNumber1, CN, CellNumber),
Reuse = no,
Vector = create(0, MaybePseudoTypeInfos, initial(LldsTypes, none),
must_be_static, CN, "arg_types", Reuse).
:- pred base_type_layout__generate_pseudotypeinfos(list(constructor_arg)::in,
int::in, existq_tvars::in, module_info::in, int::in, int::out,
list(maybe(string))::out, initial_arg_types::out,
list(maybe(rval))::out) is det.
base_type_layout__generate_pseudotypeinfos([], _, _, _,
CellNumber, CellNumber, [], [], []).
base_type_layout__generate_pseudotypeinfos([MaybeArgSymName - ArgType | Args],
NumUnivTvars, ExistTvars, ModuleInfo, CellNumber0, CellNumber,
[MaybeArgName | MaybeArgNames],
[1 - yes(LldsType) | LldsTypes],
[yes(PseudoTypeInfo) | MaybePseudoTypeInfos]) :-
(
MaybeArgSymName = yes(SymName),
unqualify_name(SymName, ArgName),
MaybeArgName = yes(ArgName)
;
MaybeArgSymName = no,
MaybeArgName = no
),
base_type_layout__construct_typed_pseudo_type_info(ArgType,
NumUnivTvars, ExistTvars, PseudoTypeInfo, LldsType,
CellNumber0, CellNumber1),
base_type_layout__generate_pseudotypeinfos(Args, NumUnivTvars,
ExistTvars, ModuleInfo, CellNumber1, CellNumber,
MaybeArgNames, LldsTypes, MaybePseudoTypeInfos).
:- pred base_type_layout__generate_type_info_locns(list(tvar)::in,
list(class_constraint)::in, class_table::in, rtti_type_id::in, int::in,
rtti_name::out, list(rtti_data)::out) is det.
base_type_layout__generate_type_info_locns(ExistTvars, Constraints, ClassTable,
RttiTypeId, Ordinal, exist_info(Ordinal),
[ExistInfo, ExistLocns]) :-
list__map((pred(C::in, Ts::out) is det :- C = constraint(_, Ts)),
Constraints, ConstrainedTvars0),
list__condense(ConstrainedTvars0, ConstrainedTvars1),
term__vars_list(ConstrainedTvars1, ConstrainedTvars2),
list__delete_elems(ExistTvars, ConstrainedTvars2, UnconstrainedTvars),
% We do this to maintain the ordering of the type variables.
list__delete_elems(ExistTvars, UnconstrainedTvars, ConstrainedTvars),
map__init(LocnMap0),
list__foldl2((pred(T::in, N0::in, N::out, Lm0::in, Lm::out) is det :-
Locn = plain_typeinfo(N0),
map__det_insert(Lm0, T, Locn, Lm),
N = N0 + 1
), UnconstrainedTvars, 0, TIsPlain, LocnMap0, LocnMap1),
list__length(ExistTvars, AllTIs),
TIsInTCIs = AllTIs - TIsPlain,
list__foldl(
find_type_info_index(Constraints, ClassTable, TIsPlain),
ConstrainedTvars, LocnMap1, LocnMap),
list__length(Constraints, TCIs),
ExistInfo = exist_info(RttiTypeId, Ordinal,
TIsPlain, TIsInTCIs, TCIs, exist_locns(Ordinal)),
list__map((pred(Tvar::in, Locn::out) is det :-
map__lookup(LocnMap, Tvar, Locn)),
ExistTvars, Locns),
ExistLocns = exist_locns(RttiTypeId, Ordinal, Locns).
:- pred find_type_info_index(list(class_constraint)::in, class_table::in,
int::in, tvar::in, map(tvar, exist_typeinfo_locn)::in,
map(tvar, exist_typeinfo_locn)::out) is det.
find_type_info_index(Constraints, ClassTable, StartSlot, Tvar,
LocnMap0, LocnMap) :-
first_matching_type_class_info(Constraints, Tvar,
FirstConstraint, StartSlot, Slot, TypeInfoIndex),
FirstConstraint = constraint(ClassName, Args),
list__length(Args, ClassArity),
map__lookup(ClassTable, class_id(ClassName, ClassArity), ClassDefn),
ClassDefn = hlds_class_defn(_, SuperClasses, _, _, _, _, _),
list__length(SuperClasses, NumSuperClasses),
RealTypeInfoIndex = TypeInfoIndex + NumSuperClasses,
Locn = typeinfo_in_tci(Slot, RealTypeInfoIndex),
map__det_insert(LocnMap0, Tvar, Locn, LocnMap).
:- pred first_matching_type_class_info(list(class_constraint)::in, tvar::in,
class_constraint::out, int::in, int::out, int::out) is det.
first_matching_type_class_info([], _, _, _, _, _) :-
error("base_type_layout: constrained type info not found").
first_matching_type_class_info([C|Cs], Tvar, MatchingConstraint, N0, N,
TypeInfoIndex) :-
C = constraint(_, Ts),
term__vars_list(Ts, TVs),
( list__nth_member_search(TVs, Tvar, Index) ->
N = N0,
MatchingConstraint = C,
TypeInfoIndex = Index
;
first_matching_type_class_info(Cs, Tvar, MatchingConstraint,
N0 + 1, N, TypeInfoIndex)
).
%---------------------------------------------------------------------------%
:- pred base_type_layout__update_tag_info(int::in, int::in, sectag_locn::in,
rtti_name::in, tag_map::in, tag_map::out) is det.
base_type_layout__update_tag_info(Ptag, Stag, Locn, RttiName, TagMap0, TagMap)
:-
( map__search(TagMap0, Ptag, OldLocn - OldSharerMap) ->
( Locn = sectag_none ->
error("unshared ptag shared after all")
; OldLocn = Locn ->
true
;
error("disagreement on sectag location for ptag")
),
map__det_insert(OldSharerMap, Stag, RttiName, NewSharerMap),
map__det_update(TagMap0, Ptag, Locn - NewSharerMap, TagMap)
;
map__init(NewSharerMap0),
map__det_insert(NewSharerMap0, Stag, RttiName, NewSharerMap),
map__det_insert(TagMap0, Ptag, Locn - NewSharerMap, TagMap)
).
:- pred base_type_layout__make_du_ptag_ordered_table(tag_map::in, int::in,
rtti_type_id::in, rtti_name::out, list(rtti_data)::out) is det.
base_type_layout__make_du_ptag_ordered_table(TagMap, MaxPtagValue,
RttiTypeId, PtagOrderedRttiName, Tables) :-
map__to_assoc_list(TagMap, TagList),
base_type_layout__make_du_ptag_layouts(0, MaxPtagValue, TagList,
RttiTypeId, PtagLayoutsRttiNames, SubTables),
PtagOrderedTable = du_ptag_ordered_table(RttiTypeId,
PtagLayoutsRttiNames),
PtagOrderedRttiName = du_ptag_ordered_table,
Tables = [PtagOrderedTable | SubTables].
:- pred base_type_layout__make_du_ptag_layouts(int::in, int::in,
tag_list::in, rtti_type_id::in, list(maybe(rtti_name))::out,
list(rtti_data)::out) is det.
base_type_layout__make_du_ptag_layouts(CurPtag, MaxPtag, TagList0,
RttiTypeId, PtagLayoutAddrs, Tables) :-
( CurPtag =< MaxPtag ->
(
TagList0 = [],
TagList = [],
CurPtagLayoutAddr = no,
CurTables = []
;
TagList0 = [Ptag - (Locn - StagMap) | TagList],
require(unify(CurPtag, Ptag),
"missing ptag value in make_du_ptag_layout"),
map__to_assoc_list(StagMap, StagList),
list__length(StagList, StagListLength),
base_type_layout__make_du_stag_table(
0, StagListLength - 1, StagList,
StagRttiNames),
StagOrderedTable = du_stag_ordered_table(RttiTypeId,
Ptag, StagRttiNames),
StagOrderedAddr = du_stag_ordered_table(Ptag),
PtagLayoutTable = du_ptag_layout(RttiTypeId, Ptag,
StagListLength, Locn, StagOrderedAddr),
PtagLayoutAddr = du_ptag_layout(Ptag),
CurPtagLayoutAddr = yes(PtagLayoutAddr),
CurTables = [PtagLayoutTable, StagOrderedTable]
),
base_type_layout__make_du_ptag_layouts(
CurPtag + 1, MaxPtag, TagList, RttiTypeId,
PtagLayoutAddrs1, Tables1),
PtagLayoutAddrs = [CurPtagLayoutAddr | PtagLayoutAddrs1],
list__append(CurTables, Tables1, Tables)
;
require(unify(TagList0, []),
"leftover ptag values in make_du_ptag_layouts"),
PtagLayoutAddrs = [],
Tables = []
).
:- pred base_type_layout__make_du_stag_table(int::in, int::in,
assoc_list(int, rtti_name)::in, list(rtti_name)::out) is det.
base_type_layout__make_du_stag_table(CurStag, MaxStag, TagList0,
StagRttiNames) :-
( CurStag =< MaxStag ->
(
TagList0 = [],
error("short stag list in make_du_stag_table")
;
TagList0 = [Stag - RttiName | TagList],
require(unify(CurStag, Stag),
"missing stag value in make_du_stag_table")
),
base_type_layout__make_du_stag_table(CurStag + 1, MaxStag,
TagList, StagRttiNames1),
StagRttiNames = [RttiName | StagRttiNames1]
;
require(unify(TagList0, []),
"leftover stag values in make_du_stag_table"),
StagRttiNames = []
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred base_type_layout__get_next_cell_number(int::in, int::out, int::out)
is det.
base_type_layout__get_next_cell_number(CellNumber0, Next, CellNumber) :-
CellNumber = CellNumber0 + 1,
Next = CellNumber.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
--------------------------------------------------------------------------
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