For review: base_type_functors
Tyson Richard DOWD
trd at students.cs.mu.oz.au
Fri Feb 21 15:00:54 AEDT 1997
Hi everyone.
This is stage 1 of changes designed to allow io__read/3 to be
implemented. It will also allow the other code dealing with
runtime type information to be significantly simplified.
Fergus, could you please review this?
(Oliver, you might want to have a look at the changes to
type_info.h).
===================================================================
Estimated hours taken: 15
Create new `base_type_functors' data structures, that describe the
functors of discriminated union types.
compiler/base_type_info.m:
- Make the base_type_info reference the base_type_functors.
compiler/base_type_layout.m:
- Clean up header documentation, fix inaccuracies.
- Add support for creation of base_type_functors tables,
document the tables created.
- Add a representation of the primary and secondary tag
to the descriptions created for functors.
- Rename predicates since this module now creates two
tables.
- Split some predicates so that code can be re-used.
compiler/llds.m:
- Instead of
base_type_info(string, arity),
base_type_layout(string, arity) and the new
base_type_functors(string, arity),
use
base_type(base_data, string, arity)
where base_data is one of
info, layout or functors
compiler/llds_out.m:
- Add llds_out__make_base_type_name, which generates identifier
names for base_data data items.
compiler/opt_debug.m:
compiler/unify_gen.m:
- Use new base_data type.
library/io.m:
library/mercury_builtin.m:
library/std_util.m:
library/uniq_arry.m:
- Add definitions for base_type_functors for builtin types, and
types defined in C.
runtime/type_info.h:
- Add definitions for base_type_functors.
- Modify existing #defines (in particular, offset for type name).
Index: compiler/base_type_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_type_info.m,v
retrieving revision 1.7
diff -u -r1.7 base_type_info.m
--- base_type_info.m 1997/02/18 02:50:53 1.7
+++ base_type_info.m 1997/02/20 04:07:59
@@ -145,12 +145,15 @@
->
base_type_info__construct_layout(ModuleInfo, TypeName,
TypeArity, LayoutArg),
+ base_type_info__construct_functors(ModuleInfo, TypeName,
+ TypeArity, FunctorsArg),
NameArg = yes(const(string_const(TypeName))),
- list__append(PredAddrArgs, [LayoutArg, NameArg], FinalArgs)
+ list__append(PredAddrArgs, [LayoutArg, FunctorsArg, NameArg],
+ FinalArgs)
;
FinalArgs = PredAddrArgs
),
- CModule = c_data(ModuleName, base_type_info(TypeName, TypeArity),
+ CModule = c_data(ModuleName, base_type(info, TypeName, TypeArity),
Exported, [ArityArg | FinalArgs], Procs),
base_type_info__construct_base_type_infos(BaseGenInfos, ModuleInfo,
CModules).
@@ -160,7 +163,15 @@
base_type_info__construct_layout(ModuleInfo, TypeName, TypeArity, Rval) :-
module_info_name(ModuleInfo, ModuleName),
Rval = yes(const(data_addr_const(data_addr(ModuleName,
- base_type_layout(TypeName, TypeArity))))).
+ base_type(layout, TypeName, TypeArity))))).
+
+:- pred base_type_info__construct_functors(module_info, string, int,
+ maybe(rval)).
+:- mode base_type_info__construct_functors(in, in, in, out) is det.
+base_type_info__construct_functors(ModuleInfo, TypeName, TypeArity, Rval) :-
+ module_info_name(ModuleInfo, ModuleName),
+ Rval = yes(const(data_addr_const(data_addr(ModuleName,
+ base_type(functors, TypeName, TypeArity))))).
:- pred base_type_info__construct_pred_addrs(list(pred_proc_id), maybe(int),
module_info, list(maybe(rval))).
Index: compiler/base_type_layout.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_type_layout.m,v
retrieving revision 1.12
diff -u -r1.12 base_type_layout.m
--- base_type_layout.m 1997/02/17 01:26:25 1.12
+++ base_type_layout.m 1997/02/21 01:36:09
@@ -5,17 +5,17 @@
%---------------------------------------------------------------------------%
%
% This module generates the LLDS code that defines global constants
-% to hold the base_type_layout structures of the types defined by the
-% current module.
+% to hold the `base_type_layout' and `base_type_functors' structures
+% of the types defined by the current module.
%
% It requires that type_infos are generated using the
% shared-one-of-two-cells option. This layout structures will
% not be generated if this option is not specified.
%
-% These global constants are needed only with when we are using accurate
-% garbage collection. It is up to the caller to check this.
-% (When using other garbage collectors, defining these global constants
-% is harmless except for adding to compilation time and executable size.)
+%
+% These global constants are used by the predicates functor/3, arg/3
+% and expand/4 in std_util.m, and solutions in non conservative-gc grades.
+% They will also be used for accurate garbage collection.
%
% The tables generated have a number of `create' rvals within them,
% these are removed by llds_common.m to create static structures.
@@ -63,20 +63,27 @@
% Tag 0 - CONST Word = 7 - pred
% Words 8 - 1024 reserved for future use
% Tag 0 - CONST Word = 1024+ - constant(s)
-% word is pointer to
-% - 1 or 0 (enumeration or not)
-% - S, the number of constants
-% sharing this tag
-% - S strings - functor names
+% word is pointer to enum
+% vector.
+%
+% enum vector:
+% - 1 or 0 (1 = enumeration, 0 = complicated constant)
+% - S, the number of constants sharing this tag
+% - S strings (functor names)
%
% Note that tag 0 value 0 is presently unassigned. This may be used
-% in future for some common purpose.
+% in future for some common case optimization.
%
-% Tag 1 - SIMPLE Word = pointer to argument vector
+% Tag 1 - SIMPLE Word = pointer to simple vector
+%
+% SIMPLE: Simple vector contains
+% - the arity of the functor (N)
+% - N pointers to pseudo-typeinfos (of each argument),
+% - a pointer to a string containing the name of this
+% functor.
+% - A word containing a representation of the primary and
+% secondary tags of this functor
%
-% SIMPLE: Argument vector contains N, then N pointers to pseudo-typeinfos,
-% finally, a pointer to a string containing the name of this
-% functor.
% No further indexing is required. The data word points to a
% vector of its argument data.
%
@@ -120,6 +127,10 @@
% In any case, you need to look at the equivalent type
% to find out what the data word represents.
%
+%---------------------------------------------------------------------------%
+%
+% Definitions:
+%
% Argument vector - arity, then pointers to pseudo-typeinfos.
% Multi-Argument vector - number of functors sharing this tag, then
% pointers to argument vectors.
@@ -135,6 +146,49 @@
% and the second is the contents of the rest of the word.
%
%---------------------------------------------------------------------------%
+%
+% Data representation: Functors Tables
+%
+% base_type_functors tables are generated, one for each type. These
+% contain information about the functors of discriminated union (du)
+% types. The same information is available in the base_type_layouts, but
+% is quite difficult to obtain, because the functors tables are designed
+% for easy indexing via primary and secondary tag.
+%
+% The first word of any functors table is an indicator of whether this
+% type is a du, no_tag, equivalence, enumeration or special (e.g. builtin).
+%
+% For discriminated unions, the tables contain:
+% - disc. union indicator
+% - number of functors this type has
+% - vector of pointers to a simple vector, one for each functor
+%
+% For no_tag types, the tables contain:
+% - no_tag indicator
+% - pointers to a simple vector, for the functor
+%
+% For enumerations, the tables contain:
+% - enumeration indicator
+% - pointer to enumeration vector
+%
+% For equivalences, the tables contain:
+% - equivalence indicator
+% - pointer to pseudo-type-info of equivalent type
+%
+% For special or builtin types (not discriminated unions), the tables contain:
+% - special indicator
+%
+% Note: Future Work
+% By using the indicator in this table, it may be much easier to
+% encode the base_type_layout tables - for example, no encoding
+% for equivalences needs to be done, the special
+% base_type_functors table could be augmented with a description
+% of which builtin is being used, so the encodings of constants
+% can be simplified, and so can enumerations and no_tags. In fact,
+% the base_type_layout table could really just be used to
+% determine whether a tag is simple or complicated.
+%
+%---------------------------------------------------------------------------%
:- module base_type_layout.
@@ -234,19 +288,24 @@
module_info_ctors(ModuleInfo, ConsTable),
LayoutInfo0 = layout_info(ModuleName, ConsTable, MaxTags, 0,
unqualified("") - 0, []),
- base_type_layout__construct_base_type_layouts(BaseGenInfos,
+ base_type_layout__construct_base_type_data(BaseGenInfos,
LayoutInfo0, LayoutInfo),
LayoutInfo = layout_info(_, _, _, _, _, CModules).
+%---------------------------------------------------------------------------%
+
- % For each type, generate the required CModule
+%---------------------------------------------------------------------------%
+
+ % For each type, generate the required CModules, one for
+ % functors, one for layout.
-:- pred base_type_layout__construct_base_type_layouts(list(base_gen_layout),
+:- pred base_type_layout__construct_base_type_data(list(base_gen_layout),
layout_info, layout_info).
-:- mode base_type_layout__construct_base_type_layouts(in, in, out) is det.
+:- mode base_type_layout__construct_base_type_data(in, in, out) is det.
-base_type_layout__construct_base_type_layouts([], LayoutInfo, LayoutInfo).
-base_type_layout__construct_base_type_layouts([BaseGenInfo | BaseGenInfos],
+base_type_layout__construct_base_type_data([], LayoutInfo, LayoutInfo).
+base_type_layout__construct_base_type_data([BaseGenInfo | BaseGenInfos],
LayoutInfo0, LayoutInfo) :-
BaseGenInfo = base_gen_layout(TypeId, ModuleName, TypeName, TypeArity,
Status, HldsType),
@@ -254,15 +313,18 @@
hlds_data__get_type_defn_body(HldsType, TypeBody),
(
TypeBody = uu_type(_Alts),
- error("base_type_layout: undiscriminated union unimplemented\n")
+ error("base_type_layout: sorry, undiscriminated union unimplemented\n")
;
TypeBody = eqv_type(Type),
- base_type_layout__construct_eqv_type(Type, LayoutInfo1,
- LayoutInfo2, TypeData)
+ base_type_layout__layout_eqv(Type, LayoutInfo1,
+ LayoutInfo2, LayoutTypeData),
+ base_type_layout__functors_eqv(Type, LayoutInfo2, LayoutInfo3,
+ FunctorsTypeData)
;
TypeBody = abstract_type,
- LayoutInfo2 = LayoutInfo1,
- TypeData = []
+ LayoutInfo3 = LayoutInfo1,
+ LayoutTypeData = [],
+ FunctorsTypeData = []
;
TypeBody = du_type(Ctors, ConsTagMap, Enum),
@@ -270,25 +332,34 @@
% enums, complicated constants and
% complicated tags have their shared
% functors in the right order.
- map__to_assoc_list(ConsTagMap, ConsTags0),
- assoc_list__reverse_members(ConsTags0, RevConsList),
+ map__to_assoc_list(ConsTagMap, UnsortedConsTags),
+ assoc_list__reverse_members(UnsortedConsTags, RevConsList),
list__sort(RevConsList, SortedRevConsList),
- assoc_list__reverse_members(SortedRevConsList, ConsTags),
+ assoc_list__reverse_members(SortedRevConsList, SortedConsTags),
(
Enum = yes,
- base_type_layout__construct_enum(ConsTags,
- LayoutInfo1, LayoutInfo2, TypeData)
+ base_type_layout__layout_enum(SortedConsTags,
+ LayoutInfo1, LayoutInfo2, LayoutTypeData),
+ base_type_layout__functors_enum(UnsortedConsTags,
+ LayoutInfo2, LayoutInfo3, FunctorsTypeData)
;
Enum = no,
(
type_is_no_tag_type(Ctors, Name, TypeArg)
->
- base_type_layout__construct_no_tag_type(Name,
+ base_type_layout__layout_no_tag(Name,
TypeArg, LayoutInfo1, LayoutInfo2,
- TypeData)
+ LayoutTypeData),
+ base_type_layout__functors_no_tag(Name,
+ TypeArg, LayoutInfo2, LayoutInfo3,
+ FunctorsTypeData)
;
- base_type_layout__construct_du_type(ConsTags,
- LayoutInfo1, LayoutInfo2, TypeData)
+ base_type_layout__layout_du(
+ SortedConsTags, LayoutInfo1,
+ LayoutInfo2, LayoutTypeData),
+ base_type_layout__functors_du(
+ UnsortedConsTags, LayoutInfo2,
+ LayoutInfo3, FunctorsTypeData)
)
)
),
@@ -302,23 +373,27 @@
% pure abstract types have no layout definition.
(
- TypeData = []
+ LayoutTypeData = []
->
- LayoutInfo3 = LayoutInfo2
+ LayoutInfo5 = LayoutInfo3
;
- CModule = c_data(ModuleName, base_type_layout(TypeName,
- TypeArity), Exported, TypeData, []),
- base_type_layout__add_cmodule(LayoutInfo2, CModule,
- LayoutInfo3)
+ CModule = c_data(ModuleName, base_type(layout, TypeName,
+ TypeArity), Exported, LayoutTypeData, []),
+ CModule2 = c_data(ModuleName, base_type(functors, TypeName,
+ TypeArity), Exported, FunctorsTypeData, []),
+ base_type_layout__add_cmodule(LayoutInfo3, CModule,
+ LayoutInfo4),
+ base_type_layout__add_cmodule(LayoutInfo4, CModule2,
+ LayoutInfo5)
),
- base_type_layout__construct_base_type_layouts(BaseGenInfos, LayoutInfo3,
+ base_type_layout__construct_base_type_data(BaseGenInfos, LayoutInfo5,
LayoutInfo).
%---------------------------------------------------------------------------%
% Constants - these should be kept in check with the runtime
- % definition.
+ % definitions.
:- type const_sort ---> unassigned
; unused
@@ -371,6 +446,22 @@
:- pred base_type_layout__tag_value_equiv(int::out) is det.
base_type_layout__tag_value_equiv(3).
+ % Constants for base_type_functors
+
+:- type functors_category ---> du
+ ; enum
+ ; equiv
+ ; special
+ ; no_tag.
+
+:- pred base_type_layout__functors_value(functors_category::in, int::out)
+ is det.
+base_type_layout__functors_value(du, 0).
+base_type_layout__functors_value(enum, 1).
+base_type_layout__functors_value(equiv, 2).
+base_type_layout__functors_value(special, 3).
+base_type_layout__functors_value(no_tag, 4).
+
%---------------------------------------------------------------------------%
% Encoding
@@ -409,15 +500,41 @@
Rvals = [yes(create(Tag, Rvals0, Unique, Label))]
).
+ % Encode a cons tag (simple or complicated) in rvals.
+
+:- pred base_type_layout__encode_cons_tag(cons_tag, list(maybe(rval)),
+ layout_info, layout_info).
+:- mode base_type_layout__encode_cons_tag(in, out, in, out) is det.
+base_type_layout__encode_cons_tag(ConsTag, ConsTagRval, LayoutInfo,
+ LayoutInfo) :-
+ (
+ ConsTag = simple_tag(Tag0)
+ ->
+ SecTag = 0, Tag = Tag0
+ ;
+ ConsTag = complicated_tag(Tag0, SecTag0)
+ ->
+ SecTag = SecTag0, Tag = Tag0
+ ;
+ ConsTag = complicated_constant_tag(Tag0, SecTag0)
+ ->
+ SecTag = SecTag0, Tag = Tag0
+ ;
+ error(
+ "base_type_layout: cons_tag not simple or complicated in du")
+ ),
+ base_type_layout__encode_mkword(LayoutInfo, Tag,
+ const(int_const(SecTag)), ConsTagRval).
+
%---------------------------------------------------------------------------%
% If the type is reduced to some sort of constant or special,
% handle it seperately.
-:- pred base_type_layout__construct_special_tagged(pair(cons_id, cons_tag),
+:- pred base_type_layout__layout_special(pair(cons_id, cons_tag),
layout_info, int, list(maybe(rval))).
-:- mode base_type_layout__construct_special_tagged(in, in, in, out) is semidet.
-base_type_layout__construct_special_tagged(_ConsId - ConsTag, LayoutInfo,
+:- mode base_type_layout__layout_special(in, in, in, out) is semidet.
+base_type_layout__layout_special(_ConsId - ConsTag, LayoutInfo,
MaxTags, Rvals) :-
base_type_layout__tag_value_const(Tag),
(
@@ -451,15 +568,37 @@
% For enumerations:
%
- % tag is 0, rest of word is pointer to
- % - enum indicator
- % - S, the number of constants in this enum
- % - S strings of constant names
+ % tag is 0, rest of word is pointer to enumeration vector.
-:- pred base_type_layout__construct_enum(assoc_list(cons_id, cons_tag),
+:- pred base_type_layout__layout_enum(assoc_list(cons_id, cons_tag),
layout_info, layout_info, list(maybe(rval))).
-:- mode base_type_layout__construct_enum(in, in, out, out) is det.
-base_type_layout__construct_enum(ConsList, LayoutInfo0, LayoutInfo, Rvals) :-
+:- mode base_type_layout__layout_enum(in, in, out, out) is det.
+base_type_layout__layout_enum(ConsList, LayoutInfo0, LayoutInfo, Rvals) :-
+
+ % Construct the vector
+ base_type_layout__layout_enum_vector(ConsList, VectorRvals),
+
+ % Create a tagged pointer to it
+ base_type_layout__get_next_label(LayoutInfo0, NextLabel),
+ base_type_layout__incr_next_label(LayoutInfo0, LayoutInfo),
+ base_type_layout__tag_value_const(Tag),
+ base_type_layout__encode_create(LayoutInfo, Tag,
+ VectorRvals, no, NextLabel, Rval),
+
+ % Duplicate it MaxTags times.
+ base_type_layout__get_max_tags(LayoutInfo, MaxTags),
+ list__duplicate(MaxTags, Rval, RvalList),
+ list__condense(RvalList, Rvals).
+
+ % Construct enumeration vector, which contains:
+ % - enum indicator (that is, yes, this is an enum)
+ % - S, the number of constants in this enum
+ % - S strings of constant names
+
+:- pred base_type_layout__layout_enum_vector(assoc_list(cons_id, cons_tag),
+ list(maybe(rval))).
+:- mode base_type_layout__layout_enum_vector(in, out) is det.
+base_type_layout__layout_enum_vector(ConsList, Rvals) :-
list__map(
lambda([ConsId::in, CtorRval::out] is det, (
( ConsId = cons(SymName, _Arity) - _ConsTag ->
@@ -470,31 +609,54 @@
)
)),
ConsList, CtorNameRvals),
-
base_type_layout__enum_indicator(yes, EnumIndicator),
Rval0 = yes(const(int_const(EnumIndicator))),
-
list__length(ConsList, NumCtors),
Rval1 = yes(const(int_const(NumCtors))),
+ Rvals = [Rval0, Rval1 | CtorNameRvals].
- base_type_layout__get_next_label(LayoutInfo0, NextLabel),
- base_type_layout__incr_next_label(LayoutInfo0, LayoutInfo),
- base_type_layout__tag_value_const(Tag),
- base_type_layout__encode_create(LayoutInfo, Tag,
- [Rval0, Rval1 | CtorNameRvals], no, NextLabel, Rval),
- base_type_layout__get_max_tags(LayoutInfo, MaxTags),
- list__duplicate(MaxTags, Rval, RvalList),
- list__condense(RvalList, Rvals).
% For no_tag types:
%
- % Tag is 3, rest of word is pointer to vector of
- % no_tag indicator, pseudo_type_info and functor name.
+ % Tag is 3, rest of word is pointer to no_tag vector.
-:- pred base_type_layout__construct_no_tag_type(sym_name, type, layout_info,
+:- pred base_type_layout__layout_no_tag(sym_name, type, layout_info,
layout_info, list(maybe(rval))).
-:- mode base_type_layout__construct_no_tag_type(in, in, in, out, out) is det.
-base_type_layout__construct_no_tag_type(SymName, Type, LayoutInfo0,
+:- mode base_type_layout__layout_no_tag(in, in, in, out, out) is det.
+base_type_layout__layout_no_tag(SymName, Type, LayoutInfo0,
+ LayoutInfo, Rvals) :-
+
+ base_type_layout__layout_no_tag_vector(SymName, Type,
+ LayoutInfo0, LayoutInfo1, VectorRvals),
+
+ base_type_layout__get_next_label(LayoutInfo1, NextLabel),
+ base_type_layout__incr_next_label(LayoutInfo1, LayoutInfo),
+ base_type_layout__tag_value_equiv(Tag),
+
+ base_type_layout__encode_create(LayoutInfo, Tag,
+ VectorRvals, no, NextLabel, Rval),
+
+ base_type_layout__get_max_tags(LayoutInfo, MaxTags),
+ list__duplicate(MaxTags, Rval, RvalsList),
+ list__condense(RvalsList, Rvals).
+
+ % no_tag vector:
+ % - no_tag indicator
+ % - pseudo_type_info (of the argument)
+ % - functor name.
+ % - tag information (bogus, see comment in code below)
+ %
+ % NOTE: Since the no_tag indicator is 1, this is the
+ % same data as a simple tagged functor of
+ % arity one would have, which is often convenient
+ % because for some purposes no_tags should be
+ % treated like simples.
+
+:- pred base_type_layout__layout_no_tag_vector(sym_name, type,
+ layout_info, layout_info, list(maybe(rval))).
+:- mode base_type_layout__layout_no_tag_vector(in, in, in, out, out)
+ is det.
+base_type_layout__layout_no_tag_vector(SymName, Type, LayoutInfo0,
LayoutInfo, Rvals) :-
% indicator of tag_type
@@ -509,27 +671,24 @@
unqualify_name(SymName, Name),
Rval2 = yes(const(string_const(Name))),
- base_type_layout__get_next_label(LayoutInfo1, NextLabel),
- base_type_layout__incr_next_label(LayoutInfo1, LayoutInfo),
- base_type_layout__tag_value_equiv(Tag),
-
- base_type_layout__encode_create(LayoutInfo, Tag,
- [Rval0, Rval1, Rval2], no, NextLabel, Rval),
-
- base_type_layout__get_max_tags(LayoutInfo, MaxTags),
- list__duplicate(MaxTags, Rval, RvalsList),
- list__condense(RvalsList, Rvals).
+ % create tag information
+ % since it's a no_tag, we'll give it a tag value of 0
+ % to be consistent, but this doesn't really have any
+ % meaning.
+ base_type_layout__encode_cons_tag(simple_tag(0), ConsTagRvals,
+ LayoutInfo1, LayoutInfo),
+ Rvals = [Rval0, Rval1, Rval2 | ConsTagRvals].
% For equivalences:
%
- % Tag is 3, rest of word is pointer to vector or
+ % Tag is 3, rest of word is pointer to pseudo_type_info or
% variable number
-:- pred base_type_layout__construct_eqv_type(type, layout_info,
+:- pred base_type_layout__layout_eqv(type, layout_info,
layout_info, list(maybe(rval))).
-:- mode base_type_layout__construct_eqv_type(in, in, out, out) is det.
-base_type_layout__construct_eqv_type(Type, LayoutInfo0, LayoutInfo, Rvals) :-
+:- mode base_type_layout__layout_eqv(in, in, out, out) is det.
+base_type_layout__layout_eqv(Type, LayoutInfo0, LayoutInfo, Rvals) :-
% generate rest of word, remove a level of creates
base_type_layout__generate_pseudo_type_info(Type, LayoutInfo0,
@@ -566,16 +725,16 @@
% describes what it represents. The list of words will
% form an array that can be indexed by primary tag.
-:- pred base_type_layout__construct_du_type(assoc_list(cons_id, cons_tag),
+:- pred base_type_layout__layout_du(assoc_list(cons_id, cons_tag),
layout_info, layout_info, list(maybe(rval))).
-:- mode base_type_layout__construct_du_type(in, in, out, out) is det.
-base_type_layout__construct_du_type([], _, _, []) :-
+:- mode base_type_layout__layout_du(in, in, out, out) is det.
+base_type_layout__layout_du([], _, _, []) :-
error("base_type_layout: type with no cons_tag information").
-base_type_layout__construct_du_type(ConsList, LayoutInfo0, LayoutInfo, Rvals) :-
+base_type_layout__layout_du(ConsList, LayoutInfo0, LayoutInfo, Rvals) :-
ConsList = [ConsPair | _],
base_type_layout__get_max_tags(LayoutInfo0, MaxTags),
(
- base_type_layout__construct_special_tagged(ConsPair,
+ base_type_layout__layout_special(ConsPair,
LayoutInfo0, MaxTags, Rvals0)
->
LayoutInfo0 = LayoutInfo,
@@ -588,6 +747,8 @@
).
+ % Generate an rval for each primary tag value.
+
:- pred base_type_layout__generate_rvals(list(pair(tag_category,
list(pair(cons_id, cons_tag)))), layout_info, layout_info,
list(maybe(rval)), list(maybe(rval))).
@@ -631,10 +792,9 @@
% For complicated constants:
%
% tag is 0, rest of word is pointer to
- % - enum indicator
+ % - enum indicator (no, this isn't an enum)
% - S, the number of constants sharing this tag
% - S strings of constant names
-
:- pred base_type_layout__handle_comp_const(list(pair(cons_id, cons_tag)),
layout_info, layout_info, list(maybe(rval))).
@@ -670,8 +830,9 @@
%
% Tag 1, with a pointer to an array containing:
% N - the arity of this functor
- % N argument pseudo-typeinfos
+ % N pseudo-typeinfos (of the arguments)
% - a string constant (the name of the functor)
+ % - tag information
:- pred base_type_layout__handle_simple(list(pair(cons_id, cons_tag)),
layout_info, layout_info, list(maybe(rval))).
@@ -679,7 +840,7 @@
base_type_layout__handle_simple([], _, _, _) :-
error("base_type_layout: no constructors for simple tag").
-base_type_layout__handle_simple([ConsId - _ConsTag | _], LayoutInfo0,
+base_type_layout__handle_simple([ConsId - ConsTag | _], LayoutInfo0,
LayoutInfo, Rval) :-
(
ConsId = cons(SymName, _Arity)
@@ -693,21 +854,24 @@
base_type_layout__incr_next_label(LayoutInfo0, LayoutInfo1),
list__length(ConsArgs, NumArgs),
base_type_layout__generate_pseudo_type_infos(ConsArgs,
- LayoutInfo1, LayoutInfo, PseudoTypeInfos),
+ LayoutInfo1, LayoutInfo2, PseudoTypeInfos),
+ base_type_layout__encode_cons_tag(ConsTag, ConsTagRvals, LayoutInfo2,
+ LayoutInfo),
list__append(PseudoTypeInfos,
- [yes(const(string_const(ConsString)))], EndRvals),
+ [yes(const(string_const(ConsString))) | ConsTagRvals],
+ EndRvals),
base_type_layout__tag_value(simple, Tag),
base_type_layout__encode_create(LayoutInfo, Tag,
[yes(const(int_const(NumArgs))) | EndRvals], no, NextLabel,
Rval).
+
% For complicated tags:
%
% Tag 2, with a pointer to an array containing:
% F - the number of functors sharing this tag
- % F pointers to arrays containing:
- % N - the arity of this functor
- % N argument pseudo-typeinfos
+ % F pointers to vectors, with the same info as
+ % a functor with a simple tag.
:- pred base_type_layout__handle_complicated(list(pair(cons_id, cons_tag)),
layout_info, layout_info, list(maybe(rval))).
@@ -740,6 +904,118 @@
base_type_layout__encode_create(LayoutInfo, Tag,
[NumSharersRval | SharedRvals], no, NextLabel, Rval).
+%---------------------------------------------------------------------------%
+
+ % Code to create the contents of base_type_functors.
+
+
+ % base_type_functors of an equivalence type:
+ %
+ % - equivalence indicator
+ % - pointer to equivalent pseudo_type_info
+
+:- pred base_type_layout__functors_eqv(type, layout_info, layout_info,
+ list(maybe(rval))).
+:- mode base_type_layout__functors_eqv(in, in, out, out) is det.
+
+base_type_layout__functors_eqv(Type, LayoutInfo0, LayoutInfo, Rvals) :-
+
+ % Construct pseudo
+ base_type_layout__generate_pseudo_type_info(Type, LayoutInfo0,
+ LayoutInfo, Rvals0),
+ base_type_layout__functors_value(equiv, EqvIndicator),
+ EqvRval = yes(const(int_const(EqvIndicator))),
+ Rvals = [EqvRval, Rvals0].
+
+ % base_type_functors of an enumeration:
+ %
+ % - enumeration indicator
+ % - pointer to enumeration vector
+
+:- pred base_type_layout__functors_enum(assoc_list(cons_id, cons_tag),
+ layout_info, layout_info, list(maybe(rval))).
+:- mode base_type_layout__functors_enum(in, in, out, out) is det.
+
+base_type_layout__functors_enum(ConsList, LayoutInfo0, LayoutInfo, Rvals) :-
+
+ % Construct the vector
+ base_type_layout__layout_enum_vector(ConsList, VectorRvals),
+
+ % Create a pointer to it
+ base_type_layout__get_next_label(LayoutInfo0, NextLabel),
+ base_type_layout__incr_next_label(LayoutInfo0, LayoutInfo),
+ base_type_layout__functors_value(enum, EnumIndicator),
+ EnumRval = yes(const(int_const(EnumIndicator))),
+ CreateRval = yes(create(0, VectorRvals, no, NextLabel)),
+ Rvals = [EnumRval, CreateRval].
+
+ % base_type_functors of a no_tag:
+ %
+ % - no_tag indicator
+ % - pointer to simple vector (same as for simple tag functors
+ % in base_type_layouts).
+ % (the simple vector describes the functor).
+
+:- pred base_type_layout__functors_no_tag(sym_name, type, layout_info,
+ layout_info, list(maybe(rval))).
+:- mode base_type_layout__functors_no_tag(in, in, in, out, out) is det.
+base_type_layout__functors_no_tag(SymName, Type, LayoutInfo0,
+ LayoutInfo, Rvals) :-
+
+ base_type_layout__layout_no_tag_vector(SymName, Type,
+ LayoutInfo0, LayoutInfo1, VectorRvals),
+
+ base_type_layout__get_next_label(LayoutInfo1, NextLabel),
+ base_type_layout__incr_next_label(LayoutInfo1, LayoutInfo),
+ CreateRval = yes(create(0, VectorRvals, no, NextLabel)),
+
+ base_type_layout__functors_value(no_tag, NoTagIndicator),
+ NoTagRval = yes(const(int_const(NoTagIndicator))),
+
+ Rvals = [NoTagRval, CreateRval].
+
+ % base_type_functors of a du:
+ %
+ % - du indicator
+ % - number of functors
+ % - vector of pointers to simple vector (same as for simple tag
+ % functors in base_type_layouts).
+ % (each simple vector describes a functor).
+
+:- pred base_type_layout__functors_du(assoc_list(cons_id, cons_tag),
+ layout_info, layout_info, list(maybe(rval))).
+:- mode base_type_layout__functors_du(in, in, out, out) is det.
+base_type_layout__functors_du(ConsList, LayoutInfo0, LayoutInfo, Rvals) :-
+ base_type_layout__functors_value(du, DuIndicator),
+ DuIndicatorRval = yes(const(int_const(DuIndicator))),
+ list__length(ConsList, Length),
+ LengthRval = yes(const(int_const(Length))),
+ list__foldr(
+ lambda([ConsPair::in, Acc::in, NewAcc::out] is det, (
+ Acc = Rvals0 - LayoutInfoA,
+ base_type_layout__handle_simple([ConsPair], LayoutInfoA,
+ LayoutInfoB, Rval1),
+ list__append(Rval1, Rvals0, Rvals1),
+ NewAcc = Rvals1 - LayoutInfoB)),
+ ConsList, [] - LayoutInfo0, VectorRvals - LayoutInfo),
+ Rvals = [DuIndicatorRval, LengthRval | VectorRvals].
+
+ % base_type_functors of a special:
+ %
+ % - special indicator
+
+:- pred base_type_layout__functors_special(pair(cons_id, cons_tag),
+ list(maybe(rval))).
+:- mode base_type_layout__functors_special(in, out) is semidet.
+base_type_layout__functors_special(_ConsId - ConsTag, Rvals) :-
+ (
+ ConsTag = string_constant(_) ;
+ ConsTag = float_constant(_) ;
+ ConsTag = int_constant(_)
+ ),
+ base_type_layout__functors_value(special, BuiltinIndicator),
+ BuiltinRval = yes(const(int_const(BuiltinIndicator))),
+ Rvals = [BuiltinRval].
%---------------------------------------------------------------------------%
@@ -798,7 +1074,7 @@
base_type_layout__get_next_label(LayoutInfo0, NextLabel),
base_type_layout__incr_next_label(LayoutInfo0, LayoutInfo1),
Pseudo0 = yes(const(data_addr_const(data_addr(TypeModule,
- base_type_info(TypeName, Arity))))),
+ base_type(info, TypeName, Arity))))),
% generate args, but remove one level of create()s.
base_type_layout__generate_pseudo_type_infos(TypeArgs,
Index: compiler/llds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds.m,v
retrieving revision 1.199
diff -u -r1.199 llds.m
--- llds.m 1997/01/29 00:47:40 1.199
+++ llds.m 1997/02/18 05:14:54
@@ -386,10 +386,16 @@
:- type data_name
---> common(int)
- ; base_type_info(string, arity)
- % type name, type arity
- ; base_type_layout(string, arity).
- % type name, type arity
+ ; base_type(base_data, string, arity).
+ % base_data, type name, type arity
+
+:- type base_data
+ ---> info
+ % basic information, including special preds
+ ; layout
+ % layout information
+ ; functors.
+ % information on functors
:- type unary_op
---> mktag
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.37
diff -u -r1.37 llds_out.m
--- llds_out.m 1997/02/17 03:47:32 1.37
+++ llds_out.m 1997/02/21 03:00:47
@@ -65,6 +65,11 @@
:- pred llds_out__maybe_qualify_name(string, string, string).
:- mode llds_out__maybe_qualify_name(in, in, out) is det.
+ % Create a name for base_type_*
+
+:- pred llds_out__make_base_type_name(base_data, string, arity, string).
+:- mode llds_out__make_base_type_name(in, in, in, out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -324,7 +329,7 @@
output_c_data_init_list(Ms).
output_c_data_init_list([c_data(BaseName, DataName, _, _, _) | Ms]) -->
(
- { DataName = base_type_info(TypeName, Arity) }
+ { DataName = base_type(info, TypeName, Arity) }
->
io__write_string("\tMR_INIT_BASE_TYPE_INFO(\n\t\t"),
output_data_addr(BaseName, DataName),
@@ -1499,7 +1504,7 @@
{ globals__have_static_code_addresses(Globals, StaticCode) },
(
{ StaticCode = no },
- { DeclId = data_addr(data_addr(_, base_type_info(_, _))) }
+ { DeclId = data_addr(data_addr(_, base_type(info, _, _))) }
->
[]
;
@@ -1802,7 +1807,7 @@
% Don't make decls of base_type_infos `const' if we
% don't have static code addresses.
(
- { VarName = base_type_info(_, _) },
+ { VarName = base_type(info, _, _) },
{ globals__have_static_code_addresses(Globals, no) }
->
[]
@@ -2009,19 +2014,11 @@
{ string__int_to_string(N, NStr) },
io__write_string(NStr)
;
- { VarName = base_type_info(TypeName0, TypeArity) },
- io__write_string("__base_type_info_"),
- { llds_out__name_mangle(TypeName0, TypeName) },
- io__write_string(TypeName),
- io__write_string("_"),
- io__write_int(TypeArity)
- ;
- { VarName = base_type_layout(TypeName0, TypeArity) },
- io__write_string("__base_type_layout_"),
- { llds_out__name_mangle(TypeName0, TypeName) },
- io__write_string(TypeName),
- io__write_string("_"),
- io__write_int(TypeArity)
+ { VarName = base_type(BaseData, TypeName0, TypeArity) },
+ { llds_out__make_base_type_name(BaseData, TypeName0, TypeArity,
+ Str) },
+ io__write_string("__"),
+ io__write_string(Str)
).
:- pred output_label_as_code_addr(label, io__state, io__state).
@@ -2935,6 +2932,25 @@
% String is the empty string
Name = String
).
+
+%-----------------------------------------------------------------------------%
+
+llds_out__make_base_type_name(BaseData, TypeName0, TypeArity, Str) :-
+ (
+ BaseData = info,
+ BaseString = "info"
+ ;
+ BaseData = layout,
+ BaseString = "layout"
+ ;
+ BaseData = functors,
+ BaseString = "functors"
+ ),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__append_list(["base_type_", BaseString, "_", TypeName, "_",
+ A_str], Str).
+
%-----------------------------------------------------------------------------%
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/opt_debug.m,v
retrieving revision 1.65
diff -u -r1.65 opt_debug.m
--- opt_debug.m 1997/01/29 00:48:08 1.65
+++ opt_debug.m 1997/02/18 06:04:19
@@ -676,12 +676,8 @@
opt_debug__dump_data_name(common(N), Str) :-
string__int_to_string(N, N_str),
string__append("common", N_str, Str).
-opt_debug__dump_data_name(base_type_info(TypeName, TypeArity), Str) :-
- string__int_to_string(TypeArity, A_str),
- string__append_list(["base_type_info_", TypeName, "_", A_str], Str).
-opt_debug__dump_data_name(base_type_layout(TypeName, TypeArity), Str) :-
- string__int_to_string(TypeArity, A_str),
- string__append_list(["base_type_layout_", TypeName, "_", A_str], Str).
+opt_debug__dump_data_name(base_type(BaseData, TypeName, TypeArity), Str) :-
+ llds_out__make_base_type_name(BaseData, TypeName, TypeArity, Str).
opt_debug__dump_unop(mktag, "mktag").
opt_debug__dump_unop(tag, "tag").
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_gen.m,v
retrieving revision 1.77
diff -u -r1.77 unify_gen.m
--- unify_gen.m 1996/12/31 09:58:50 1.77
+++ unify_gen.m 1997/02/18 05:52:42
@@ -294,7 +294,7 @@
),
{ Code = empty },
code_info__cache_expression(Var, const(data_addr_const(data_addr(
- ModuleName, base_type_info(TypeName, TypeArity))))).
+ ModuleName, base_type(info, TypeName, TypeArity))))).
unify_gen__generate_construction_2(code_addr_constant(PredId, ProcId),
Var, Args, _Modes, Code) -->
( { Args = [] } ->
Index: library/io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.m,v
retrieving revision 1.112
diff -u -r1.112 io.m
--- io.m 1997/02/19 02:47:39 1.112
+++ io.m 1997/02/21 01:28:48
@@ -1803,11 +1803,13 @@
const Word *f2;
const Word *f3;
const Word *f4;
+ Integer f5;
} mercury_data_io__base_type_layout_io__stream_0a = {
((Integer) 2),
(const Word *) & mercury_data_io__base_type_layout_io__stream_0b,
(const Word *) & mercury_data_io__base_type_layout_io__stream_0b,
- (const Word *) string_const(""io__stream"", 10)
+ (const Word *) string_const(""io__stream"", 10),
+ ((Integer) 0) /* Primary tag 0, no secondary tag */
};
const struct mercury_data_io__base_type_layout_io__stream_0_struct {
@@ -1817,6 +1819,16 @@
(const Word *) & mercury_data_io__base_type_layout_io__stream_0a)
};
+const struct mercury_data_io__base_type_functors_io__stream_0_struct {
+ Integer f1;
+ Integer f2;
+ const Word * f3;
+} mercury_data_io__base_type_functors_io__stream_0 = {
+ MR_TYPEFUNCTORS_DU,
+ ((Integer) 1), /* Single functor */
+ (const Word *) & mercury_data_io__base_type_layout_io__stream_0a
+};
+
#endif
Define_extern_entry(mercury____Unify___io__stream_0_0);
@@ -2147,6 +2159,12 @@
} mercury_data_io__base_type_layout_io__external_state_0 = {
make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG,
mkbody(TYPELAYOUT_INT_VALUE))
+};
+
+const struct mercury_data_io__base_type_functors_io__external_state_0_struct {
+ Integer f1;
+} mercury_data_io__base_type_functors_io__external_state_0 = {
+ MR_TYPEFUNCTORS_SPECIAL
};
#endif
Index: library/mercury_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/mercury_builtin.m,v
retrieving revision 1.67
diff -u -r1.67 mercury_builtin.m
--- mercury_builtin.m 1997/02/18 03:56:43 1.67
+++ mercury_builtin.m 1997/02/21 01:28:14
@@ -477,6 +477,8 @@
#ifdef USE_TYPE_LAYOUT
+ /* base_type_layout definitions */
+
const struct mercury_data___base_type_layout_int_0_struct {
TYPE_LAYOUT_FIELDS
} mercury_data___base_type_layout_int_0 = {
@@ -512,6 +514,38 @@
mkbody(TYPELAYOUT_PREDICATE_VALUE))
};
+ /* base_type_functors definitions */
+
+const struct mercury_data___base_type_functors_int_0_struct {
+ Integer f1;
+} mercury_data___base_type_functors_int_0 = {
+ MR_TYPEFUNCTORS_SPECIAL
+};
+
+const struct mercury_data___base_type_functors_character_0_struct {
+ Integer f1;
+} mercury_data___base_type_functors_character_0 = {
+ MR_TYPEFUNCTORS_SPECIAL
+};
+
+const struct mercury_data___base_type_functors_string_0_struct {
+ Integer f1;
+} mercury_data___base_type_functors_string_0 = {
+ MR_TYPEFUNCTORS_SPECIAL
+};
+
+const struct mercury_data___base_type_functors_float_0_struct {
+ Integer f1;
+} mercury_data___base_type_functors_float_0 = {
+ MR_TYPEFUNCTORS_SPECIAL
+};
+
+const struct mercury_data___base_type_functors_pred_0_struct {
+ Integer f1;
+} mercury_data___base_type_functors_pred_0 = {
+ MR_TYPEFUNCTORS_SPECIAL
+};
+
#endif /* USE_TYPE_LAYOUT */
Declare_entry(mercury__builtin_unify_int_2_0);
@@ -531,6 +565,7 @@
#ifdef USE_TYPE_LAYOUT
const Word *f7;
const Word *f8;
+ const Word *f9;
#endif
} mercury_data___base_type_info_int_0 = {
((Integer) 0),
@@ -543,6 +578,7 @@
#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_int_0,
+ (const Word *) & mercury_data___base_type_functors_int_0,
(const Word *) string_const(""int"", 3)
#endif
};
@@ -566,6 +602,7 @@
#ifdef USE_TYPE_LAYOUT
const Word *f7;
const Word *f8;
+ const Word *f9;
#endif
} mercury_data___base_type_info_character_0 = {
((Integer) 0),
@@ -580,6 +617,7 @@
#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_character_0,
+ (const Word *) & mercury_data___base_type_functors_character_0,
(const Word *) string_const(""char"", 4)
#endif
};
@@ -602,6 +640,7 @@
#ifdef USE_TYPE_LAYOUT
const Word *f7;
const Word *f8;
+ const Word *f9;
#endif
} mercury_data___base_type_info_string_0 = {
((Integer) 0),
@@ -614,6 +653,7 @@
#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_string_0,
+ (const Word *) & mercury_data___base_type_functors_string_0,
(const Word *) string_const(""string"", 6)
#endif
};
@@ -636,6 +676,7 @@
#ifdef USE_TYPE_LAYOUT
const Word *f7;
const Word *f8;
+ const Word *f9;
#endif
} mercury_data___base_type_info_float_0 = {
((Integer) 0),
@@ -648,6 +689,7 @@
#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_float_0,
+ (const Word *) & mercury_data___base_type_functors_float_0,
(const Word *) string_const(""float"", 5)
#endif
};
@@ -670,6 +712,7 @@
#ifdef USE_TYPE_LAYOUT
const Word *f7;
const Word *f8;
+ const Word *f9;
#endif
} mercury_data___base_type_info_pred_0 = {
((Integer) 0),
@@ -682,6 +725,7 @@
#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_pred_0,
+ (const Word *) & mercury_data___base_type_functors_pred_0,
(const Word *) string_const(""pred"", 4)
#endif
};
Index: library/std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.72
diff -u -r1.72 std_util.m
--- std_util.m 1997/02/19 04:10:14 1.72
+++ std_util.m 1997/02/21 01:03:02
@@ -692,6 +692,12 @@
mkbody(TYPELAYOUT_UNIV_VALUE))
};
+const struct mercury_data_std_util__base_type_functors_univ_0_struct {
+ Integer f1;
+} mercury_data_std_util__base_type_functors_univ_0 = {
+ MR_TYPEFUNCTORS_UNIV
+};
+
#endif
Define_extern_entry(mercury____Unify___std_util__univ_0_0);
Index: library/uniq_array.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/uniq_array.m,v
retrieving revision 1.15
diff -u -r1.15 uniq_array.m
--- uniq_array.m 1996/12/19 08:07:34 1.15
+++ uniq_array.m 1997/02/21 01:06:42
@@ -217,6 +217,12 @@
mkbody(TYPELAYOUT_INT_VALUE))
};
+const struct mercury_data_uniq_array__base_type_functors_uniq_array_1_struct {
+ Integer f1;
+} mercury_data_uniq_array__base_type_functors_uniq_array_1 = {
+ MR_TYPEFUNCTORS_SPECIAL
+};
+
#endif
BEGIN_MODULE(uniq_array_module)
Index: runtime/type_info.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/type_info.h,v
retrieving revision 1.19
diff -u -r1.19 type_info.h
--- type_info.h 1997/02/18 02:53:02 1.19
+++ type_info.h 1997/02/21 01:22:23
@@ -73,11 +73,13 @@
#ifdef USE_TYPE_TO_TERM
#define OFFSET_FOR_ARG_TYPE_INFOS 6
#define OFFSET_FOR_BASE_TYPE_LAYOUT 6
- #define OFFSET_FOR_TYPE_NAME 7
+ #define OFFSET_FOR_BASE_TYPE_FUNCTORS 7
+ #define OFFSET_FOR_TYPE_NAME 8
#else
#define OFFSET_FOR_ARG_TYPE_INFOS 4
#define OFFSET_FOR_BASE_TYPE_LAYOUT 4
- #define OFFSET_FOR_TYPE_NAME 5
+ #define OFFSET_FOR_BASE_TYPE_FUNCTORS 5
+ #define OFFSET_FOR_TYPE_NAME 6
#endif
/*
@@ -435,6 +437,20 @@
do { } while (0)
#endif /* MR_STATIC_CODE_ADDRESSES */
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** Macros and defintions for defining and dealing with
+** base_type_functors.
+*/
+
+#define MR_TYPEFUNCTORS_DU ((Integer) 0)
+#define MR_TYPEFUNCTORS_ENUM ((Integer) 1)
+#define MR_TYPEFUNCTORS_EQUIV ((Integer) 2)
+#define MR_TYPEFUNCTORS_SPECIAL ((Integer) 3)
+#define MR_TYPEFUNCTORS_NO_TAG ((Integer) 4)
+#define MR_TYPEFUNCTORS_UNIV ((Integer) 5)
/*---------------------------------------------------------------------------*/
--
Tyson Dowd # "Most people's C code should be indented
# six feet downward and covered with
trd at cs.mu.oz.au # dirt."
http://www.cs.mu.oz.au/~trd # - Blair Houghton, on C code indentation
More information about the developers
mailing list