[m-dev.] for review: compiler RTTI reorganization
Fergus Henderson
fjh at cs.mu.OZ.AU
Sun Mar 26 02:48:09 AEDT 2000
Zoltan, could you please review this one?
----------
Estimated hours taken: 30
Restructure the handling of RTTI and pseudo_type_infos
to reduce dependencies on the LLDS.
compiler/rtti.m:
- Change the various occurrences of llds__rval to rtti_data.
- Add `field_types' and `pseudo_type_info' as
new alternatives in the rtti_data and rtti_name types,
to provide ways of representing things that were
previously represented as create() llds__rvals.
compiler/rtti_out.m:
- Add some documentation to the interface.
- Modify to handle the changes to rtti.m.
compiler/type_ctor_info.m:
- Modify to handle the changes to rtti.m.
- Don't thread the cell_count or module_info through
most of the code here, since it is no longer necessary.
- Modify the interface to eliminate dependency on LLDS:
change generate_llds to return a list(rtti_data)
rather than a list(llds__comp_gen_c_data), and rename
it as generate_rtti.
compiler/mercury_compile.m:
Update to reflect the changed interface to type_ctor_info.m.
compiler/pseudo_type_info.m:
Rewrite much of this module to eliminate all dependencies on LLDS.
Rather than generating an llds__rval, this module now generates a new
type pseudo_type_info (which is used in the pseudo_type_info
alternative of the rtti_data type).
compiler/ll_pseudo_type_info.m:
New file, contains the parts of pseudo_type_info.m that depended on
LLDS. This is needed for stack_layout.m, which still needs
pseudo_type_infos represented as llds__rvals.
compiler/stack_layout.m:
Call the routines in ll_pseudo_type_info rather than those in
pseudo_type_info.
compiler/llds_common.m:
Don't traverse rtti_data rvals, since they can't contain create()
rvals anymore.
compiler/opt_debug.m:
Handle the new `field_types' and `pseudo_type_info' alternatives in
the rtti_data and rtti_name types.
compiler/rtti.m:
compiler/rtti_out.m:
compiler/llds_out.m:
The predicate `rtti_address_would_include_code_addrs' was
duplicated in both rtti.m and rtti_out.m. I deleted
the version in rtti.m, exported the version in rtti_out.m,
and changed llds_out.m to call the version in rtti_out.m.
runtime/mercury_type_info.h:
- Define macros for defining MR_TypeInfo and MR_PseudoTypeInfo
struct types of different arities, for use by the code
generated by compiler/rtti_out.m.
- Define MR_TypeCtorInfo as a pointer to a _const_ struct type,
to avoid the need to generate casts to cast-away-const in
various places in compiler/rtti_out.m.
(It would be nice to do the same thing for MR_TypeInfo
and MR_PseudoTypeInfo, since we never modify them after
constructing them, but currently they are modified by the
MR_fill_in_*() macros which are used to construct them.)
- Fix a couple of places where macro arguments were not
properly parenthesized.
Workspace: /home/mercury0/fjh/mercury
cvs diff: compiler/ll_pseudo_type_info.m is a new entry, no comparison available
Index: compiler/llds_common.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_common.m,v
retrieving revision 1.30
diff -u -d -r1.30 llds_common.m
--- compiler/llds_common.m 2000/03/20 05:24:55 1.30
+++ compiler/llds_common.m 2000/03/22 16:23:37
@@ -123,86 +123,8 @@
comp_gen_c_data(Name, DataName, Export, Args, ArgTypes, Refs),
Info0, Info) :-
llds_common__process_maybe_rvals(Args0, Args, Info0, Info).
-llds_common__process_data(rtti_data(RttiData0), rtti_data(RttiData),
- Info0, Info) :-
- llds_common__process_rtti_data(RttiData0, RttiData, Info0, Info).
-
-:- pred llds_common__process_rtti_data(rtti_data::in, rtti_data::out,
- common_info::in, common_info::out) is det.
-
-llds_common__process_rtti_data(
- exist_locns(RttiTypeId, Ordinal, Locns),
- exist_locns(RttiTypeId, Ordinal, Locns),
- Info, Info).
-llds_common__process_rtti_data(
- exist_info(RttiTypeId, Ordinal, Plain, InTci, Tci, Locns),
- exist_info(RttiTypeId, Ordinal, Plain, InTci, Tci, Locns),
- Info, Info).
-llds_common__process_rtti_data(
- field_names(RttiTypeId, Ordinal, Names),
- field_names(RttiTypeId, Ordinal, Names),
- Info, Info).
-llds_common__process_rtti_data(
- enum_functor_desc(RttiTypeId, FunctorName, Ordinal),
- enum_functor_desc(RttiTypeId, FunctorName, Ordinal),
- Info, Info).
-llds_common__process_rtti_data(
- notag_functor_desc(RttiTypeId, FunctorName, ArgType0),
- notag_functor_desc(RttiTypeId, FunctorName, ArgType),
- Info0, Info) :-
- llds_common__process_rval(ArgType0, ArgType, Info0, Info).
-llds_common__process_rtti_data(
- du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag, Locn,
- Ordinal, Arity, BitVector, Args0, Names, Exist),
- du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag, Locn,
- Ordinal, Arity, BitVector, Args, Names, Exist),
- Info0, Info) :-
- llds_common__process_rval(Args0, Args, Info0, Info).
-llds_common__process_rtti_data(
- enum_name_ordered_table(RttiTypeId, Functors),
- enum_name_ordered_table(RttiTypeId, Functors),
- Info, Info).
-llds_common__process_rtti_data(
- enum_value_ordered_table(RttiTypeId, Functors),
- enum_value_ordered_table(RttiTypeId, Functors),
- Info, Info).
-llds_common__process_rtti_data(
- du_name_ordered_table(RttiTypeId, Functors),
- du_name_ordered_table(RttiTypeId, Functors),
- Info, Info).
-llds_common__process_rtti_data(
- du_stag_ordered_table(RttiTypeId, Ptag, Functors),
- du_stag_ordered_table(RttiTypeId, Ptag, Functors),
- Info, Info).
-llds_common__process_rtti_data(
- du_ptag_ordered_table(RttiTypeId, Functors),
- du_ptag_ordered_table(RttiTypeId, Functors),
- Info, Info).
-llds_common__process_rtti_data(
- type_ctor_info(RttiTypeId, Unify, Index, Compare, Rep, Solver,
- Init, Version, NumPtags, NumFunctors, Functors,
- Layout0, HashCons, PrettyPrint),
- type_ctor_info(RttiTypeId, Unify, Index, Compare, Rep, Solver,
- Init, Version, NumPtags, NumFunctors, Functors,
- Layout, HashCons, PrettyPrint),
- Info0, Info) :-
- llds_common__process_layout_info(Layout0, Layout, Info0, Info).
-
-:- pred llds_common__process_layout_info(type_ctor_layout_info::in,
- type_ctor_layout_info::out, common_info::in, common_info::out) is det.
-
-llds_common__process_layout_info(no_layout, no_layout, Info, Info).
-llds_common__process_layout_info(enum_layout(Layout), enum_layout(Layout),
- Info, Info).
-llds_common__process_layout_info(notag_layout(Layout), notag_layout(Layout),
- Info, Info).
-llds_common__process_layout_info(du_layout(Layout), du_layout(Layout),
+llds_common__process_data(rtti_data(RttiData), rtti_data(RttiData),
Info, Info).
-llds_common__process_layout_info(
- equiv_layout(PseudoTypeInfo0), equiv_layout(PseudoTypeInfo),
- Info0, Info) :-
- llds_common__process_rval(PseudoTypeInfo0, PseudoTypeInfo,
- Info0, Info).
:- pred llds_common__process_procs(list(c_procedure)::in,
list(c_procedure)::out, common_info::in, common_info::out) is det.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.139
diff -u -d -r1.139 llds_out.m
--- compiler/llds_out.m 2000/03/21 04:54:26 1.139
+++ compiler/llds_out.m 2000/03/25 11:28:11
@@ -2402,7 +2402,7 @@
data_addr_would_include_code_address(data_addr(_, DataName), CodeAddr) :-
data_name_would_include_code_address(DataName, CodeAddr).
data_addr_would_include_code_address(rtti_addr(_, RttiName), CodeAddr) :-
- rtti__name_would_include_code_address(RttiName, CodeAddr).
+ rtti_name_would_include_code_addr(RttiName, CodeAddr).
:- pred data_name_would_include_code_address(data_name, bool).
:- mode data_name_would_include_code_address(in, out) is det.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.150
diff -u -d -r1.150 mercury_compile.m
--- compiler/mercury_compile.m 2000/03/10 13:37:46 1.150
+++ compiler/mercury_compile.m 2000/03/25 13:29:44
@@ -2033,7 +2033,8 @@
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(statistics, Stats),
globals__io_lookup_bool_option(common_data, CommonData),
- { type_ctor_info__generate_llds(HLDS0, HLDS1, TypeCtorTables) },
+ { type_ctor_info__generate_rtti(HLDS0, HLDS1, TypeCtorRttiData) },
+ { list__map(llds__wrap_rtti_data, TypeCtorRttiData, TypeCtorTables) },
{ base_typeclass_info__generate_llds(HLDS1, TypeClassInfos) },
{ stack_layout__generate_llds(HLDS1, HLDS, GlobalData,
PossiblyDynamicLayouts, StaticLayouts, LayoutLabels) },
@@ -2041,7 +2042,7 @@
{ global_data_get_all_proc_vars(GlobalData, GlobalVars) },
{ global_data_get_all_non_common_static_data(GlobalData,
NonCommonStaticData) },
- { list__append(StaticLayouts, TypeCtorTables, CommonableData0) },
+ { CommonableData0 = StaticLayouts },
( { CommonData = yes } ->
{ llds_common(Procs0, CommonableData0, ModuleName, Procs1,
CommonableData) }
@@ -2050,7 +2051,8 @@
{ Procs1 = Procs0 }
),
{ list__condense([CommonableData, NonCommonStaticData,
- TypeClassInfos, PossiblyDynamicLayouts], AllData) },
+ TypeCtorTables, TypeClassInfos, PossiblyDynamicLayouts],
+ AllData) },
mercury_compile__construct_c_file(C_InterfaceInfo, Procs1, GlobalVars,
AllData, CFile, NumChunks),
mercury_compile__output_llds(ModuleName, CFile, LayoutLabels,
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.100
diff -u -d -r1.100 opt_debug.m
--- compiler/opt_debug.m 2000/03/20 05:26:34 1.100
+++ compiler/opt_debug.m 2000/03/25 11:04:33
@@ -761,6 +761,9 @@
opt_debug__dump_rtti_name(field_names(Ordinal), Str) :-
string__int_to_string(Ordinal, Ordinal_str),
string__append("field_names_", Ordinal_str, Str).
+opt_debug__dump_rtti_name(field_types(Ordinal), Str) :-
+ string__int_to_string(Ordinal, Ordinal_str),
+ string__append("field_types_", Ordinal_str, Str).
opt_debug__dump_rtti_name(enum_functor_desc(Ordinal), Str) :-
string__int_to_string(Ordinal, Ordinal_str),
string__append("enum_functor_desc_", Ordinal_str, Str).
@@ -782,6 +785,9 @@
Str = "du_ptag_ordered_table".
opt_debug__dump_rtti_name(type_ctor_info, Str) :-
Str = "type_ctor_info".
+opt_debug__dump_rtti_name(pseudo_type_info(_Pseudo), Str) :-
+ % XXX should give more info than this
+ Str = "pseudo_type_info".
opt_debug__dump_rtti_name(type_hashcons_pointer, Str) :-
Str = "type_hashcons_pointer".
Index: compiler/pseudo_type_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pseudo_type_info.m,v
retrieving revision 1.1
diff -u -d -r1.1 pseudo_type_info.m
--- compiler/pseudo_type_info.m 2000/03/10 13:37:50 1.1
+++ compiler/pseudo_type_info.m 2000/03/25 14:44:58
@@ -15,17 +15,15 @@
%---------------------------------------------------------------------------%
:- module pseudo_type_info.
-
:- interface.
-
-:- import_module llds, prog_data.
+:- import_module prog_data, rtti.
+:- import_module list.
- % pseudo_type_info__construct_typed_pseudo_type_info(Type,
- % NumUnivQTvars, ExistQVars, Rval, LldsType, LabelNum0, LabelNum)
+ % pseudo_type_info__construct_pseudo_type_info(Type,
+ % NumUnivQTvars, ExistQVars, PseudoTypeInfo)
%
- % 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.
+ % Given a Mercury type (`Type'), this predicate returns an
+ % representation of the pseudo type info for that type.
%
% NumUnivQTvars is either the number of universally quantified type
% variables of the enclosing type (so that all universally quantified
@@ -33,37 +31,56 @@
% or is the special value -1, meaning that all variables in the type
% are universally quantified. 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 pseudo_type_info__construct_typed_pseudo_type_info((type)::in,
- int::in, existq_tvars::in, rval::out, llds_type::out,
- int::in, int::out) is det.
+:- pred pseudo_type_info__construct_pseudo_type_info((type)::in,
+ int::in, existq_tvars::in, pseudo_type_info::out) is det.
- % This is the same as the previous predicate, but does not return
- % the LLDS type.
+:- type pseudo_type_info
+ ---> type_var(int)
+ % This represents a type variable.
+ % Type variables are numbered consecutively,
+ % starting from 1.
+ ; type_ctor_info(
+ %
+ % This represents a zero-arity type,
+ % i.e. a type constructor with no arguments.
+ %
+ rtti_type_id
+ )
+ ; type_info(
+ %
+ % This represents a type with arity > zero,
+ % i.e. a type constructor applied to some arguments.
+ % The argument list should not be empty.
+ %
+ rtti_type_id,
+ list(pseudo_type_info)
+ )
+ ; higher_order_type_info(
+ %
+ % This represents a higher-order type.
+ % The rtti_type_id field will be pred/0
+ % or func/0; the real arity is
+ % given in the arity field.
+ %
+ rtti_type_id,
+ arity,
+ list(pseudo_type_info)
+ )
+ .
-:- pred pseudo_type_info__construct_pseudo_type_info((type)::in,
- int::in, existq_tvars::in, rval::out, int::in, int::out) is det.
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds_data, hlds_pred, hlds_out, builtin_ops, type_util.
-:- import_module rtti, make_tags, code_util, globals, options, prog_util.
-:- import_module list, assoc_list, bool, string, int, map, std_util, require.
-:- import_module term.
+:- import_module prog_util, type_util.
+:- import_module int, list, term, std_util, require.
%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
pseudo_type_info__construct_pseudo_type_info(Type, NumUnivQTvars,
- ExistQTvars, Pseudo, CNum0, CNum) :-
- pseudo_type_info__construct_typed_pseudo_type_info(Type, NumUnivQTvars,
- ExistQTvars, Pseudo, _LldsType, CNum0, CNum).
-
-pseudo_type_info__construct_typed_pseudo_type_info(Type, NumUnivQTvars,
- ExistQTvars, Pseudo, LldsType, CNum0, CNum) :-
+ ExistQTvars, Pseudo) :-
(
type_to_type_id(Type, TypeId, TypeArgs0)
->
@@ -94,34 +111,26 @@
TypeModule = unqualified(""),
TypeName = "pred",
Arity = 0,
+ RttiTypeId = rtti_type_id(TypeModule, TypeName, Arity),
TypeId = _QualTypeName - RealArity,
- RealArityArg = [yes(const(int_const(RealArity)))]
+ pseudo_type_info__generate_args(TypeArgs,
+ NumUnivQTvars, ExistQTvars, PseudoArgs),
+ Pseudo = higher_order_type_info(RttiTypeId, RealArity,
+ PseudoArgs)
;
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 :-
- pseudo_type_info__construct_pseudo_type_info(
- T, NumUnivQTvars, ExistQTvars, P, C0, C)
- ), TypeArgs, PseudoArgs0, CNum1, CNum),
- list__map(pseudo_type_info__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)
+ RttiTypeId = rtti_type_id(TypeModule, TypeName, Arity),
+ pseudo_type_info__generate_args(TypeArgs,
+ NumUnivQTvars, ExistQTvars, PseudoArgs),
+ ( PseudoArgs = [] ->
+ Pseudo = type_ctor_info(RttiTypeId)
+ ;
+ Pseudo = type_info(RttiTypeId, PseudoArgs)
+ )
+ )
;
type_util__var(Type, Var)
->
@@ -159,23 +168,20 @@
),
require(VarInt =< pseudo_type_info__pseudo_typeinfo_max_var,
"type_ctor_layout: type variable representation exceeds limit"),
- Pseudo = const(int_const(VarInt)),
- LldsType = integer,
- CNum = CNum0
+ Pseudo = type_var(VarInt)
;
error("type_ctor_layout: type neither var nor non-var")
).
- % Remove a create() from an rval, if present.
-
-:- pred pseudo_type_info__remove_create(rval::in, maybe(rval)::out) is det.
+:- pred pseudo_type_info__generate_args(list(type)::in,
+ int::in, existq_tvars::in, list(pseudo_type_info)::out) is det.
-pseudo_type_info__remove_create(Rval0, MaybeRval) :-
- ( Rval0 = create(_, [PTI], _, _, _, _, _) ->
- MaybeRval = PTI
- ;
- MaybeRval = yes(Rval0)
- ).
+pseudo_type_info__generate_args(TypeArgs, NumUnivQTvars, ExistQTvars,
+ PseudoArgs) :-
+ list__map((pred(T::in, P::out) is det :-
+ pseudo_type_info__construct_pseudo_type_info(
+ T, NumUnivQTvars, ExistQTvars, P)
+ ), TypeArgs, PseudoArgs).
%---------------------------------------------------------------------------%
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.1
diff -u -d -r1.1 rtti.m
--- compiler/rtti.m 2000/03/10 13:37:50 1.1
+++ compiler/rtti.m 2000/03/25 14:06:20
@@ -8,9 +8,12 @@
% within the compiler. When output by rtti_out.m, values of most these types
% will correspond to the types defined in runtime/mercury_type_info.h;
% the documentation of those types can be found there.
+% The code to generate the structures is in type_ctor_info.m.
+% See also pseudo_type_info.m.
%
% Eventually, this module will be independent of whether we are compiling
% to LLDS or MLDS. For the time being, it depends on LLDS.
+% See the XXX comment below.
%
% Author: zs.
@@ -20,8 +23,9 @@
:- interface.
-:- import_module llds, prog_data.
-:- import_module bool, list, std_util.
+:- import_module llds. % XXX for code_addr, which is used in type_ctor_infos
+:- import_module prog_data, pseudo_type_info.
+:- import_module list, std_util.
% For a given du type and a primary tag value, this says where,
% if anywhere, the secondary tag is.
@@ -68,7 +72,7 @@
rtti_name
)
; equiv_layout(
- rval
+ rtti_data % a pseudo_type_info rtti_data
)
; no_layout.
@@ -160,6 +164,14 @@
list(maybe(string)) % gives the field names
)
+ ; field_types(
+ rtti_type_id, % identifies the type
+ int, % identifies functor in type
+
+ list(rtti_data) % gives the field types
+ % (as pseudo_type_info
+ % rtti_data)
+ )
; enum_functor_desc(
rtti_type_id, % identifies the type
@@ -179,7 +191,9 @@
% the MR_NotagFunctorDesc C type.
string, % functor name
- rval % pseudo typeinfo of argument
+ rtti_data % pseudo typeinfo of argument
+ % (as a pseudo_type_info
+ % rtti_data)
)
; du_functor_desc(
rtti_type_id, % identifies the type
@@ -203,15 +217,18 @@
% contains variables (assuming
% that arguments are numbered
% from zero)
- rval, % a vector of length arity
+ rtti_name, % a vector of length arity
% containing the pseudo
% typeinfos of the arguments
+ % (a field_types rtti_name)
maybe(rtti_name), % possibly a vector of length
% arity containing the names
% of the arguments, if any
+ % (a field_names rtti_name)
maybe(rtti_name) % information about the
% existentially quantified
% type variables, if any
+ % (an exist_info rtti_name)
)
; enum_name_ordered_table(
rtti_type_id, % identifies the type
@@ -263,7 +280,7 @@
% one-to-one to the fields of the MR_TypeCtorInfo
% C type.
- rtti_type_id, % identifies the type
+ rtti_type_id, % identifies the type ctor
maybe(code_addr), % unify
maybe(code_addr), % index
maybe(code_addr), % compare
@@ -278,12 +295,15 @@
type_ctor_layout_info, % the layout table
maybe(rtti_name), % the type's hash cons table
maybe(code_addr) % prettyprinter
- ).
+ )
+ ; pseudo_type_info(pseudo_type_info)
+ .
:- type rtti_name
---> exist_locns(int) % functor ordinal
; exist_info(int) % functor ordinal
; field_names(int) % functor ordinal
+ ; field_types(int) % functor ordinal
; enum_functor_desc(int) % functor ordinal
; notag_functor_desc
; du_functor_desc(int) % functor ordinal
@@ -293,37 +313,33 @@
; du_stag_ordered_table(int) % primary tag
; du_ptag_ordered_table
; type_ctor_info
+ ; pseudo_type_info(pseudo_type_info)
; type_hashcons_pointer.
% Return the C variable name of the RTTI data structure identified
% by the input arguments.
+ % XXX this should be in rtti_out.m
:- pred rtti__addr_to_string(rtti_type_id::in, rtti_name::in, string::out)
is det.
% Return the C representation of a secondary tag location.
+ % XXX this should be in rtti_out.m
:- pred rtti__sectag_locn_to_string(sectag_locn::in, string::out) is det.
% Return the C representation of a type_ctor_rep value.
+ % XXX this should be in rtti_out.m
:- pred rtti__type_ctor_rep_to_string(type_ctor_rep::in, string::out) is det.
- % Return true iff the given type of RTTI data structure includes
- % code addresses.
-
-:- pred rtti__name_would_include_code_address(rtti_name::in, bool::out) is det.
-
:- implementation.
-:- import_module llds_out.
-:- import_module string.
+:- import_module llds_out, hlds_data, type_util.
+:- import_module string, require.
rtti__addr_to_string(RttiTypeId, RttiName, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
+ rtti__mangle_rtti_type_id(RttiTypeId, ModuleName, TypeName, A_str),
(
RttiName = exist_locns(Ordinal),
string__int_to_string(Ordinal, O_str),
@@ -340,6 +356,11 @@
string__append_list([ModuleName, "__field_names_",
TypeName, "_", A_str, "_", O_str], Str)
;
+ RttiName = field_types(Ordinal),
+ string__int_to_string(Ordinal, O_str),
+ string__append_list([ModuleName, "__field_types_",
+ TypeName, "_", A_str, "_", O_str], Str)
+ ;
RttiName = enum_functor_desc(Ordinal),
string__int_to_string(Ordinal, O_str),
string__append_list([ModuleName, "__enum_functor_desc_",
@@ -379,11 +400,80 @@
string__append_list([ModuleName, "__type_ctor_info_",
TypeName, "_", A_str], Str)
;
+ RttiName = pseudo_type_info(PseudoTypeInfo),
+ rtti__pseudo_type_info_to_string(PseudoTypeInfo, Str)
+ ;
RttiName = type_hashcons_pointer,
string__append_list([ModuleName, "__hashcons_ptr_",
TypeName, "_", A_str], Str)
).
+:- pred rtti__mangle_rtti_type_id(rtti_type_id, string, string, string).
+:- mode rtti__mangle_rtti_type_id(in, out, out, out) is det.
+
+rtti__mangle_rtti_type_id(RttiTypeId, ModuleName, TypeName, A_str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str).
+
+:- pred rtti__pseudo_type_info_to_string(pseudo_type_info::in, string::out)
+ is det.
+
+rtti__pseudo_type_info_to_string(PseudoTypeInfo, Str) :-
+ (
+ PseudoTypeInfo = type_var(VarNum),
+ string__int_to_string(VarNum, Str)
+ ;
+ PseudoTypeInfo = type_ctor_info(RttiTypeId),
+ rtti__addr_to_string(RttiTypeId, type_ctor_info, Str)
+ ;
+ PseudoTypeInfo = type_info(RttiTypeId, ArgTypes),
+ rtti__mangle_rtti_type_id(RttiTypeId,
+ ModuleName, TypeName, A_str),
+ ATs_str = pseudo_type_list_to_string(ArgTypes),
+ string__append_list([ModuleName, "__type_info_",
+ TypeName, "_", A_str, ATs_str], Str)
+ ;
+ PseudoTypeInfo = higher_order_type_info(RttiTypeId, RealArity, ArgTypes),
+ rtti__mangle_rtti_type_id(RttiTypeId,
+ ModuleName, TypeName, _A_str),
+ ATs_str = pseudo_type_list_to_string(ArgTypes),
+ string__int_to_string(RealArity, RA_str),
+ string__append_list([ModuleName, "__ho_type_info_",
+ TypeName, "_", RA_str, ATs_str], Str)
+ ).
+
+:- func pseudo_type_list_to_string(list(pseudo_type_info)) = string.
+pseudo_type_list_to_string(PseudoTypeList) =
+ string__append_list(list__map(pseudo_type_to_string, PseudoTypeList)).
+
+:- func pseudo_type_to_string(pseudo_type_info) = string.
+pseudo_type_to_string(type_var(Int)) =
+ string__append("__var_", string__int_to_string(Int)).
+pseudo_type_to_string(type_ctor_info(TypeId)) =
+ string__append("__type0_", rtti__type_id_to_string(TypeId)).
+pseudo_type_to_string(type_info(TypeId, ArgTypes)) =
+ string__append_list([
+ "__type_", rtti__type_id_to_string(TypeId),
+ pseudo_type_list_to_string(ArgTypes)
+ ]).
+pseudo_type_to_string(higher_order_type_info(TypeId, Arity, ArgTypes)) =
+ string__append_list([
+ "__ho_type_", rtti__type_id_to_string(TypeId),
+ "_", string__int_to_string(Arity),
+ pseudo_type_list_to_string(ArgTypes)
+ ]).
+
+:- func rtti__type_id_to_string(rtti_type_id) = string.
+rtti__type_id_to_string(RttiTypeId) = String :-
+ rtti__mangle_rtti_type_id(RttiTypeId, ModuleName, TypeName, A_Str),
+ String0 = string__append_list([ModuleName, "__", TypeName, "_", A_Str]),
+ % To ensure that the mapping is one-to-one, and to make demangling
+ % easier, we insert the length of the string at the start of the string.
+ string__length(String0, Length),
+ String = string__format("%d_%s", [i(Length), s(String0)]).
+
rtti__sectag_locn_to_string(sectag_none, "MR_SECTAG_NONE").
rtti__sectag_locn_to_string(sectag_local, "MR_SECTAG_LOCAL").
rtti__sectag_locn_to_string(sectag_remote, "MR_SECTAG_REMOTE").
@@ -411,16 +501,3 @@
rtti__type_ctor_rep_to_string(unknown,
"MR_TYPECTOR_REP_UNKNOWN").
-rtti__name_would_include_code_address(exist_locns(_), no).
-rtti__name_would_include_code_address(exist_info(_), no).
-rtti__name_would_include_code_address(field_names(_), no).
-rtti__name_would_include_code_address(enum_functor_desc(_), no).
-rtti__name_would_include_code_address(notag_functor_desc, no).
-rtti__name_would_include_code_address(du_functor_desc(_), no).
-rtti__name_would_include_code_address(enum_name_ordered_table, no).
-rtti__name_would_include_code_address(enum_value_ordered_table, no).
-rtti__name_would_include_code_address(du_name_ordered_table, no).
-rtti__name_would_include_code_address(du_stag_ordered_table(_), no).
-rtti__name_would_include_code_address(du_ptag_ordered_table, no).
-rtti__name_would_include_code_address(type_ctor_info, yes).
-rtti__name_would_include_code_address(type_hashcons_pointer, no).
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.4
diff -u -d -r1.4 rtti_out.m
--- compiler/rtti_out.m 2000/03/24 10:27:34 1.4
+++ compiler/rtti_out.m 2000/03/25 13:33:39
@@ -21,31 +21,59 @@
:- import_module rtti, llds_out.
:- import_module bool, io.
+ % output a C expression holding the address of the C name of
+ % the specified rtti_data
+:- pred output_addr_of_rtti_data(rtti_data::in, io__state::di, io__state::uo)
+ is det.
+
+ % output a C declaration for the rtti_data
:- pred output_rtti_data_decl(rtti_data::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
+ % output a C definition for the rtti_data
:- pred output_rtti_data_defn(rtti_data::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
+ % output C code (e.g. a call to the MR_INIT_TYPE_CTOR_INFO() macro)
+ % to initialize the rtti_data if necessary.
:- pred rtti_out__init_rtti_data_if_nec(rtti_data::in,
io__state::di, io__state::uo) is det.
+ % output the C name of the rtti_data specified by the given
+ % rtti_type_id and rtti_name.
:- pred output_rtti_addr(rtti_type_id::in, rtti_name::in,
io__state::di, io__state::uo) is det.
+ % output the C storage class, C type, and C name of the rtti_data
+ % specified by the given rtti_type_id and rtti_name,
+ % for use in a declaration or definition.
+ % The bool should be `yes' iff it is for a definition.
:- pred output_rtti_addr_storage_type_name(rtti_type_id::in, rtti_name::in,
bool::in, io__state::di, io__state::uo) is det.
+ % convert a rtti_data to an rtti_type_id and an rtti_name.
+ % This calls error/1 if the argument is a type_var/1 rtti_data,
+ % since there is no rtti_type_id to return in that case.
:- pred rtti_data_to_name(rtti_data::in, rtti_type_id::out, rtti_name::out)
is det.
+ % Return true iff the given type of RTTI data structure includes
+ % code addresses.
+:- pred rtti_name_would_include_code_addr(rtti_name::in, bool::out) is det.
+
:- pred rtti_name_linkage(rtti_name::in, linkage::out) is det.
+ % rtti_name_c_type(RttiName, Type, TypeSuffix):
+ % The type of the specified RttiName is given by Type
+ % and TypeSuffix, which are C code fragments suitable
+ % for use in a C declaration `<TypeName> foo <TypeSuffix>'.
+ % TypeSuffix will be "[]" if the given RttiName
+ % has an array type.
:- pred rtti_name_c_type(rtti_name::in, string::out, string::out) is det.
:- implementation.
-:- import_module llds, prog_out, c_util, options, globals.
+:- import_module pseudo_type_info, llds, prog_out, c_util, options, globals.
:- import_module string, list, require, std_util.
%-----------------------------------------------------------------------------%
@@ -79,6 +107,14 @@
io__write_string(" = {\n"),
output_maybe_quoted_strings(MaybeNames),
io__write_string("};\n").
+output_rtti_data_defn(field_types(RttiTypeId, Ordinal, Types),
+ DeclSet0, DeclSet) -->
+ output_rtti_datas_decls(Types, "", "", 0, _, DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeId, field_types(Ordinal),
+ DeclSet1, DeclSet),
+ io__write_string(" = {\n"),
+ output_addr_of_rtti_datas(Types),
+ io__write_string("};\n").
output_rtti_data_defn(enum_functor_desc(RttiTypeId, FunctorName, Ordinal),
DeclSet0, DeclSet) -->
output_generic_rtti_data_defn_start(RttiTypeId,
@@ -90,19 +126,20 @@
io__write_string("\n};\n").
output_rtti_data_defn(notag_functor_desc(RttiTypeId, FunctorName, ArgType),
DeclSet0, DeclSet) -->
- output_rval_decls(ArgType, "", "", 0, _, DeclSet0, DeclSet1),
+ output_rtti_data_decls(ArgType, "", "", 0, _, DeclSet0, DeclSet1),
output_generic_rtti_data_defn_start(RttiTypeId, notag_functor_desc,
DeclSet1, DeclSet),
io__write_string(" = {\n\t"""),
c_util__output_quoted_string(FunctorName),
- io__write_string(""",\n\t (MR_PseudoTypeInfo) "),
- output_rval(ArgType),
+ io__write_string(""",\n\t "),
+ output_addr_of_rtti_data(ArgType),
io__write_string("\n};\n").
output_rtti_data_defn(du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag,
Locn, Ordinal, Arity, ContainsVarBitVector, ArgTypes,
MaybeNames, MaybeExist),
DeclSet0, DeclSet) -->
- output_rval_decls(ArgTypes, "", "", 0, _, DeclSet0, DeclSet1),
+ output_rtti_addr_decls(RttiTypeId, ArgTypes, "", "", 0, _,
+ DeclSet0, DeclSet1),
(
{ MaybeNames = yes(NamesInfo1) },
output_rtti_addr_decls(RttiTypeId, NamesInfo1, "", "",
@@ -136,9 +173,10 @@
io__write_int(Stag),
io__write_string(",\n\t"),
io__write_int(Ordinal),
- io__write_string(",\n\t(MR_PseudoTypeInfo *) "),
- output_rval(ArgTypes),
io__write_string(",\n\t"),
+ io__write_string("(MR_PseudoTypeInfo *) "), % cast away const
+ output_addr_of_rtti_addr(RttiTypeId, ArgTypes),
+ io__write_string(",\n\t"),
(
{ MaybeNames = yes(NamesInfo2) },
output_rtti_addr(RttiTypeId, NamesInfo2)
@@ -149,8 +187,7 @@
io__write_string(",\n\t"),
(
{ MaybeExist = yes(ExistInfo2) },
- io__write_string("&"),
- output_rtti_addr(RttiTypeId, ExistInfo2)
+ output_addr_of_rtti_addr(RttiTypeId, ExistInfo2)
;
{ MaybeExist = no },
io__write_string("NULL")
@@ -273,9 +310,9 @@
output_rtti_addr(RttiTypeId, DuLayoutInfo),
io__write_string(" }")
;
- { LayoutInfo = equiv_layout(EquivRval) },
+ { LayoutInfo = equiv_layout(EquivTypeInfo) },
io__write_string("{ (void *) "),
- output_rval(EquivRval),
+ output_addr_of_rtti_data(EquivTypeInfo),
io__write_string(" }")
;
{ LayoutInfo = no_layout },
@@ -300,7 +337,44 @@
% io__write_string(",\n\t"),
% output_maybe_code_addr(Prettyprinter),
io__write_string("\n};\n").
+output_rtti_data_defn(pseudo_type_info(Pseudo), DeclSet0, DeclSet) -->
+ output_pseudo_type_info_defn(Pseudo, DeclSet0, DeclSet).
+
+:- pred output_pseudo_type_info_defn(pseudo_type_info, decl_set, decl_set,
+ io__state, io__state).
+:- mode output_pseudo_type_info_defn(in, in, out, di, uo) is det.
+output_pseudo_type_info_defn(type_var(_), DeclSet, DeclSet) --> [].
+output_pseudo_type_info_defn(type_ctor_info(_), DeclSet, DeclSet) --> [].
+output_pseudo_type_info_defn(TypeInfo, DeclSet0, DeclSet) -->
+ { TypeInfo = type_info(RttiTypeId, ArgTypes) },
+ { TypeCtorRttiData = pseudo_type_info(type_ctor_info(RttiTypeId)) },
+ { ArgRttiDatas = list__map(func(P) = pseudo_type_info(P), ArgTypes) },
+ output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _, DeclSet0, DeclSet1),
+ output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _, DeclSet1, DeclSet2),
+ output_generic_rtti_data_defn_start(RttiTypeId,
+ pseudo_type_info(TypeInfo), DeclSet2, DeclSet),
+ io__write_string(" = {\n\t&"),
+ output_rtti_addr(RttiTypeId, type_ctor_info),
+ io__write_string(",\n{"),
+ output_addr_of_rtti_datas(ArgRttiDatas),
+ io__write_string("}};\n").
+output_pseudo_type_info_defn(HO_TypeInfo, DeclSet0, DeclSet) -->
+ { HO_TypeInfo = higher_order_type_info(RttiTypeId, Arity, ArgTypes) },
+ { TypeCtorRttiData = pseudo_type_info(type_ctor_info(RttiTypeId)) },
+ { ArgRttiDatas = list__map(func(P) = pseudo_type_info(P), ArgTypes) },
+ output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _, DeclSet0, DeclSet1),
+ output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _, DeclSet1, DeclSet2),
+ output_generic_rtti_data_defn_start(RttiTypeId,
+ pseudo_type_info(HO_TypeInfo), DeclSet2, DeclSet),
+ io__write_string(" = {\n\t&"),
+ output_rtti_addr(RttiTypeId, type_ctor_info),
+ io__write_string(",\n\t"),
+ io__write_int(Arity),
+ io__write_string(",\n{"),
+ output_addr_of_rtti_datas(ArgRttiDatas),
+ io__write_string("}};\n").
+
:- pred output_functors_info_decl(rtti_type_id::in,
type_ctor_functors_info::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
@@ -334,9 +408,9 @@
DeclSet0, DeclSet) -->
output_generic_rtti_data_decl(RttiTypeId, DuLayoutInfo,
DeclSet0, DeclSet).
-output_layout_info_decl(_RttiTypeId, equiv_layout(EquivRval),
+output_layout_info_decl(_RttiTypeId, equiv_layout(EquivRttiData),
DeclSet0, DeclSet) -->
- output_rval_decls(EquivRval, "", "", 0, _, DeclSet0, DeclSet).
+ output_rtti_data_decl(EquivRttiData, DeclSet0, DeclSet).
output_layout_info_decl(_RttiTypeId, no_layout, DeclSet, DeclSet) --> [].
:- pred output_ptag_layout_decls(list(du_ptag_layout)::in, rtti_type_id::in,
@@ -373,9 +447,16 @@
%-----------------------------------------------------------------------------%
output_rtti_data_decl(RttiData, DeclSet0, DeclSet) -->
- { rtti_data_to_name(RttiData, RttiTypeId, RttiName) },
- output_generic_rtti_data_decl(RttiTypeId, RttiName,
- DeclSet0, DeclSet).
+ ( { RttiData = pseudo_type_info(type_var(_)) } ->
+ % These just get represented as integers,
+ % so we don't need to declare them.
+ % Also rtti_data_to_name/3 does not handle this case.
+ { DeclSet = DeclSet0 }
+ ;
+ { rtti_data_to_name(RttiData, RttiTypeId, RttiName) },
+ output_generic_rtti_data_decl(RttiTypeId, RttiName,
+ DeclSet0, DeclSet)
+ ).
rtti_data_to_name(exist_locns(RttiTypeId, Ordinal, _),
RttiTypeId, exist_locns(Ordinal)).
@@ -383,6 +464,8 @@
RttiTypeId, exist_info(Ordinal)).
rtti_data_to_name(field_names(RttiTypeId, Ordinal, _),
RttiTypeId, field_names(Ordinal)).
+rtti_data_to_name(field_types(RttiTypeId, Ordinal, _),
+ RttiTypeId, field_types(Ordinal)).
rtti_data_to_name(enum_functor_desc(RttiTypeId, _, Ordinal),
RttiTypeId, enum_functor_desc(Ordinal)).
rtti_data_to_name(notag_functor_desc(RttiTypeId, _, _),
@@ -401,7 +484,17 @@
RttiTypeId, du_ptag_ordered_table).
rtti_data_to_name(type_ctor_info(RttiTypeId, _,_,_,_,_,_,_,_,_,_,_,_,_),
RttiTypeId, type_ctor_info).
+rtti_data_to_name(pseudo_type_info(PseudoTypeInfo), RttiTypeId,
+ pseudo_type_info(PseudoTypeInfo)) :-
+ RttiTypeId = pti_get_rtti_type_id(PseudoTypeInfo).
+:- func pti_get_rtti_type_id(pseudo_type_info) = rtti_type_id.
+pti_get_rtti_type_id(type_ctor_info(RttiTypeId)) = RttiTypeId.
+pti_get_rtti_type_id(type_info(RttiTypeId, _)) = RttiTypeId.
+pti_get_rtti_type_id(higher_order_type_info(RttiTypeId, _, _)) = RttiTypeId.
+pti_get_rtti_type_id(type_var(_)) = _ :-
+ error("rtti_data_to_name: type_var").
+
%-----------------------------------------------------------------------------%
:- pred output_generic_rtti_data_decl(rtti_type_id::in, rtti_name::in,
@@ -423,6 +516,7 @@
{ decl_set_insert(DeclSet0, data_addr(DataAddr), DeclSet) }.
output_rtti_addr_storage_type_name(RttiTypeId, RttiName, BeingDefined) -->
+ output_rtti_type_decl(RttiName),
{ rtti_name_linkage(RttiName, Linkage) },
globals__io_get_globals(Globals),
{ c_data_linkage_string(Globals, Linkage, BeingDefined, LinkageStr) },
@@ -438,6 +532,44 @@
output_rtti_addr(RttiTypeId, RttiName),
io__write_string(Suffix).
+:- pred output_rtti_type_decl(rtti_name::in, io__state::di, io__state::uo)
+ is det.
+output_rtti_type_decl(RttiName) -->
+ (
+ %
+ % Each pseudo-type-info may have a different type,
+ % depending on what kind of pseudo-type-info it is,
+ % and also on its arity.
+ % We need to declare that type here.
+ %
+ {
+ RttiName = pseudo_type_info(type_info(_, ArgTypes)),
+ TypeNameBase = "MR_FO_PseudoTypeInfo_Struct",
+ DefineType = "MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT"
+ ;
+ RttiName = pseudo_type_info(higher_order_type_info(_, _,
+ ArgTypes)),
+ TypeNameBase = "MR_HO_PseudoTypeInfo_Struct",
+ DefineType = "MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT"
+ }
+ ->
+ { NumArgTypes = list__length(ArgTypes) },
+ { Template =
+"#ifndef %s%d_GUARD
+#define %s%d_GUARD
+%s(%s%d, %d);
+#endif
+" },
+ io__format(Template, [
+ s(TypeNameBase), i(NumArgTypes),
+ s(TypeNameBase), i(NumArgTypes),
+ s(DefineType), s(TypeNameBase),
+ i(NumArgTypes), i(NumArgTypes)
+ ])
+ ;
+ []
+ ).
+
%-----------------------------------------------------------------------------%
rtti_out__init_rtti_data_if_nec(Data) -->
@@ -488,6 +620,18 @@
output_maybe_rtti_addrs_decls(RttiTypeId, RttiNames,
FirstIndent, LaterIndent, N1, N, DeclSet1, DeclSet).
+:- pred output_rtti_datas_decls(list(rtti_data)::in,
+ string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_rtti_datas_decls([], _, _, N, N, DeclSet, DeclSet) --> [].
+output_rtti_datas_decls([RttiData | RttiDatas],
+ FirstIndent, LaterIndent, N0, N, DeclSet0, DeclSet) -->
+ output_rtti_data_decls(RttiData,
+ FirstIndent, LaterIndent, N0, N1, DeclSet0, DeclSet1),
+ output_rtti_datas_decls(RttiDatas,
+ FirstIndent, LaterIndent, N1, N, DeclSet1, DeclSet).
+
:- pred output_rtti_addrs_decls(rtti_type_id::in, list(rtti_name)::in,
string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
@@ -500,6 +644,24 @@
output_rtti_addrs_decls(RttiTypeId, RttiNames,
FirstIndent, LaterIndent, N1, N, DeclSet1, DeclSet).
+:- pred output_rtti_data_decls(rtti_data::in,
+ string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_rtti_data_decls(RttiData, FirstIndent, LaterIndent,
+ N0, N, DeclSet0, DeclSet) -->
+ ( { RttiData = pseudo_type_info(type_var(_)) } ->
+ % These just get represented as integers,
+ % so we don't need to declare them.
+ % Also rtti_data_to_name/3 does not handle this case.
+ { DeclSet = DeclSet0 },
+ { N = N0 }
+ ;
+ { rtti_data_to_name(RttiData, RttiTypeId, RttiName) },
+ output_rtti_addr_decls(RttiTypeId, RttiName,
+ FirstIndent, LaterIndent, N0, N, DeclSet0, DeclSet)
+ ).
+
:- pred output_rtti_addr_decls(rtti_type_id::in, rtti_name::in,
string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
@@ -542,11 +704,55 @@
output_addr_of_rtti_addr(RttiTypeId)),
io__write_string("\n").
+:- pred output_addr_of_rtti_datas(list(rtti_data)::in,
+ io__state::di, io__state::uo) is det.
+
+output_addr_of_rtti_datas([]) --> [].
+output_addr_of_rtti_datas([RttiData | RttiDatas]) -->
+ io__write_string("\t"),
+ io__write_list([RttiData | RttiDatas], ",\n\t",
+ output_addr_of_rtti_data),
+ io__write_string("\n").
+
+output_addr_of_rtti_data(RttiData) -->
+ ( { RttiData = pseudo_type_info(type_var(VarNum)) } ->
+ % rtti_data_to_name/3 does not handle this case
+ io__write_string("(MR_PseudoTypeInfo) "),
+ io__write_int(VarNum)
+ ;
+ { rtti_data_to_name(RttiData, RttiTypeId, RttiName) },
+ output_addr_of_rtti_addr(RttiTypeId, RttiName)
+ ).
+
:- pred output_addr_of_rtti_addr(rtti_type_id::in, rtti_name::in,
io__state::di, io__state::uo) is det.
output_addr_of_rtti_addr(RttiTypeId, RttiName) -->
- io__write_string("&"),
+ %
+ % The various different kinds of pseudotypeinfos
+ % each have different types, but really we treat
+ % them like a union rather than as separate types,
+ % so here we need to cast all such constants to
+ % a single type MR_PseudoTypeInfo.
+ %
+ (
+ { RttiName = pseudo_type_info(_) }
+ ->
+ io__write_string("(MR_PseudoTypeInfo) ")
+ ;
+ []
+ ),
+ %
+ % If the RttiName is not an array, then
+ % we need to use `&' to take its address
+ %
+ (
+ { rtti_name_c_type(RttiName, _, "[]" ) }
+ ->
+ []
+ ;
+ io__write_string("&")
+ ),
output_rtti_addr(RttiTypeId, RttiName).
output_rtti_addr(RttiTypeId, RttiName) -->
@@ -554,6 +760,8 @@
{ rtti__addr_to_string(RttiTypeId, RttiName, Str) },
io__write_string(Str).
+%-----------------------------------------------------------------------------%
+
:- pred output_maybe_quoted_string(maybe(string)::in,
io__state::di, io__state::uo) is det.
@@ -576,6 +784,8 @@
io__write_list(MaybeNames, ",\n\t", output_maybe_quoted_string),
io__write_string("\n").
+%-----------------------------------------------------------------------------%
+
:- pred output_exist_locn(exist_typeinfo_locn::in,
io__state::di, io__state::uo) is det.
@@ -610,11 +820,12 @@
output_maybe_code_addr(no) -->
io__write_string("NULL").
-:- pred rtti_name_would_include_code_addr(rtti_name::in, bool::out) is det.
+%-----------------------------------------------------------------------------%
rtti_name_would_include_code_addr(exist_locns(_), no).
rtti_name_would_include_code_addr(exist_info(_), no).
rtti_name_would_include_code_addr(field_names(_), no).
+rtti_name_would_include_code_addr(field_types(_), no).
rtti_name_would_include_code_addr(enum_functor_desc(_), no).
rtti_name_would_include_code_addr(notag_functor_desc, no).
rtti_name_would_include_code_addr(du_functor_desc(_), no).
@@ -624,11 +835,20 @@
rtti_name_would_include_code_addr(du_stag_ordered_table(_), no).
rtti_name_would_include_code_addr(du_ptag_ordered_table, no).
rtti_name_would_include_code_addr(type_ctor_info, yes).
+rtti_name_would_include_code_addr(pseudo_type_info(Pseudo),
+ pseudo_type_info_would_incl_code_addr(Pseudo)).
rtti_name_would_include_code_addr(type_hashcons_pointer, no).
+:- func pseudo_type_info_would_incl_code_addr(pseudo_type_info) = bool.
+pseudo_type_info_would_incl_code_addr(type_var(_)) = no.
+pseudo_type_info_would_incl_code_addr(type_ctor_info(_)) = yes.
+pseudo_type_info_would_incl_code_addr(type_info(_, _)) = no.
+pseudo_type_info_would_incl_code_addr(higher_order_type_info(_, _, _)) = no.
+
rtti_name_linkage(exist_locns(_), static).
rtti_name_linkage(exist_info(_), static).
rtti_name_linkage(field_names(_), static).
+rtti_name_linkage(field_types(_), static).
rtti_name_linkage(enum_functor_desc(_), static).
rtti_name_linkage(notag_functor_desc, static).
rtti_name_linkage(du_functor_desc(_), static).
@@ -638,11 +858,19 @@
rtti_name_linkage(du_stag_ordered_table(_), static).
rtti_name_linkage(du_ptag_ordered_table, static).
rtti_name_linkage(type_ctor_info, extern).
+rtti_name_linkage(pseudo_type_info(Pseudo), pseudo_type_info_linkage(Pseudo)).
rtti_name_linkage(type_hashcons_pointer, static).
+:- func pseudo_type_info_linkage(pseudo_type_info) = linkage.
+pseudo_type_info_linkage(type_var(_)) = static.
+pseudo_type_info_linkage(type_ctor_info(_)) = extern.
+pseudo_type_info_linkage(type_info(_, _)) = static.
+pseudo_type_info_linkage(higher_order_type_info(_, _, _)) = static.
+
rtti_name_c_type(exist_locns(_), "MR_DuExistLocn", "[]").
rtti_name_c_type(exist_info(_), "MR_DuExistInfo", "").
rtti_name_c_type(field_names(_), "ConstString", "[]").
+rtti_name_c_type(field_types(_), "MR_PseudoTypeInfo", "[]").
rtti_name_c_type(enum_functor_desc(_), "MR_EnumFunctorDesc", "").
rtti_name_c_type(notag_functor_desc, "MR_NotagFunctorDesc", "").
rtti_name_c_type(du_functor_desc(_), "MR_DuFunctorDesc", "").
@@ -653,4 +881,26 @@
rtti_name_c_type(du_ptag_ordered_table, "MR_DuPtagLayout", "[]").
rtti_name_c_type(type_ctor_info, "struct MR_TypeCtorInfo_Struct",
"").
+rtti_name_c_type(pseudo_type_info(Pseudo), TypePrefix, TypeSuffix) :-
+ pseudo_type_info_name_c_type(Pseudo, TypePrefix, TypeSuffix).
rtti_name_c_type(type_hashcons_pointer, "union MR_TableNode_Union **", "").
+
+:- pred pseudo_type_info_name_c_type(pseudo_type_info, string, string).
+:- mode pseudo_type_info_name_c_type(in, out, out) is det.
+
+pseudo_type_info_name_c_type(type_var(_), _, _) :-
+ % we use small integers to represent type_vars,
+ % rather than pointers, so there is no pointed-to type
+ error("rtti_name_c_type: type_var").
+pseudo_type_info_name_c_type(type_ctor_info(_),
+ "struct MR_TypeCtorInfo_Struct", "").
+pseudo_type_info_name_c_type(type_info(_TypeId, ArgTypes),
+ TypeInfoStruct, "") :-
+ TypeInfoStruct = string__format("struct MR_FO_PseudoTypeInfo_Struct%d",
+ [i(list__length(ArgTypes))]).
+pseudo_type_info_name_c_type(higher_order_type_info(_TypeId, _Arity, ArgTypes),
+ TypeInfoStruct, "") :-
+ TypeInfoStruct = string__format("struct MR_HO_PseudoTypeInfo_Struct%d",
+ [i(list__length(ArgTypes))]).
+
+%-----------------------------------------------------------------------------%
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.44
diff -u -d -r1.44 stack_layout.m
--- compiler/stack_layout.m 2000/03/10 13:37:53 1.44
+++ compiler/stack_layout.m 2000/03/22 16:23:37
@@ -253,8 +253,8 @@
:- implementation.
:- import_module globals, options, llds_out, trace.
-:- import_module hlds_data, hlds_pred, pseudo_type_info, prog_data, prog_out.
-:- import_module rtti, (inst), code_util.
+:- import_module hlds_data, hlds_pred, prog_data, prog_out.
+:- import_module rtti, ll_pseudo_type_info, (inst), code_util.
:- import_module assoc_list, bool, string, int, require.
:- import_module map, term, set.
@@ -1297,7 +1297,7 @@
ExistQTvars = [],
NumUnivQTvars = -1,
- pseudo_type_info__construct_typed_pseudo_type_info(Type,
+ ll_pseudo_type_info__construct_typed_llds_pseudo_type_info(Type,
NumUnivQTvars, ExistQTvars, ArgRval, ArgRvalType, CNum0, CNum).
%---------------------------------------------------------------------------%
@@ -1363,7 +1363,7 @@
% variable number directly from the procedure's tvar set.
{ ExistQTvars = [] },
{ NumUnivQTvars = -1 },
- { pseudo_type_info__construct_typed_pseudo_type_info(Type,
+ { ll_pseudo_type_info__construct_typed_llds_pseudo_type_info(Type,
NumUnivQTvars, ExistQTvars,
Rval, LldsType, CNum0, CNum) },
stack_layout__set_cell_number(CNum).
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.2
diff -u -d -r1.2 type_ctor_info.m
--- compiler/type_ctor_info.m 2000/03/24 02:16:19 1.2
+++ compiler/type_ctor_info.m 2000/03/25 13:35:50
@@ -21,14 +21,9 @@
% 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 low-level descriptions of type_ctor_infos
-% for LLDS (or later MLDS) from the surviving type_ctor_gen_infos.
-%
-% 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.
+% second stage then generates lower-level RTTI descriptions of type_ctor_infos
+% from the surviving type_ctor_gen_infos. These can then be easily
+% turned into either LLDS or MLDS.
%
% 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
@@ -44,17 +39,18 @@
:- interface.
-:- import_module hlds_module, llds.
+:- import_module hlds_module, rtti.
:- import_module list.
:- pred type_ctor_info__generate_hlds(module_info::in, module_info::out)
is det.
-:- pred type_ctor_info__generate_llds(module_info::in, module_info::out,
- list(comp_gen_c_data)::out) is det.
+:- pred type_ctor_info__generate_rtti(module_info::in, module_info::out,
+ list(rtti_data)::out) is det.
:- implementation.
+:- import_module llds. % XXX for code_addr
:- import_module rtti, pseudo_type_info.
:- import_module hlds_data, hlds_pred, hlds_out.
:- import_module make_tags, prog_data, prog_util, prog_out.
@@ -152,37 +148,38 @@
%---------------------------------------------------------------------------%
-type_ctor_info__generate_llds(ModuleInfo0, ModuleInfo, Tables) :-
- module_info_type_ctor_gen_infos(ModuleInfo0, TypeCtorGenInfos),
+type_ctor_info__generate_rtti(ModuleInfo, ModuleInfo, Tables) :-
+ module_info_type_ctor_gen_infos(ModuleInfo, TypeCtorGenInfos),
type_ctor_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),
+ ModuleInfo, [], Dynamic, [], Static0),
+ % The same pseudo_type_info may be generated in several
+ % places; we need to eliminate duplicates here, to avoid
+ % duplicate definition errors in the generated C code.
+ Static = list__remove_dups(Static0),
list__append(Dynamic, Static, Tables).
:- pred type_ctor_info__construct_type_ctor_infos(
- list(type_ctor_gen_info)::in, module_info::in, module_info::out,
+ list(type_ctor_gen_info)::in, module_info::in,
list(rtti_data)::in, list(rtti_data)::out,
list(rtti_data)::in, list(rtti_data)::out) is det.
-type_ctor_info__construct_type_ctor_infos([], ModuleInfo, ModuleInfo,
+type_ctor_info__construct_type_ctor_infos([], _ModuleInfo,
Dynamic, Dynamic, Static, Static).
type_ctor_info__construct_type_ctor_infos(
- [TypeCtorGenInfo | TypeCtorGenInfos], ModuleInfo0, ModuleInfo,
+ [TypeCtorGenInfo | TypeCtorGenInfos], ModuleInfo,
Dynamic0, Dynamic, Static0, Static) :-
type_ctor_info__construct_type_ctor_info(TypeCtorGenInfo,
- ModuleInfo0, ModuleInfo1, TypeCtorCModule, TypeCtorTables),
+ ModuleInfo, TypeCtorCModule, TypeCtorTables),
Dynamic1 = [TypeCtorCModule | Dynamic0],
list__append(TypeCtorTables, Static0, Static1),
type_ctor_info__construct_type_ctor_infos(TypeCtorGenInfos,
- ModuleInfo1, ModuleInfo, Dynamic1, Dynamic, Static1, Static).
+ ModuleInfo, Dynamic1, Dynamic, Static1, Static).
:- pred type_ctor_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.
+ module_info::in, rtti_data::out, list(rtti_data)::out) is det.
type_ctor_info__construct_type_ctor_info(TypeCtorGenInfo,
- ModuleInfo0, ModuleInfo, TypeCtorData, TypeCtorTables) :-
+ ModuleInfo, TypeCtorData, TypeCtorTables) :-
TypeCtorGenInfo = type_ctor_gen_info(_TypeId, ModuleName, TypeName,
TypeArity, _Status, HldsDefn,
MaybeUnify, MaybeIndex, MaybeCompare,
@@ -194,11 +191,11 @@
type_ctor_info__make_pred_addr(MaybeInit, ModuleInfo, Init),
type_ctor_info__make_pred_addr(MaybePretty, ModuleInfo, Pretty),
- module_info_globals(ModuleInfo0, Globals),
+ module_info_globals(ModuleInfo, Globals),
globals__lookup_bool_option(Globals, type_layout, TypeLayoutOption),
( TypeLayoutOption = yes ->
type_ctor_info__gen_layout_info(ModuleName,
- TypeName, TypeArity, HldsDefn, ModuleInfo0, ModuleInfo,
+ TypeName, TypeArity, HldsDefn, ModuleInfo,
TypeCtorRep, NumFunctors, MaybeFunctors, MaybeLayout,
NumPtags, TypeCtorTables)
;
@@ -210,8 +207,7 @@
NumFunctors = -1,
MaybeFunctors = no_functors,
MaybeLayout = no_layout,
- TypeCtorTables = [],
- ModuleInfo = ModuleInfo0
+ TypeCtorTables = []
),
Version = type_ctor_info_rtti_version,
RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity),
@@ -252,15 +248,14 @@
:- pred type_ctor_info__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,
+ module_info::in, type_ctor_rep::out, int::out,
type_ctor_functors_info::out, type_ctor_layout_info::out,
int::out, list(rtti_data)::out) is det.
type_ctor_info__gen_layout_info(ModuleName, TypeName, TypeArity, HldsDefn,
- ModuleInfo0, ModuleInfo, TypeCtorRep, NumFunctors,
+ ModuleInfo, TypeCtorRep, NumFunctors,
FunctorsInfo, LayoutInfo, NumPtags, 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")
@@ -271,7 +266,6 @@
FunctorsInfo = no_functors,
LayoutInfo = no_layout,
TypeTables = [],
- CellNumber = CellNumber0,
NumPtags = -1
;
TypeBody = eqv_type(Type),
@@ -281,15 +275,15 @@
TypeCtorRep = equiv(equiv_type_is_not_ground)
),
NumFunctors = -1,
+ FunctorsInfo = no_functors,
UnivTvars = TypeArity,
% There can be no existentially typed args to an
% equivalence.
ExistTvars = [],
- pseudo_type_info__construct_pseudo_type_info(Type,
- UnivTvars, ExistTvars, Rval, CellNumber0, CellNumber),
- FunctorsInfo = no_functors,
- LayoutInfo = equiv_layout(Rval),
- TypeTables = [],
+ make_pseudo_type_info_and_tables(Type,
+ UnivTvars, ExistTvars, PseudoTypeInfoRttiData,
+ [], TypeTables),
+ LayoutInfo = equiv_layout(PseudoTypeInfoRttiData),
NumPtags = -1
;
TypeBody = du_type(Ctors, ConsTagMap, Enum, EqualityPred),
@@ -308,7 +302,6 @@
type_ctor_info__make_enum_tables(Ctors, ConsTagMap,
RttiTypeId, TypeTables,
FunctorsInfo, LayoutInfo),
- CellNumber = CellNumber0,
NumPtags = -1
;
Enum = no,
@@ -321,11 +314,10 @@
TypeCtorRep = notag(EqualityAxioms, Inst),
type_ctor_info__make_notag_tables(Name,
ArgType, RttiTypeId,
- CellNumber0, CellNumber,
TypeTables, FunctorsInfo, LayoutInfo),
NumPtags = -1
;
- module_info_globals(ModuleInfo0, Globals),
+ module_info_globals(ModuleInfo, Globals),
globals__lookup_int_option(Globals,
num_tag_bits, NumTagBits),
int__pow(2, NumTagBits, NumTags),
@@ -333,39 +325,72 @@
TypeCtorRep = du(EqualityAxioms),
type_ctor_info__make_du_tables(Ctors,
ConsTagMap, MaxPtag, RttiTypeId,
- ModuleInfo0, CellNumber0, CellNumber,
+ ModuleInfo,
TypeTables, NumPtags,
FunctorsInfo, LayoutInfo)
)
)
- ),
- module_info_set_cell_count(ModuleInfo0, CellNumber, ModuleInfo).
+ ).
+% Construct an rtti_data for a pseudo_type_info,
+% and also construct rtti_data definitions for all of the pseudo_type_infos
+% that it references and prepend them to the given list of rtti_data tables.
+
+:- pred make_pseudo_type_info_and_tables(type, int, existq_tvars, rtti_data,
+ list(rtti_data), list(rtti_data)).
+:- mode make_pseudo_type_info_and_tables(in, in, in, out, in, out) is det.
+
+make_pseudo_type_info_and_tables(Type, UnivTvars, ExistTvars, RttiData,
+ Tables0, Tables) :-
+ pseudo_type_info__construct_pseudo_type_info(Type,
+ UnivTvars, ExistTvars, PseudoTypeInfo),
+ RttiData = pseudo_type_info(PseudoTypeInfo),
+ make_pseudo_type_info_tables(PseudoTypeInfo,
+ Tables0, Tables).
+
+% Construct rtti_data definitions for all of the non-atomic subterms
+% of a pseudo_type_info, and prepend them to the given
+% list of rtti_data tables.
+
+:- pred make_pseudo_type_info_tables(pseudo_type_info,
+ list(rtti_data), list(rtti_data)).
+:- mode make_pseudo_type_info_tables(in, in, out) is det.
+
+make_pseudo_type_info_tables(type_var(_), Tables, Tables).
+make_pseudo_type_info_tables(type_ctor_info(_), Tables, Tables).
+make_pseudo_type_info_tables(TypeInfo, Tables0, Tables) :-
+ TypeInfo = type_info(_, Args),
+ Tables1 = [pseudo_type_info(TypeInfo) | Tables0],
+ list__foldl(make_pseudo_type_info_tables, Args, Tables1, Tables).
+make_pseudo_type_info_tables(HO_TypeInfo, Tables0, Tables) :-
+ HO_TypeInfo = higher_order_type_info(_, _, Args),
+ Tables1 = [pseudo_type_info(HO_TypeInfo) | Tables0],
+ list__foldl(make_pseudo_type_info_tables, Args, Tables1, Tables).
+
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% Make the functor and notag tables for a notag type.
:- pred type_ctor_info__make_notag_tables(sym_name::in, (type)::in,
- rtti_type_id::in, int::in, int::out, list(rtti_data)::out,
+ rtti_type_id::in, list(rtti_data)::out,
type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
type_ctor_info__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 = [],
- pseudo_type_info__construct_pseudo_type_info(ArgType,
- UnivTvars, ExistTvars, Rval, CellNumber0, CellNumber),
- FunctorDesc = notag_functor_desc(RttiTypeId, FunctorName, Rval),
+ make_pseudo_type_info_and_tables(ArgType, UnivTvars, ExistTvars,
+ RttiData, [], Tables0),
+ FunctorDesc = notag_functor_desc(RttiTypeId, FunctorName, RttiData),
FunctorRttiName = notag_functor_desc,
FunctorsInfo = notag_functors(FunctorRttiName),
LayoutInfo = notag_layout(FunctorRttiName),
- TypeTables = [FunctorDesc].
+ TypeTables = [FunctorDesc | Tables0].
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -446,15 +471,14 @@
:- pred type_ctor_info__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, int::out,
+ list(rtti_data)::out, int::out,
type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
type_ctor_info__make_du_tables(Ctors, ConsTagMap, MaxPtag, RttiTypeId,
- ModuleInfo, CellNumber0, CellNumber,
- TypeTables, NumPtags, FunctorInfo, LayoutInfo) :-
+ ModuleInfo, TypeTables, NumPtags, FunctorInfo, LayoutInfo) :-
map__init(TagMap0),
type_ctor_info__make_du_functor_tables(Ctors, 0, ConsTagMap,
- RttiTypeId, ModuleInfo, CellNumber0, CellNumber,
+ RttiTypeId, ModuleInfo,
FunctorDescs, SortInfo0, TagMap0, TagMap),
list__sort(SortInfo0, SortInfo),
assoc_list__values(SortInfo, NameOrderedRttiNames),
@@ -481,13 +505,13 @@
:- pred type_ctor_info__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,
+ list(rtti_data)::out, name_sort_info::out,
tag_map::in, tag_map::out) is det.
type_ctor_info__make_du_functor_tables([], _, _, _, _,
- CellNumber, CellNumber, [], [], TagMap, TagMap).
+ [], [], TagMap, TagMap).
type_ctor_info__make_du_functor_tables([Functor | Functors], Ordinal,
- ConsTagMap, RttiTypeId, ModuleInfo, CellNumber0, CellNumber,
+ ConsTagMap, RttiTypeId, ModuleInfo,
Tables, SortInfo, TagMap0, TagMap) :-
Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs),
list__length(FunctorArgs, Arity),
@@ -519,7 +543,7 @@
type_ctor_info__generate_arg_info_tables(ModuleInfo,
RttiTypeId, Ordinal, FunctorArgs, ExistTvars,
- CellNumber0, CellNumber1, MaybeArgNames,
+ MaybeArgNames,
ArgPseudoTypeInfoVector, FieldTables, ContainsVarBitVector),
( ExistTvars = [] ->
MaybeExistInfo = no,
@@ -537,7 +561,7 @@
ArgPseudoTypeInfoVector, MaybeArgNames, MaybeExistInfo),
FunctorSortInfo = (FunctorName - Arity) - RttiName,
type_ctor_info__make_du_functor_tables(Functors, Ordinal + 1,
- ConsTagMap, RttiTypeId, ModuleInfo, CellNumber1, CellNumber,
+ ConsTagMap, RttiTypeId, ModuleInfo,
Tables1, SortInfo1, TagMap1, TagMap),
list__append([FunctorDesc | SubTables], Tables1, Tables),
SortInfo = [FunctorSortInfo | SortInfo1].
@@ -546,41 +570,39 @@
:- pred type_ctor_info__generate_arg_info_tables(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, int::out) is det.
+ maybe(rtti_name)::out, rtti_name::out, list(rtti_data)::out, int::out)
+ is det.
type_ctor_info__generate_arg_info_tables(
- ModuleInfo, RttiTypeId, Ordinal,
- Args, ExistTvars, CellNumber0, CellNumber,
- MaybeFieldNamesRttiName, Vector, Tables,
+ ModuleInfo, RttiTypeId, Ordinal, Args, ExistTvars,
+ MaybeFieldNamesRttiName, FieldTypesRttiName, Tables,
ContainsVarBitVector) :-
RttiTypeId = rtti_type_id(_TypeModule, _TypeName, TypeArity),
type_ctor_info__generate_arg_infos(Args, TypeArity, ExistTvars,
- ModuleInfo, CellNumber0, CellNumber1,
- MaybeArgNames, LldsTypes, MaybePseudoTypeInfos,
- 0, 0, ContainsVarBitVector),
+ ModuleInfo, MaybeArgNames, PseudoTypeInfos,
+ 0, 0, ContainsVarBitVector, [], Tables0),
+ FieldTypesRttiName = field_types(Ordinal),
+ FieldTypesTable = field_types(RttiTypeId, Ordinal,
+ PseudoTypeInfos),
+ Tables1 = [FieldTypesTable | Tables0],
list__filter((lambda([MaybeName::in] is semidet, MaybeName = yes(_))),
MaybeArgNames, FieldNames),
(
FieldNames = [],
MaybeFieldNamesRttiName = no,
- Tables = []
+ Tables = Tables1
;
FieldNames = [_|_],
FieldNameTable = field_names(RttiTypeId, Ordinal,
MaybeArgNames),
FieldNamesRttiName = field_names(Ordinal),
MaybeFieldNamesRttiName = yes(FieldNamesRttiName),
- Tables = [FieldNameTable]
- ),
- type_ctor_info__get_next_cell_number(CellNumber1, CN, CellNumber),
- Reuse = no,
- Vector = create(0, MaybePseudoTypeInfos, initial(LldsTypes, none),
- must_be_static, CN, "arg_types", Reuse).
+ Tables = [FieldNameTable | Tables1]
+ ).
% For each argument of a functor, return three items of information:
-% its name (if any), a pseudotypeinfo describing its type (and the llds_type
-% that describes the pseudotypeinfo), and an indication whether the type
+% its name (if any), a rtti_data for the pseudotypeinfo describing
+% its type, and an indication whether the type
% contains variables or not. The last item is encoded as an integer
% which contains a 1 bit in the position given by 1 << N if argument N's type
% contains variables (assuming that arguments are numbered starting from zero).
@@ -588,19 +610,17 @@
% arguments beyond this limit do not contribute to this bit vector.
:- pred type_ctor_info__generate_arg_infos(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, int::in, int::in, int::out) is det.
+ int::in, existq_tvars::in, module_info::in, list(maybe(string))::out,
+ list(rtti_data)::out, int::in, int::in, int::out,
+ list(rtti_data)::in, list(rtti_data)::out) is det.
-type_ctor_info__generate_arg_infos([], _, _, _,
- CellNumber, CellNumber, [], [], [],
- _, ContainsVarBitVector, ContainsVarBitVector).
+type_ctor_info__generate_arg_infos([], _, _, _, [], [],
+ _, ContainsVarBitVector, ContainsVarBitVector, Tables, Tables).
type_ctor_info__generate_arg_infos([MaybeArgSymName - ArgType | Args],
- NumUnivTvars, ExistTvars, ModuleInfo, CellNumber0, CellNumber,
- [MaybeArgName | MaybeArgNames],
- [1 - yes(LldsType) | LldsTypes],
- [yes(PseudoTypeInfo) | MaybePseudoTypeInfos],
- ArgNum, ContainsVarBitVector0, ContainsVarBitVector) :-
+ NumUnivTvars, ExistTvars, ModuleInfo,
+ [MaybeArgName | MaybeArgNames], [RttiData | RttiDatas],
+ ArgNum, ContainsVarBitVector0, ContainsVarBitVector,
+ Tables0, Tables) :-
(
MaybeArgSymName = yes(SymName),
unqualify_name(SymName, ArgName),
@@ -609,9 +629,8 @@
MaybeArgSymName = no,
MaybeArgName = no
),
- pseudo_type_info__construct_typed_pseudo_type_info(ArgType,
- NumUnivTvars, ExistTvars, PseudoTypeInfo, LldsType,
- CellNumber0, CellNumber1),
+ make_pseudo_type_info_and_tables(ArgType, NumUnivTvars, ExistTvars,
+ RttiData, Tables0, Tables1),
( term__is_ground(ArgType) ->
ContainsVarBitVector1 = ContainsVarBitVector0
;
@@ -623,9 +642,9 @@
ContainsVarBitVector1 = ContainsVarBitVector0 \/ (1 << BitNum)
),
type_ctor_info__generate_arg_infos(Args, NumUnivTvars,
- ExistTvars, ModuleInfo, CellNumber1, CellNumber,
- MaybeArgNames, LldsTypes, MaybePseudoTypeInfos,
- ArgNum + 1, ContainsVarBitVector1, ContainsVarBitVector).
+ ExistTvars, ModuleInfo, MaybeArgNames, RttiDatas,
+ ArgNum + 1, ContainsVarBitVector1, ContainsVarBitVector,
+ Tables1, Tables).
% This function gives the size of the MR_du_functor_arg_type_contains_var
% field of the C type MR_DuFunctorDesc in bits.
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.41
diff -u -d -r1.41 mercury_type_info.h
--- runtime/mercury_type_info.h 2000/03/24 10:27:52 1.41
+++ runtime/mercury_type_info.h 2000/03/25 13:52:00
@@ -82,8 +82,8 @@
/* Forward declarations */
-typedef struct MR_TypeCtorInfo_Struct *MR_TypeCtorInfo;
-typedef struct MR_TypeInfo_Almost_Struct *MR_TypeInfo;
+typedef const struct MR_TypeCtorInfo_Struct *MR_TypeCtorInfo;
+typedef struct MR_TypeInfo_Almost_Struct *MR_TypeInfo;
typedef struct MR_PseudoTypeInfo_Almost_Struct *MR_PseudoTypeInfo;
/*---------------------------------------------------------------------------*/
@@ -120,26 +120,45 @@
** 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.
*/
-struct MR_TypeInfo_Almost_Struct {
- MR_TypeCtorInfo MR_ti_type_ctor_info;
- Integer MR_ti_higher_order_arity;
- MR_TypeInfo MR_ti_first_ho_arg_typeinfo;
-};
+/*
+** First define generic macro versions of these struct types;
+** these are used in the code that the compiler generates
+** for static constant typeinfos and pseudotypeinfos.
+*/
+#define MR_FIRST_ORDER_TYPEINFO_STRUCT(NAME, ARITY) \
+ struct NAME { \
+ MR_TypeCtorInfo MR_ti_type_ctor_info; \
+ MR_TypeInfo MR_ti_first_order_arg_typeinfos[ARITY]; \
+ }
+#define MR_HIGHER_ORDER_TYPEINFO_STRUCT(NAME, ARITY) \
+ struct NAME { \
+ MR_TypeCtorInfo MR_ti_type_ctor_info; \
+ Integer MR_ti_higher_order_arity; \
+ MR_TypeInfo MR_ti_higher_order_arg_typeinfos[ARITY]; \
+ }
+#define MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(NAME, ARITY) \
+ struct NAME { \
+ MR_TypeCtorInfo MR_pti_type_ctor_info; \
+ MR_PseudoTypeInfo MR_pti_first_order_arg_pseudo_typeinfos[ARITY]; \
+ }
+#define MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(NAME, ARITY) \
+ struct NAME { \
+ MR_TypeCtorInfo MR_pti_type_ctor_info; \
+ Integer MR_pti_higher_order_arity; \
+ MR_PseudoTypeInfo MR_pti_higher_order_arg_pseudo_typeinfos[ARITY]; \
+ }
-struct MR_PseudoTypeInfo_Almost_Struct {
- MR_TypeCtorInfo MR_pti_type_ctor_info;
- Integer MR_pti_higher_order_arity;
- MR_PseudoTypeInfo MR_pti_first_ho_arg_pseudo_typeinfo;
-};
+/*
+** Now define specific versions of these struct types,
+** which are used by the MR_TypeInfo and MR_PseudoTypeInfo
+** typedefs above.
+*/
+MR_HIGHER_ORDER_TYPEINFO_STRUCT(MR_TypeInfo_Almost_Struct,
+ MR_VARIABLE_SIZED);
+MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_PseudoTypeInfo_Almost_Struct,
+ MR_VARIABLE_SIZED);
/*
** When converting a MR_PseudoTypeInfo to a MR_TypeInfo, we need the
@@ -147,9 +166,16 @@
** A MR_TypeInfoParams array serves this purpose. Because type variables
** start at one, MR_TypeInfoParams arrays also start at one.
*/
-
typedef MR_TypeInfo *MR_TypeInfoParams;
+/*
+** 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.
+*/
#define MR_PSEUDOTYPEINFO_EXIST_VAR_BASE 512
#define MR_PSEUDOTYPEINFO_MAX_VAR 1024
@@ -191,9 +217,9 @@
#define MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info) \
((MR_TypeInfoParams) &(type_info)->MR_ti_type_ctor_info)
- /*
- ** Macros for creating type_infos.
- */
+/*
+** Macros for creating type_infos.
+*/
#define MR_first_order_type_info_size(arity) \
(1 + (arity))
@@ -204,18 +230,18 @@
#define MR_fill_in_first_order_type_info(arena, type_ctor_info, vector) \
do { \
MR_TypeInfo new_ti; \
- new_ti = (MR_TypeInfo) arena; \
+ new_ti = (MR_TypeInfo) (arena); \
new_ti->MR_ti_type_ctor_info = (type_ctor_info); \
- vector = (MR_TypeInfoParams) &new_ti->MR_ti_type_ctor_info; \
+ (vector) = (MR_TypeInfoParams) &new_ti->MR_ti_type_ctor_info; \
} while (0)
#define MR_fill_in_higher_order_type_info(arena, type_ctor_info, arity, vector)\
do { \
MR_TypeInfo new_ti; \
- new_ti = (MR_TypeInfo) arena; \
+ new_ti = (MR_TypeInfo) (arena); \
new_ti->MR_ti_type_ctor_info = (type_ctor_info); \
new_ti->MR_ti_higher_order_arity = (arity); \
- vector = (MR_TypeInfoParams) &new_ti->MR_ti_higher_order_arity;\
+ (vector) = (MR_TypeInfoParams) &new_ti->MR_ti_higher_order_arity;\
} while (0)
/*---------------------------------------------------------------------------*/
==================================================
new file compiler/ll_pseudo_type_info.m
==================================================
%---------------------------------------------------------------------------%
% Copyright (C) 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: ll_pseudo_type_info.m
% author: fjh
%
% This module generates LLDS representations for pseudo-type-infos.
%
% Most of the work is done by pseudo_type_info.m, which generates
% a back-end-independent representation of pseudo-type-infos;
% this module just converts that representation to LLDS.
%
% The documentation of the structures of pseudo-type-infos is in
% runtime/mercury_type_info.h; that file also contains a list of all
% the files that depend on such data structures.
%
%---------------------------------------------------------------------------%
:- module ll_pseudo_type_info.
:- interface.
:- import_module prog_data, llds.
% ll_pseudo_type_info__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 either the number of universally quantified type
% variables of the enclosing type (so that all universally quantified
% variables in the type have numbers in the range [1..NumUnivQTvars],
% or is the special value -1, meaning that all variables in the type
% are universally quantified. 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 ll_pseudo_type_info__construct_typed_llds_pseudo_type_info((type)::in,
int::in, existq_tvars::in, rval::out, llds_type::out,
int::in, int::out) is det.
% This is the same as the previous predicate, but does not return
% the LLDS type.
:- pred ll_pseudo_type_info__construct_llds_pseudo_type_info((type)::in,
int::in, existq_tvars::in, rval::out, int::in, int::out) is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module pseudo_type_info, rtti.
:- import_module std_util, list, bool, int.
ll_pseudo_type_info__construct_llds_pseudo_type_info(Type, NumUnivQTvars,
ExistQTvars, Pseudo, CNum0, CNum) :-
ll_pseudo_type_info__construct_typed_llds_pseudo_type_info(Type,
NumUnivQTvars, ExistQTvars, Pseudo, _LldsType, CNum0, CNum).
ll_pseudo_type_info__construct_typed_llds_pseudo_type_info(Type, NumUnivQTvars,
ExistQTvars, PseudoRval, LldsType, CNum0, CNum) :-
pseudo_type_info__construct_pseudo_type_info(Type, NumUnivQTvars,
ExistQTvars, Pseudo),
convert_pseudo(Pseudo, PseudoRval, LldsType, CNum0, CNum).
:- pred convert_pseudo(pseudo_type_info, rval, llds_type, int, int).
:- mode convert_pseudo(in, out, out, in, out) is det.
convert_pseudo(Pseudo, Rval, LldsType, CNum0, CNum) :-
(
Pseudo = type_var(Int),
Rval = const(int_const(Int)),
LldsType = integer,
CNum = CNum0
;
Pseudo = type_ctor_info(RttiTypeId),
DataAddr = rtti_addr(RttiTypeId, pseudo_type_info(Pseudo)),
Rval = const(data_addr_const(DataAddr)),
LldsType = data_ptr,
CNum = CNum0
;
Pseudo = type_info(RttiTypeId, Args),
convert_compound_pseudo(RttiTypeId, [], Args, Rval, LldsType,
CNum0, CNum)
;
Pseudo = higher_order_type_info(RttiTypeId, Arity, Args),
ArityArg = yes(const(int_const(Arity))),
convert_compound_pseudo(RttiTypeId, [ArityArg], Args, Rval,
LldsType, CNum0, CNum)
).
:- pred convert_compound_pseudo(rtti_type_id, list(maybe(rval)),
list(pseudo_type_info), rval, llds_type, int, int).
:- mode convert_compound_pseudo(in, in, in, out, out, in, out) is det.
convert_compound_pseudo(RttiTypeId, ArgRvals0, Args,
Rval, LldsType, CNum0, CNum) :-
TypeCtorInfoPseudo = pseudo_type_info(type_ctor_info(RttiTypeId)),
TypeCtorInfoDataAddr = rtti_addr(RttiTypeId, TypeCtorInfoPseudo),
TypeCtorInfoRval = yes(const(data_addr_const(TypeCtorInfoDataAddr))),
LldsType = data_ptr,
CNum1 = CNum0 + 1,
list__map_foldl((pred(A::in, yes(AR)::out, C0::in, C::out) is det :-
convert_pseudo(A, AR, _LldsType, C0, C)
), Args, ArgRvals1, CNum1, CNum),
list__append(ArgRvals0, ArgRvals1, ArgRvals),
Reuse = no,
Rval = create(0, [TypeCtorInfoRval | ArgRvals],
uniform(no), must_be_static, CNum1, "type_info",
Reuse).
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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