[m-rev.] for review: a step towards Mercury-level RTTI for Java and IL
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu May 16 02:20:47 AEST 2002
For review by Fergus and/or Pete.
Zoltan.
Another step towards RTTI in Mercury.
This step redefines the representation of type_ctor_infos inside the compiler
to be identical to the representation we will need for efficient interpretation
of RTTI data structures in Mercury, following on from an earlier step which
did the same for (pseudo)typeinfos.
Instead of the type_ctor_info being broken down into its components in
type_ctor_info.m, the breakdown process is now performed in rtti_out.m (for the
LLDS backend) and rtti_to_mlds.m (for the MLDS backend). Eventually, the IL and
Java backends will stop using rtti_to_mlds.m for this purpose, and will instead
write out the type_ctor_data structures as static data to be interpreted
directly.
runtime/mercury_type_info.h:
To be able to represent all the kinds of types we now support
- add a data structure for converting values of reserved_addr types
from their printable representation to their internal representation
(it was previously missing), and
- add a type_ctor_rep to represent foreign types.
Add missing MR_ prefixes on some field names.
compiler/rtti.m:
Add new, purely Mercury data structures for representing
type_ctor_infos and their components, designed both for efficient
interpretation and as a source for the generation of static data
structures in C.
This entailed deleting most of the alternatives of the rtti_data type
while preserving their rtti_name equivalents; the deleted alternatives
represent tables are no longer created in type_ctor_info.m but which
are created dynamically in rtti_out.m and rtti_to_mlds.m (which need
a way for one table to refer to another).
Add utility predicates on the new data structures for use by both
rtti_out.m and rtti_to_mlds.m.
compiler/hlds_module.m:
Always store the ids of unification and comparison procedures in
type_ctor_gen_infos, to simplify their handling.
compiler/type_ctor_info.m:
Generate the new data structures for representing type_ctor_infos.
Conform to the changed data structures for type_ctor_gen_infos.
compiler/rtti_out.m:
compiler/rtti_to_mlsd.m:
Rewrite substantial parts of these modules to convert the new data
structures for representing type_ctor_infos to sets of discrete
structures dynamically.
Most of the dynamically created structures are unique by construction,
but this is not true for typeinfos and pseudo-typeinfos. Therefore
add mechanisms to ensure that we don't generate redundant structures
representing typeinfos and pseudo-typeinfos.
compiler/mlds_to_gcc.m:
Conform to the changed data structures in rtti.m and
mercury_type_info.h.
compiler/opt_debug.m:
Conform to the changed data structures in rtti.m.
compiler/dead_proc_elim.m:
Conform to the changed data structures for type_ctor_gen_infos.
compiler/pseudo_type_info.m:
Add a predicate to construct a representation of a type that may or may
not be ground.
compiler/mlds_to_gcc.m:
java/runtime/TypeCtorRep.java:
library/rtti_implemenation.m:
library/private_builtin.m:
runtime/mercury_mcpp.{cpp,h}:
Add the type_ctor_rep for foreign types to the lists of type_ctor_reps.
library/construct.m:
library/deconstruct.m:
Add missing MR_ prefixes on field names.
runtime/mercury_construct.c:
runtime/mercury_deconstruct.c:
runtime/mercury_deep_copy_body.h:
runtime/mercury_ml_expand_body.h:
runtime/mercury_tabling.c:
runtime/mercury_type_info.c:
runtime/mercury_unify_compare_body.h:
Handle the type_ctor_rep for foreign types.
Add missing MR_ prefixes on field names.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.71
diff -u -b -r1.71 dead_proc_elim.m
--- compiler/dead_proc_elim.m 28 Mar 2002 03:42:51 -0000 1.71
+++ compiler/dead_proc_elim.m 28 Apr 2002 16:52:02 -0000
@@ -334,13 +334,10 @@
(
TypeCtorGenInfo = type_ctor_gen_info(_TypeCtor, ModuleName,
TypeName, TypeArity, _Status, _HldsDefn,
- MaybeUnify, MaybeCompare)
+ Unify, Compare)
->
- Refs0 = [],
- dead_proc_elim__maybe_add_ref(MaybeUnify, Refs0, Refs1),
- dead_proc_elim__maybe_add_ref(MaybeCompare, Refs1, Refs2),
- % dead_proc_elim__maybe_add_ref(MaybePretty, Refs2, Refs3),
- Refs = Refs2
+ Refs = [Unify, Compare]
+ % dead_proc_elim__maybe_add_ref(MaybePretty, Refs0, Refs)
;
dead_proc_elim__find_base_gen_info(ModuleName, TypeName,
TypeArity, TypeCtorGenInfos, Refs)
@@ -669,20 +666,15 @@
Needed, TypeCtorGenInfos) :-
dead_proc_elim__eliminate_base_gen_infos(TypeCtorGenInfos0, Needed,
TypeCtorGenInfos1),
- TypeCtorGenInfo0 = type_ctor_gen_info(TypeCtor, ModuleName,
- TypeName, Arity, Status, HldsDefn,
- _MaybeUnify, _MaybeCompare),
+ TypeCtorGenInfo0 = type_ctor_gen_info(_TypeCtor, ModuleName,
+ TypeName, Arity, _Status, _HldsDefn, _Unify, _Compare),
(
Entity = base_gen_info(ModuleName, TypeName, Arity),
map__search(Needed, Entity, _)
->
TypeCtorGenInfos = [TypeCtorGenInfo0 | TypeCtorGenInfos1]
;
- NeuteredTypeCtorGenInfo = type_ctor_gen_info(TypeCtor,
- ModuleName, TypeName, Arity, Status, HldsDefn,
- no, no),
- TypeCtorGenInfos = [NeuteredTypeCtorGenInfo |
- TypeCtorGenInfos1]
+ TypeCtorGenInfos = TypeCtorGenInfos1
).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.74
diff -u -b -r1.74 hlds_module.m
--- compiler/hlds_module.m 7 Apr 2002 10:22:30 -0000 1.74
+++ compiler/hlds_module.m 28 Apr 2002 16:02:08 -0000
@@ -65,8 +65,8 @@
int, % type arity
import_status, % of the type
hlds_type_defn, % defn of type
- maybe(pred_proc_id), % unify, if not eliminated
- maybe(pred_proc_id) % compare, if not eliminated
+ pred_proc_id, % unify procedure
+ pred_proc_id % compare procedure
% maybe(pred_proc_id) % prettyprinter, if relevant
).
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.71
diff -u -b -r1.71 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 7 May 2002 11:03:06 -0000 1.71
+++ compiler/mlds_to_gcc.m 11 May 2002 14:58:46 -0000
@@ -1916,9 +1916,9 @@
build_sized_array_type('MR_ConstString', Size, GCC_Type).
build_rtti_type(field_types(_), Size, GCC_Type) -->
build_sized_array_type('MR_PseudoTypeInfo', Size, GCC_Type).
-build_rtti_type(reserved_addrs, Size, GCC_Type) -->
+build_rtti_type(res_addrs, Size, GCC_Type) -->
build_sized_array_type(gcc__ptr_type_node, Size, GCC_Type).
-build_rtti_type(reserved_addr_functors, Size, GCC_Type) -->
+build_rtti_type(res_addr_functors, Size, GCC_Type) -->
{ MR_ReservedAddrFunctorDescPtr = gcc__ptr_type_node },
build_sized_array_type(MR_ReservedAddrFunctorDescPtr, Size, GCC_Type).
build_rtti_type(enum_functor_desc(_), _, GCC_Type) -->
@@ -1970,12 +1970,12 @@
MR_ConstStringPtr - "MR_du_functor_arg_names",
MR_DuExistInfoPtr - "MR_du_functor_exist_info"],
GCC_Type).
-build_rtti_type(reserved_addr_functor_desc(_), _, GCC_Type) -->
+build_rtti_type(res_functor_desc(_), _, GCC_Type) -->
% typedef struct {
% MR_ConstString MR_ra_functor_name;
% MR_int_least32_t MR_ra_functor_ordinal;
% const void * MR_ra_functor_reserved_addr;
- % } MR_EnumFunctorDesc;
+ % } MR_ReservedAddrFunctorDesc;
build_struct_type("MR_ReservedAddrFunctorDesc",
['MR_ConstString' - "MR_ra_functor_name",
'MR_int_least32_t' - "MR_ra_functor_ordinal",
@@ -2005,7 +2005,7 @@
gcc__ptr_type_node - "MR_sectag_alternatives"],
MR_DuPtagLayout),
build_sized_array_type(MR_DuPtagLayout, Size, GCC_Type).
-build_rtti_type(reserved_addr_table, _, GCC_Type) -->
+build_rtti_type(res_value_ordered_table, _, GCC_Type) -->
% typedef struct {
% MR_int_least16_t MR_ra_num_res_numeric_addrs;
% MR_int_least16_t MR_ra_num_res_symbolic_addrs;
@@ -2020,6 +2020,27 @@
gcc__ptr_type_node - "MR_ra_constants",
gcc__ptr_type_node - "MR_ra_other_functors"
], GCC_Type).
+build_rtti_type(res_name_ordered_table, _, GCC_Type) -->
+ % typedef union {
+ % MR_DuFunctorDesc *MR_maybe_res_du_ptr;
+ % MR_ReservedAddrFunctorDesc *MR_maybe_res_res_ptr;
+ % } MR_MaybeResFunctorDescPtr;
+ %
+ % typedef struct {
+ % MR_ConstString MR_maybe_res_name;
+ % MR_Integer MR_maybe_res_arity;
+ % MR_bool MR_maybe_res_is_res;
+ % MR_MaybeResFunctorDescPtr MR_maybe_res_ptr;
+ % } MR_MaybeResAddrFunctorDesc;
+ build_struct_type("MR_MaybeResAddrFunctorDesc",
+ [gcc__ptr_type_node - "MR_maybe_res_init"],
+ MR_MaybeResAddrFunctorDesc),
+ build_struct_type("MR_ReservedAddrFunctorDesc",
+ ['MR_ConstString' - "MR_maybe_res_name",
+ 'MR_Integer' - "MR_maybe_res_arity",
+ 'MR_bool' - "MR_maybe_res_is_res",
+ MR_MaybeResAddrFunctorDesc - "MR_maybe_res_ptr"
+ ], GCC_Type).
build_rtti_type(type_ctor_info, _, GCC_Type) -->
% MR_Integer MR_type_ctor_arity;
% MR_int_least8_t MR_type_ctor_version;
@@ -2035,10 +2056,10 @@
{ MR_ProcAddr = gcc__ptr_type_node },
build_struct_type("MR_TypeFunctors",
- [gcc__ptr_type_node - "functors_init"],
+ [gcc__ptr_type_node - "MR_functors_init"],
MR_TypeFunctors),
build_struct_type("MR_TypeLayout",
- [gcc__ptr_type_node - "layout_init"],
+ [gcc__ptr_type_node - "MR_layout_init"],
MR_TypeLayout),
build_struct_type("MR_TypeCtorInfo_Struct",
['MR_Integer' - "MR_type_ctor_arity",
@@ -2224,7 +2245,8 @@
rtti_enum_const("MR_TYPECTOR_REP_BASETYPECLASSINFO", 34).
rtti_enum_const("MR_TYPECTOR_REP_TYPEDESC", 35).
rtti_enum_const("MR_TYPECTOR_REP_TYPECTORDESC", 36).
-rtti_enum_const("MR_TYPECTOR_REP_UNKNOWN", 37).
+rtti_enum_const("MR_TYPECTOR_REP_FOREIGN", 37).
+rtti_enum_const("MR_TYPECTOR_REP_UNKNOWN", 38).
rtti_enum_const("MR_SECTAG_NONE", 0).
rtti_enum_const("MR_SECTAG_LOCAL", 1).
rtti_enum_const("MR_SECTAG_REMOTE", 2).
@@ -3464,6 +3486,7 @@
:- func 'MR_String' = gcc__type.
:- func 'MR_ConstString' = gcc__type.
:- func 'MR_Word' = gcc__type.
+:- func 'MR_bool' = gcc__type.
:- func 'MR_TypeInfo' = gcc__type.
:- func 'MR_PseudoTypeInfo' = gcc__type.
:- func 'MR_Sectag_Locn' = gcc__type.
@@ -3484,6 +3507,7 @@
'MR_ConstString' = gcc__string_type_node.
% XXX 'MR_Word' should perhaps be unsigned, to match the C back-end
'MR_Word' = gcc__intptr_type_node.
+'MR_bool' = gcc__char_type_node.
'MR_TypeInfo' = gcc__ptr_type_node.
'MR_PseudoTypeInfo' = gcc__ptr_type_node.
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.122
diff -u -b -r1.122 opt_debug.m
--- compiler/opt_debug.m 12 Apr 2002 10:08:15 -0000 1.122
+++ compiler/opt_debug.m 6 May 2002 15:10:30 -0000
@@ -379,10 +379,10 @@
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(reserved_addrs, Str) :-
- Str = "reserved_addrs".
-opt_debug__dump_rtti_name(reserved_addr_functors, Str) :-
- Str = "reserved_addr_functors".
+opt_debug__dump_rtti_name(res_addrs, Str) :-
+ Str = "res_addrs".
+opt_debug__dump_rtti_name(res_addr_functors, Str) :-
+ Str = "res_addr_functors".
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).
@@ -391,9 +391,9 @@
opt_debug__dump_rtti_name(du_functor_desc(Ordinal), Str) :-
string__int_to_string(Ordinal, Ordinal_str),
string__append("du_functor_desc_", Ordinal_str, Str).
-opt_debug__dump_rtti_name(reserved_addr_functor_desc(Ordinal), Str) :-
+opt_debug__dump_rtti_name(res_functor_desc(Ordinal), Str) :-
string__int_to_string(Ordinal, Ordinal_str),
- string__append("reserved_addr_functor_desc_", Ordinal_str, Str).
+ string__append("res_functor_desc_", Ordinal_str, Str).
opt_debug__dump_rtti_name(enum_name_ordered_table, Str) :-
Str = "enum_name_ordered_table".
opt_debug__dump_rtti_name(enum_value_ordered_table, Str) :-
@@ -405,8 +405,10 @@
string__append("du_stag_ordered_table_", Ptag_str, Str).
opt_debug__dump_rtti_name(du_ptag_ordered_table, Str) :-
Str = "du_ptag_ordered_table".
-opt_debug__dump_rtti_name(reserved_addr_table, Str) :-
- Str = "reserved_addr_table".
+opt_debug__dump_rtti_name(res_value_ordered_table, Str) :-
+ Str = "res_value_ordered_table".
+opt_debug__dump_rtti_name(res_name_ordered_table, Str) :-
+ Str = "res_name_ordered_table".
opt_debug__dump_rtti_name(type_ctor_info, Str) :-
Str = "type_ctor_info".
opt_debug__dump_rtti_name(base_typeclass_info(_ModuleName, ClassId,
Index: compiler/pseudo_type_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pseudo_type_info.m,v
retrieving revision 1.8
diff -u -b -r1.8 pseudo_type_info.m
--- compiler/pseudo_type_info.m 12 Apr 2002 01:24:13 -0000 1.8
+++ compiler/pseudo_type_info.m 3 May 2002 08:03:07 -0000
@@ -42,6 +42,17 @@
:- pred pseudo_type_info__construct_type_info((type)::in, rtti_type_info::out)
is det.
+ % pseudo_type_info__construct_maybe_pseudo_type_info(Type,
+ % NumUnivQTvars, ExistQVars, MaybePseudoTypeInfo)
+ %
+ % Given a Mercury type (`Type'), this predicate checks whether it is
+ % ground or not. If it is ground, it returns a typeinfo for it; if it
+ % is not ground, it returns a pseudo type info for it. The arguments
+ % are the same as for pseudo_type_info__construct_pseudo_type_info.
+
+:- pred pseudo_type_info__construct_maybe_pseudo_type_info((type)::in,
+ int::in, existq_tvars::in, rtti_maybe_pseudo_type_info::out) is det.
+
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -52,8 +63,19 @@
%---------------------------------------------------------------------------%
+pseudo_type_info__construct_maybe_pseudo_type_info(Type, NumUnivQTvars,
+ ExistQTvars, MaybePseudoTypeInfo) :-
+ ( term__is_ground(Type) ->
+ pseudo_type_info__construct_type_info(Type, TypeInfo),
+ MaybePseudoTypeInfo = plain(TypeInfo)
+ ;
+ pseudo_type_info__construct_pseudo_type_info(Type,
+ NumUnivQTvars, ExistQTvars, PseudoTypeInfo),
+ MaybePseudoTypeInfo = pseudo(PseudoTypeInfo)
+ ).
+
pseudo_type_info__construct_pseudo_type_info(Type, NumUnivQTvars,
- ExistQTvars, Pseudo) :-
+ ExistQTvars, PseudoTypeInfo) :-
( type_to_ctor_and_args(Type, TypeCtor, TypeArgs0) ->
canonicalize_type_args(TypeCtor, TypeArgs0, TypeArgs),
( type_is_var_arity(Type, VarArityId) ->
@@ -63,7 +85,7 @@
require(check_var_arity(VarArityId, PseudoArgs,
RealArity),
"construct_pseudo_type_info: arity mismatch"),
- Pseudo = var_arity_pseudo_type_info(VarArityId,
+ PseudoTypeInfo = var_arity_pseudo_type_info(VarArityId,
PseudoArgs)
;
TypeCtor = QualTypeName - Arity,
@@ -77,10 +99,12 @@
require(check_arity(PseudoArgs, Arity),
"construct_pseudo_type_info: arity mismatch"),
( PseudoArgs = [] ->
- Pseudo = plain_arity_zero_pseudo_type_info(
+ PseudoTypeInfo =
+ plain_arity_zero_pseudo_type_info(
RttiTypeCtor)
;
- Pseudo = plain_pseudo_type_info(RttiTypeCtor,
+ PseudoTypeInfo =
+ plain_pseudo_type_info(RttiTypeCtor,
PseudoArgs)
)
)
@@ -119,7 +143,7 @@
),
require(VarInt =< pseudo_type_info__pseudo_typeinfo_max_var,
"construct_pseudo_type_info: type var exceeds limit"),
- Pseudo = type_var(VarInt)
+ PseudoTypeInfo = type_var(VarInt)
;
error("construct_pseudo_type_info: neither var nor non-var")
).
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.18
diff -u -b -r1.18 rtti.m
--- compiler/rtti.m 12 Apr 2002 01:24:13 -0000 1.18
+++ compiler/rtti.m 13 May 2002 10:00:31 -0000
@@ -28,13 +28,14 @@
:- import_module hlds__hlds_module, hlds__hlds_pred, hlds__hlds_data.
:- import_module backend_libs__code_model.
-:- import_module bool, list, std_util.
+:- import_module bool, list, std_util, map.
-:- type var_arity_ctor_id
- ---> pred_type_info
- ; func_type_info
- ; tuple_type_info.
+%-----------------------------------------------------------------------------%
+%
+% The data structures representing types, both ground (typeinfos) and
+% nonground (pseudo-typeinfos).
+ % An rtti_type_info identifies a ground type.
:- type rtti_type_info
---> plain_arity_zero_type_info(
rtti_type_ctor
@@ -50,6 +51,7 @@
list(rtti_type_info)
).
+ % An rtti_pseudo_type_info identifies a possibly non-ground type.
:- type rtti_pseudo_type_info
---> plain_arity_zero_pseudo_type_info(
rtti_type_ctor
@@ -66,84 +68,204 @@
)
; type_var(int).
+ % An rtti_maybe_pseudo_type_info identifies a type. If the type is
+ % ground, it should be bound to plain; if it is non-ground, it should
+ % be bound to pseudo.
:- type rtti_maybe_pseudo_type_info
---> pseudo(rtti_pseudo_type_info)
; plain(rtti_type_info).
-:- type rtti_maybe_pseudo_type_info_or_self
- ---> pseudo(rtti_pseudo_type_info)
- ; plain(rtti_type_info)
- ; self.
+ % An rtti_type_ctor uniquely identifies a fixed arity type constructor.
+:- type rtti_type_ctor
+ ---> rtti_type_ctor(
+ module_name, % module name
+ string, % type ctor's name
+ arity % type ctor's arity
+ ).
- % For a given du type and a primary tag value, this says where,
- % if anywhere, the secondary tag is.
-:- type sectag_locn
- ---> sectag_none
- ; sectag_local
- ; sectag_remote.
+ % A var_arity_ctor_id uniquely identifies a variable arity type
+ % constructor.
+:- type var_arity_ctor_id
+ ---> pred_type_info
+ ; func_type_info
+ ; tuple_type_info.
+
+%-----------------------------------------------------------------------------%
+%
+% The data structures representing type constructors.
+
+ % A type_ctor_data structure contains all the information that the
+ % runtime system needs to know about a type constructor.
+:- type type_ctor_data
+ ---> type_ctor_data(
+ tcr_version :: int,
+ tcr_module_name :: module_name,
+ tcr_type_name :: string,
+ tcr_arity :: int,
+ tcr_unify_pred :: univ,
+ tcr_compare_pred :: univ,
+ tcr_rep_details :: type_ctor_details
+ ).
+
+ % A type_ctor_details structure contains all the information that the
+ % runtime system needs to know about the data representation scheme
+ % used by a type constructor.
+ %
+ % The alternatives that correspond to discriminated union types have
+ % four kinds of information.
+ %
+ % First, an indication of whether the type has user-defined equality or
+ % not.
+ %
+ % Second, a list of descriptors containing all the function symbols
+ % defined by the type, in declaration order.
+ %
+ % Third, a table that allows the runtime system to map a value in
+ % memory to a printable representation (i.e. to implement the
+ % deconstruct operation).
+ %
+ % Fourth, a table that allows the runtime system to map a printable
+ % representation to a value in memory (i.e. to implement the
+ % construct operation).
+ %
+ % For types in which some function symbols are represented by reserved
+ % addresses, the third component is in two parts: a list of function
+ % symbols so represented, and a table indexed by the primary tag for
+ % all the other function symbols. The runtime system must check every
+ % element on the list before looking at the primary tag.
+ %
+ % For notag types, the single functor descriptor fills the roles of
+ % the second, third and fourth components.
+
+:- type type_ctor_details
+ ---> enum(
+ enum_axioms :: equality_axioms,
+ enum_functors :: list(enum_functor),
+ enum_value_table :: map(int, enum_functor),
+ enum_name_table :: map(string, enum_functor)
+ )
+ ; du(
+ du_axioms :: equality_axioms,
+ du_functors :: list(du_functor),
+ du_value_table :: ptag_map,
+ du_name_table :: map(string, map(int,
+ du_functor))
+ )
+ ; reserved(
+ res_axioms :: equality_axioms,
+ res_functors :: list(maybe_reserved_functor),
+ res_value_table_res :: list(reserved_functor),
+ res_value_table_du :: ptag_map,
+ res_name_table :: map(string, map(int,
+ maybe_reserved_functor))
+ )
+ ; notag(
+ notag_axioms :: equality_axioms,
+ notag_functor :: notag_functor
+ )
+ ; eqv(
+ eqv_type :: rtti_maybe_pseudo_type_info
+ )
+ ; builtin(
+ builtin_ctor :: builtin_ctor
+ )
+ ; impl_artifact(
+ impl_ctor :: impl_ctor
+ )
+ ; foreign.
% For a given du family type, this says whether the user has defined
- % their own unification predicate.
+ % their own unification predicate for the type.
:- type equality_axioms
---> standard
; user_defined.
- % For a notag or equiv type, this says whether the target type
- % contains variables or not.
-:- type equiv_type_inst
- ---> equiv_type_is_ground
- ; equiv_type_is_not_ground.
-
- % The compiler is concerned with the type constructor representations
- % of only the types it generates RTTI information for; it need not and
- % does not know about the type_ctor_reps of types which have
- % hand-defined RTTI.
-:- type type_ctor_rep
- ---> enum(equality_axioms)
- ; du(equality_axioms)
- ; reserved_addr(equality_axioms)
- ; notag(equality_axioms, equiv_type_inst)
- ; equiv(equiv_type_inst)
- ; unknown.
-
- % Different kinds of types have different type_layout information
- % generated for them, and some have no type_layout info at all.
- % This type represents values that will be put into the type_layout
- % field of a MR_TypeCtorInfo.
-:- type type_ctor_layout_info
- ---> enum_layout(
- rtti_name
- )
- ; notag_layout(
- rtti_name
- )
- ; du_layout(
- rtti_name
- )
- ; reserved_addr_layout(
- rtti_name
- )
- ; equiv_layout(
- rtti_data % a pseudo_type_info rtti_data
- )
- ; no_layout.
-
- % Different kinds of types have different type_functors information
- % generated for them, and some have no type_functors info at all.
- % This type represents values that will be put into the type_functors
- % field of a MR_TypeCtorInfo.
-:- type type_ctor_functors_info
- ---> enum_functors(
- rtti_name
- )
- ; notag_functors(
- rtti_name
+ % Descriptor for a functor in an enum type.
+ %
+ % This type corresponds to the C type MR_EnumFunctorDesc.
+:- type enum_functor
+ ---> enum_functor(
+ enum_name :: string,
+ enum_ordinal :: int
+ ).
+
+ % Descriptor for a functor in a notag type.
+ %
+ % This type corresponds to the C type MR_NotagFunctorDesc.
+:- type notag_functor
+ ---> notag_functor(
+ nt_name :: string,
+ nt_arg_type :: rtti_maybe_pseudo_type_info,
+ nt_arg_name :: maybe(string)
+ ).
+
+ % Descriptor for a functor in a du type. Also used for functors in
+ % reserved address types which are not represented by a reserved
+ % address.
+ %
+ % This type mostly corresponds to the C type MR_DuFunctorDesc.
+:- type du_functor
+ ---> du_functor(
+ du_name :: string,
+ du_orig_arity :: int,
+ du_ordinal :: int,
+ du_rep :: du_rep,
+ du_arg_infos :: list(du_arg_info),
+ du_exist_info :: maybe(exist_info)
+ ).
+
+ % Descriptor for a functor represented by a reserved address.
+ %
+ % This type corresponds to the C type MR_ReservedAddrFunctorDesc.
+:- type reserved_functor
+ ---> reserved_functor(
+ res_name :: string,
+ res_ordinal :: int,
+ res_rep :: reserved_address
+ ).
+
+ % Descriptor for a functor in reserved address type.
+ %
+ % This type mostly corresponds to the C union
+ % MR_MaybeResAddrFunctorDesc.
+:- type maybe_reserved_functor
+ ---> res_func(
+ mrf_res :: reserved_functor
)
- ; du_functors(
- rtti_name
+ ; du_func(
+ mrf_du :: du_functor
+ ).
+
+ % Describes the representation of a functor in a general
+ % discriminated union type.
+ %
+ % Will probably need modification for the Java and IL back ends.
+:- type du_rep
+ ---> du_ll_rep(
+ du_ll_ptag :: int,
+ du_ll_sec_tag :: sectag_and_locn
)
- ; no_functors.
+ ; du_hl_rep(
+ remote_sec_tag :: int
+ ).
+
+ % Describes the types of the existentially types arguments of a
+ % discriminated union functor.
+ %
+ % This type corresponds to the C type MR_DuExistInfo.
+:- type exist_info
+ ---> exist_info(
+ exist_num_plain_typeinfos :: int,
+ exist_num_typeinfos_in_tcis :: int,
+ exist_num_typeclass_infos :: int,
+ exist_typeinfo_locns ::
+ list(exist_typeinfo_locn)
+ ).
+ % Describes the location at which one can find the typeinfo for the
+ % type bound to an existentially quantified type variable in a
+ % discriminated union functor.
+ %
% This type corresponds to the C type MR_DuExistLocn.
:- type exist_typeinfo_locn
---> plain_typeinfo(
@@ -163,278 +285,85 @@
% macro.
).
- % This type corresponds to the MR_DuPtagTypeLayout C type.
-:- type du_ptag_layout
- ---> du_ptag_layout(
- int, % number of function symbols
- % sharing this primary tag
- sectag_locn,
- rtti_name % a vector of size num_sharers;
- % element N points to the
- % functor descriptor for the
- % functor with secondary tag S;
- % if sectag_locn is none, S=0
- ).
+ % These tables let the runtime system interpret values in memory
+ % of general discriminated union types.
+ %
+ % The runtime system should first use the primary tag to index into
+ % the type's ptag_map. It can then find the location (if any) of the
+ % secondary tag, and use the secondary tag (or zero if there isn't one)
+ % to index into the stag_map to find the functor descriptor.
+ %
+ % The type sectag_table corresponds to the C type MR_DuPtagLayout.
+ % The two maps are implemented in C as simple arrays.
- % Values of this type uniquely identify a type in the program.
-:- type rtti_type_ctor
- ---> rtti_type_ctor(
- module_name, % module name
- string, % type ctor's name
- arity % type ctor's arity
- ).
+:- type ptag_map == map(int, sectag_table). % key is primary tag
+:- type stag_map == map(int, du_functor). % key is secondary tag
- % Global data generated by the compiler. Usually readonly,
- % with one exception: data containing code addresses must
- % be initialized at runtime in grades that don't support static
- % code initializers.
-:- type rtti_data
- ---> exist_locns(
- rtti_type_ctor, % identifies the type
- int, % identifies functor in type
+:- type sectag_table
+ ---> sectag_table(
+ sectag_locn :: sectag_locn,
+ sectag_num_sharers :: int,
+ sectag_map :: stag_map
+ ).
- % The remaining argument of this function symbol
- % corresponds to an array of MR_ExistTypeInfoLocns.
+ % Describes the location of the secondary tag for a given primary tag
+ % value in a given type.
+:- type sectag_locn
+ ---> sectag_none
+ ; sectag_local
+ ; sectag_remote.
- list(exist_typeinfo_locn)
- )
- ; exist_info(
- rtti_type_ctor, % identifies the type
- int, % identifies functor in type
-
- % The remaining arguments of this function symbol
- % correspond to the MR_DuExistInfo C type.
-
- int, % number of plain typeinfos
- int, % number of typeinfos in tcis
- int, % number of tcis
- rtti_name % table of typeinfo locations
- )
- ; field_names(
- rtti_type_ctor, % identifies the type
- int, % identifies functor in type
-
- list(maybe(string)) % gives the field names
- )
- ; field_types(
- rtti_type_ctor, % identifies the type
- int, % identifies functor in type
-
- list(rtti_data) % gives the field types
- % (as pseudo_type_info
- % rtti_data)
- )
- ; reserved_addrs(
- rtti_type_ctor, % identifies the type
-
- % The remaining argument of this function symbol
- % corresponds to an array of const void *.
-
- list(reserved_address) % gives the values of the
- % reserved addresses for that
- % type
- )
- ; reserved_addr_functors(
- rtti_type_ctor, % identifies the type
-
- % The remaining argument of this function symbol
- % corresponds to an array of MR_ReservedAddrFunctorDesc
-
- list(rtti_name) % gives the functor descriptors
- % for the reserved_addr
- % functors for that type
- )
- ; enum_functor_desc(
- rtti_type_ctor, % identifies the type
-
- % The remaining arguments of this function symbol
- % correspond one-to-one to the fields of
- % MR_EnumFunctorDesc.
-
- string, % functor name
- int % ordinal number of functor
- % (also its value)
- )
- ; notag_functor_desc(
- rtti_type_ctor, % identifies the type
-
- % The remaining arguments of this function symbol
- % correspond one-to-one to the fields of
- % the MR_NotagFunctorDesc C type.
-
- string, % functor name
- rtti_data, % pseudo typeinfo of argument
- % (as a pseudo_type_info
- % rtti_data)
- maybe(string) % the argument's name, if any
- )
- ; du_functor_desc(
- rtti_type_ctor, % identifies the type
-
- % The remaining arguments of this function symbol
- % correspond one-to-one to the fields of
- % the MR_DuFunctorDesc C type.
-
- string, % functor name
- int, % functor primary tag
- int, % functor secondary tag
- sectag_locn,
- int, % ordinal number of functor
- % in type definition
- arity, % the functor's visible arity
- int, % a bit vector of size at most
- % contains_var_bit_vector_size
- % which contains a 1 bit in the
- % position given by 1 << N if
- % the type of argument N
- % contains variables (assuming
- % that arguments are numbered
- % from zero)
- maybe(rtti_name), % a vector of length arity
- % containing the pseudo
- % typeinfos of the arguments,
- % if any
- % (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)
- )
- ; reserved_addr_functor_desc(
- rtti_type_ctor, % identifies the type
-
- % The remaining arguments of this function symbol
- % correspond one-to-one to the fields of
- % MR_ReservedAddrFunctorDesc.
-
- string, % functor name
- int, % ordinal number of functor
- reserved_address % value
- )
- ; enum_name_ordered_table(
- rtti_type_ctor, % identifies the type
-
- % The remaining argument of this function symbol
- % corresponds to the functors_enum alternative of
- % the MR_TypeFunctors C type.
-
- list(rtti_name)
- )
- ; enum_value_ordered_table(
- rtti_type_ctor, % identifies the type
-
- % The remaining argument of this function symbol
- % corresponds to the MR_EnumTypeLayout C type.
-
- list(rtti_name)
- )
- ; reserved_addr_table(
- rtti_type_ctor, % identifies the type
-
- % The remaining argument of this function symbol
- % corresponds to the functors_du alternative of
- % the MR_ReservedAddrTypeDesc C type.
- int, % number of reserved numeric addresses
- int, % number of reserved symbolic addresses
- rtti_name, % the values of the reserved addresses
- rtti_name, % the reserved_addr_functor_descs
- % for all the constants that are
- % represented as reserved addresses
- rtti_name % the du_ptag_ordered_table for
- % the remaining functors
- )
- ; du_name_ordered_table(
- rtti_type_ctor, % identifies the type
-
- % The remaining argument of this function symbol
- % corresponds to the functors_du alternative of
- % the MR_TypeFunctors C type.
-
- list(rtti_name)
- )
- ; du_stag_ordered_table(
- rtti_type_ctor, % identifies the type
- int, % primary tag value
-
- % The remaining argument of this function symbol
- % corresponds to the MR_sectag_alternatives field
- % of the MR_DuPtagTypeLayout C type.
-
- list(rtti_name)
- )
- ; du_ptag_ordered_table(
- rtti_type_ctor, % identifies the type
-
- % The remaining argument of this function symbol
- % corresponds to the elements of the MR_DuTypeLayout
- % C type.
-
- list(du_ptag_layout)
- )
- ; type_ctor_info(
- % The arguments of this function symbol correspond
- % one-to-one to the fields of the MR_TypeCtorInfo
- % C type.
-
- rtti_type_ctor, % identifies the type ctor
- maybe(rtti_proc_label), % unify
- maybe(rtti_proc_label), % compare
- type_ctor_rep,
- int, % RTTI version number
- int, % num of ptags used if ctor_rep
- % is DU or DUUSEREQ
- int, % number of functors in type
- type_ctor_functors_info,% the functor layout
- type_ctor_layout_info % the layout table
- % maybe(rtti_name), % the type's hash cons table
- % maybe(rtti_proc_label)% prettyprinter
- )
- ; type_info(
- rtti_type_info
- )
- ; pseudo_type_info(
- rtti_pseudo_type_info
- )
- ; base_typeclass_info(
- module_name, % module containing instance decl.
- class_id, % specifies class name & class arity
- string, % encodes the names and arities of the
- % types in the instance declaration
+ % Describes the location of the secondary tag and its value for a
+ % given functor in a given type.
+:- type sectag_and_locn
+ ---> sectag_none
+ ; sectag_local(int)
+ ; sectag_remote(int).
- base_typeclass_info
+ % Information about an argument of a functor in a discriminated union
+ % type.
+:- type du_arg_info
+ ---> du_arg_info(
+ du_arg_name :: maybe(string),
+ du_arg_type :: rtti_maybe_pseudo_type_info_or_self
).
-:- type rtti_name
- ---> exist_locns(int) % functor ordinal
- ; exist_info(int) % functor ordinal
- ; field_names(int) % functor ordinal
- ; field_types(int) % functor ordinal
- ; reserved_addrs
- ; reserved_addr_functors
- ; enum_functor_desc(int) % functor ordinal
- ; notag_functor_desc
- ; du_functor_desc(int) % functor ordinal
- ; reserved_addr_functor_desc(int) % functor ordinal
- ; enum_name_ordered_table
- ; enum_value_ordered_table
- ; du_name_ordered_table
- ; du_stag_ordered_table(int) % primary tag
- ; du_ptag_ordered_table
- ; reserved_addr_table
- ; type_ctor_info
- ; type_info(rtti_type_info)
- ; pseudo_type_info(rtti_pseudo_type_info)
- ; base_typeclass_info(
- module_name, % module containing instance decl.
- class_id, % specifies class name & class arity
- string % encodes the names and arities of the
- % types in the instance declaration
- )
- ; type_hashcons_pointer.
+ % An rtti_maybe_pseudo_type_info identifies the type of a function
+ % symbol's argument. If the type of the argument is the same as the
+ % type of the whole term, it should be bound to self. Otherwise, if
+ % the argument's type is ground, it should be bound to plain; if it
+ % is non-ground, it should be bound to pseudo.
+:- type rtti_maybe_pseudo_type_info_or_self
+ ---> pseudo(rtti_pseudo_type_info)
+ ; plain(rtti_type_info)
+ ; self.
+
+ % The list of type constructors for types that are built into the
+ % Mercury language. The compiler never creates type_ctor_datas for
+ % these, but RTTI predicates implemented in Mercury will need to
+ % know about them.
+:- type builtin_ctor
+ ---> int
+ ; float
+ ; char
+ ; string
+ ; univ
+ ; void
+ ; c_pointer. % maybe more to come later
+
+ % The list of type constructors that are used behind the scenes by
+ % the Mercury implementation. The compiler never creates
+ % type_ctor_datas for these, but RTTI predicates implemented
+ % in Mercury will need to know about them.
+:- type impl_ctor
+ ---> sp
+ ; hp
+ ; maxfr
+ ; curfr. % maybe more to come later
+
+%-----------------------------------------------------------------------------%
+%
+% The data structures representing type class dictionaries.
% A base_typeclass_info holds information about a typeclass instance.
% See notes/type_class_transformation.html for details.
@@ -463,24 +392,6 @@
methods :: list(rtti_proc_label)
).
- % Convert a rtti_data to a rtti_type_ctor and a rtti_name.
- % This calls error/1 if the argument is a type_var/1 rtti_data,
- % since there is no rtti_type_ctor to return in that case.
-:- pred rtti_data_to_name(rtti_data::in, rtti_type_ctor::out, rtti_name::out)
- is det.
-
- % Convert an id that specifies a kind of variable arity type_info
- % or pseudo_type_info into the type_ctor of the canonical (arity-zero)
- % type of that kind.
-:- func var_arity_id_to_rtti_type_ctor(var_arity_ctor_id) = rtti_type_ctor.
-
- % return yes iff the specified rtti_name is an array
-:- func rtti_name_has_array_type(rtti_name) = bool.
-
- % Return yes iff the specified rtti_name should be exported
- % for use by other modules.
-:- func rtti_name_is_exported(rtti_name) = bool.
-
% The rtti_proc_label type holds all the information about a procedure
% that we need to compute the entry label for that procedure
% in the target language (the llds__code_addr or mlds__code_addr).
@@ -521,6 +432,88 @@
is_special_pred_instance :: bool
).
+%-----------------------------------------------------------------------------%
+%
+% The data structures representing the XXX
+
+ % Global data generated by the compiler. Usually readonly,
+ % with one exception: data containing code addresses must
+ % be initialized at runtime in grades that don't support static
+ % code initializers.
+:- type rtti_data
+ ---> type_ctor_info(
+ type_ctor_data
+ )
+ ; type_info(
+ rtti_type_info
+ )
+ ; pseudo_type_info(
+ rtti_pseudo_type_info
+ )
+ ; base_typeclass_info(
+ module_name, % module containing instance decl.
+ class_id, % specifies class name & class arity
+ string, % encodes the names and arities of the
+ % types in the instance declaration
+
+ base_typeclass_info
+ ).
+
+:- type rtti_name
+ ---> exist_locns(int) % functor ordinal
+ ; exist_info(int) % functor ordinal
+ ; field_names(int) % functor ordinal
+ ; field_types(int) % functor ordinal
+ ; res_addrs
+ ; res_addr_functors
+ ; enum_functor_desc(int) % functor ordinal
+ ; notag_functor_desc
+ ; du_functor_desc(int) % functor ordinal
+ ; res_functor_desc(int) % functor ordinal
+ ; enum_name_ordered_table
+ ; enum_value_ordered_table
+ ; du_name_ordered_table
+ ; du_stag_ordered_table(int) % primary tag
+ ; du_ptag_ordered_table
+ ; res_value_ordered_table
+ ; res_name_ordered_table
+ ; type_ctor_info
+ ; type_info(rtti_type_info)
+ ; pseudo_type_info(rtti_pseudo_type_info)
+ ; base_typeclass_info(
+ module_name, % module containing instance decl.
+ class_id, % specifies class name & class arity
+ string % encodes the names and arities of the
+ % types in the instance declaration
+ )
+ ; type_hashcons_pointer.
+
+%-----------------------------------------------------------------------------%
+%
+% The functions
+
+
+ % Return the id of the type constructor.
+:- func tcd_get_rtti_type_ctor(type_ctor_data) = rtti_type_ctor.
+
+ % Convert a rtti_data to a rtti_type_ctor and a rtti_name.
+ % This calls error/1 if the argument is a type_var/1 rtti_data,
+ % since there is no rtti_type_ctor to return in that case.
+:- pred rtti_data_to_name(rtti_data::in, rtti_type_ctor::out, rtti_name::out)
+ is det.
+
+ % Convert an id that specifies a kind of variable arity type_info
+ % or pseudo_type_info into the type_ctor of the canonical (arity-zero)
+ % type of that kind.
+:- func var_arity_id_to_rtti_type_ctor(var_arity_ctor_id) = rtti_type_ctor.
+
+ % return yes iff the specified rtti_name is an array
+:- func rtti_name_has_array_type(rtti_name) = bool.
+
+ % Return yes iff the specified rtti_name should be exported
+ % for use by other modules.
+:- func rtti_name_is_exported(rtti_name) = bool.
+
% Construct an rtti_proc_label for a given procedure.
:- func rtti__make_proc_label(module_info, pred_id, proc_id) = rtti_proc_label.
@@ -530,25 +523,67 @@
% 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_ctor::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 the C representation of a secondary tag location.
+:- pred rtti__sectag_and_locn_to_locn_string(sectag_and_locn::in, string::out)
+ is det.
+
+ % Return the C representation of the type_ctor_rep value of the given
+ % type_ctor.
+:- pred rtti__type_ctor_rep_to_string(type_ctor_data::in, string::out)
+ is det.
+ % Return the rtti_data containing the given type_info.
:- func type_info_to_rtti_data(rtti_type_info) = rtti_data.
+ % Return the rtti_data containing the given type_info or
+ % pseudo_type_info.
:- func maybe_pseudo_type_info_to_rtti_data(rtti_maybe_pseudo_type_info)
= rtti_data.
+ % Return the rtti_data containing the given type_info or
+ % pseudo_type_info or self.
:- func maybe_pseudo_type_info_or_self_to_rtti_data(
- rtti_maybe_pseudo_type_info_or_self) = rtti_data is semidet.
+ rtti_maybe_pseudo_type_info_or_self) = rtti_data.
+
+ % Given a type constructor with the given details, return the number
+ % of primary tag values used by the type. The return value will be
+ % negative if the type constructor doesn't reserve primary tags.
+:- func type_ctor_details_num_ptags(type_ctor_details) = int.
+
+ % Given a type constructor with the given details, return the number
+ % of function symbols defined by the type. The return value will be
+ % negative if the type constructor doesn't define any function symbols.
+:- func type_ctor_details_num_functors(type_ctor_details) = int.
+
+ % Extract the argument name (if any) from a du_arg_info.
+:- func du_arg_info_name(du_arg_info) = maybe(string).
+
+ % Extract the argument type from a du_arg_info.
+:- func du_arg_info_type(du_arg_info) = rtti_maybe_pseudo_type_info_or_self.
+
+ % If the given value is bound to yes, return its argument.
+:- func project_yes(maybe(T)) = T is semidet.
+
+ % Return the symbolic representation of the address of the given
+ % functor descriptor.
+:- func enum_functor_rtti_name(enum_functor) = rtti_name.
+:- func du_functor_rtti_name(du_functor) = rtti_name.
+:- func res_functor_rtti_name(reserved_functor) = rtti_name.
+:- func maybe_res_functor_rtti_name(maybe_reserved_functor) = rtti_name.
+
+ % Extract the reserved address from a reserved address functor
+ % descriptor.
+:- func res_addr_rep(reserved_functor) = reserved_address.
+
+ % Reserved addresses can be numeric or symbolic. Succeed if the
+ % one passed is numeric.
+:- pred res_addr_is_numeric(reserved_address::in) is semidet.
:- implementation.
@@ -558,42 +593,11 @@
:- import_module ll_backend__code_util. % for code_util__compiler_generated
:- import_module ll_backend__llds_out. % for name_mangle and sym_name_mangle
-:- import_module string, require.
+:- import_module int, string, require.
-rtti_data_to_name(exist_locns(RttiTypeCtor, Ordinal, _),
- RttiTypeCtor, exist_locns(Ordinal)).
-rtti_data_to_name(exist_info(RttiTypeCtor, Ordinal, _, _, _, _),
- RttiTypeCtor, exist_info(Ordinal)).
-rtti_data_to_name(field_names(RttiTypeCtor, Ordinal, _),
- RttiTypeCtor, field_names(Ordinal)).
-rtti_data_to_name(field_types(RttiTypeCtor, Ordinal, _),
- RttiTypeCtor, field_types(Ordinal)).
-rtti_data_to_name(reserved_addrs(RttiTypeCtor, _),
- RttiTypeCtor, reserved_addrs).
-rtti_data_to_name(reserved_addr_functors(RttiTypeCtor, _),
- RttiTypeCtor, reserved_addr_functors).
-rtti_data_to_name(enum_functor_desc(RttiTypeCtor, _, Ordinal),
- RttiTypeCtor, enum_functor_desc(Ordinal)).
-rtti_data_to_name(notag_functor_desc(RttiTypeCtor, _, _, _),
- RttiTypeCtor, notag_functor_desc).
-rtti_data_to_name(du_functor_desc(RttiTypeCtor, _,_,_,_, Ordinal, _,_,_,_,_),
- RttiTypeCtor, du_functor_desc(Ordinal)).
-rtti_data_to_name(reserved_addr_functor_desc(RttiTypeCtor, _, Ordinal, _),
- RttiTypeCtor, reserved_addr_functor_desc(Ordinal)).
-rtti_data_to_name(enum_name_ordered_table(RttiTypeCtor, _),
- RttiTypeCtor, enum_name_ordered_table).
-rtti_data_to_name(enum_value_ordered_table(RttiTypeCtor, _),
- RttiTypeCtor, enum_value_ordered_table).
-rtti_data_to_name(du_name_ordered_table(RttiTypeCtor, _),
- RttiTypeCtor, du_name_ordered_table).
-rtti_data_to_name(du_stag_ordered_table(RttiTypeCtor, Ptag, _),
- RttiTypeCtor, du_stag_ordered_table(Ptag)).
-rtti_data_to_name(du_ptag_ordered_table(RttiTypeCtor, _),
- RttiTypeCtor, du_ptag_ordered_table).
-rtti_data_to_name(reserved_addr_table(RttiTypeCtor, _, _, _, _, _),
- RttiTypeCtor, reserved_addr_table).
-rtti_data_to_name(type_ctor_info(RttiTypeCtor, _,_,_,_,_,_,_,_),
- RttiTypeCtor, type_ctor_info).
+rtti_data_to_name(type_ctor_info(TypeCtorData), RttiTypeCtor,
+ type_ctor_info) :-
+ RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData).
rtti_data_to_name(type_info(TypeInfo), RttiTypeCtor, type_info(TypeInfo)) :-
RttiTypeCtor = ti_get_rtti_type_ctor(TypeInfo).
rtti_data_to_name(pseudo_type_info(PseudoTypeInfo), RttiTypeCtor,
@@ -603,6 +607,12 @@
% there's no rtti_type_ctor associated with a base_typeclass_info
error("rtti_data_to_name: base_typeclass_info").
+tcd_get_rtti_type_ctor(TypeCtorData) = RttiTypeCtor :-
+ ModuleName = TypeCtorData ^ tcr_module_name,
+ TypeName = TypeCtorData ^ tcr_type_name,
+ Arity = TypeCtorData ^ tcr_arity,
+ RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, Arity).
+
:- func ti_get_rtti_type_ctor(rtti_type_info) = rtti_type_ctor.
ti_get_rtti_type_ctor(plain_arity_zero_type_info(RttiTypeCtor))
@@ -638,18 +648,19 @@
rtti_name_has_array_type(exist_info(_)) = no.
rtti_name_has_array_type(field_names(_)) = yes.
rtti_name_has_array_type(field_types(_)) = yes.
-rtti_name_has_array_type(reserved_addrs) = yes.
-rtti_name_has_array_type(reserved_addr_functors) = yes.
+rtti_name_has_array_type(res_addrs) = yes.
+rtti_name_has_array_type(res_addr_functors) = yes.
rtti_name_has_array_type(enum_functor_desc(_)) = no.
rtti_name_has_array_type(notag_functor_desc) = no.
rtti_name_has_array_type(du_functor_desc(_)) = no.
-rtti_name_has_array_type(reserved_addr_functor_desc(_)) = no.
+rtti_name_has_array_type(res_functor_desc(_)) = no.
rtti_name_has_array_type(enum_name_ordered_table) = yes.
rtti_name_has_array_type(enum_value_ordered_table) = yes.
rtti_name_has_array_type(du_name_ordered_table) = yes.
rtti_name_has_array_type(du_stag_ordered_table(_)) = yes.
rtti_name_has_array_type(du_ptag_ordered_table) = yes.
-rtti_name_has_array_type(reserved_addr_table) = no.
+rtti_name_has_array_type(res_value_ordered_table) = no.
+rtti_name_has_array_type(res_name_ordered_table) = yes.
rtti_name_has_array_type(type_ctor_info) = no.
rtti_name_has_array_type(type_info(_)) = no.
rtti_name_has_array_type(pseudo_type_info(_)) = no.
@@ -660,18 +671,19 @@
rtti_name_is_exported(exist_info(_)) = no.
rtti_name_is_exported(field_names(_)) = no.
rtti_name_is_exported(field_types(_)) = no.
-rtti_name_is_exported(reserved_addrs) = no.
-rtti_name_is_exported(reserved_addr_functors) = no.
+rtti_name_is_exported(res_addrs) = no.
+rtti_name_is_exported(res_addr_functors) = no.
rtti_name_is_exported(enum_functor_desc(_)) = no.
rtti_name_is_exported(notag_functor_desc) = no.
rtti_name_is_exported(du_functor_desc(_)) = no.
-rtti_name_is_exported(reserved_addr_functor_desc(_)) = no.
+rtti_name_is_exported(res_functor_desc(_)) = no.
rtti_name_is_exported(enum_name_ordered_table) = no.
rtti_name_is_exported(enum_value_ordered_table) = no.
rtti_name_is_exported(du_name_ordered_table) = no.
rtti_name_is_exported(du_stag_ordered_table(_)) = no.
rtti_name_is_exported(du_ptag_ordered_table) = no.
-rtti_name_is_exported(reserved_addr_table) = no.
+rtti_name_is_exported(res_value_ordered_table) = no.
+rtti_name_is_exported(res_name_ordered_table) = no.
rtti_name_is_exported(type_ctor_info) = yes.
rtti_name_is_exported(type_info(TypeInfo)) =
type_info_is_exported(TypeInfo).
@@ -744,11 +756,11 @@
string__append_list([ModuleName, "__field_types_",
TypeName, "_", A_str, "_", O_str], Str)
;
- RttiName = reserved_addrs,
+ RttiName = res_addrs,
string__append_list([ModuleName, "__reserved_addrs_",
TypeName, "_", A_str], Str)
;
- RttiName = reserved_addr_functors,
+ RttiName = res_addr_functors,
string__append_list([ModuleName, "__reserved_addr_functors_",
TypeName, "_", A_str], Str)
;
@@ -766,7 +778,7 @@
string__append_list([ModuleName, "__du_functor_desc_",
TypeName, "_", A_str, "_", O_str], Str)
;
- RttiName = reserved_addr_functor_desc(Ordinal),
+ RttiName = res_functor_desc(Ordinal),
string__int_to_string(Ordinal, O_str),
string__append_list([ModuleName,
"__reserved_addr_functor_desc_",
@@ -793,8 +805,12 @@
string__append_list([ModuleName, "__du_ptag_ordered_",
TypeName, "_", A_str], Str)
;
- RttiName = reserved_addr_table,
- string__append_list([ModuleName, "__reserved_addr_table_",
+ RttiName = res_value_ordered_table,
+ string__append_list([ModuleName, "__res_layout_ordered_table_",
+ TypeName, "_", A_str], Str)
+ ;
+ RttiName = res_name_ordered_table,
+ string__append_list([ModuleName, "__res_name_ordered_table_",
TypeName, "_", A_str], Str)
;
RttiName = type_ctor_info,
@@ -923,32 +939,80 @@
rtti__sectag_locn_to_string(sectag_local, "MR_SECTAG_LOCAL").
rtti__sectag_locn_to_string(sectag_remote, "MR_SECTAG_REMOTE").
-rtti__type_ctor_rep_to_string(du(standard),
- "MR_TYPECTOR_REP_DU").
-rtti__type_ctor_rep_to_string(du(user_defined),
- "MR_TYPECTOR_REP_DU_USEREQ").
-rtti__type_ctor_rep_to_string(reserved_addr(standard),
- "MR_TYPECTOR_REP_RESERVED_ADDR").
-rtti__type_ctor_rep_to_string(reserved_addr(user_defined),
- "MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ").
-rtti__type_ctor_rep_to_string(enum(standard),
- "MR_TYPECTOR_REP_ENUM").
-rtti__type_ctor_rep_to_string(enum(user_defined),
- "MR_TYPECTOR_REP_ENUM_USEREQ").
-rtti__type_ctor_rep_to_string(notag(standard, equiv_type_is_not_ground),
- "MR_TYPECTOR_REP_NOTAG").
-rtti__type_ctor_rep_to_string(notag(user_defined, equiv_type_is_not_ground),
- "MR_TYPECTOR_REP_NOTAG_USEREQ").
-rtti__type_ctor_rep_to_string(notag(standard, equiv_type_is_ground),
- "MR_TYPECTOR_REP_NOTAG_GROUND").
-rtti__type_ctor_rep_to_string(notag(user_defined, equiv_type_is_ground),
- "MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ").
-rtti__type_ctor_rep_to_string(equiv(equiv_type_is_not_ground),
- "MR_TYPECTOR_REP_EQUIV").
-rtti__type_ctor_rep_to_string(equiv(equiv_type_is_ground),
- "MR_TYPECTOR_REP_EQUIV_GROUND").
-rtti__type_ctor_rep_to_string(unknown,
- "MR_TYPECTOR_REP_UNKNOWN").
+rtti__sectag_and_locn_to_locn_string(sectag_none, "MR_SECTAG_NONE").
+rtti__sectag_and_locn_to_locn_string(sectag_local(_), "MR_SECTAG_LOCAL").
+rtti__sectag_and_locn_to_locn_string(sectag_remote(_), "MR_SECTAG_REMOTE").
+
+rtti__type_ctor_rep_to_string(TypeCtorData, RepStr) :-
+ TypeCtorDetails = TypeCtorData ^ tcr_rep_details,
+ (
+ TypeCtorDetails = enum(TypeCtorUserEq, _, _, _),
+ (
+ TypeCtorUserEq = standard,
+ RepStr = "MR_TYPECTOR_REP_ENUM"
+ ;
+ TypeCtorUserEq = user_defined,
+ RepStr = "MR_TYPECTOR_REP_ENUM_USEREQ"
+ )
+ ;
+ TypeCtorDetails = du(TypeCtorUserEq, _, _, _),
+ (
+ TypeCtorUserEq = standard,
+ RepStr = "MR_TYPECTOR_REP_DU"
+ ;
+ TypeCtorUserEq = user_defined,
+ RepStr = "MR_TYPECTOR_REP_DU_USEREQ"
+ )
+ ;
+ TypeCtorDetails = reserved(TypeCtorUserEq, _, _, _, _),
+ (
+ TypeCtorUserEq = standard,
+ RepStr = "MR_TYPECTOR_REP_RESERVED_ADDR"
+ ;
+ TypeCtorUserEq = user_defined,
+ RepStr = "MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ"
+ )
+ ;
+ TypeCtorDetails = notag(TypeCtorUserEq, NotagFunctor),
+ NotagEqvType = NotagFunctor ^ nt_arg_type,
+ (
+ TypeCtorUserEq = standard,
+ (
+ NotagEqvType = pseudo(_),
+ RepStr = "MR_TYPECTOR_REP_NOTAG"
+ ;
+ NotagEqvType = plain(_),
+ RepStr = "MR_TYPECTOR_REP_NOTAG_GROUND"
+ )
+ ;
+ TypeCtorUserEq = user_defined,
+ (
+ NotagEqvType = pseudo(_),
+ RepStr = "MR_TYPECTOR_REP_NOTAG_USEREQ"
+ ;
+ NotagEqvType = plain(_),
+ RepStr = "MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ"
+ )
+ )
+ ;
+ TypeCtorDetails = eqv(EqvType),
+ (
+ EqvType = pseudo(_),
+ RepStr = "MR_TYPECTOR_REP_EQUIV"
+ ;
+ EqvType = plain(_),
+ RepStr = "MR_TYPECTOR_REP_EQUIV_GROUND"
+ )
+ ;
+ TypeCtorDetails = builtin(_),
+ error("rtti__type_ctor_rep_to_string: builtin")
+ ;
+ TypeCtorDetails = impl_artifact(_),
+ error("rtti__type_ctor_rep_to_string: impl_artifact")
+ ;
+ TypeCtorDetails = foreign,
+ RepStr = "MR_TYPECTOR_REP_FOREIGN"
+ ).
type_info_to_rtti_data(TypeInfo) = type_info(TypeInfo).
@@ -961,3 +1025,54 @@
pseudo_type_info(PseudoTypeInfo).
maybe_pseudo_type_info_or_self_to_rtti_data(plain(TypeInfo)) =
type_info(TypeInfo).
+maybe_pseudo_type_info_or_self_to_rtti_data(self) =
+ pseudo_type_info(type_var(0)).
+
+type_ctor_details_num_ptags(enum(_, _, _, _)) = -1.
+type_ctor_details_num_ptags(du(_, _, PtagMap, _)) = LastPtag + 1 :-
+ map__keys(PtagMap, Ptags),
+ list__last_det(Ptags, LastPtag).
+type_ctor_details_num_ptags(reserved(_, _, _, PtagMap, _)) = LastPtag + 1 :-
+ map__keys(PtagMap, Ptags),
+ list__last_det(Ptags, LastPtag).
+type_ctor_details_num_ptags(notag(_, _)) = -1.
+type_ctor_details_num_ptags(eqv(_)) = -1.
+type_ctor_details_num_ptags(builtin(_)) = -1.
+type_ctor_details_num_ptags(impl_artifact(_)) = -1.
+type_ctor_details_num_ptags(foreign) = -1.
+
+type_ctor_details_num_functors(enum(_, EnumFunctors, _, _)) =
+ list__length(EnumFunctors).
+type_ctor_details_num_functors(du(_, DuFunctors, _, _)) =
+ list__length(DuFunctors).
+type_ctor_details_num_functors(reserved(_, ResFunctors, _, _, _)) =
+ list__length(ResFunctors).
+type_ctor_details_num_functors(notag(_, _)) = 1.
+type_ctor_details_num_functors(eqv(_)) = -1.
+type_ctor_details_num_functors(builtin(_)) = -1.
+type_ctor_details_num_functors(impl_artifact(_)) = -1.
+type_ctor_details_num_functors(foreign) = -1.
+
+du_arg_info_name(ArgInfo) = ArgInfo ^ du_arg_name.
+
+du_arg_info_type(ArgInfo) = ArgInfo ^ du_arg_type.
+
+project_yes(yes(X)) = X.
+
+enum_functor_rtti_name(EnumFunctor) =
+ enum_functor_desc(EnumFunctor ^ enum_ordinal).
+
+du_functor_rtti_name(DuFunctor) = du_functor_desc(DuFunctor ^ du_ordinal).
+
+res_functor_rtti_name(ResFunctor) =
+ res_functor_desc(ResFunctor ^ res_ordinal).
+
+maybe_res_functor_rtti_name(du_func(DuFunctor)) =
+ du_functor_desc(DuFunctor ^ du_ordinal).
+maybe_res_functor_rtti_name(res_func(ResFunctor)) =
+ res_functor_desc(ResFunctor ^ res_ordinal).
+
+res_addr_rep(ResFunctor) = ResFunctor ^ res_rep.
+
+res_addr_is_numeric(null_pointer).
+res_addr_is_numeric(small_pointer(_)).
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.29
diff -u -b -r1.29 rtti_out.m
--- compiler/rtti_out.m 24 Apr 2002 07:37:32 -0000 1.29
+++ compiler/rtti_out.m 15 May 2002 09:11:21 -0000
@@ -93,109 +93,357 @@
:- implementation.
-:- import_module backend_libs__pseudo_type_info, ll_backend__code_util.
-:- import_module ll_backend__llds, parse_tree__prog_out, backend_libs__c_util.
+:- import_module parse_tree__prog_out.
:- import_module hlds__error_util.
+:- import_module backend_libs__pseudo_type_info, backend_libs__type_ctor_info.
+:- import_module backend_libs__c_util.
+:- import_module ll_backend__llds, ll_backend__code_util.
:- import_module libs__options, libs__globals.
-:- import_module int, string, list, require, std_util.
+:- import_module int, string, list, assoc_list, map, require, std_util.
%-----------------------------------------------------------------------------%
-output_rtti_data_defn(exist_locns(RttiTypeCtor, Ordinal, Locns),
+output_rtti_data_defn(base_typeclass_info(InstanceModuleName, ClassId,
+ InstanceString, BaseTypeClassInfo), DeclSet0, DeclSet) -->
+ output_base_typeclass_info_defn(InstanceModuleName, ClassId,
+ InstanceString, BaseTypeClassInfo, DeclSet0, DeclSet).
+output_rtti_data_defn(type_info(TypeInfo), DeclSet0, DeclSet) -->
+ output_type_info_defn(TypeInfo, DeclSet0, DeclSet).
+output_rtti_data_defn(pseudo_type_info(PseudoTypeInfo), DeclSet0, DeclSet) -->
+ output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet).
+output_rtti_data_defn(type_ctor_info(TypeCtorData), DeclSet0, DeclSet) -->
+ output_type_ctor_data_defn(TypeCtorData, DeclSet0, DeclSet).
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_base_typeclass_info_defn(module_name::in, class_id::in,
+ string::in, base_typeclass_info::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_base_typeclass_info_defn(InstanceModuleName, ClassId, InstanceString,
+ base_typeclass_info(N1, N2, N3, N4, N5, Methods),
DeclSet0, DeclSet) -->
- output_generic_rtti_data_defn_start(RttiTypeCtor, exist_locns(Ordinal),
- DeclSet0, DeclSet),
- (
- % ANSI/ISO C doesn't allow empty arrays, so
- % place a dummy value in the array if necessary.
- { Locns = [] }
- ->
- io__write_string("= { {0, 0} };\n")
- ;
- io__write_string(" = {\n"),
- output_exist_locns(Locns),
- io__write_string("};\n")
- ).
-output_rtti_data_defn(exist_info(RttiTypeCtor, Ordinal, Plain, InTci, Tci,
- Locns), DeclSet0, DeclSet) -->
- output_rtti_addr_decls(RttiTypeCtor, Locns, "", "", 0, _,
- DeclSet0, DeclSet1),
- output_generic_rtti_data_defn_start(RttiTypeCtor, exist_info(Ordinal),
- DeclSet1, DeclSet),
- io__write_string(" = {\n\t"),
- io__write_int(Plain),
- io__write_string(",\n\t"),
- io__write_int(InTci),
- io__write_string(",\n\t"),
- io__write_int(Tci),
+ { CodeAddrs = list__map(make_code_addr, Methods) },
+ output_code_addrs_decls(CodeAddrs, "", "", 0, _, DeclSet0, DeclSet1),
+ io__write_string("\n"),
+ output_base_typeclass_info_storage_type_name(InstanceModuleName,
+ ClassId, InstanceString, yes),
+ % XXX It would be nice to avoid generating redundant declarations
+ % of base_typeclass_infos, but currently we don't.
+ { DeclSet1 = DeclSet },
+ io__write_string(" = {\n\t(MR_Code *) "),
+ io__write_list([N1, N2, N3, N4, N5],
+ ",\n\t(MR_Code *) ", io__write_int),
io__write_string(",\n\t"),
- output_rtti_addr(RttiTypeCtor, Locns),
+ io__write_list(CodeAddrs, ",\n\t", output_static_code_addr),
io__write_string("\n};\n").
-output_rtti_data_defn(field_names(RttiTypeCtor, Ordinal, MaybeNames),
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_maybe_pseudo_type_info_or_self_defn(
+ rtti_maybe_pseudo_type_info_or_self::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_maybe_pseudo_type_info_or_self_defn(plain(TypeInfo),
DeclSet0, DeclSet) -->
- output_generic_rtti_data_defn_start(RttiTypeCtor, field_names(Ordinal),
- DeclSet0, DeclSet),
+ output_type_info_defn(TypeInfo, DeclSet0, DeclSet).
+output_maybe_pseudo_type_info_or_self_defn(pseudo(PseudoTypeInfo),
+ DeclSet0, DeclSet) -->
+ output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet).
+output_maybe_pseudo_type_info_or_self_defn(self, DeclSet, DeclSet) --> [].
+
+:- pred output_maybe_pseudo_type_info_defn(rtti_maybe_pseudo_type_info::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_maybe_pseudo_type_info_defn(plain(TypeInfo), DeclSet0, DeclSet) -->
+ output_type_info_defn(TypeInfo, DeclSet0, DeclSet).
+output_maybe_pseudo_type_info_defn(pseudo(PseudoTypeInfo), DeclSet0, DeclSet)
+ -->
+ output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet).
+
+:- pred output_type_info_defn(rtti_type_info::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_type_info_defn(TypeInfo, DeclSet0, DeclSet) -->
(
- % ANSI/ISO C doesn't allow empty arrays, so
- % place a dummy value in the array if necessary.
- { MaybeNames = [] }
+ { rtti_data_to_name(type_info(TypeInfo),
+ RttiTypeCtor, RttiName) },
+ { DataAddr = rtti_addr(RttiTypeCtor, RttiName) },
+ { decl_set_is_member(data_addr(DataAddr), DeclSet0) }
->
- io__write_string("= { "" };\n")
+ { DeclSet = DeclSet0 }
;
- io__write_string(" = {\n"),
- output_maybe_quoted_strings(MaybeNames),
- io__write_string("};\n")
+ do_output_type_info_defn(TypeInfo, DeclSet0, DeclSet)
).
-output_rtti_data_defn(field_types(RttiTypeCtor, Ordinal, Types),
- DeclSet0, DeclSet) -->
- output_rtti_datas_decls(Types, "", "", 0, _, DeclSet0, DeclSet1),
- output_generic_rtti_data_defn_start(RttiTypeCtor, field_types(Ordinal),
- DeclSet1, DeclSet),
+
+:- pred do_output_type_info_defn(rtti_type_info::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+do_output_type_info_defn(plain_arity_zero_type_info(_),
+ DeclSet, DeclSet) --> [].
+do_output_type_info_defn(TypeInfo, DeclSet0, DeclSet) -->
+ { TypeInfo = plain_type_info(RttiTypeCtor, Args) },
+ { TypeCtorRttiData = type_info(
+ plain_arity_zero_type_info(RttiTypeCtor)) },
+ { ArgRttiDatas = list__map(type_info_to_rtti_data, Args) },
+ output_type_ctor_and_arg_defns_and_decls(TypeCtorRttiData,
+ ArgRttiDatas, DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ type_info(TypeInfo), DeclSet1, DeclSet),
+ io__write_string(" = {\n\t&"),
+ output_rtti_addr(RttiTypeCtor, type_ctor_info),
+ io__write_string(",\n{"),
+ output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas),
+ io__write_string("}};\n").
+do_output_type_info_defn(TypeInfo, DeclSet0, DeclSet) -->
+ { TypeInfo = var_arity_type_info(RttiVarArityId, Args) },
+ { RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId) },
+ { TypeCtorRttiData = type_info(
+ plain_arity_zero_type_info(RttiTypeCtor)) },
+ { ArgRttiDatas = list__map(type_info_to_rtti_data, Args) },
+ output_type_ctor_and_arg_defns_and_decls(TypeCtorRttiData,
+ ArgRttiDatas, DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ type_info(TypeInfo), DeclSet1, DeclSet),
+ io__write_string(" = {\n\t&"),
+ output_rtti_addr(RttiTypeCtor, type_ctor_info),
+ io__write_string(",\n\t"),
+ { list__length(Args, Arity) },
+ io__write_int(Arity),
+ io__write_string(",\n{"),
+ output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas),
+ io__write_string("}};\n").
+
+:- pred output_pseudo_type_info_defn(rtti_pseudo_type_info::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet) -->
(
- % ANSI/ISO C doesn't allow empty arrays, so
- % place a dummy value in the array if necessary.
- { Types = [] }
+ { PseudoTypeInfo = type_var(_) }
->
- io__write_string("= { NULL };\n")
+ { DeclSet = DeclSet0 }
;
- io__write_string(" = {\n"),
- output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", Types),
- io__write_string("};\n")
- ).
-output_rtti_data_defn(reserved_addrs(RttiTypeCtor, ReservedAddrs),
- DeclSet0, DeclSet) -->
- output_generic_rtti_data_defn_start(RttiTypeCtor, reserved_addrs,
- DeclSet0, DeclSet),
- (
- % ANSI/ISO C doesn't allow empty arrays, so
- % place a dummy value in the array if necessary.
- { ReservedAddrs = [] }
+ { rtti_data_to_name(pseudo_type_info(PseudoTypeInfo),
+ RttiTypeCtor, RttiName) },
+ { DataAddr = rtti_addr(RttiTypeCtor, RttiName) },
+ { decl_set_is_member(data_addr(DataAddr), DeclSet0) }
->
- io__write_string("= { NULL };\n")
+ { DeclSet = DeclSet0 }
;
- io__write_string(" = {\n"),
- io__write_list(ReservedAddrs, ",\n\t", output_reserved_address),
- io__write_string("\n};\n")
+ do_output_pseudo_type_info_defn(PseudoTypeInfo,
+ DeclSet0, DeclSet)
).
-output_rtti_data_defn(reserved_addr_functors(RttiTypeCtor, FunctorDescs),
+
+:- pred do_output_pseudo_type_info_defn(rtti_pseudo_type_info::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+do_output_pseudo_type_info_defn(plain_arity_zero_pseudo_type_info(_),
+ DeclSet, DeclSet) --> [].
+do_output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet) -->
+ { PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, Args) },
+ { TypeCtorRttiData = pseudo_type_info(
+ plain_arity_zero_pseudo_type_info(RttiTypeCtor)) },
+ { ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Args) },
+ output_type_ctor_and_arg_defns_and_decls(TypeCtorRttiData,
+ ArgRttiDatas, DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ pseudo_type_info(PseudoTypeInfo), DeclSet1, DeclSet),
+ io__write_string(" = {\n\t&"),
+ output_rtti_addr(RttiTypeCtor, type_ctor_info),
+ io__write_string(",\n{"),
+ output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgRttiDatas),
+ io__write_string("}};\n").
+do_output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet) -->
+ { PseudoTypeInfo = var_arity_pseudo_type_info(RttiVarArityId, Args) },
+ { RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId) },
+ { TypeCtorRttiData = pseudo_type_info(
+ plain_arity_zero_pseudo_type_info(RttiTypeCtor)) },
+ { ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Args) },
+ output_type_ctor_and_arg_defns_and_decls(TypeCtorRttiData,
+ ArgRttiDatas, DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ pseudo_type_info(PseudoTypeInfo), DeclSet1, DeclSet),
+ io__write_string(" = {\n\t&"),
+ output_rtti_addr(RttiTypeCtor, type_ctor_info),
+ io__write_string(",\n\t"),
+ { list__length(Args, Arity) },
+ io__write_int(Arity),
+ io__write_string(",\n{"),
+ output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgRttiDatas),
+ io__write_string("}};\n").
+do_output_pseudo_type_info_defn(type_var(_), DeclSet, DeclSet) --> [].
+
+:- pred output_type_ctor_and_arg_defns_and_decls(rtti_data::in,
+ list(rtti_data)::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_type_ctor_and_arg_defns_and_decls(TypeCtorRttiData, ArgRttiDatas,
DeclSet0, DeclSet) -->
- output_rtti_addrs_decls(RttiTypeCtor, FunctorDescs, "", "", 0, _,
+ output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _,
DeclSet0, DeclSet1),
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- reserved_addr_functors, DeclSet1, DeclSet),
+ % We must output the definitions of the rtti_datas of the argument
+ % typeinfos and/or pseudo-typeinfos, because they may contain other
+ % typeinfos and/or pseudo-typeinfos nested within them. However,
+ % zero arity typeinfos and pseudo-typeinfos have empty definitions,
+ % yet the type_ctor_info they refer to still must be declared.
+ % This is why both calls below are needed.
+ list__foldl2(output_rtti_data_defn, ArgRttiDatas, DeclSet1, DeclSet2),
+ output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _,
+ DeclSet2, DeclSet).
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_type_ctor_data_defn(type_ctor_data::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_type_ctor_data_defn(TypeCtorData, DeclSet0, DeclSet) -->
+ { RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData) },
+ { TypeCtorData = type_ctor_data(Version, Module, TypeName, TypeArity,
+ UnifyUniv, CompareUniv, TypeCtorDetails) },
+ output_type_ctor_details_defn(RttiTypeCtor, TypeCtorDetails,
+ MaybeFunctorsName, MaybeLayoutName, DeclSet0, DeclSet1),
+ { det_univ_to_type(UnifyUniv, UnifyProcLabel) },
+ { UnifyCodeAddr = make_code_addr(UnifyProcLabel) },
+ { det_univ_to_type(CompareUniv, CompareProcLabel) },
+ { CompareCodeAddr = make_code_addr(CompareProcLabel) },
+ { CodeAddrs = [UnifyCodeAddr, CompareCodeAddr] },
+ output_code_addrs_decls(CodeAddrs, "", "", 0, _, DeclSet1, DeclSet2),
+ output_generic_rtti_data_defn_start(RttiTypeCtor, type_ctor_info,
+ DeclSet2, DeclSet), io__write_string(" = {\n\t"),
+ io__write_int(TypeArity),
+ io__write_string(",\n\t"),
+ io__write_int(Version),
+ io__write_string(",\n\t"),
+ io__write_int(type_ctor_details_num_ptags(TypeCtorDetails)),
+ io__write_string(",\n\t"),
+ { rtti__type_ctor_rep_to_string(TypeCtorData, CtorRepStr) },
+ io__write_string(CtorRepStr),
+ io__write_string(",\n\t"),
+ output_static_code_addr(UnifyCodeAddr),
+ io__write_string(",\n\t"),
+ output_static_code_addr(CompareCodeAddr),
+ io__write_string(",\n\t"""),
+ { prog_out__sym_name_to_string(Module, ModuleName) },
+ c_util__output_quoted_string(ModuleName),
+ io__write_string(""",\n\t"""),
+ c_util__output_quoted_string(TypeName),
+ io__write_string(""",\n\t"),
(
- % ANSI/ISO C doesn't allow empty arrays, so
- % place a dummy value in the array if necessary.
- { FunctorDescs = [] }
- ->
- io__write_string("= { NULL };\n")
+ { MaybeFunctorsName = yes(FunctorsName) },
+ io__write_string("{ (void *) &"),
+ output_rtti_addr(RttiTypeCtor, FunctorsName),
+ io__write_string(" }")
;
- io__write_string(" = {\n"),
- output_addr_of_rtti_addrs(RttiTypeCtor, FunctorDescs),
- io__write_string("};\n")
+ { MaybeFunctorsName = no },
+ io__write_string("{ 0 }")
+ ),
+ io__write_string(",\n\t"),
+ (
+ { MaybeLayoutName = yes(LayoutName) },
+ io__write_string("{ (void *) &"),
+ output_rtti_addr(RttiTypeCtor, LayoutName),
+ io__write_string(" }")
+ ;
+ { MaybeLayoutName = no },
+ io__write_string("{ 0 }")
+ ),
+ io__write_string(",\n\t"),
+ io__write_int(type_ctor_details_num_functors(TypeCtorDetails)),
+% This code is commented out while the corresponding fields of the
+% MR_TypeCtorInfo_Struct type are commented out.
+%
+% io__write_string(",\n\t"),
+% (
+% { MaybeHashCons = yes(HashConsDataAddr) },
+% io__write_string("&"),
+% output_rtti_addr(RttiTypeCtor, HashConsDataAddr)
+% ;
+% { MaybeHashCons = no },
+% io__write_string("NULL")
+% ),
+% io__write_string(",\n\t"),
+% output_maybe_static_code_addr(Prettyprinter),
+ io__write_string("\n};\n").
+
+:- pred output_type_ctor_details_defn(rtti_type_ctor::in,
+ type_ctor_details::in, maybe(rtti_name)::out, maybe(rtti_name)::out,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_type_ctor_details_defn(RttiTypeCtor, TypeCtorDetails,
+ MaybeFunctorsName, MaybeLayoutName, DeclSet0, DeclSet) -->
+ (
+ { TypeCtorDetails = enum(_, EnumFunctors, EnumByRep,
+ EnumByName) },
+ list__foldl2(output_enum_functor_defn(RttiTypeCtor),
+ EnumFunctors, DeclSet0, DeclSet1),
+ output_enum_value_ordered_table(RttiTypeCtor, EnumByRep,
+ DeclSet1, DeclSet2),
+ output_enum_name_ordered_table(RttiTypeCtor, EnumByName,
+ DeclSet2, DeclSet),
+ { MaybeLayoutName = yes(enum_value_ordered_table) },
+ { MaybeFunctorsName = yes(enum_name_ordered_table) }
+ ;
+ { TypeCtorDetails = du(_, DuFunctors, DuByRep, DuByName) },
+ list__foldl2(output_du_functor_defn(RttiTypeCtor), DuFunctors,
+ DeclSet0, DeclSet1),
+ output_du_ptag_ordered_table(RttiTypeCtor, DuByRep,
+ DeclSet1, DeclSet2),
+ output_du_name_ordered_table(RttiTypeCtor, DuByName,
+ DeclSet2, DeclSet),
+ { MaybeLayoutName = yes(du_ptag_ordered_table) },
+ { MaybeFunctorsName = yes(du_name_ordered_table) }
+ ;
+ { TypeCtorDetails = reserved(_, MaybeResFunctors, ResFunctors,
+ DuByRep, MaybeResByName) },
+ list__foldl2(output_maybe_res_functor_defn(RttiTypeCtor),
+ MaybeResFunctors, DeclSet0, DeclSet1),
+ output_res_value_ordered_table(RttiTypeCtor, ResFunctors,
+ DuByRep, DeclSet1, DeclSet2),
+ output_res_name_ordered_table(RttiTypeCtor, MaybeResByName,
+ DeclSet2, DeclSet),
+ { MaybeLayoutName = yes(res_value_ordered_table) },
+ { MaybeFunctorsName = yes(res_name_ordered_table) }
+ ;
+ { TypeCtorDetails = notag(_, NotagFunctor) },
+ output_notag_functor_defn(RttiTypeCtor, NotagFunctor,
+ DeclSet0, DeclSet),
+ { MaybeLayoutName = yes(notag_functor_desc) },
+ { MaybeFunctorsName = yes(notag_functor_desc) }
+ ;
+ { TypeCtorDetails = eqv(EqvType) },
+ output_maybe_pseudo_type_info_defn(EqvType,
+ DeclSet0, DeclSet1),
+ { TypeData = maybe_pseudo_type_info_to_rtti_data(EqvType) },
+ output_rtti_data_decls(TypeData, "", "", 0, _,
+ DeclSet1, DeclSet),
+ {
+ EqvType = plain(TypeInfo),
+ LayoutName = type_info(TypeInfo)
+ ;
+ EqvType = pseudo(PseudoTypeInfo),
+ LayoutName = pseudo_type_info(PseudoTypeInfo)
+ },
+ { MaybeLayoutName = yes(LayoutName) },
+ { MaybeFunctorsName = no }
+ ;
+ { TypeCtorDetails = builtin(_) }, { error("output_type_ctor_details_defn: builtin") }
+ ;
+ { TypeCtorDetails = impl_artifact(_) },
+ { error("output_type_ctor_details_defn: impl_artifact") }
+ ;
+ { TypeCtorDetails = foreign },
+ { DeclSet = DeclSet0 },
+ { MaybeLayoutName = no },
+ { MaybeFunctorsName = no }
).
-output_rtti_data_defn(enum_functor_desc(RttiTypeCtor, FunctorName, Ordinal),
- DeclSet0, DeclSet) -->
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_enum_functor_defn(rtti_type_ctor::in, enum_functor::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_enum_functor_defn(RttiTypeCtor, EnumFunctor, DeclSet0, DeclSet) -->
+ { EnumFunctor = enum_functor(FunctorName, Ordinal) },
output_generic_rtti_data_defn_start(RttiTypeCtor,
enum_functor_desc(Ordinal), DeclSet0, DeclSet),
io__write_string(" = {\n\t"""),
@@ -203,15 +451,29 @@
io__write_string(""",\n\t"),
io__write_int(Ordinal),
io__write_string("\n};\n").
-output_rtti_data_defn(notag_functor_desc(RttiTypeCtor, FunctorName, ArgType,
- MaybeArgName), DeclSet0, DeclSet) -->
- output_rtti_data_decls(ArgType, "", "", 0, _, DeclSet0, DeclSet1),
+
+:- pred output_notag_functor_defn(rtti_type_ctor::in, notag_functor::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_notag_functor_defn(RttiTypeCtor, NotagFunctor, DeclSet0, DeclSet) -->
+ { NotagFunctor = notag_functor(FunctorName, ArgType, MaybeArgName) },
+ output_maybe_pseudo_type_info_defn(ArgType, DeclSet0, DeclSet1),
+ { ArgTypeData = maybe_pseudo_type_info_to_rtti_data(ArgType) },
+ output_rtti_data_decls(ArgTypeData, "", "", 0, _,
+ DeclSet1, DeclSet2),
output_generic_rtti_data_defn_start(RttiTypeCtor, notag_functor_desc,
- DeclSet1, DeclSet),
+ DeclSet2, DeclSet),
io__write_string(" = {\n\t"""),
c_util__output_quoted_string(FunctorName),
- io__write_string(""",\n\t "),
- output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ", ArgType),
+ io__write_string(""",\n\t"),
+ (
+ { ArgType = plain(ArgTypeInfo) },
+ output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ",
+ type_info(ArgTypeInfo))
+ ;
+ { ArgType = pseudo(ArgPseudoTypeInfo) },
+ output_addr_of_rtti_data(pseudo_type_info(ArgPseudoTypeInfo))
+ ),
io__write_string(",\n\t"),
(
{ MaybeArgName = yes(ArgName) },
@@ -223,32 +485,38 @@
io__write_string("NULL")
),
io__write_string("\n};\n").
-output_rtti_data_defn(du_functor_desc(RttiTypeCtor, FunctorName, Ptag, Stag,
- Locn, Ordinal, Arity, ContainsVarBitVector, MaybeArgTypes,
- MaybeNames, MaybeExist),
- DeclSet0, DeclSet) -->
+
+:- pred output_du_functor_defn(rtti_type_ctor::in, du_functor::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_du_functor_defn(RttiTypeCtor, DuFunctor, DeclSet0, DeclSet) -->
+ { DuFunctor = du_functor(FunctorName, OrigArity, Ordinal, Rep,
+ ArgInfos, MaybeExistInfo) },
+ { ArgTypes = list__map(du_arg_info_type, ArgInfos) },
+ { MaybeArgNames = list__map(du_arg_info_name, ArgInfos) },
+ { ArgNames = list__filter_map(project_yes, MaybeArgNames) },
(
- { MaybeArgTypes = yes(ArgTypes) },
- output_rtti_addr_decls(RttiTypeCtor, ArgTypes, "", "", 0, _,
+ { ArgInfos = [_ | _] },
+ output_du_arg_types(RttiTypeCtor, Ordinal, ArgTypes,
DeclSet0, DeclSet1)
;
- { MaybeArgTypes = no },
+ { ArgInfos = [] },
{ DeclSet1 = DeclSet0 }
),
(
- { MaybeNames = yes(NamesInfo1) },
- output_rtti_addr_decls(RttiTypeCtor, NamesInfo1, "", "",
- 0, _, DeclSet1, DeclSet2)
+ { ArgNames = [_ | _] },
+ output_du_arg_names(RttiTypeCtor, Ordinal, MaybeArgNames,
+ DeclSet1, DeclSet2)
;
- { MaybeNames = no },
+ { ArgNames = [] },
{ DeclSet2 = DeclSet1 }
),
(
- { MaybeExist = yes(ExistInfo1) },
- output_rtti_addr_decls(RttiTypeCtor, ExistInfo1, "", "",
- 0, _, DeclSet2, DeclSet3)
+ { MaybeExistInfo = yes(ExistInfo) },
+ output_exist_info(RttiTypeCtor, Ordinal, ExistInfo,
+ DeclSet2, DeclSet3)
;
- { MaybeExist = no },
+ { MaybeExistInfo = no },
{ DeclSet3 = DeclSet2 }
),
output_generic_rtti_data_defn_start(RttiTypeCtor,
@@ -256,12 +524,29 @@
io__write_string(" = {\n\t"""),
c_util__output_quoted_string(FunctorName),
io__write_string(""",\n\t"),
- io__write_int(Arity),
+ io__write_int(OrigArity),
io__write_string(",\n\t"),
+ { ContainsVarBitVector = compute_contains_var_bit_vector(ArgTypes) },
io__write_int(ContainsVarBitVector),
io__write_string(",\n\t"),
- { rtti__sectag_locn_to_string(Locn, LocnStr) },
- io__write_string(LocnStr),
+ {
+ Rep = du_ll_rep(Ptag, SectagAndLocn)
+ ;
+ Rep = du_hl_rep(_),
+ error("output_du_functor_defn: du_hl_rep")
+ },
+ {
+ SectagAndLocn = sectag_none,
+ Locn = "MR_SECTAG_NONE",
+ Stag = -1
+ ;
+ SectagAndLocn = sectag_local(Stag),
+ Locn = "MR_SECTAG_LOCAL"
+ ;
+ SectagAndLocn = sectag_remote(Stag),
+ Locn = "MR_SECTAG_REMOTE"
+ },
+ io__write_string(Locn),
io__write_string(",\n\t"),
io__write_int(Ptag),
io__write_string(",\n\t"),
@@ -271,421 +556,255 @@
io__write_string(",\n\t"),
io__write_string("(MR_PseudoTypeInfo *) "), % cast away const
(
- { MaybeArgTypes = yes(ArgTypes2) },
- output_addr_of_rtti_addr(RttiTypeCtor, ArgTypes2)
+ { ArgInfos = [_ | _] },
+ output_addr_of_rtti_addr(RttiTypeCtor, field_types(Ordinal))
;
- { MaybeArgTypes = no },
+ { ArgInfos = [] },
io__write_string("NULL")
),
io__write_string(",\n\t"),
(
- { MaybeNames = yes(NamesInfo2) },
- output_rtti_addr(RttiTypeCtor, NamesInfo2)
+ { ArgNames = [_ | _] },
+ output_addr_of_rtti_addr(RttiTypeCtor, field_names(Ordinal))
;
- { MaybeNames = no },
+ { ArgNames = [] },
io__write_string("NULL")
),
io__write_string(",\n\t"),
(
- { MaybeExist = yes(ExistInfo2) },
- output_addr_of_rtti_addr(RttiTypeCtor, ExistInfo2)
+ { MaybeExistInfo = yes(_) },
+ output_addr_of_rtti_addr(RttiTypeCtor, exist_info(Ordinal))
;
- { MaybeExist = no },
+ { MaybeExistInfo = no },
io__write_string("NULL")
),
io__write_string("\n};\n").
-output_rtti_data_defn(reserved_addr_functor_desc(RttiTypeCtor, FunctorName,
- Ordinal, ReservedAddr), DeclSet0, DeclSet) -->
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- reserved_addr_functor_desc(Ordinal), DeclSet0, DeclSet),
- io__write_string(" = {\n\t"""),
- c_util__output_quoted_string(FunctorName),
- io__write_string(""",\n\t"),
- io__write_int(Ordinal),
- io__write_string(",\n\t"),
- output_reserved_address(ReservedAddr),
- io__write_string("\n};\n").
-output_rtti_data_defn(enum_name_ordered_table(RttiTypeCtor, Functors),
- DeclSet0, DeclSet) -->
- output_rtti_addrs_decls(RttiTypeCtor, Functors, "", "", 0, _,
- DeclSet0, DeclSet1),
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- enum_name_ordered_table, DeclSet1, DeclSet),
- io__write_string(" = {\n"),
- output_addr_of_rtti_addrs(RttiTypeCtor, Functors),
- io__write_string("};\n").
-output_rtti_data_defn(enum_value_ordered_table(RttiTypeCtor, Functors),
- DeclSet0, DeclSet) -->
- output_rtti_addrs_decls(RttiTypeCtor, Functors, "", "", 0, _,
- DeclSet0, DeclSet1),
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- enum_value_ordered_table, DeclSet1, DeclSet),
- io__write_string(" = {\n"),
- output_addr_of_rtti_addrs(RttiTypeCtor, Functors),
- io__write_string("};\n").
-output_rtti_data_defn(du_name_ordered_table(RttiTypeCtor, Functors),
- DeclSet0, DeclSet) -->
- output_rtti_addrs_decls(RttiTypeCtor, Functors, "", "", 0, _,
- DeclSet0, DeclSet1),
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- du_name_ordered_table, DeclSet1, DeclSet),
- io__write_string(" = {\n"),
- output_addr_of_rtti_addrs(RttiTypeCtor, Functors),
- io__write_string("};\n").
-output_rtti_data_defn(du_stag_ordered_table(RttiTypeCtor, Ptag, Sharers),
- DeclSet0, DeclSet) -->
- output_rtti_addrs_decls(RttiTypeCtor, Sharers, "", "", 0, _,
- DeclSet0, DeclSet1),
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- du_stag_ordered_table(Ptag), DeclSet1, DeclSet),
- io__write_string(" = {\n"),
- output_addr_of_rtti_addrs(RttiTypeCtor, Sharers),
- io__write_string("\n};\n").
-output_rtti_data_defn(du_ptag_ordered_table(RttiTypeCtor, PtagLayouts),
- DeclSet0, DeclSet) -->
- output_ptag_layout_decls(PtagLayouts, RttiTypeCtor,
- DeclSet0, DeclSet1),
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- du_ptag_ordered_table, DeclSet1, DeclSet),
- io__write_string(" = {\n"),
- globals__io_lookup_bool_option(reserve_tag, ReserveTag),
- (
- { ReserveTag = yes }
- ->
- % Output a dummy ptag definition for the
- % reserved tag first
- output_dummy_ptag_layout_defn
- ;
- []
- ),
- output_ptag_layout_defns(PtagLayouts, RttiTypeCtor),
- io__write_string("\n};\n").
-output_rtti_data_defn(reserved_addr_table(RttiTypeCtor,
- NumNumericReservedAddrs, NumSymbolicReservedAddrs,
- SymbolicReservedAddrs, ReservedAddrFunctorDescs,
- DuFunctorLayout), DeclSet0, DeclSet) -->
- output_rtti_addrs_decls(RttiTypeCtor, [SymbolicReservedAddrs,
- DuFunctorLayout, ReservedAddrFunctorDescs],
- "", "", 0, _, DeclSet0, DeclSet1),
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- reserved_addr_table, DeclSet1, DeclSet),
- io__write_string(" = {\n\t"),
- io__write_int(NumNumericReservedAddrs),
- io__write_string(",\n\t"),
- io__write_int(NumSymbolicReservedAddrs),
- io__write_string(",\n\t"),
- output_rtti_addr(RttiTypeCtor, SymbolicReservedAddrs),
- io__write_string(",\n\t"),
- output_rtti_addr(RttiTypeCtor, ReservedAddrFunctorDescs),
- io__write_string(",\n\t"),
- output_rtti_addr(RttiTypeCtor, DuFunctorLayout),
- io__write_string("\n};\n").
-output_rtti_data_defn(type_ctor_info(RttiTypeCtor, Unify, Compare, CtorRep,
- Version, NumPtags, NumFunctors, FunctorsInfo, LayoutInfo),
- DeclSet0, DeclSet) -->
- { UnifyCA = make_maybe_code_addr(Unify) },
- { CompareCA = make_maybe_code_addr(Compare) },
- { MaybeCodeAddrs = [UnifyCA, CompareCA] },
- { CodeAddrs = list__filter_map(func(yes(CA)) = CA is semidet,
- MaybeCodeAddrs) },
- output_code_addrs_decls(CodeAddrs, "", "", 0, _, DeclSet0, DeclSet1),
- output_functors_info_decl(RttiTypeCtor, FunctorsInfo,
- DeclSet1, DeclSet2),
- output_layout_info_decl(RttiTypeCtor, LayoutInfo, DeclSet2, DeclSet3),
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- type_ctor_info, DeclSet3, DeclSet),
- io__write_string(" = {\n\t"),
- { RttiTypeCtor = rtti_type_ctor(Module, Type, TypeArity) },
- io__write_int(TypeArity),
- io__write_string(",\n\t"),
- io__write_int(Version),
- io__write_string(",\n\t"),
- io__write_int(NumPtags),
- io__write_string(",\n\t"),
- { rtti__type_ctor_rep_to_string(CtorRep, CtorRepStr) },
- io__write_string(CtorRepStr),
- io__write_string(",\n\t"),
- output_maybe_static_code_addr(UnifyCA),
- io__write_string(",\n\t"),
- output_maybe_static_code_addr(CompareCA),
- io__write_string(",\n\t"""),
- { prog_out__sym_name_to_string(Module, ModuleName) },
- c_util__output_quoted_string(ModuleName),
- io__write_string(""",\n\t"""),
- c_util__output_quoted_string(Type),
- io__write_string(""",\n\t"),
- (
- { FunctorsInfo = enum_functors(EnumFunctorsInfo) },
- io__write_string("{ (void *) "),
- output_rtti_addr(RttiTypeCtor, EnumFunctorsInfo),
- io__write_string(" }")
- ;
- { FunctorsInfo = notag_functors(NotagFunctorsInfo) },
- io__write_string("{ (void *) &"),
- output_rtti_addr(RttiTypeCtor, NotagFunctorsInfo),
- io__write_string(" }")
- ;
- { FunctorsInfo = du_functors(DuFunctorsInfo) },
- io__write_string("{ (void *) "),
- output_rtti_addr(RttiTypeCtor, DuFunctorsInfo),
- io__write_string(" }")
- ;
- { FunctorsInfo = no_functors },
- io__write_string("{ 0 }")
- ),
- io__write_string(",\n\t"),
- (
- { LayoutInfo = enum_layout(EnumLayoutInfo) },
- io__write_string("{ (void *) "),
- output_rtti_addr(RttiTypeCtor, EnumLayoutInfo),
- io__write_string(" }")
- ;
- { LayoutInfo = notag_layout(NotagLayoutInfo) },
- io__write_string("{ (void *) &"),
- output_rtti_addr(RttiTypeCtor, NotagLayoutInfo),
- io__write_string(" }")
- ;
- { LayoutInfo = du_layout(DuLayoutInfo) },
- io__write_string("{ (void *) "),
- output_rtti_addr(RttiTypeCtor, DuLayoutInfo),
- io__write_string(" }")
- ;
- { LayoutInfo = reserved_addr_layout(RaLayoutInfo) },
- io__write_string("{ (void *) &"),
- output_rtti_addr(RttiTypeCtor, RaLayoutInfo),
- io__write_string(" }")
- ;
- { LayoutInfo = equiv_layout(EquivTypeInfo) },
- io__write_string("{ (void *) "),
- output_addr_of_rtti_data(EquivTypeInfo),
- io__write_string(" }")
- ;
- { LayoutInfo = no_layout },
- io__write_string("{ 0 }")
- ),
- io__write_string(",\n\t"),
- io__write_int(NumFunctors),
-% This code is commented out while the corresponding fields of the
-% MR_TypeCtorInfo_Struct type are commented out.
-%
-% io__write_string(",\n\t"),
-% (
-% { MaybeHashCons = yes(HashConsDataAddr) },
-% io__write_string("&"),
-% output_rtti_addr(RttiTypeCtor, HashConsDataAddr)
-% ;
-% { MaybeHashCons = no },
-% io__write_string("NULL")
-% ),
-% io__write_string(",\n\t"),
-% output_maybe_static_code_addr(Prettyprinter),
- io__write_string("\n};\n").
-output_rtti_data_defn(type_info(TypeInfo), DeclSet0, DeclSet) -->
- output_type_info_defn(TypeInfo, DeclSet0, DeclSet).
-output_rtti_data_defn(pseudo_type_info(PseudoTypeInfo), DeclSet0, DeclSet) -->
- output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet).
-output_rtti_data_defn(base_typeclass_info(InstanceModuleName, ClassId,
- InstanceString, BaseTypeClassInfo), DeclSet0, DeclSet) -->
- output_base_typeclass_info_defn(InstanceModuleName, ClassId,
- InstanceString, BaseTypeClassInfo, DeclSet0, DeclSet).
-:- pred output_base_typeclass_info_defn(module_name::in, class_id::in,
- string::in, base_typeclass_info::in, decl_set::in, decl_set::out,
- io__state::di, io__state::uo) is det.
+:- pred output_res_functor_defn(rtti_type_ctor::in, reserved_functor::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_base_typeclass_info_defn(InstanceModuleName, ClassId, InstanceString,
- base_typeclass_info(N1, N2, N3, N4, N5, Methods),
- DeclSet0, DeclSet) -->
- { CodeAddrs = list__map(make_code_addr, Methods) },
- output_code_addrs_decls(CodeAddrs, "", "", 0, _, DeclSet0, DeclSet1),
- io__write_string("\n"),
- output_base_typeclass_info_storage_type_name(InstanceModuleName,
- ClassId, InstanceString, yes),
- % XXX It would be nice to avoid generating redundant declarations
- % of base_typeclass_infos, but currently we don't.
- { DeclSet1 = DeclSet },
- io__write_string(" = {\n\t(MR_Code *) "),
- io__write_list([N1, N2, N3, N4, N5],
- ",\n\t(MR_Code *) ", io__write_int),
+output_res_functor_defn(RttiTypeCtor, ResFunctor, DeclSet0, DeclSet) -->
+ { ResFunctor = reserved_functor(FunctorName, Ordinal, Rep) },
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ res_functor_desc(Ordinal), DeclSet0, DeclSet),
+ io__write_string(" = {\n\t"""),
+ c_util__output_quoted_string(FunctorName),
+ io__write_string(""",\n\t"),
+ io__write_int(Ordinal),
io__write_string(",\n\t"),
- io__write_list(CodeAddrs, ",\n\t", output_static_code_addr),
+ io__write_string("(void *) "),
+ (
+ { Rep = null_pointer },
+ io__write_string("NULL")
+ ;
+ { Rep = small_pointer(SmallPtr) },
+ io__write_int(SmallPtr)
+ ;
+ { Rep = reserved_object(_, _, _) },
+ { error("output_res_functor_defn: reserved object") }
+ ),
io__write_string("\n};\n").
-:- func make_maybe_code_addr(maybe(rtti_proc_label)) = maybe(code_addr).
+:- pred output_maybe_res_functor_defn(rtti_type_ctor::in,
+ maybe_reserved_functor::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_maybe_res_functor_defn(RttiTypeCtor, MaybeResFunctor, DeclSet0, DeclSet)
+ -->
+ (
+ { MaybeResFunctor = res_func(ResFunctor) },
+ output_res_functor_defn(RttiTypeCtor, ResFunctor,
+ DeclSet0, DeclSet)
+ ;
+ { MaybeResFunctor = du_func(DuFunctor) },
+ output_du_functor_defn(RttiTypeCtor, DuFunctor,
+ DeclSet0, DeclSet)
+ ).
-make_maybe_code_addr(no) = no.
-make_maybe_code_addr(yes(ProcLabel)) = yes(make_code_addr(ProcLabel)).
+%-----------------------------------------------------------------------------%
-:- func make_code_addr(rtti_proc_label) = code_addr.
+:- pred output_exist_locns_array(rtti_type_ctor::in, int::in,
+ list(exist_typeinfo_locn)::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-make_code_addr(ProcLabel) = CodeAddr :-
- code_util__make_entry_label_from_rtti(ProcLabel, no, CodeAddr).
+output_exist_locns_array(RttiTypeCtor, Ordinal, Locns, DeclSet0, DeclSet) -->
+ output_generic_rtti_data_defn_start(RttiTypeCtor, exist_locns(Ordinal),
+ DeclSet0, DeclSet),
+ (
+ % ANSI/ISO C doesn't allow empty arrays, so
+ % place a dummy value in the array if necessary.
+ { Locns = [] }
+ ->
+ io__write_string("= { {0, 0} };\n")
+ ;
+ io__write_string(" = {\n"),
+ output_exist_locns(Locns),
+ io__write_string("};\n")
+ ).
-:- pred output_type_info_defn(rtti_type_info::in,
+:- pred output_exist_info(rtti_type_ctor::in, int::in, exist_info::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_type_info_defn(plain_arity_zero_type_info(_),
- DeclSet, DeclSet) --> [].
-output_type_info_defn(TypeInfo, DeclSet0, DeclSet) -->
- { TypeInfo = plain_type_info(RttiTypeCtor, Args) },
- { TypeCtorRttiData = type_info(
- plain_arity_zero_type_info(RttiTypeCtor)) },
- { ArgRttiDatas = list__map(type_info_to_rtti_data, Args) },
- output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _,
- DeclSet0, DeclSet1),
- output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _,
- DeclSet1, DeclSet2),
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- type_info(TypeInfo), DeclSet2, DeclSet),
- io__write_string(" = {\n\t&"),
- output_rtti_addr(RttiTypeCtor, type_ctor_info),
- io__write_string(",\n{"),
- output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas),
- io__write_string("}};\n").
-output_type_info_defn(TypeInfo, DeclSet0, DeclSet) -->
- { TypeInfo = var_arity_type_info(RttiVarArityId, Args) },
- { RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId) },
- { TypeCtorRttiData = type_info(
- plain_arity_zero_type_info(RttiTypeCtor)) },
- { ArgRttiDatas = list__map(type_info_to_rtti_data, Args) },
- output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _,
+output_exist_info(RttiTypeCtor, Ordinal, ExistInfo, DeclSet0, DeclSet) -->
+ { ExistInfo = exist_info(Plain, InTci, Tci, Locns) },
+ output_exist_locns_array(RttiTypeCtor, Ordinal, Locns,
DeclSet0, DeclSet1),
- output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _,
- DeclSet1, DeclSet2),
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- type_info(TypeInfo), DeclSet2, DeclSet),
- io__write_string(" = {\n\t&"),
- output_rtti_addr(RttiTypeCtor, type_ctor_info),
+ output_generic_rtti_data_defn_start(RttiTypeCtor, exist_info(Ordinal),
+ DeclSet1, DeclSet),
+ io__write_string(" = {\n\t"),
+ io__write_int(Plain),
io__write_string(",\n\t"),
- { list__length(Args, Arity) },
- io__write_int(Arity),
- io__write_string(",\n{"),
- output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas),
- io__write_string("}};\n").
+ io__write_int(InTci),
+ io__write_string(",\n\t"),
+ io__write_int(Tci),
+ io__write_string(",\n\t"),
+ output_rtti_addr(RttiTypeCtor, exist_locns(Ordinal)),
+ io__write_string("\n};\n").
-:- pred output_pseudo_type_info_defn(rtti_pseudo_type_info::in,
+:- pred output_du_arg_types(rtti_type_ctor::in, int::in,
+ list(rtti_maybe_pseudo_type_info_or_self)::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_pseudo_type_info_defn(plain_arity_zero_pseudo_type_info(_),
- DeclSet, DeclSet) --> [].
-output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet) -->
- { PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, Args) },
- { TypeCtorRttiData = pseudo_type_info(
- plain_arity_zero_pseudo_type_info(RttiTypeCtor)) },
- { ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Args) },
- output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _,
+output_du_arg_types(RttiTypeCtor, Ordinal, ArgTypes, DeclSet0, DeclSet) -->
+ list__foldl2(output_maybe_pseudo_type_info_or_self_defn, ArgTypes,
DeclSet0, DeclSet1),
- output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _,
+ { ArgTypeDatas = list__map(maybe_pseudo_type_info_or_self_to_rtti_data,
+ ArgTypes) },
+ output_rtti_datas_decls(ArgTypeDatas, "", "", 0, _,
DeclSet1, DeclSet2),
- output_generic_rtti_data_defn_start(RttiTypeCtor,
- pseudo_type_info(PseudoTypeInfo), DeclSet2, DeclSet),
- io__write_string(" = {\n\t&"),
- output_rtti_addr(RttiTypeCtor, type_ctor_info),
- io__write_string(",\n{"),
+ output_generic_rtti_data_defn_start(RttiTypeCtor, field_types(Ordinal),
+ DeclSet2, DeclSet),
+ io__write_string(" = {\n"),
+ { ArgRttiDatas = list__map(maybe_pseudo_type_info_or_self_to_rtti_data,
+ ArgTypes) },
output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgRttiDatas),
- io__write_string("}};\n").
-output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet) -->
- { PseudoTypeInfo = var_arity_pseudo_type_info(RttiVarArityId, Args) },
- { RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId) },
- { TypeCtorRttiData = pseudo_type_info(
- plain_arity_zero_pseudo_type_info(RttiTypeCtor)) },
- { ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Args) },
- output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _,
- DeclSet0, DeclSet1),
- output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _,
- DeclSet1, DeclSet2),
+ io__write_string("};\n").
+
+:- pred output_du_arg_names(rtti_type_ctor::in, int::in,
+ list(maybe(string))::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_du_arg_names(RttiTypeCtor, Ordinal, MaybeNames, DeclSet0, DeclSet) -->
+ output_generic_rtti_data_defn_start(RttiTypeCtor, field_names(Ordinal),
+ DeclSet0, DeclSet),
+ io__write_string(" = {\n"),
+ output_maybe_quoted_strings(MaybeNames),
+ io__write_string("};\n").
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_enum_value_ordered_table(rtti_type_ctor::in,
+ map(int, enum_functor)::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_enum_value_ordered_table(RttiTypeCtor, FunctorMap, DeclSet0, DeclSet)
+ -->
+ { Functors = map__values(FunctorMap) },
+ { FunctorRttiNames = list__map(enum_functor_rtti_name, Functors) },
output_generic_rtti_data_defn_start(RttiTypeCtor,
- pseudo_type_info(PseudoTypeInfo), DeclSet2, DeclSet),
- io__write_string(" = {\n\t&"),
- output_rtti_addr(RttiTypeCtor, type_ctor_info),
- io__write_string(",\n\t"),
- { list__length(Args, Arity) },
- io__write_int(Arity),
- io__write_string(",\n{"),
- output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgRttiDatas),
- io__write_string("}};\n").
-output_pseudo_type_info_defn(type_var(_), DeclSet, DeclSet) --> [].
+ enum_value_ordered_table, DeclSet0, DeclSet),
+ io__write_string(" = {\n"),
+ output_addr_of_rtti_addrs(RttiTypeCtor, FunctorRttiNames),
+ io__write_string("};\n").
-:- pred output_functors_info_decl(rtti_type_ctor::in,
- type_ctor_functors_info::in, decl_set::in, decl_set::out,
+:- pred output_enum_name_ordered_table(rtti_type_ctor::in,
+ map(string, enum_functor)::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
-output_functors_info_decl(RttiTypeCtor, enum_functors(EnumFunctorsInfo),
- DeclSet0, DeclSet) -->
- output_generic_rtti_data_decl(RttiTypeCtor, EnumFunctorsInfo,
- DeclSet0, DeclSet).
-output_functors_info_decl(RttiTypeCtor, notag_functors(NotagFunctorsInfo),
- DeclSet0, DeclSet) -->
- output_generic_rtti_data_decl(RttiTypeCtor, NotagFunctorsInfo,
- DeclSet0, DeclSet).
-output_functors_info_decl(RttiTypeCtor, du_functors(DuFunctorsInfo),
- DeclSet0, DeclSet) -->
- output_generic_rtti_data_decl(RttiTypeCtor, DuFunctorsInfo,
- DeclSet0, DeclSet).
-output_functors_info_decl(_RttiTypeCtor, no_functors, DeclSet, DeclSet) --> [].
+output_enum_name_ordered_table(RttiTypeCtor, FunctorMap, DeclSet0, DeclSet)
+ -->
+ { Functors = map__values(FunctorMap) },
+ { FunctorRttiNames = list__map(enum_functor_rtti_name, Functors) },
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ enum_name_ordered_table, DeclSet0, DeclSet),
+ io__write_string(" = {\n"),
+ output_addr_of_rtti_addrs(RttiTypeCtor, FunctorRttiNames),
+ io__write_string("};\n").
-:- pred output_layout_info_decl(rtti_type_ctor::in, type_ctor_layout_info::in,
- decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+:- pred output_du_name_ordered_table(rtti_type_ctor::in,
+ map(string, map(int, du_functor))::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
-output_layout_info_decl(RttiTypeCtor, enum_layout(EnumLayoutInfo),
- DeclSet0, DeclSet) -->
- output_generic_rtti_data_decl(RttiTypeCtor, EnumLayoutInfo,
- DeclSet0, DeclSet).
-output_layout_info_decl(RttiTypeCtor, notag_layout(NotagLayoutInfo),
- DeclSet0, DeclSet) -->
- output_generic_rtti_data_decl(RttiTypeCtor, NotagLayoutInfo,
- DeclSet0, DeclSet).
-output_layout_info_decl(RttiTypeCtor, du_layout(DuLayoutInfo),
- DeclSet0, DeclSet) -->
- output_generic_rtti_data_decl(RttiTypeCtor, DuLayoutInfo,
- DeclSet0, DeclSet).
-output_layout_info_decl(RttiTypeCtor, reserved_addr_layout(RaLayoutInfo),
- DeclSet0, DeclSet) -->
- output_generic_rtti_data_decl(RttiTypeCtor, RaLayoutInfo,
- DeclSet0, DeclSet).
-output_layout_info_decl(_RttiTypeCtor, equiv_layout(EquivRttiData),
- DeclSet0, DeclSet) -->
- output_rtti_data_decl(EquivRttiData, DeclSet0, DeclSet).
-output_layout_info_decl(_RttiTypeCtor, no_layout, DeclSet, DeclSet) --> [].
+output_du_name_ordered_table(RttiTypeCtor, NameArityMap, DeclSet0, DeclSet) -->
+ { map__values(NameArityMap, ArityMaps) },
+ { list__map(map__values, ArityMaps, FunctorLists) },
+ { list__condense(FunctorLists, Functors) },
+ { FunctorRttiNames = list__map(du_functor_rtti_name, Functors) },
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ du_name_ordered_table, DeclSet0, DeclSet),
+ io__write_string(" = {\n"),
+ output_addr_of_rtti_addrs(RttiTypeCtor, FunctorRttiNames),
+ io__write_string("};\n").
-:- pred output_ptag_layout_decls(list(du_ptag_layout)::in, rtti_type_ctor::in,
- decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+:- pred output_du_stag_ordered_table(rtti_type_ctor::in,
+ pair(int, sectag_table)::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
-output_ptag_layout_decls([], _, DeclSet, DeclSet) --> [].
-output_ptag_layout_decls([DuPtagLayout | DuPtagLayouts], RttiTypeCtor,
+output_du_stag_ordered_table(RttiTypeCtor, Ptag - SectagTable,
DeclSet0, DeclSet) -->
- { DuPtagLayout = du_ptag_layout(_, _, Descriptors) },
- output_rtti_addr_decls(RttiTypeCtor, Descriptors, "", "", 0, _,
+ { SectagTable = sectag_table(_SectagLocn, _NumSharers, SectagMap) },
+ { map__values(SectagMap, SectagFunctors) },
+ { FunctorNames = list__map(du_functor_rtti_name, SectagFunctors) },
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ du_stag_ordered_table(Ptag), DeclSet0, DeclSet),
+ io__write_string(" = {\n"),
+ output_addr_of_rtti_addrs(RttiTypeCtor, FunctorNames),
+ io__write_string("\n};\n").
+
+:- pred output_du_ptag_ordered_table(rtti_type_ctor::in,
+ map(int, sectag_table)::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_du_ptag_ordered_table(RttiTypeCtor, PtagMap, DeclSet0, DeclSet) -->
+ { map__to_assoc_list(PtagMap, PtagList) },
+ list__foldl2(output_du_stag_ordered_table(RttiTypeCtor), PtagList,
DeclSet0, DeclSet1),
- output_ptag_layout_decls(DuPtagLayouts, RttiTypeCtor,
- DeclSet1, DeclSet).
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ du_ptag_ordered_table, DeclSet1, DeclSet),
+ io__write_string(" = {\n"),
+ ( { PtagList = [1 - _ | _] } ->
+ % Output a dummy ptag definition for the
+ % reserved tag first.
+ output_dummy_ptag_layout_defn,
+ { FirstPtag = 1 }
+ ; { PtagList = [0 - _ | _] } ->
+ { FirstPtag = 0 }
+ ;
+ { error("output_dummy_ptag_layout_defn: bad ptag list") }
+ ),
+ output_du_ptag_ordered_table_body(RttiTypeCtor, PtagList, FirstPtag),
+ io__write_string("\n};\n").
-:- pred output_ptag_layout_defns(list(du_ptag_layout)::in, rtti_type_ctor::in,
+:- pred output_du_ptag_ordered_table_body(rtti_type_ctor::in,
+ assoc_list(int, sectag_table)::in, int::in,
io__state::di, io__state::uo) is det.
-output_ptag_layout_defns([], _) --> [].
-output_ptag_layout_defns([DuPtagLayout | DuPtagLayouts], RttiTypeCtor) -->
- { DuPtagLayout = du_ptag_layout(NumSharers, Locn, Descriptors) },
+output_du_ptag_ordered_table_body(_RttiTypeCtor, [], _CurPtag) --> [].
+output_du_ptag_ordered_table_body(RttiTypeCtor,
+ [Ptag - SectagTable | PtagTail], CurPtag) -->
+ { require(unify(Ptag, CurPtag),
+ "output_du_ptag_ordered_table_body: ptag mismatch") },
+ { SectagTable = sectag_table(SectagLocn, NumSharers, _SectagMap) },
io__write_string("\t{ "),
io__write_int(NumSharers),
io__write_string(", "),
- { rtti__sectag_locn_to_string(Locn, LocnStr) },
+ { rtti__sectag_locn_to_string(SectagLocn, LocnStr) },
io__write_string(LocnStr),
io__write_string(",\n\t"),
- output_rtti_addr(RttiTypeCtor, Descriptors),
- ( { DuPtagLayouts = [] } ->
+ output_rtti_addr(RttiTypeCtor, du_stag_ordered_table(Ptag)),
+ ( { PtagTail = [] } ->
io__write_string(" }\n")
;
- io__write_string(" },\n")
- ),
- output_ptag_layout_defns(DuPtagLayouts, RttiTypeCtor).
+ io__write_string(" },\n"),
+ output_du_ptag_ordered_table_body(RttiTypeCtor, PtagTail,
+ CurPtag + 1)
+ ).
% Output a `dummy' ptag layout, for use by tags that aren't *real*
% tags, such as the tag reserved when --reserve-tag is on.
%
% XXX Note that if one of these dummy ptag definitions is actually
- % accessed by the Mercury runtime, or the construct/deconstruct
- % code in library/std_util.m, the result will be undefined.
+ % accessed by the Mercury runtime, the result will be undefined.
% This should be fixed by adding a MR_SECTAG_DUMMY and handling it
% gracefully.
:- pred output_dummy_ptag_layout_defn(io__state::di, io__state::uo) is det.
@@ -693,8 +812,98 @@
output_dummy_ptag_layout_defn -->
io__write_string("\t{ 0, MR_SECTAG_VARIABLE, NULL },\n").
+:- pred output_res_addr_functors(rtti_type_ctor::in,
+ reserved_functor::in, io__state::di, io__state::uo) is det.
+
+output_res_addr_functors(RttiTypeCtor, ResFunctor) -->
+ output_rtti_addr(RttiTypeCtor, res_functor_rtti_name(ResFunctor)),
+ io__write_string(",\n").
+
+:- pred output_res_value_ordered_table(rtti_type_ctor::in,
+ list(reserved_functor)::in, map(int, sectag_table)::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_res_value_ordered_table(RttiTypeCtor, ResFunctors, DuPtagTable,
+ DeclSet0, DeclSet) -->
+ { ResFunctorReps = list__map(res_addr_rep, ResFunctors) },
+ { list__filter(res_addr_is_numeric, ResFunctorReps,
+ NumericResFunctorReps, SymbolicResFunctorReps) },
+ { list__length(NumericResFunctorReps, NumNumericResFunctorReps) },
+ { list__length(SymbolicResFunctorReps, NumSymbolicResFunctorReps) },
+ { require(unify(NumSymbolicResFunctorReps, 0),
+ "output_res_value_ordered_table: symbolic functors") },
+
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ res_addr_functors, DeclSet0, DeclSet1),
+ io__write_string(" = {\n"),
+ list__foldl(output_res_addr_functors(RttiTypeCtor), ResFunctors),
+ io__write_string("};\n"),
+
+ output_du_ptag_ordered_table(RttiTypeCtor, DuPtagTable,
+ DeclSet1, DeclSet2),
+
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ res_value_ordered_table, DeclSet2, DeclSet),
+ io__write_string(" = {\n\t"""),
+ io__write_int(NumNumericResFunctorReps),
+ io__write_string(",\n\t"),
+ io__write_int(NumSymbolicResFunctorReps),
+ io__write_string(",\n\t"),
+ io__write_string("NULL"),
+ io__write_string(",\n\t"),
+ output_rtti_addr(RttiTypeCtor, res_addr_functors),
+ io__write_string(",\n\t"),
+ output_rtti_addr(RttiTypeCtor, du_ptag_ordered_table),
+ io__write_string("\n};\n").
+
+:- pred output_res_name_ordered_table(rtti_type_ctor::in,
+ map(string, map(int, maybe_reserved_functor))::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_res_name_ordered_table(RttiTypeCtor, NameArityMap, DeclSet0, DeclSet) -->
+ { map__values(NameArityMap, ArityMaps) },
+ { list__map(map__values, ArityMaps, FunctorLists) },
+ { list__condense(FunctorLists, Functors) },
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ res_name_ordered_table, DeclSet0, DeclSet),
+ io__write_string(" = {\n\t"""),
+ list__foldl(output_res_name_ordered_table_element(RttiTypeCtor),
+ Functors),
+ io__write_string("\n};\n").
+
+:- pred output_res_name_ordered_table_element(rtti_type_ctor::in,
+ maybe_reserved_functor::in, io__state::di, io__state::uo) is det.
+
+output_res_name_ordered_table_element(RttiTypeCtor, MaybeResFunctor) -->
+ io__write_string("\t{ """),
+ (
+ { MaybeResFunctor = res_func(ResFunctor) },
+ { Name = ResFunctor ^ res_name },
+ io__write_string(Name),
+ io__write_string(""", "),
+ io__write_string("0, "),
+ io__write_string("MR_TRUE, ")
+ ;
+ { MaybeResFunctor = du_func(DuFunctor) },
+ { Name = DuFunctor ^ du_name },
+ { Arity = DuFunctor ^ du_orig_arity },
+ io__write_string(Name),
+ io__write_string(""", "),
+ io__write_int(Arity),
+ io__write_string(", "),
+ io__write_string("MR_FALSE, ")
+ ),
+ { RttiName = maybe_res_functor_rtti_name(MaybeResFunctor) },
+ output_rtti_addr(RttiTypeCtor, RttiName),
+ io__write_string(" },\n").
+
%-----------------------------------------------------------------------------%
+:- func make_code_addr(rtti_proc_label) = code_addr.
+
+make_code_addr(ProcLabel) = CodeAddr :-
+ code_util__make_entry_label_from_rtti(ProcLabel, no, CodeAddr).
+
:- pred output_reserved_address(reserved_address::in,
io__state::di, io__state::uo) is det.
@@ -795,18 +1004,38 @@
OutputName,
io__write_string(Suffix).
+ % Each type_info and pseudo_type_info may have a different C type,
+ % depending on what kind of type_info or pseudo_type_info it is,
+ % and also on its arity. We need to declare that C type here.
+
:- pred output_rtti_type_decl(rtti_name::in, io__state::di, io__state::uo)
is det.
output_rtti_type_decl(RttiName) -->
(
- %
- % Each type_info and pseudo_type_info may have a different
- % type, depending on what kind of type_info or pseudo_type_info
- % it is, and also on its arity.
- % We need to declare that type here.
- %
- {
+ { rtti_type_needs_template(RttiName, DefineType,
+ TypeNameBase, NumArgTypes) }
+ ->
+ { 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)
+ ])
+ ;
+ []
+ ).
+
+:- pred rtti_type_needs_template(rtti_name::in, string::out, string::out,
+ int::out) is semidet.
+
+rtti_type_needs_template(RttiName, DefineType, TypeNameBase, NumArgTypes) :-
RttiName = type_info(TypeInfo),
(
TypeInfo = plain_type_info(_, ArgTypes),
@@ -817,8 +1046,8 @@
TypeNameBase = "MR_VA_TypeInfo_Struct",
DefineType = "MR_VAR_ARITY_TYPEINFO_STRUCT"
),
- NumArgTypes = list__length(ArgTypes)
- ;
+ NumArgTypes = list__length(ArgTypes).
+rtti_type_needs_template(RttiName, DefineType, TypeNameBase, NumArgTypes) :-
RttiName = pseudo_type_info(PseudoTypeInfo),
(
PseudoTypeInfo = plain_pseudo_type_info(_, ArgTypes),
@@ -829,31 +1058,15 @@
TypeNameBase = "MR_VA_PseudoTypeInfo_Struct",
DefineType = "MR_VAR_ARITY_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)
- ])
- ;
- []
- ).
+ NumArgTypes = list__length(ArgTypes).
%-----------------------------------------------------------------------------%
rtti_out__init_rtti_data_if_nec(Data) -->
(
- { Data = type_ctor_info(RttiTypeCtor, _,_,_,_,_,_,_,_) }
+ { Data = type_ctor_info(TypeCtorData) }
->
+ { RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData) },
io__write_string("\tMR_INIT_TYPE_CTOR_INFO(\n\t\t"),
output_rtti_addr(RttiTypeCtor, type_ctor_info),
io__write_string(",\n\t\t"),
@@ -892,8 +1105,9 @@
rtti_out__register_rtti_data_if_nec(Data, SplitFiles) -->
(
- { Data = type_ctor_info(RttiTypeCtor, _,_,_,_,_,_,_,_) }
+ { Data = type_ctor_info(TypeCtorData) }
->
+ { RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData) },
(
{ SplitFiles = yes },
io__write_string("\t{\n\t"),
@@ -1194,18 +1408,19 @@
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(reserved_addrs) = no.
-rtti_name_would_include_code_addr(reserved_addr_functors) = no.
+rtti_name_would_include_code_addr(res_addrs) = no.
+rtti_name_would_include_code_addr(res_addr_functors) = 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.
-rtti_name_would_include_code_addr(reserved_addr_functor_desc(_)) = no.
+rtti_name_would_include_code_addr(res_functor_desc(_)) = no.
rtti_name_would_include_code_addr(enum_name_ordered_table) = no.
rtti_name_would_include_code_addr(enum_value_ordered_table) = no.
rtti_name_would_include_code_addr(du_name_ordered_table) = no.
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(reserved_addr_table) = no.
+rtti_name_would_include_code_addr(res_value_ordered_table) = no.
+rtti_name_would_include_code_addr(res_name_ordered_table) = no.
rtti_name_would_include_code_addr(type_ctor_info) = yes.
rtti_name_would_include_code_addr(base_typeclass_info(_, _, _)) = yes.
rtti_name_would_include_code_addr(type_info(TypeInfo)) =
@@ -1248,20 +1463,20 @@
rtti_name_c_type(exist_info(_), "MR_DuExistInfo", "").
rtti_name_c_type(field_names(_), "MR_ConstString", "[]").
rtti_name_c_type(field_types(_), "MR_PseudoTypeInfo", "[]").
-rtti_name_c_type(reserved_addrs, "/* const */ void *", "[]").
-rtti_name_c_type(reserved_addr_functors, "MR_ReservedAddrFunctorDesc *",
+rtti_name_c_type(res_addrs, "/* const */ void *", "[]").
+rtti_name_c_type(res_addr_functors, "MR_ReservedAddrFunctorDesc *",
"[]").
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", "").
-rtti_name_c_type(reserved_addr_functor_desc(_), "MR_ReservedAddrFunctorDesc",
- "").
+rtti_name_c_type(res_functor_desc(_), "MR_ReservedAddrFunctorDesc", "").
rtti_name_c_type(enum_name_ordered_table, "MR_EnumFunctorDesc *", "[]").
rtti_name_c_type(enum_value_ordered_table, "MR_EnumFunctorDesc *", "[]").
rtti_name_c_type(du_name_ordered_table, "MR_DuFunctorDesc *", "[]").
rtti_name_c_type(du_stag_ordered_table(_), "MR_DuFunctorDesc *", "[]").
rtti_name_c_type(du_ptag_ordered_table, "MR_DuPtagLayout", "[]").
-rtti_name_c_type(reserved_addr_table, "MR_ReservedAddrTypeLayout", "").
+rtti_name_c_type(res_value_ordered_table, "MR_ReservedAddrTypeLayout", "").
+rtti_name_c_type(res_name_ordered_table, "MR_MaybeResAddrFunctorDesc", "[]").
rtti_name_c_type(type_ctor_info, "struct MR_TypeCtorInfo_Struct",
"").
rtti_name_c_type(base_typeclass_info(_, _, _), "MR_Code *", "[]").
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.31
diff -u -b -r1.31 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 24 Apr 2002 07:37:33 -0000 1.31
+++ compiler/rtti_to_mlds.m 15 May 2002 09:16:54 -0000
@@ -5,7 +5,7 @@
%-----------------------------------------------------------------------------%
%
% rtti_to_mlds.m: convert RTTI data structures to MLDS.
-% Author: fjh
+% Authors: fjh, zs
%
% This module defines routines to convert from the back-end-independent
% RTTI data structures into MLDS definitions.
@@ -30,18 +30,40 @@
:- func mlds_rtti_type_name(rtti_name) = string.
:- implementation.
-:- import_module backend_libs__foreign, parse_tree__prog_data, hlds__hlds_data.
-:- import_module backend_libs__pseudo_type_info, parse_tree__prog_util.
-:- import_module parse_tree__prog_out, check_hlds__type_util.
+:- import_module parse_tree__prog_data, parse_tree__prog_data.
+:- import_module parse_tree__prog_out, parse_tree__prog_util.
+:- import_module hlds__hlds_data.
+:- import_module check_hlds__type_util.
+:- import_module backend_libs__foreign, backend_libs__type_ctor_info.
+:- import_module backend_libs__pseudo_type_info.
:- import_module ml_backend__ml_code_util, ml_backend__ml_unify_gen.
:- import_module ml_backend__ml_closure_gen.
-:- import_module bool, list, std_util, string, term, require.
+:- import_module bool, string, int, list, assoc_list, map.
+:- import_module std_util, term, require.
-rtti_data_list_to_mlds(ModuleInfo, RttiDatas) =
- list__condense(list__map(rtti_data_to_mlds(ModuleInfo), RttiDatas)).
+rtti_data_list_to_mlds(ModuleInfo, RttiDatas) = MLDS_Defns :-
+ RealRttiDatas = list__filter(real_rtti_data, RttiDatas),
+ MLDS_DefnLists0 = list__map(rtti_data_to_mlds(ModuleInfo),
+ RealRttiDatas),
+ MLDS_Defns0 = list__condense(MLDS_DefnLists0),
+ list__filter(mlds_defn_is_potentially_duplicated, MLDS_Defns0,
+ MaybeDupDefns0, NoDupDefns),
+ list__sort_and_remove_dups(MaybeDupDefns0, MaybeDupDefns),
+ MLDS_Defns = list__append(MaybeDupDefns, NoDupDefns).
+
+:- pred mlds_defn_is_potentially_duplicated(mlds__defn::in) is semidet.
+
+mlds_defn_is_potentially_duplicated(MLDS_Defn) :-
+ MLDS_Defn = mlds__defn(EntityName, _, _, _),
+ EntityName = data(DataName),
+ DataName = rtti(_, RttiName),
+ ( RttiName = type_info(_)
+ ; RttiName = pseudo_type_info(_)
+ ).
% return a list of MLDS definitions for the given rtti_data.
:- func rtti_data_to_mlds(module_info, rtti_data) = mlds__defns.
+
rtti_data_to_mlds(ModuleInfo, RttiData) = MLDS_Defns :-
( RttiData = pseudo_type_info(type_var(_)) ->
% These just get represented as integers,
@@ -64,6 +86,25 @@
Name = data(rtti(RttiTypeCtor, RttiName))
),
+ gen_init_rtti_data_defn(RttiData, ModuleInfo, Initializer,
+ ExtraDefns),
+ rtti_entity_name_and_init_to_defn(Name, RttiName, Initializer,
+ MLDS_Defn),
+ MLDS_Defns = [MLDS_Defn | ExtraDefns]
+ ).
+
+:- pred rtti_name_and_init_to_defn(rtti_type_ctor::in, rtti_name::in,
+ mlds__initializer::in, mlds__defn::out) is det.
+
+rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer, MLDS_Defn) :-
+ Name = data(rtti(RttiTypeCtor, RttiName)),
+ rtti_entity_name_and_init_to_defn(Name, RttiName, Initializer,
+ MLDS_Defn).
+
+:- pred rtti_entity_name_and_init_to_defn(mlds__entity_name::in, rtti_name::in,
+ mlds__initializer::in, mlds__defn::out) is det.
+
+rtti_entity_name_and_init_to_defn(Name, RttiName, Initializer, MLDS_Defn) :-
%
% Generate the context
%
@@ -89,24 +130,15 @@
% i.e. the type and the initializer
%
MLDS_Type = rtti_type(RttiName),
- module_info_name(ModuleInfo, ModuleName),
- gen_init_rtti_data_defn(RttiData, ModuleName, ModuleInfo,
- Initializer, ExtraDefns),
DefnBody = mlds__data(MLDS_Type, Initializer, GC_TraceCode),
-
- %
- % put it all together
- %
- MLDS_Defn = mlds__defn(Name, MLDS_Context, Flags, DefnBody),
- MLDS_Defns = [MLDS_Defn | ExtraDefns]
- ).
-
+ MLDS_Defn = mlds__defn(Name, MLDS_Context, Flags, DefnBody).
% Return the declaration flags appropriate for an rtti_data.
% Note that this must be the same as ml_static_const_decl_flags,
% except for the access, so that ml_decl_is_static_const works.
%
:- func rtti_data_decl_flags(bool) = mlds__decl_flags.
+
rtti_data_decl_flags(Exported) = MLDS_DeclFlags :-
( Exported = yes ->
Access = public
@@ -125,136 +157,58 @@
% Return an MLDS initializer for the given RTTI definition
% occurring in the given module.
-:- pred gen_init_rtti_data_defn(rtti_data, module_name, module_info,
- mlds__initializer, list(mlds__defn)).
-:- mode gen_init_rtti_data_defn(in, in, in, out, out) is det.
-
-gen_init_rtti_data_defn(exist_locns(_RttiTypeCtor, _Ordinal, Locns), _, _,
- Init, []) :-
- Init = gen_init_array(gen_init_exist_locn, Locns).
-gen_init_rtti_data_defn(exist_info(RttiTypeCtor, _Ordinal, Plain, InTci, Tci,
- Locns), ModuleName, _, Init, []) :-
- Init = init_struct([
- gen_init_int(Plain),
- gen_init_int(InTci),
- gen_init_int(Tci),
- gen_init_rtti_name(ModuleName, RttiTypeCtor, Locns)
- ]).
-gen_init_rtti_data_defn(field_names(_RttiTypeCtor, _Ordinal, MaybeNames), _, _,
- Init, []) :-
- StrType = term__functor(term__atom("string"), [], context("", 0)),
- Init = gen_init_array(gen_init_maybe(
- mercury_type(StrType, str_type,
- non_foreign_type(StrType)),
- gen_init_string), MaybeNames).
-
-gen_init_rtti_data_defn(field_types(_RttiTypeCtor, _Ordinal, Types),
- ModuleName, _, Init, []) :-
- Init = gen_init_array(
- gen_init_cast_rtti_data(mlds__pseudo_type_info_type,
- ModuleName), Types).
-gen_init_rtti_data_defn(reserved_addrs(_RttiTypeCtor, ReservedAddrs),
- _ModuleName, ModuleInfo, Init, []) :-
- Init = gen_init_array(gen_init_reserved_address(ModuleInfo),
- ReservedAddrs).
-gen_init_rtti_data_defn(reserved_addr_functors(RttiTypeCtor,
- ReservedAddrFunctorDescs),
- ModuleName, _, Init, []) :-
- Init = gen_init_array(
- gen_init_rtti_name(ModuleName, RttiTypeCtor),
- ReservedAddrFunctorDescs).
-gen_init_rtti_data_defn(enum_functor_desc(_RttiTypeCtor, FunctorName, Ordinal),
- _, _, Init, []) :-
- Init = init_struct([
- gen_init_string(FunctorName),
- gen_init_int(Ordinal)
- ]).
-gen_init_rtti_data_defn(notag_functor_desc(_RttiTypeCtor, FunctorName, ArgType,
- MaybeArgName), ModuleName, _, Init, []) :-
- Init = init_struct([
- gen_init_string(FunctorName),
- gen_init_cast_rtti_data(mlds__pseudo_type_info_type,
- ModuleName, ArgType),
- gen_init_maybe(ml_string_type, gen_init_string, MaybeArgName)
- ]).
-gen_init_rtti_data_defn(du_functor_desc(RttiTypeCtor, FunctorName, Ptag, Stag,
- Locn, Ordinal, Arity, ContainsVarBitVector, MaybeArgTypes,
- MaybeNames, MaybeExist), ModuleName, _, Init, []) :-
- Init = init_struct([
- gen_init_string(FunctorName),
- gen_init_int(Arity),
- gen_init_int(ContainsVarBitVector),
- gen_init_sectag_locn(Locn),
- gen_init_int(Ptag),
- gen_init_int(Stag),
- gen_init_int(Ordinal),
- gen_init_maybe(mlds__rtti_type(field_types(0)),
- gen_init_rtti_name(ModuleName, RttiTypeCtor),
- MaybeArgTypes),
- gen_init_maybe(mlds__rtti_type(field_names(0)),
- gen_init_rtti_name(ModuleName, RttiTypeCtor),
- MaybeNames),
- gen_init_maybe(mlds__rtti_type(exist_info(0)),
- gen_init_rtti_name(ModuleName, RttiTypeCtor),
- MaybeExist)
- ]).
-gen_init_rtti_data_defn(reserved_addr_functor_desc(_RttiTypeCtor, FunctorName,
- Ordinal, ReservedAddress), _, ModuleInfo, Init, []) :-
- Init = init_struct([
- gen_init_string(FunctorName),
- gen_init_int(Ordinal),
- gen_init_reserved_address(ModuleInfo, ReservedAddress)
- ]).
-gen_init_rtti_data_defn(enum_name_ordered_table(RttiTypeCtor, Functors),
- ModuleName, _, Init, []) :-
- Init = gen_init_rtti_names_array(ModuleName, RttiTypeCtor, Functors).
-gen_init_rtti_data_defn(enum_value_ordered_table(RttiTypeCtor, Functors),
- ModuleName, _, Init, []) :-
- Init = gen_init_rtti_names_array(ModuleName, RttiTypeCtor, Functors).
-gen_init_rtti_data_defn(du_name_ordered_table(RttiTypeCtor, Functors),
- ModuleName, _, Init, []) :-
- Init = gen_init_rtti_names_array(ModuleName, RttiTypeCtor, Functors).
-gen_init_rtti_data_defn(du_stag_ordered_table(RttiTypeCtor, _Ptag, Sharers),
- ModuleName, _, Init, []) :-
- Init = gen_init_rtti_names_array(ModuleName, RttiTypeCtor, Sharers).
-gen_init_rtti_data_defn(du_ptag_ordered_table(RttiTypeCtor, PtagLayouts),
- ModuleName, _, Init, []) :-
- Init = gen_init_array(gen_init_ptag_layout_defn(ModuleName,
- RttiTypeCtor), PtagLayouts).
-gen_init_rtti_data_defn(reserved_addr_table(RttiTypeCtor,
- NumNumeric, NumSymbolic, ReservedAddrs, FunctorDescs, DuLayout),
- ModuleName, _, Init, []) :-
- Init = init_struct([
- gen_init_int(NumNumeric),
- gen_init_int(NumSymbolic),
- gen_init_rtti_name(ModuleName, RttiTypeCtor, ReservedAddrs),
- gen_init_rtti_name(ModuleName, RttiTypeCtor, FunctorDescs),
- gen_init_rtti_name(ModuleName, RttiTypeCtor, DuLayout)
+:- pred gen_init_rtti_data_defn(rtti_data::in, module_info::in,
+ mlds__initializer::out, list(mlds__defn)::out) is det.
+gen_init_rtti_data_defn(RttiData, ModuleInfo, Init, ExtraDefns) :-
+ RttiData = base_typeclass_info(_InstanceModule, _ClassId, _InstanceStr,
+ BaseTypeClassInfo),
+ BaseTypeClassInfo = base_typeclass_info(N1, N2, N3, N4, N5,
+ Methods),
+ NumExtra = BaseTypeClassInfo ^ num_extra,
+ list__map_foldl(gen_init_method(ModuleInfo, NumExtra),
+ Methods, MethodInitializers, [], ExtraDefns),
+ Init = init_array([
+ gen_init_boxed_int(N1),
+ gen_init_boxed_int(N2),
+ gen_init_boxed_int(N3),
+ gen_init_boxed_int(N4),
+ gen_init_boxed_int(N5)
+ | MethodInitializers
]).
-gen_init_rtti_data_defn(type_ctor_info(RttiTypeCtor, UnifyProc, CompareProc,
- CtorRep, Version, NumPtags, NumFunctors, FunctorsInfo,
- LayoutInfo), ModuleName, ModuleInfo, Init, []) :-
- RttiTypeCtor = rtti_type_ctor(TypeModule, Type, TypeArity),
+gen_init_rtti_data_defn(RttiData, ModuleInfo, Init, SubDefns) :-
+ RttiData = type_info(TypeInfo),
+ gen_type_info_defn(ModuleInfo, TypeInfo, Init, SubDefns).
+gen_init_rtti_data_defn(RttiData, ModuleInfo, Init, SubDefns) :-
+ RttiData = pseudo_type_info(PseudoTypeInfo),
+ gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, Init, SubDefns).
+
+gen_init_rtti_data_defn(RttiData, ModuleInfo, Init, SubDefns) :-
+ RttiData = type_ctor_info(TypeCtorData),
+ TypeCtorData = type_ctor_data(Version, TypeModule, TypeName,
+ TypeArity, UnifyUniv, CompareUniv, TypeCtorDetails),
+ RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName, TypeArity),
prog_out__sym_name_to_string(TypeModule, TypeModuleName),
+ NumPtags = type_ctor_details_num_ptags(TypeCtorDetails),
+ NumFunctors = type_ctor_details_num_functors(TypeCtorDetails),
+ gen_functors_layout_info(ModuleInfo, RttiTypeCtor, TypeCtorDetails,
+ FunctorsInfo, LayoutInfo, SubDefns),
Init = init_struct([
gen_init_int(TypeArity),
gen_init_int(Version),
gen_init_int(NumPtags),
- gen_init_type_ctor_rep(CtorRep),
- gen_init_maybe_proc_id(ModuleInfo, UnifyProc),
- gen_init_maybe_proc_id(ModuleInfo, CompareProc),
+ gen_init_type_ctor_rep(TypeCtorData),
+ gen_init_proc_id_from_univ(ModuleInfo, UnifyUniv),
+ gen_init_proc_id_from_univ(ModuleInfo, CompareUniv),
gen_init_string(TypeModuleName),
- gen_init_string(Type),
+ gen_init_string(TypeName),
% In the C back-end, these two "structs" are actually unions.
% We need to use `init_struct' here so that the initializers
% get enclosed in curly braces.
init_struct([
- gen_init_functors_info(FunctorsInfo, ModuleName,
- RttiTypeCtor)
+ FunctorsInfo
]),
init_struct([
- gen_init_layout_info(LayoutInfo, ModuleName,
- RttiTypeCtor)
+ LayoutInfo
]),
gen_init_int(NumFunctors)
% These two are commented out while the corresponding
@@ -262,94 +216,36 @@
% commented out.
% gen_init_maybe(gen_init_rtti_name(RttiTypeCtor),
% MaybeHashCons),
- % gen_init_maybe_proc_id(ModuleInfo, PrettyprinterProc)
- ]).
-gen_init_rtti_data_defn(base_typeclass_info(_InstanceModule, _ClassId,
- _InstanceStr, BaseTypeClassInfo), _ModuleName, ModuleInfo,
- Init, ExtraDefns) :-
- BaseTypeClassInfo = base_typeclass_info(N1, N2, N3, N4, N5,
- Methods),
- NumExtra = BaseTypeClassInfo^num_extra,
- list__map_foldl(gen_init_method(ModuleInfo, NumExtra),
- Methods, MethodInitializers, [], ExtraDefns),
- Init = init_array([
- gen_init_boxed_int(N1),
- gen_init_boxed_int(N2),
- gen_init_boxed_int(N3),
- gen_init_boxed_int(N4),
- gen_init_boxed_int(N5)
- | MethodInitializers
+ % gen_init_proc_id_from_univ(ModuleInfo, PrettyprinterProc)
]).
-gen_init_rtti_data_defn(type_info(TypeInfo), ModuleName, _, Init, []) :-
- Init = gen_init_type_info_defn(TypeInfo, ModuleName).
-gen_init_rtti_data_defn(pseudo_type_info(Pseudo), ModuleName, _, Init, []) :-
- Init = gen_init_pseudo_type_info_defn(Pseudo, ModuleName).
-
-:- func gen_init_functors_info(type_ctor_functors_info, module_name,
- rtti_type_ctor) = mlds__initializer.
-gen_init_functors_info(enum_functors(EnumFunctorsInfo), ModuleName,
- RttiTypeCtor) =
- gen_init_cast_rtti_name(mlds__generic_type,
- ModuleName, RttiTypeCtor, EnumFunctorsInfo).
-gen_init_functors_info(notag_functors(NotagFunctorsInfo), ModuleName,
- RttiTypeCtor) =
- gen_init_cast_rtti_name(mlds__generic_type,
- ModuleName, RttiTypeCtor, NotagFunctorsInfo).
-gen_init_functors_info(du_functors(DuFunctorsInfo), ModuleName,
- RttiTypeCtor) =
- gen_init_cast_rtti_name(mlds__generic_type,
- ModuleName, RttiTypeCtor, DuFunctorsInfo).
-gen_init_functors_info(no_functors, _, _) =
- gen_init_null_pointer(mlds__rtti_type(du_name_ordered_table)).
-
-:- func gen_init_layout_info(type_ctor_layout_info, module_name,
- rtti_type_ctor) = mlds__initializer.
-
-gen_init_layout_info(enum_layout(EnumLayoutInfo), ModuleName, RttiTypeCtor) =
- gen_init_cast_rtti_name(mlds__generic_type, ModuleName, RttiTypeCtor,
- EnumLayoutInfo).
-gen_init_layout_info(notag_layout(NotagLayoutInfo), ModuleName, RttiTypeCtor) =
- gen_init_cast_rtti_name(mlds__generic_type, ModuleName, RttiTypeCtor,
- NotagLayoutInfo).
-gen_init_layout_info(du_layout(DuLayoutInfo), ModuleName, RttiTypeCtor) =
- gen_init_cast_rtti_name(mlds__generic_type, ModuleName, RttiTypeCtor,
- DuLayoutInfo).
-gen_init_layout_info(reserved_addr_layout(RaLayoutInfo), ModuleName,
- RttiTypeCtor) =
- gen_init_cast_rtti_name(mlds__generic_type, ModuleName, RttiTypeCtor,
- RaLayoutInfo).
-gen_init_layout_info(equiv_layout(EquivTypeInfo), ModuleName, _RttiTypeCtor) =
- gen_init_cast_rtti_data(mlds__generic_type, ModuleName,
- EquivTypeInfo).
-gen_init_layout_info(no_layout, _, _) =
- gen_init_null_pointer(mlds__rtti_type(du_ptag_ordered_table)).
-
-:- func gen_init_maybe_proc_id(module_info, maybe(rtti_proc_label)) =
- mlds__initializer.
- % XXX the type here is a bit of a lie, but it is only used if we
- % generate a null constant, so it's pretty harmless right now.
-gen_init_maybe_proc_id(ModuleInfo, MaybeProcLabel) =
- gen_init_maybe(mlds__func_type(mlds__func_params([], [])),
- gen_init_proc_id(ModuleInfo), MaybeProcLabel).
+%-----------------------------------------------------------------------------%
-:- func gen_init_type_info_defn(rtti_type_info, module_name) =
- mlds__initializer.
+:- pred gen_type_info_defn(module_info::in, rtti_type_info::in,
+ mlds__initializer::out, list(mlds__defn)::out) is det.
-gen_init_type_info_defn(plain_arity_zero_type_info(_), _) = _ :-
- error("gen_init_type_info_defn: plain_arity_zero_type_info").
-gen_init_type_info_defn(plain_type_info(RttiTypeCtor, ArgTypes), ModuleName)
- = Init :-
+gen_type_info_defn(_, plain_arity_zero_type_info(_), _, _) :-
+ error("gen_type_info_defn: plain_arity_zero_type_info").
+gen_type_info_defn(ModuleInfo, plain_type_info(RttiTypeCtor, ArgTypes),
+ Init, SubDefns) :-
ArgRttiDatas = list__map(type_info_to_rtti_data, ArgTypes),
+ RealRttiDatas = list__filter(real_rtti_data, ArgRttiDatas),
+ SubDefnLists = list__map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
+ SubDefns = list__condense(SubDefnLists),
+ module_info_name(ModuleInfo, ModuleName),
Init = init_struct([
gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
gen_init_cast_rtti_datas_array(mlds__type_info_type,
ModuleName, ArgRttiDatas)
]).
-gen_init_type_info_defn(var_arity_type_info(VarArityId, ArgTypes), ModuleName)
- = Init :-
+gen_type_info_defn(ModuleInfo, var_arity_type_info(VarArityId, ArgTypes),
+ Init, SubDefns) :-
ArgRttiDatas = list__map(type_info_to_rtti_data, ArgTypes),
+ RealRttiDatas = list__filter(real_rtti_data, ArgRttiDatas),
+ SubDefnLists = list__map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
+ SubDefns = list__condense(SubDefnLists),
RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
+ module_info_name(ModuleInfo, ModuleName),
Init = init_struct([
gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
gen_init_int(list__length(ArgTypes)),
@@ -357,42 +253,551 @@
ModuleName, ArgRttiDatas)
]).
-:- func gen_init_pseudo_type_info_defn(rtti_pseudo_type_info, module_name) =
- mlds__initializer.
+:- pred gen_pseudo_type_info_defn(module_info::in, rtti_pseudo_type_info::in,
+ mlds__initializer::out, list(mlds__defn)::out) is det.
-gen_init_pseudo_type_info_defn(plain_arity_zero_pseudo_type_info(_), _) = _ :-
- error("gen_init_pseudo_type_info_defn: plain_arity_zero_pseudo_type_info").
-gen_init_pseudo_type_info_defn(plain_pseudo_type_info(RttiTypeCtor, ArgTypes),
- ModuleName) = Init :-
+gen_pseudo_type_info_defn(_, plain_arity_zero_pseudo_type_info(_), _, _) :-
+ error("gen_pseudo_type_info_defn: plain_arity_zero_pseudo_type_info").
+gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, Init, SubDefns) :-
+ PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, ArgTypes),
ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, ArgTypes),
+ RealRttiDatas = list__filter(real_rtti_data, ArgRttiDatas),
+ SubDefnLists = list__map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
+ SubDefns = list__condense(SubDefnLists),
+ module_info_name(ModuleInfo, ModuleName),
Init = init_struct([
gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
gen_init_cast_rtti_datas_array(mlds__pseudo_type_info_type,
ModuleName, ArgRttiDatas)
]).
-gen_init_pseudo_type_info_defn(var_arity_pseudo_type_info(VarArityId,
- ArgTypes), ModuleName) = Init :-
+gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, Init, SubDefns) :-
+ PseudoTypeInfo = var_arity_pseudo_type_info(VarArityId, ArgTypes),
ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, ArgTypes),
+ RealRttiDatas = list__filter(real_rtti_data, ArgRttiDatas),
+ SubDefnLists = list__map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
+ SubDefns = list__condense(SubDefnLists),
RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
+ module_info_name(ModuleInfo, ModuleName),
Init = init_struct([
gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
gen_init_int(list__length(ArgTypes)),
gen_init_cast_rtti_datas_array(mlds__pseudo_type_info_type,
ModuleName, ArgRttiDatas)
]).
-gen_init_pseudo_type_info_defn(type_var(_), _) = _ :-
- error("gen_init_pseudo_type_info_defn: type_var").
+gen_pseudo_type_info_defn(_, type_var(_), _, _) :-
+ error("gen_pseudo_type_info_defn: type_var").
-:- func gen_init_ptag_layout_defn(module_name, rtti_type_ctor, du_ptag_layout)
- = mlds__initializer.
+%-----------------------------------------------------------------------------%
-gen_init_ptag_layout_defn(ModuleName, RttiTypeCtor, DuPtagLayout) = Init :-
- DuPtagLayout = du_ptag_layout(NumSharers, Locn, Descriptors) ,
+:- pred gen_functors_layout_info(module_info::in, rtti_type_ctor::in,
+ type_ctor_details::in, mlds__initializer::out, mlds__initializer::out,
+ list(mlds__defn)::out) is det.
+
+gen_functors_layout_info(ModuleInfo, RttiTypeCtor, TypeCtorDetails,
+ FunctorInit, LayoutInit, Defns) :-
+ module_info_name(ModuleInfo, ModuleName),
+ (
+ TypeCtorDetails = enum(_, EnumFunctors, EnumByValue,
+ EnumByName),
+ EnumFunctorDescs = list__map(
+ gen_enum_functor_desc(ModuleInfo, RttiTypeCtor),
+ EnumFunctors),
+ ByValueDefn = gen_enum_value_ordered_table(ModuleInfo,
+ RttiTypeCtor, EnumByValue),
+ ByNameDefn = gen_enum_name_ordered_table(ModuleInfo,
+ RttiTypeCtor, EnumByName),
+ LayoutInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ enum_value_ordered_table),
+ FunctorInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ enum_name_ordered_table),
+ Defns = [ByValueDefn, ByNameDefn | EnumFunctorDescs]
+ ;
+ TypeCtorDetails = du(_, DuFunctors, DuByPtag, DuByName),
+ DuFunctorDefnLists = list__map(
+ gen_du_functor_desc(ModuleInfo, RttiTypeCtor),
+ DuFunctors),
+ DuFunctorDefns = list__condense(DuFunctorDefnLists),
+ ByPtagDefns = gen_du_ptag_ordered_table(ModuleInfo,
+ RttiTypeCtor, DuByPtag),
+ ByNameDefn = gen_du_name_ordered_table(ModuleInfo,
+ RttiTypeCtor, DuByName),
+ LayoutInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ du_ptag_ordered_table),
+ FunctorInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ du_name_ordered_table),
+ Defns = [ByNameDefn |
+ list__append(ByPtagDefns, DuFunctorDefns)]
+ ;
+ TypeCtorDetails = reserved(_, MaybeResFunctors, ResFunctors,
+ DuByPtag, MaybeResByName),
+ MaybeResFunctorDefnLists = list__map(
+ gen_maybe_res_functor_desc(ModuleInfo, RttiTypeCtor),
+ MaybeResFunctors),
+ MaybeResFunctorDefns =
+ list__condense(MaybeResFunctorDefnLists),
+ ByValueDefns = gen_maybe_res_value_ordered_table(ModuleInfo,
+ RttiTypeCtor, ResFunctors, DuByPtag),
+ ByNameDefn = gen_maybe_res_name_ordered_table(ModuleInfo,
+ RttiTypeCtor, MaybeResByName),
+ LayoutInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ res_value_ordered_table),
+ FunctorInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ res_name_ordered_table),
+ Defns = [ByNameDefn |
+ list__append(ByValueDefns, MaybeResFunctorDefns)]
+ ;
+ TypeCtorDetails = notag(_, NotagFunctor),
+ Defns = gen_notag_functor_desc(ModuleInfo,
+ RttiTypeCtor, NotagFunctor),
+ LayoutInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ notag_functor_desc),
+ FunctorInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ notag_functor_desc)
+ ;
+ TypeCtorDetails = eqv(EqvType),
+ TypeRttiData = maybe_pseudo_type_info_to_rtti_data(EqvType),
+ RealRttiDatas = list__filter(real_rtti_data, [TypeRttiData]),
+ DefnsList = list__map(rtti_data_to_mlds(ModuleInfo),
+ RealRttiDatas),
+ Defns = list__condense(DefnsList),
+ LayoutInit = gen_init_cast_rtti_data(
+ mlds__pseudo_type_info_type, ModuleName, TypeRttiData),
+ % The type is a lie, but a safe one.
+ FunctorInit = gen_init_null_pointer(mlds__generic_type)
+ ;
+ TypeCtorDetails = builtin(_),
+ error("gen_functors_layout_info: builtin")
+ ;
+ TypeCtorDetails = impl_artifact(_),
+ error("gen_functors_layout_info: impl_artifact")
+ ;
+ TypeCtorDetails = foreign,
+ Defns = [],
+ LayoutInit = gen_init_null_pointer(mlds__generic_type),
+ FunctorInit = gen_init_null_pointer(mlds__generic_type)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func gen_enum_functor_desc(module_info, rtti_type_ctor, enum_functor)
+ = mlds__defn.
+
+gen_enum_functor_desc(_ModuleInfo, RttiTypeCtor, EnumFunctor) = MLDS_Defn :-
+ EnumFunctor = enum_functor(FunctorName, Ordinal),
Init = init_struct([
- gen_init_int(NumSharers),
+ gen_init_string(FunctorName),
+ gen_init_int(Ordinal)
+ ]),
+ RttiName = enum_functor_desc(Ordinal),
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+
+:- func gen_notag_functor_desc(module_info, rtti_type_ctor, notag_functor)
+ = list(mlds__defn).
+
+gen_notag_functor_desc(ModuleInfo, RttiTypeCtor, NotagFunctorDesc)
+ = MLDS_Defns :-
+ NotagFunctorDesc = notag_functor(FunctorName, ArgType, MaybeArgName),
+ module_info_name(ModuleInfo, ModuleName),
+ ArgTypeRttiData = maybe_pseudo_type_info_to_rtti_data(ArgType),
+ Init = init_struct([
+ gen_init_string(FunctorName),
+ gen_init_cast_rtti_data(mlds__pseudo_type_info_type,
+ ModuleName, ArgTypeRttiData),
+ gen_init_maybe(ml_string_type, gen_init_string, MaybeArgName)
+ ]),
+ RttiName = notag_functor_desc,
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
+ RealRttiDatas = list__filter(real_rtti_data, [ArgTypeRttiData]),
+ SubDefnsList = list__map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
+ SubDefns = list__condense(SubDefnsList),
+ MLDS_Defns = [MLDS_Defn | SubDefns].
+
+:- func gen_du_functor_desc(module_info, rtti_type_ctor, du_functor)
+ = list(mlds__defn).
+
+gen_du_functor_desc(ModuleInfo, RttiTypeCtor, DuFunctor) = MLDS_Defns :-
+ DuFunctor = du_functor(FunctorName, Arity, Ordinal, Rep, ArgInfos,
+ MaybeExistInfo),
+ ArgTypes = list__map(du_arg_info_type, ArgInfos),
+ MaybeArgNames = list__map(du_arg_info_name, ArgInfos),
+ ArgNames = list__filter_map(project_yes, MaybeArgNames),
+ ContainsVarBitVector = compute_contains_var_bit_vector(ArgTypes),
+ module_info_name(ModuleInfo, ModuleName),
+ (
+ ArgInfos = [_ | _],
+ ArgTypeDefns = gen_field_types(ModuleInfo, RttiTypeCtor,
+ Ordinal, ArgTypes),
+ ArgTypeInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ field_types(Ordinal))
+ ;
+ ArgInfos = [],
+ ArgTypeDefns = [],
+ ArgTypeInit = gen_init_null_pointer(
+ mlds__rtti_type(field_types(0)))
+ ),
+ (
+ ArgNames = [_ | _],
+ ArgNameDefn = gen_field_names(ModuleInfo, RttiTypeCtor,
+ Ordinal, MaybeArgNames),
+ ArgNameDefns = [ArgNameDefn],
+ ArgNameInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ field_names(Ordinal))
+ ;
+ ArgNames = [],
+ ArgNameDefns = [],
+ ArgNameInit = gen_init_null_pointer(
+ mlds__rtti_type(field_names(0)))
+ ),
+ (
+ MaybeExistInfo = yes(ExistInfo),
+ ExistInfoDefns = gen_exist_info(ModuleInfo, RttiTypeCtor,
+ Ordinal, ExistInfo),
+ ExistInfoInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ exist_info(Ordinal))
+ ;
+ MaybeExistInfo = no,
+ ExistInfoDefns = [],
+ ExistInfoInit = gen_init_null_pointer(
+ mlds__rtti_type(exist_info(0)))
+ ),
+ SubDefns = list__condense([ArgTypeDefns, ArgNameDefns,
+ ExistInfoDefns]),
+ (
+ Rep = du_ll_rep(Ptag, SectagAndLocn)
+ ;
+ Rep = du_hl_rep(_),
+ error("output_du_functor_defn: du_hl_rep")
+ ),
+ (
+ SectagAndLocn = sectag_none,
+ Locn = sectag_none,
+ Stag = -1
+ ;
+ SectagAndLocn = sectag_local(Stag),
+ Locn = sectag_local
+ ;
+ SectagAndLocn = sectag_remote(Stag),
+ Locn = sectag_remote
+ ),
+ Init = init_struct([
+ gen_init_string(FunctorName),
+ gen_init_int(Arity),
+ gen_init_int(ContainsVarBitVector),
gen_init_sectag_locn(Locn),
- gen_init_rtti_name(ModuleName, RttiTypeCtor, Descriptors)
+ gen_init_int(Ptag),
+ gen_init_int(Stag),
+ gen_init_int(Ordinal),
+ ArgTypeInit,
+ ArgNameInit,
+ ExistInfoInit
+ ]),
+ RttiName = du_functor_desc(Ordinal),
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
+ MLDS_Defns = [MLDS_Defn | SubDefns].
+
+:- func gen_res_addr_functor_desc(module_info, rtti_type_ctor,
+ reserved_functor) = mlds__defn.
+
+gen_res_addr_functor_desc(ModuleInfo, RttiTypeCtor, ResFunctor) = MLDS_Defn :-
+ ResFunctor = reserved_functor(FunctorName, Ordinal, ReservedAddress),
+ Init = init_struct([
+ gen_init_string(FunctorName),
+ gen_init_int(Ordinal),
+ gen_init_reserved_address(ModuleInfo, ReservedAddress)
+ ]),
+ RttiName = res_functor_desc(Ordinal),
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+
+:- func gen_maybe_res_functor_desc(module_info, rtti_type_ctor,
+ maybe_reserved_functor) = list(mlds__defn).
+
+gen_maybe_res_functor_desc(ModuleInfo, RttiTypeCtor, MaybeResFunctor)
+ = MLDS_Defns :-
+ (
+ MaybeResFunctor = res_func(ResFunctor),
+ MLDS_Defn = gen_res_addr_functor_desc(ModuleInfo, RttiTypeCtor,
+ ResFunctor),
+ MLDS_Defns = [MLDS_Defn]
+ ;
+ MaybeResFunctor = du_func(DuFunctor),
+ MLDS_Defns = gen_du_functor_desc(ModuleInfo, RttiTypeCtor,
+ DuFunctor)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func gen_init_exist_locn(exist_typeinfo_locn) = mlds__initializer.
+
+gen_init_exist_locn(plain_typeinfo(SlotInCell)) =
+ init_struct([
+ gen_init_int(SlotInCell),
+ gen_init_int(-1)
]).
+gen_init_exist_locn(typeinfo_in_tci(SlotInCell, SlotInTci)) =
+ init_struct([
+ gen_init_int(SlotInCell),
+ gen_init_int(SlotInTci)
+ ]).
+
+:- func gen_exist_locns_array(module_info, rtti_type_ctor, int,
+ list(exist_typeinfo_locn)) = mlds__defn.
+
+gen_exist_locns_array(_ModuleInfo, RttiTypeCtor, Ordinal, Locns) = MLDS_Defn :-
+ Init = gen_init_array(gen_init_exist_locn, Locns),
+ RttiName = exist_locns(Ordinal),
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+
+:- func gen_exist_info(module_info, rtti_type_ctor, int, exist_info)
+ = list(mlds__defn).
+
+gen_exist_info(ModuleInfo, RttiTypeCtor, Ordinal, ExistInfo) = MLDS_Defns :-
+ ExistInfo = exist_info(Plain, InTci, Tci, Locns),
+ module_info_name(ModuleInfo, ModuleName),
+ Init = init_struct([
+ gen_init_int(Plain),
+ gen_init_int(InTci),
+ gen_init_int(Tci),
+ gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ exist_locns(Ordinal))
+ ]),
+ RttiName = exist_info(Ordinal),
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
+ Sub_Defn = gen_exist_locns_array(ModuleInfo, RttiTypeCtor, Ordinal,
+ Locns),
+ MLDS_Defns = [MLDS_Defn, Sub_Defn].
+
+:- func gen_field_names(module_info, rtti_type_ctor, int, list(maybe(string)))
+ = mlds__defn.
+
+gen_field_names(_ModuleInfo, RttiTypeCtor, Ordinal, MaybeNames) = MLDS_Defn :-
+ StrType = term__functor(term__atom("string"), [], context("", 0)),
+ Init = gen_init_array(gen_init_maybe(
+ mercury_type(StrType, str_type,
+ non_foreign_type(StrType)),
+ gen_init_string), MaybeNames),
+ RttiName = field_names(Ordinal),
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+
+:- func gen_field_types(module_info, rtti_type_ctor, int,
+ list(rtti_maybe_pseudo_type_info_or_self)) = list(mlds__defn).
+
+gen_field_types(ModuleInfo, RttiTypeCtor, Ordinal, Types) = MLDS_Defns :-
+ module_info_name(ModuleInfo, ModuleName),
+ TypeRttiDatas = list__map(maybe_pseudo_type_info_or_self_to_rtti_data,
+ Types),
+ Init = gen_init_array(
+ gen_init_cast_rtti_data(mlds__pseudo_type_info_type,
+ ModuleName), TypeRttiDatas),
+ RttiName = field_types(Ordinal),
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
+ RealRttiDatas = list__filter(real_rtti_data, TypeRttiDatas),
+ SubDefnsList = list__map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
+ SubDefns = list__condense(SubDefnsList),
+ MLDS_Defns = [MLDS_Defn | SubDefns].
+
+%-----------------------------------------------------------------------------%
+
+:- func gen_enum_value_ordered_table(module_info, rtti_type_ctor,
+ map(int, enum_functor)) = mlds__defn.
+
+gen_enum_value_ordered_table(ModuleInfo, RttiTypeCtor, EnumByValue)
+ = MLDS_Defn :-
+ map__values(EnumByValue, Functors),
+ module_info_name(ModuleInfo, ModuleName),
+ FunctorRttiNames = list__map(enum_functor_rtti_name, Functors),
+ Init = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
+ FunctorRttiNames),
+ RttiName = enum_value_ordered_table,
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+
+:- func gen_enum_name_ordered_table(module_info, rtti_type_ctor,
+ map(string, enum_functor)) = mlds__defn.
+
+gen_enum_name_ordered_table(ModuleInfo, RttiTypeCtor, EnumByName)
+ = MLDS_Defn :-
+ map__values(EnumByName, Functors),
+ module_info_name(ModuleInfo, ModuleName),
+ FunctorRttiNames = list__map(enum_functor_rtti_name, Functors),
+ Init = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
+ FunctorRttiNames),
+ RttiName = enum_name_ordered_table,
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+
+:- func gen_du_ptag_ordered_table(module_info, rtti_type_ctor,
+ map(int, sectag_table)) = list(mlds__defn).
+
+gen_du_ptag_ordered_table(ModuleInfo, RttiTypeCtor, PtagMap) = MLDS_Defns :-
+ module_info_name(ModuleInfo, ModuleName),
+ map__to_assoc_list(PtagMap, PtagList),
+ SubDefns = list__map(
+ gen_du_stag_ordered_table(ModuleName, RttiTypeCtor), PtagList),
+ ( PtagList = [1 - _ | _] ->
+ % Output a dummy ptag definition for the
+ % reserved tag first.
+ PtagInitPrefix = [init_struct([
+ gen_init_int(0),
+ gen_init_builtin_const("MR_SECTAG_VARIABLE"),
+ gen_init_null_pointer(
+ mlds__rtti_type(du_stag_ordered_table(0)))
+ ])],
+ FirstPtag = 1
+ ; PtagList = [0 - _ | _] ->
+ PtagInitPrefix = [],
+ FirstPtag = 0
+ ;
+ error("gen_du_ptag_ordered_table: bad ptag list")
+ ),
+ PtagInits = gen_du_ptag_ordered_table_body(ModuleName, RttiTypeCtor,
+ PtagList, FirstPtag),
+ Init = init_array(list__append(PtagInitPrefix, PtagInits)),
+ RttiName = du_ptag_ordered_table,
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
+ MLDS_Defns = [MLDS_Defn | SubDefns].
+
+:- func gen_du_ptag_ordered_table_body(module_name, rtti_type_ctor,
+ assoc_list(int, sectag_table), int) = list(mlds__initializer).
+
+gen_du_ptag_ordered_table_body(_, _, [], _) = [].
+gen_du_ptag_ordered_table_body(ModuleName, RttiTypeCtor,
+ [Ptag - SectagTable | PtagTail], CurPtag) = [Init | Inits] :-
+ require(unify(Ptag, CurPtag),
+ "gen_du_ptag_ordered_table_body: ptag mismatch"),
+ SectagTable = sectag_table(SectagLocn, NumSharers, _SectagMap),
+ Init = init_struct([
+ gen_init_int(NumSharers),
+ gen_init_sectag_locn(SectagLocn),
+ gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ du_stag_ordered_table(Ptag))
+ ]),
+ Inits = gen_du_ptag_ordered_table_body(ModuleName, RttiTypeCtor,
+ PtagTail, CurPtag + 1).
+
+:- func gen_du_stag_ordered_table(module_name, rtti_type_ctor,
+ pair(int, sectag_table)) = mlds__defn.
+
+gen_du_stag_ordered_table(ModuleName, RttiTypeCtor, Ptag - SectagTable)
+ = MLDS_Defn :-
+ SectagTable = sectag_table(_SectagLocn, _NumSharers, SectagMap),
+ map__values(SectagMap, SectagFunctors),
+ FunctorRttiNames = list__map(du_functor_rtti_name, SectagFunctors),
+ Init = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
+ FunctorRttiNames),
+ RttiName = du_stag_ordered_table(Ptag),
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+
+:- func gen_du_name_ordered_table(module_info, rtti_type_ctor,
+ map(string, map(int, du_functor))) = mlds__defn.
+
+gen_du_name_ordered_table(ModuleInfo, RttiTypeCtor, NameArityMap)
+ = MLDS_Defn :-
+ map__values(NameArityMap, ArityMaps),
+ list__map(map__values, ArityMaps, FunctorLists),
+ list__condense(FunctorLists, Functors),
+ module_info_name(ModuleInfo, ModuleName),
+ FunctorRttiNames = list__map(du_functor_rtti_name, Functors),
+ Init = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
+ FunctorRttiNames),
+ RttiName = du_name_ordered_table,
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+
+:- func gen_maybe_res_value_ordered_table(module_info, rtti_type_ctor,
+ list(reserved_functor), map(int, sectag_table)) = list(mlds__defn).
+
+gen_maybe_res_value_ordered_table(ModuleInfo, RttiTypeCtor, ResFunctors,
+ DuByPtag) = MLDS_Defns :-
+ ResFunctorReps = list__map(res_addr_rep, ResFunctors),
+ list__filter(res_addr_is_numeric, ResFunctorReps,
+ NumericResFunctorReps, SymbolicResFunctorReps),
+ list__length(NumericResFunctorReps, NumNumericResFunctorReps),
+ list__length(SymbolicResFunctorReps, NumSymbolicResFunctorReps),
+ module_info_name(ModuleInfo, ModuleName),
+ ResDefns = [gen_res_addr_functor_table(ModuleName, RttiTypeCtor,
+ ResFunctors)],
+ ( NumSymbolicResFunctorReps = 0 ->
+ ResAddrDefns = [],
+ ResAddrInit = gen_init_null_pointer(mlds__generic_type)
+ ;
+ ResAddrDefns = [gen_res_addrs_list(ModuleInfo, RttiTypeCtor,
+ SymbolicResFunctorReps)],
+ ResAddrInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ res_addrs)
+ ),
+ DuDefns = gen_du_ptag_ordered_table(ModuleInfo, RttiTypeCtor,
+ DuByPtag),
+ SubDefns = list__condense([ResDefns, ResAddrDefns, DuDefns]),
+ Init = init_struct([
+ gen_init_int(NumNumericResFunctorReps),
+ gen_init_int(NumSymbolicResFunctorReps),
+ ResAddrInit,
+ gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ res_addr_functors),
+ gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ du_ptag_ordered_table)
+ ]),
+ RttiName = res_value_ordered_table,
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
+ MLDS_Defns = [MLDS_Defn | SubDefns].
+
+:- func gen_res_addr_functor_table(module_name, rtti_type_ctor,
+ list(reserved_functor)) = mlds__defn.
+
+gen_res_addr_functor_table(ModuleName, RttiTypeCtor, ResFunctors) = MLDS_Defn :-
+ FunctorRttiNames = list__map(res_functor_rtti_name, ResFunctors),
+ Init = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
+ FunctorRttiNames),
+ RttiName = res_addr_functors,
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+
+:- func gen_res_addrs_list(module_info, rtti_type_ctor, list(reserved_address))
+ = mlds__defn.
+
+gen_res_addrs_list(ModuleInfo, RttiTypeCtor, ResAddrs) = MLDS_Defn :-
+ Init = gen_init_array(gen_init_reserved_address(ModuleInfo), ResAddrs),
+ RttiName = res_addrs,
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+
+:- func gen_maybe_res_name_ordered_table(module_info, rtti_type_ctor,
+ map(string, map(int, maybe_reserved_functor))) = mlds__defn.
+
+gen_maybe_res_name_ordered_table(ModuleInfo, RttiTypeCtor, NameArityMap)
+ = MLDS_Defn :-
+ map__values(NameArityMap, ArityMaps),
+ list__map(map__values, ArityMaps, FunctorLists),
+ list__condense(FunctorLists, Functors),
+ module_info_name(ModuleInfo, ModuleName),
+ Init = gen_init_array(
+ gen_maybe_res_name_ordered_table_element(ModuleName,
+ RttiTypeCtor),
+ Functors),
+ RttiName = res_name_ordered_table,
+ rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+
+:- func gen_maybe_res_name_ordered_table_element(module_name, rtti_type_ctor,
+ maybe_reserved_functor) = mlds__initializer.
+
+gen_maybe_res_name_ordered_table_element(ModuleName, RttiTypeCtor,
+ MaybeResFunctor) = Init :-
+ (
+ MaybeResFunctor = res_func(ResFunctor),
+ Name = ResFunctor ^ res_name,
+ Init = init_struct([
+ gen_init_builtin_const(Name),
+ gen_init_int(0),
+ gen_init_builtin_const("MR_TRUE"),
+ gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ maybe_res_functor_rtti_name(MaybeResFunctor))
+ ])
+ ;
+ MaybeResFunctor = du_func(DuFunctor),
+ Name = DuFunctor ^ du_name,
+ Init = init_struct([
+ gen_init_builtin_const(Name),
+ gen_init_int(DuFunctor ^ du_orig_arity),
+ gen_init_builtin_const("MR_TRUE"),
+ gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ maybe_res_functor_rtti_name(MaybeResFunctor))
+ ])
+ ).
%-----------------------------------------------------------------------------%
@@ -523,19 +928,6 @@
DataAddr = data_addr(MLDS_ModuleName, MLDS_DataName),
Rval = const(data_addr_const(DataAddr)).
-:- func gen_init_exist_locn(exist_typeinfo_locn) = mlds__initializer.
-
-gen_init_exist_locn(plain_typeinfo(SlotInCell)) =
- init_struct([
- gen_init_int(SlotInCell),
- gen_init_int(-1)
- ]).
-gen_init_exist_locn(typeinfo_in_tci(SlotInCell, SlotInTci)) =
- init_struct([
- gen_init_int(SlotInCell),
- gen_init_int(SlotInTci)
- ]).
-
%-----------------------------------------------------------------------------%
:- pred gen_init_method(module_info, int, rtti_proc_label, mlds__initializer,
@@ -568,8 +960,8 @@
% does not overlap with any function labels used
% when generating code for the wrapped procedure.
%
- PredId = RttiProcId^pred_id,
- ProcId = RttiProcId^proc_id,
+ PredId = RttiProcId ^ pred_id,
+ ProcId = RttiProcId ^ proc_id,
MLGenInfo0 = ml_gen_info_init(ModuleInfo, PredId, ProcId),
ml_gen_info_bump_func_label(MLGenInfo0, MLGenInfo1),
@@ -599,7 +991,7 @@
%
ml_gen_pred_label_from_rtti(ModuleInfo, RttiProcId, PredLabel,
PredModule),
- ProcId = RttiProcId^proc_id,
+ ProcId = RttiProcId ^ proc_id,
QualifiedProcLabel = qual(PredModule, PredLabel - ProcId),
Params = ml_gen_proc_params_from_rtti(ModuleInfo, RttiProcId),
Signature = mlds__get_func_signature(Params),
@@ -614,6 +1006,31 @@
ProcAddrArg = unop(box(mlds__func_type(Params)), ProcAddrRval),
Init = init_obj(ProcAddrArg).
+:- func gen_init_proc_id_from_univ(module_info, univ) =
+ mlds__initializer.
+
+gen_init_proc_id_from_univ(ModuleInfo, ProcLabelUniv) = Init :-
+ ( univ_to_type(ProcLabelUniv, ProcLabel) ->
+ Init = gen_init_proc_id(ModuleInfo, ProcLabel)
+ ;
+ error("gen_init_proc_id_from_univ: cannot extract univ value")
+ ).
+
+:- pred real_rtti_data(rtti_data::in) is semidet.
+
+real_rtti_data(RttiData) :-
+ \+ (
+ (
+ RttiData = type_info(TypeInfo),
+ TypeInfo = plain_arity_zero_type_info(_)
+ ;
+ RttiData = pseudo_type_info(PseudoTypeInfo),
+ ( PseudoTypeInfo = plain_arity_zero_pseudo_type_info(_)
+ ; PseudoTypeInfo = type_var(_)
+ )
+ )
+ ).
+
%-----------------------------------------------------------------------------%
%
% Conversion functions for builtin enumeration types.
@@ -624,14 +1041,17 @@
% runtime is expected to define.
:- func gen_init_sectag_locn(sectag_locn) = mlds__initializer.
+
gen_init_sectag_locn(Locn) = gen_init_builtin_const(Name) :-
rtti__sectag_locn_to_string(Locn, Name).
-:- func gen_init_type_ctor_rep(type_ctor_rep) = mlds__initializer.
-gen_init_type_ctor_rep(Rep) = gen_init_builtin_const(Name) :-
- rtti__type_ctor_rep_to_string(Rep, Name).
+:- func gen_init_type_ctor_rep(type_ctor_data) = mlds__initializer.
+
+gen_init_type_ctor_rep(TypeCtorData) = gen_init_builtin_const(Name) :-
+ rtti__type_ctor_rep_to_string(TypeCtorData, Name).
:- func gen_init_builtin_const(string) = mlds__initializer.
+
gen_init_builtin_const(Name) = init_obj(Rval) :-
mercury_private_builtin_module(PrivateBuiltin),
MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin),
@@ -689,22 +1109,25 @@
% the type names mentioned here should be defined in runtime/mercury.h
% (or in some header file that is included by that one)
+% XXX factor out code common with rtti_name_c_type in rtti_out.m
+% XXX check res_addr entries
mlds_rtti_type_name(exist_locns(_)) = "DuExistLocn".
mlds_rtti_type_name(exist_info(_)) = "DuExistInfo".
mlds_rtti_type_name(field_names(_)) = "ConstString".
mlds_rtti_type_name(field_types(_)) = "PseudoTypeInfo".
-mlds_rtti_type_name(reserved_addrs) = "ReservedAddrs".
-mlds_rtti_type_name(reserved_addr_functors) = "ReservedAddrFunctors".
+mlds_rtti_type_name(res_addrs) = "ReservedAddrs".
+mlds_rtti_type_name(res_addr_functors) = "ReservedAddrFunctors".
mlds_rtti_type_name(enum_functor_desc(_)) = "EnumFunctorDesc".
mlds_rtti_type_name(notag_functor_desc) = "NotagFunctorDesc".
mlds_rtti_type_name(du_functor_desc(_)) = "DuFunctorDesc".
-mlds_rtti_type_name(reserved_addr_functor_desc(_)) = "ReservedAddrFunctorDesc".
+mlds_rtti_type_name(res_functor_desc(_)) = "ReservedAddrFunctorDesc".
mlds_rtti_type_name(enum_name_ordered_table) = "EnumFunctorDescPtr".
mlds_rtti_type_name(enum_value_ordered_table) = "EnumFunctorDescPtr".
mlds_rtti_type_name(du_name_ordered_table) = "DuFunctorDescPtr".
mlds_rtti_type_name(du_stag_ordered_table(_)) = "DuFunctorDescPtr".
mlds_rtti_type_name(du_ptag_ordered_table) = "DuPtagLayout".
-mlds_rtti_type_name(reserved_addr_table) = "ReservedAddrTypeDesc".
+mlds_rtti_type_name(res_value_ordered_table) = "ReservedAddrTypeDesc".
+mlds_rtti_type_name(res_name_ordered_table) = "ReservedAddrTypeDesc".
mlds_rtti_type_name(type_ctor_info) = "TypeCtorInfo_Struct".
mlds_rtti_type_name(base_typeclass_info(_, _, _)) = "BaseTypeclassInfo".
mlds_rtti_type_name(type_info(TypeInfo)) =
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.27
diff -u -b -r1.27 type_ctor_info.m
--- compiler/type_ctor_info.m 13 May 2002 09:44:20 -0000 1.27
+++ compiler/type_ctor_info.m 15 May 2002 15:35:54 -0000
@@ -44,6 +44,9 @@
:- pred type_ctor_info__generate_rtti(module_info::in, list(rtti_data)::out)
is det.
+:- func compute_contains_var_bit_vector(
+ list(rtti_maybe_pseudo_type_info_or_self)) = int.
+
:- implementation.
:- import_module backend_libs__rtti, backend_libs__pseudo_type_info.
@@ -127,18 +130,30 @@
map__lookup(SpecMap, unify - TypeCtor, UnifyPredId),
special_pred_mode_num(unify, UnifyProcInt),
proc_id_to_int(UnifyProcId, UnifyProcInt),
- MaybeUnify = yes(proc(UnifyPredId, UnifyProcId)),
+ Unify = proc(UnifyPredId, UnifyProcId),
map__lookup(SpecMap, compare - TypeCtor, ComparePredId),
special_pred_mode_num(compare, CompareProcInt),
proc_id_to_int(CompareProcId, CompareProcInt),
- MaybeCompare = yes(proc(ComparePredId, CompareProcId))
+ Compare = proc(ComparePredId, CompareProcId)
;
- MaybeUnify = no,
- MaybeCompare = no
+ module_info_get_predicate_table(ModuleInfo, PredTable),
+ mercury_private_builtin_module(PrivateBuiltin),
+ (
+ predicate_table_search_pred_m_n_a(PredTable,
+ PrivateBuiltin, "unused", 0, PredIds),
+ PredIds = [PredId]
+ ->
+ get_proc_id(ModuleInfo, PredId, ProcId),
+ Unused = proc(PredId, ProcId),
+ Unify = Unused,
+ Compare = Unused
+ ;
+ error("type_ctor_info__gen_type_ctor_gen_info: no unique unused predicate")
+ )
),
TypeCtorGenInfo = type_ctor_gen_info(TypeCtor, ModuleName, TypeName,
- TypeArity, Status, TypeDefn, MaybeUnify, MaybeCompare).
+ TypeArity, Status, TypeDefn, Unify, Compare).
%---------------------------------------------------------------------------%
@@ -163,126 +178,47 @@
[TypeCtorGenInfo | TypeCtorGenInfos], ModuleInfo,
Dynamic0, Dynamic, Static0, Static) :-
type_ctor_info__construct_type_ctor_info(TypeCtorGenInfo,
- ModuleInfo, TypeCtorCModule, TypeCtorTables),
+ ModuleInfo, TypeCtorCModule),
Dynamic1 = [TypeCtorCModule | Dynamic0],
- list__append(TypeCtorTables, Static0, Static1),
type_ctor_info__construct_type_ctor_infos(TypeCtorGenInfos,
- ModuleInfo, Dynamic1, Dynamic, Static1, Static).
+ ModuleInfo, Dynamic1, Dynamic, Static0, Static).
+
+ % Generate RTTI information for the given type.
:- pred type_ctor_info__construct_type_ctor_info(type_ctor_gen_info::in,
- module_info::in, rtti_data::out, list(rtti_data)::out) is det.
+ module_info::in, rtti_data::out) is det.
-type_ctor_info__construct_type_ctor_info(TypeCtorGenInfo,
- ModuleInfo, TypeCtorData, TypeCtorTables) :-
+type_ctor_info__construct_type_ctor_info(TypeCtorGenInfo, ModuleInfo,
+ RttiData) :-
TypeCtorGenInfo = type_ctor_gen_info(_TypeCtor, ModuleName, TypeName,
- TypeArity, _Status, HldsDefn, MaybeUnify, MaybeCompare),
- type_ctor_info__make_proc_label(MaybeUnify, ModuleInfo, Unify),
- type_ctor_info__make_proc_label(MaybeCompare, ModuleInfo, Compare),
-
- 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, ModuleInfo,
- TypeCtorRep, NumFunctors, MaybeFunctors, MaybeLayout,
- NumPtags, TypeCtorTables)
- ;
- % This is for measuring code size only; if this path
- % is ever taken, the resulting executable will not
- % work.
- TypeCtorRep = unknown,
- NumPtags = -1,
- NumFunctors = -1,
- MaybeFunctors = no_functors,
- MaybeLayout = no_layout,
- TypeCtorTables = []
- ),
- Version = type_ctor_info_rtti_version,
- RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, TypeArity),
- TypeCtorData = type_ctor_info(RttiTypeCtor, Unify, Compare,
- TypeCtorRep, Version, NumPtags, NumFunctors,
- MaybeFunctors, MaybeLayout).
-
-:- pred type_ctor_info__make_proc_label(maybe(pred_proc_id)::in,
- module_info::in, maybe(rtti_proc_label)::out) is det.
-
-type_ctor_info__make_proc_label(no, _ModuleInfo, no).
-type_ctor_info__make_proc_label(yes(PredProcId), ModuleInfo, yes(ProcLabel)) :-
- PredProcId = proc(PredId, ProcId),
- ProcLabel = rtti__make_proc_label(ModuleInfo, PredId, ProcId).
-
-%---------------------------------------------------------------------------%
-
- % The version of the RTTI data structures -- useful for bootstrapping.
- % If you write runtime code that checks this version number and
- % can at least handle the previous version of the data
- % structure, it makes it easier to bootstrap changes to the data
- % structures used for RTTI.
- %
- % This number should be kept in sync with MR_RTTI_VERSION in
- % runtime/mercury_type_info.h. This means you need to update
- % the handwritten type_ctor_info structures and the code in the
- % runtime that uses RTTI to conform to whatever changes the new
- % version introduces.
-
-:- func type_ctor_info_rtti_version = int.
-
-type_ctor_info_rtti_version = 7.
-
-%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
-
- % Generate RTTI layout information for the named type.
-
-:- pred type_ctor_info__gen_layout_info(module_name::in,
- string::in, int::in, hlds_type_defn::in,
- 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,
- ModuleInfo, TypeCtorRep, NumFunctors,
- FunctorsInfo, LayoutInfo, NumPtags, TypeTables) :-
+ TypeArity, _Status, HldsDefn, UnifyPredProcId,
+ ComparePredProcId),
+ type_ctor_info__make_proc_label(UnifyPredProcId, ModuleInfo,
+ UnifyProcLabel),
+ type_ctor_info__make_proc_label(ComparePredProcId, ModuleInfo,
+ CompareProcLabel),
+ type_to_univ(UnifyProcLabel, UnifyUniv),
+ type_to_univ(CompareProcLabel, CompareUniv),
module_info_globals(ModuleInfo, Globals),
hlds_data__get_type_defn_body(HldsDefn, TypeBody),
+ Version = type_ctor_info_rtti_version,
(
TypeBody = abstract_type,
- TypeCtorRep = unknown,
- NumFunctors = -1,
- FunctorsInfo = no_functors,
- LayoutInfo = no_layout,
- TypeTables = [],
- NumPtags = -1
+ error("type_ctor_info__gen_type_ctor_data: abstract_type")
;
% We treat foreign_types as equivalent to the
% type builtin__c_pointer.
TypeBody = foreign_type(_, _),
- Ctxt = term__context("builtin.m", 1),
- Type = functor(term__atom(":"), [
- functor(term__atom("builtin"), [], Ctxt),
- functor(term__atom("c_pointer"), [], Ctxt)],
- Ctxt),
- gen_layout_info_eqv_type(Type, TypeArity,
- TypeCtorRep, NumFunctors, FunctorsInfo,
- LayoutInfo, NumPtags, TypeTables)
+ Details = foreign
;
TypeBody = eqv_type(Type),
- ( term__is_ground(Type) ->
- TypeCtorRep = equiv(equiv_type_is_ground)
- ;
- TypeCtorRep = equiv(equiv_type_is_not_ground)
- ),
- NumFunctors = -1,
- FunctorsInfo = no_functors,
- UnivTvars = TypeArity,
% There can be no existentially typed args to an
% equivalence.
+ UnivTvars = TypeArity,
ExistTvars = [],
- make_pseudo_type_info_and_tables(Type,
- UnivTvars, ExistTvars, PseudoTypeInfoRttiData,
- [], TypeTables),
- LayoutInfo = equiv_layout(PseudoTypeInfoRttiData),
- NumPtags = -1
+ pseudo_type_info__construct_maybe_pseudo_type_info(Type,
+ UnivTvars, ExistTvars, MaybePseudoTypeInfo),
+ Details = eqv(MaybePseudoTypeInfo)
;
TypeBody = du_type(Ctors, ConsTagMap, Enum, EqualityPred),
(
@@ -292,70 +228,55 @@
EqualityPred = no,
EqualityAxioms = standard
),
- list__length(Ctors, NumFunctors),
globals__lookup_bool_option(Globals, reserve_tag, ReserveTag),
- RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, TypeArity),
(
Enum = yes,
- TypeCtorRep = enum(EqualityAxioms),
- type_ctor_info__make_enum_tables(Ctors, ConsTagMap,
- RttiTypeCtor, ReserveTag, TypeTables,
- FunctorsInfo, LayoutInfo),
- NumPtags = -1
+ type_ctor_info__make_enum_details(Ctors, ConsTagMap,
+ ReserveTag, EqualityAxioms, Details)
;
Enum = no,
(
type_constructors_should_be_no_tag(Ctors,
Globals, Name, ArgType, MaybeArgName)
->
- ( term__is_ground(ArgType) ->
- Inst = equiv_type_is_ground
- ;
- Inst = equiv_type_is_not_ground
- ),
- TypeCtorRep = notag(EqualityAxioms, Inst),
- type_ctor_info__make_notag_tables(Name,
- ArgType, MaybeArgName, RttiTypeCtor,
- TypeTables, FunctorsInfo, LayoutInfo),
- NumPtags = -1
- ;
- globals__lookup_int_option(Globals,
- num_tag_bits, NumTagBits),
- int__pow(2, NumTagBits, NumTags),
- MaxPtag = NumTags - 1,
- type_ctor_info__make_du_tables(Ctors,
- ConsTagMap, MaxPtag, RttiTypeCtor,
- EqualityAxioms, ModuleInfo,
- TypeTables, NumPtags,
- FunctorsInfo, LayoutInfo, TypeCtorRep)
+ type_ctor_info__make_notag_details(TypeArity,
+ Name, ArgType, MaybeArgName,
+ EqualityAxioms, Details)
+ ;
+ type_ctor_info__make_du_details(Ctors,
+ ConsTagMap, TypeArity, EqualityAxioms,
+ ModuleInfo, Details)
)
)
- ).
-
-:- pred gen_layout_info_eqv_type((type)::in, int::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.
-
-gen_layout_info_eqv_type(Type, TypeArity,
- TypeCtorRep, NumFunctors, FunctorsInfo,
- LayoutInfo, NumPtags, TypeTables) :-
- ( term__is_ground(Type) ->
- TypeCtorRep = equiv(equiv_type_is_ground)
- ;
- 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 = [],
- make_pseudo_type_info_and_tables(Type,
- UnivTvars, ExistTvars, PseudoTypeInfoRttiData,
- [], TypeTables),
- LayoutInfo = equiv_layout(PseudoTypeInfoRttiData),
- NumPtags = -1.
+ TypeCtorData = type_ctor_data(Version, ModuleName, TypeName, TypeArity,
+ UnifyUniv, CompareUniv, Details),
+ RttiData = type_ctor_info(TypeCtorData).
+
+:- pred type_ctor_info__make_proc_label(pred_proc_id::in, module_info::in,
+ rtti_proc_label::out) is det.
+
+type_ctor_info__make_proc_label(PredProcId, ModuleInfo, ProcLabel) :-
+ PredProcId = proc(PredId, ProcId),
+ ProcLabel = rtti__make_proc_label(ModuleInfo, PredId, ProcId).
+
+%---------------------------------------------------------------------------%
+
+ % The version of the RTTI data structures -- useful for bootstrapping.
+ % If you write runtime code that checks this version number and
+ % can at least handle the previous version of the data
+ % structure, it makes it easier to bootstrap changes to the data
+ % structures used for RTTI.
+ %
+ % This number should be kept in sync with MR_RTTI_VERSION in
+ % runtime/mercury_type_info.h. This means you need to update
+ % the handwritten type_ctor_info structures (and the macros that
+ % generate them) as well as the code in the runtime that uses RTTI
+ % to conform to whatever changes the new version introduces.
+
+:- func type_ctor_info_rtti_version = int.
+
+type_ctor_info_rtti_version = 7.
% Construct an rtti_data for a pseudo_type_info,
% and also construct rtti_data definitions for all of the pseudo_type_infos
@@ -431,26 +352,21 @@
% Make the functor and layout tables for a notag type.
-:- pred type_ctor_info__make_notag_tables(sym_name::in, (type)::in,
- maybe(string)::in, rtti_type_ctor::in, list(rtti_data)::out,
- type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
+:- pred type_ctor_info__make_notag_details(int::in, sym_name::in, (type)::in,
+ maybe(string)::in, equality_axioms::in, type_ctor_details::out) is det.
-type_ctor_info__make_notag_tables(SymName, ArgType, MaybeArgName, RttiTypeCtor,
- TypeTables, FunctorsInfo, LayoutInfo) :-
+type_ctor_info__make_notag_details(TypeArity, SymName, ArgType, MaybeArgName,
+ EqualityAxioms, Details) :-
unqualify_name(SymName, FunctorName),
- RttiTypeCtor = rtti_type_ctor(_, _, UnivTvars),
+ NumUnivTvars = TypeArity,
% There can be no existentially typed args to the functor
% in a notag type.
ExistTvars = [],
- make_pseudo_type_info_and_tables(ArgType, UnivTvars, ExistTvars,
- RttiData, [], Tables0),
- FunctorDesc = notag_functor_desc(RttiTypeCtor, FunctorName, RttiData,
+ pseudo_type_info__construct_maybe_pseudo_type_info(ArgType,
+ NumUnivTvars, ExistTvars, MaybePseudoTypeInfo),
+ Functor = notag_functor(FunctorName, MaybePseudoTypeInfo,
MaybeArgName),
- FunctorRttiName = notag_functor_desc,
-
- FunctorsInfo = notag_functors(FunctorRttiName),
- LayoutInfo = notag_layout(FunctorRttiName),
- TypeTables = [FunctorDesc | Tables0].
+ Details = notag(EqualityAxioms, Functor).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -459,42 +375,25 @@
% Make the functor and layout tables for an enum type.
-:- pred type_ctor_info__make_enum_tables(list(constructor)::in,
- cons_tag_values::in, rtti_type_ctor::in, bool::in, list(rtti_data)::out,
- type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
-
-type_ctor_info__make_enum_tables(Ctors, ConsTagMap, RttiTypeCtor, ReserveTag,
- TypeTables, FunctorInfo, LayoutInfo) :-
- (
- % If there are any existentially quantified type variables,
- % then the type will contain hidden fields holding the
- % type_infos and/or typeclass infos for those type variables,
- % so it won't be a single-argument type.
-
- ReserveTag = yes
- ->
+:- pred type_ctor_info__make_enum_details(list(constructor)::in,
+ cons_tag_values::in, bool::in, equality_axioms::in,
+ type_ctor_details::out) is det.
+
+type_ctor_info__make_enum_details(Ctors, ConsTagMap, ReserveTag,
+ EqualityAxioms, Details) :-
+ ( ReserveTag = yes ->
unexpected("type_ctor_info", "enum in .rt grade")
;
- InitTag = 0
+ true
),
- type_ctor_info__make_enum_functor_tables(Ctors, InitTag, ConsTagMap,
- RttiTypeCtor, FunctorDescs, OrdinalOrderRttiNames, SortInfo0),
- list__sort(SortInfo0, SortInfo),
- assoc_list__values(SortInfo, NameOrderedRttiNames),
-
- NameOrderedTable = enum_name_ordered_table(RttiTypeCtor,
- NameOrderedRttiNames),
- NameOrderedTableRttiName = enum_name_ordered_table,
- FunctorInfo = enum_functors(NameOrderedTableRttiName),
-
- ValueOrderedTable = enum_value_ordered_table(RttiTypeCtor,
- OrdinalOrderRttiNames),
- ValueOrderedTableRttiName = enum_value_ordered_table,
- LayoutInfo = enum_layout(ValueOrderedTableRttiName),
+ type_ctor_info__make_enum_functors(Ctors, 0, ConsTagMap, EnumFunctors),
+ ValueMap0 = map__init,
+ NameMap0 = map__init,
+ list__foldl2(type_ctor_info__make_enum_maps, EnumFunctors,
+ ValueMap0, ValueMap, NameMap0, NameMap),
+ Details = enum(EqualityAxioms, EnumFunctors, ValueMap, NameMap).
- TypeTables = [NameOrderedTable, ValueOrderedTable | FunctorDescs].
-
-% Create an enum_functor_desc structure for each functor in an enum type.
+% Create an enum_functor structure for each functor in an enum type.
% The functors are given to us in ordinal order (since that's how the HLDS
% stored them), and that is how we return the list of rtti names of the
% enum_functor_desc structures; that way, it is directly usable in the type
@@ -502,15 +401,12 @@
% sort this list on functor name, which is how the type functors structure
% is constructed.
-:- pred type_ctor_info__make_enum_functor_tables(list(constructor)::in,
- int::in, cons_tag_values::in, rtti_type_ctor::in,
- list(rtti_data)::out, list(rtti_name)::out,
- name_sort_info::out) is det.
-
-type_ctor_info__make_enum_functor_tables([], _, _, _, [], [], []).
-type_ctor_info__make_enum_functor_tables([Functor | Functors], NextOrdinal0,
- ConsTagMap, RttiTypeCtor,
- FunctorDescs, RttiNames, SortInfo) :-
+:- pred type_ctor_info__make_enum_functors(list(constructor)::in,
+ int::in, cons_tag_values::in, list(enum_functor)::out) is det.
+
+type_ctor_info__make_enum_functors([], _, _, []).
+type_ctor_info__make_enum_functors([Functor | Functors], NextOrdinal0,
+ ConsTagMap, [EnumFunctor | EnumFunctors]) :-
Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs),
require(unify(ExistTvars, []),
"existential arguments in functor in enum"),
@@ -524,16 +420,19 @@
require(unify(ConsTag, int_constant(NextOrdinal0)),
"mismatch on constant assigned to functor in enum"),
unqualify_name(SymName, FunctorName),
- FunctorDesc =
- enum_functor_desc(RttiTypeCtor, FunctorName, NextOrdinal0),
- RttiName = enum_functor_desc(NextOrdinal0),
- FunctorSortInfo = (FunctorName - 0) - RttiName,
- type_ctor_info__make_enum_functor_tables(Functors, NextOrdinal0 + 1,
- ConsTagMap, RttiTypeCtor, FunctorDescs1, RttiNames1,
- SortInfo1),
- FunctorDescs = [FunctorDesc | FunctorDescs1],
- RttiNames = [RttiName | RttiNames1],
- SortInfo = [FunctorSortInfo | SortInfo1].
+ EnumFunctor = enum_functor(FunctorName, NextOrdinal0),
+ type_ctor_info__make_enum_functors(Functors, NextOrdinal0 + 1,
+ ConsTagMap, EnumFunctors).
+
+:- pred type_ctor_info__make_enum_maps(enum_functor::in,
+ map(int, enum_functor)::in, map(int, enum_functor)::out,
+ map(string, enum_functor)::in, map(string, enum_functor)::out) is det.
+
+type_ctor_info__make_enum_maps(EnumFunctor, ValueMap0, ValueMap,
+ NameMap0, NameMap) :-
+ EnumFunctor = enum_functor(FunctorName, Ordinal),
+ map__det_insert(ValueMap0, Ordinal, EnumFunctor, ValueMap),
+ map__det_insert(NameMap0, FunctorName, EnumFunctor, NameMap).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -543,106 +442,42 @@
:- type reserved_addr_map == map(reserved_address, rtti_data).
-% Make the functor and layout tables for a du type
-% (including reserved_addr types).
+:- func is_du_functor(maybe_reserved_functor::in) = (du_functor::out)
+ is semidet.
-:- pred type_ctor_info__make_du_tables(list(constructor)::in,
- cons_tag_values::in, int::in, rtti_type_ctor::in, equality_axioms::in,
- module_info::in, list(rtti_data)::out, int::out,
- type_ctor_functors_info::out, type_ctor_layout_info::out,
- type_ctor_rep::out) is det.
-
-type_ctor_info__make_du_tables(Ctors, ConsTagMap, MaxPtag, RttiTypeCtor,
- EqualityAxioms, ModuleInfo, TypeTables, NumPtags,
- FunctorInfo, LayoutInfo, TypeCtorRep) :-
- module_info_globals(ModuleInfo, Globals),
- (
- globals__lookup_bool_option(Globals, reserve_tag, yes)
- ->
- InitTag = 1
- ;
- InitTag = 0
- ),
- map__init(TagMap0),
- map__init(ReservedAddrMap0),
- type_ctor_info__make_du_functor_tables(Ctors, InitTag, ConsTagMap,
- RttiTypeCtor, ModuleInfo,
- FunctorDescs, SortInfo0, TagMap0, TagMap,
- ReservedAddrMap0, ReservedAddrMap),
- list__sort(SortInfo0, SortInfo),
- assoc_list__values(SortInfo, NameOrderedRttiNames),
-
- NameOrderedTable = du_name_ordered_table(RttiTypeCtor,
- NameOrderedRttiNames),
- NameOrderedTableRttiName = du_name_ordered_table,
- FunctorInfo = du_functors(NameOrderedTableRttiName),
-
- type_ctor_info__make_du_ptag_ordered_table(TagMap, InitTag, MaxPtag,
- RttiTypeCtor, ValueOrderedTableRttiName, ValueOrderedTables,
- NumPtags),
- DuLayoutInfo = du_layout(ValueOrderedTableRttiName),
- list__append([NameOrderedTable | FunctorDescs], ValueOrderedTables,
- TypeTables0),
- ( map__is_empty(ReservedAddrMap) ->
- TypeTables = TypeTables0,
- LayoutInfo = DuLayoutInfo,
- TypeCtorRep = du(EqualityAxioms)
- ;
- type_ctor_info__make_reserved_addr_layout(RttiTypeCtor,
- ReservedAddrMap, ValueOrderedTableRttiName,
- RALayoutRttiName, RALayoutTables),
- % XXX does it matter what order they go in?
- TypeTables = RALayoutTables ++ TypeTables0,
- LayoutInfo = reserved_addr_layout(RALayoutRttiName),
- TypeCtorRep = reserved_addr(EqualityAxioms)
- ).
+is_du_functor(du_func(DuFunctor)) = DuFunctor.
-:- pred type_ctor_info__make_reserved_addr_layout(rtti_type_ctor::in,
- reserved_addr_map::in, rtti_name::in,
- rtti_name::out, list(rtti_data)::out) is det.
+:- func is_reserved_functor(maybe_reserved_functor::in) =
+ (reserved_functor::out) is semidet.
-type_ctor_info__make_reserved_addr_layout(RttiTypeCtor, ReservedAddrMap,
- DuTableRttiName, RALayoutRttiName, RALayoutTables) :-
- %
- % split the reserved addresses into numeric addresses (including null)
- % and symbolic addresses.
- %
- ReservedAddrAssocList = map__to_sorted_assoc_list(ReservedAddrMap),
- list__filter((pred(RA - _::in) is semidet :-
- RA = reserved_object(_, _, _)),
- ReservedAddrAssocList,
- SymbolicAddrAssocList, NumericAddrAssocList),
+is_reserved_functor(res_func(ResFunctor)) = ResFunctor.
- %
- % fill in the tables pointed to by the reserved_addr_table
- %
- SymbolicAddrList = assoc_list__keys(SymbolicAddrAssocList),
- SymbolicAddrTable = reserved_addrs(RttiTypeCtor, SymbolicAddrList),
- ReservedAddrFunctorDescTables =
- assoc_list__values(ReservedAddrAssocList),
- ReservedAddrFunctorDescs = list__map(
- (func(RAFD) = Name :-
- rtti_data_to_name(RAFD, _RttiTypeCtor, Name)),
- ReservedAddrFunctorDescTables),
- ReservedAddrFunctorTable = reserved_addr_functors(
- RttiTypeCtor, ReservedAddrFunctorDescs),
- %
- % fill in the reserved_addr_table,
- % which describes the representation of this type
- %
- NumNumericReservedAddrs = list__length(NumericAddrAssocList),
- NumSymbolicReservedAddrs = list__length(SymbolicAddrAssocList),
- RALayoutTable = reserved_addr_table(RttiTypeCtor,
- NumNumericReservedAddrs,
- NumSymbolicReservedAddrs,
- reserved_addrs,
- reserved_addr_functors,
- DuTableRttiName),
- RALayoutRttiName = reserved_addr_table,
-
- % put it all together
- RALayoutTables = ReservedAddrFunctorDescTables ++
- [ReservedAddrFunctorTable, SymbolicAddrTable, RALayoutTable].
+% Make the functor and layout tables for a du type
+% (including reserved_addr types).
+
+:- pred type_ctor_info__make_du_details(list(constructor)::in,
+ cons_tag_values::in, int::in, equality_axioms::in, module_info::in,
+ type_ctor_details::out) is det.
+
+type_ctor_info__make_du_details(Ctors, ConsTagMap, TypeArity, EqualityAxioms,
+ ModuleInfo, Details) :-
+ type_ctor_info__make_maybe_res_functors(Ctors, 0, ConsTagMap,
+ TypeArity, ModuleInfo, MaybeResFunctors),
+ DuFunctors = list__filter_map(is_du_functor, MaybeResFunctors),
+ ResFunctors = list__filter_map(is_reserved_functor, MaybeResFunctors),
+ list__foldl(type_ctor_info__make_du_ptag_ordered_table, DuFunctors,
+ map__init, DuPtagTable),
+ ( ResFunctors = [] ->
+ list__foldl(type_ctor_info__make_du_name_ordered_table,
+ DuFunctors, map__init, DuNameOrderedMap),
+ Details = du(EqualityAxioms, DuFunctors, DuPtagTable,
+ DuNameOrderedMap)
+ ;
+ list__foldl(type_ctor_info__make_res_name_ordered_table,
+ MaybeResFunctors, map__init, ResNameOrderedMap),
+ Details = reserved(EqualityAxioms, MaybeResFunctors,
+ ResFunctors, DuPtagTable, ResNameOrderedMap)
+ ).
% Create a du_functor_desc structure for each functor in a du type.
% Besides returning a list of the rtti names of their du_functor_desc
@@ -652,178 +487,96 @@
% groups the rttis into groups depending on their primary tags; this is
% how the type layout structure is constructed.
-:- type cons_representation
- ---> reserved_address(reserved_address)
- ; tagged_data(
- tag_bits, % primary tag value
- sectag_locn, % secondary tag location
- int % secondary tag value
+:- type maybe_reserved_rep
+ ---> reserved_rep(
+ reserved_address
+ )
+ ; du_rep(
+ du_rep
).
-:- pred type_ctor_info__make_du_functor_tables(list(constructor)::in,
- int::in, cons_tag_values::in, rtti_type_ctor::in, module_info::in,
- list(rtti_data)::out, name_sort_info::out,
- tag_map::in, tag_map::out,
- reserved_addr_map::in, reserved_addr_map::out) is det.
-
-type_ctor_info__make_du_functor_tables([], _, _, _, _,
- [], [], TagMap, TagMap, RAMap, RAMap).
-type_ctor_info__make_du_functor_tables([Functor | Functors], Ordinal,
- ConsTagMap, RttiTypeCtor, ModuleInfo,
- Tables, SortInfo, TagMap0, TagMap, RAMap0, RAMap) :-
- Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs),
- list__length(FunctorArgs, Arity),
+:- pred type_ctor_info__make_maybe_res_functors(list(constructor)::in,
+ int::in, cons_tag_values::in, int::in, module_info::in,
+ list(maybe_reserved_functor)::out) is det.
+
+type_ctor_info__make_maybe_res_functors([], _, _, _, _, []).
+type_ctor_info__make_maybe_res_functors([Functor | Functors], NextOrdinal,
+ ConsTagMap, TypeArity, ModuleInfo,
+ [MaybeResFunctor | MaybeResFunctors]) :-
+ Functor = ctor(ExistTvars, Constraints, SymName, ConstructorArgs),
+ list__length(ConstructorArgs, Arity),
unqualify_name(SymName, FunctorName),
- RttiName = du_functor_desc(Ordinal),
- make_cons_id_from_qualified_sym_name(SymName, FunctorArgs, ConsId),
+ make_cons_id_from_qualified_sym_name(SymName, ConstructorArgs, ConsId),
map__lookup(ConsTagMap, ConsId, ConsTag),
- type_ctor_info__process_cons_tag(ConsTag, RttiName, ConsRep,
- TagMap0, TagMap1),
- (
- ConsRep = tagged_data(Ptag, Locn, Stag),
- RAMap1 = RAMap0
- ;
- ConsRep = reserved_address(RA),
- RAFunctorDesc = reserved_addr_functor_desc(RttiTypeCtor,
- FunctorName, Ordinal, RA),
- RAMap1 = map__det_insert(RAMap0, RA, RAFunctorDesc),
- % These three fields are not really used for
- % reserved_address const tags, but we need to fill
- % them in with something...
- Ptag = 0,
- Stag = 0,
- Locn = sectag_none
- ),
- type_ctor_info__generate_arg_info_tables(ModuleInfo,
- RttiTypeCtor, Ordinal, FunctorArgs, ExistTvars,
- MaybeArgNames,
- ArgPseudoTypeInfoVector, FieldTables, ContainsVarBitVector),
+ type_ctor_info__process_cons_tag(ConsTag, ConsRep),
+ list__map(type_ctor_info__generate_du_arg_info(TypeArity, ExistTvars),
+ ConstructorArgs, ArgInfos),
( ExistTvars = [] ->
- MaybeExistInfo = no,
- ExistTables = []
+ MaybeExistInfo = no
;
module_info_classes(ModuleInfo, ClassTable),
- type_ctor_info__generate_type_info_locns(ExistTvars,
- Constraints, ClassTable, RttiTypeCtor, Ordinal,
- ExistInfo, ExistTables),
+ type_ctor_info__generate_exist_into(ExistTvars,
+ Constraints, ClassTable, ExistInfo),
MaybeExistInfo = yes(ExistInfo)
),
- list__append(FieldTables, ExistTables, SubTables),
- FunctorDesc = du_functor_desc(RttiTypeCtor, FunctorName, Ptag, Stag,
- Locn, Ordinal, Arity, ContainsVarBitVector,
- ArgPseudoTypeInfoVector, MaybeArgNames, MaybeExistInfo),
- FunctorSortInfo = (FunctorName - Arity) - RttiName,
- type_ctor_info__make_du_functor_tables(Functors, Ordinal + 1,
- ConsTagMap, RttiTypeCtor, ModuleInfo,
- Tables1, SortInfo1, TagMap1, TagMap, RAMap1, RAMap),
- list__append([FunctorDesc | SubTables], Tables1, Tables),
- SortInfo = [FunctorSortInfo | SortInfo1].
+ (
+ ConsRep = du_rep(DuRep),
+ DuFunctor = du_functor(FunctorName, Arity, NextOrdinal,
+ DuRep, ArgInfos, MaybeExistInfo),
+ MaybeResFunctor = du_func(DuFunctor)
+ ;
+ ConsRep = reserved_rep(ResRep),
+ require(unify(Arity, 0),
+ "type_ctor_info__make_maybe_res_functors: bad arity"),
+ require(unify(ArgInfos, []),
+ "type_ctor_info__make_maybe_res_functors: bad arsg"),
+ require(unify(MaybeExistInfo, no),
+ "type_ctor_info__make_maybe_res_functors: bad exist"),
+ ResFunctor = reserved_functor(FunctorName, NextOrdinal,
+ ResRep),
+ MaybeResFunctor = res_func(ResFunctor)
+ ),
+ type_ctor_info__make_maybe_res_functors(Functors, NextOrdinal + 1,
+ ConsTagMap, TypeArity, ModuleInfo, MaybeResFunctors).
-:- pred type_ctor_info__process_cons_tag(cons_tag::in, rtti_name::in,
- cons_representation::out, tag_map::in, tag_map::out) is det.
+:- pred type_ctor_info__process_cons_tag(cons_tag::in, maybe_reserved_rep::out)
+ is det.
-type_ctor_info__process_cons_tag(ConsTag, RttiName, ConsRep,
- TagMap0, TagMap) :-
+type_ctor_info__process_cons_tag(ConsTag, ConsRep) :-
(
( ConsTag = single_functor, ConsPtag = 0
; ConsTag = unshared_tag(ConsPtag)
)
->
- Locn = sectag_none,
- Ptag = ConsPtag,
- Stag = 0,
- type_ctor_info__update_tag_info(Ptag, Stag, Locn, RttiName,
- TagMap0, TagMap),
- ConsRep = tagged_data(Ptag, Locn, Stag)
- ; ConsTag = shared_local_tag(ConsPtag, ConsStag) ->
- Locn = sectag_local,
- Ptag = ConsPtag,
- Stag = ConsStag,
- type_ctor_info__update_tag_info(Ptag, Stag, Locn, RttiName,
- TagMap0, TagMap),
- ConsRep = tagged_data(Ptag, Locn, Stag)
- ; ConsTag = shared_remote_tag(ConsPtag, ConsStag) ->
- Locn = sectag_remote,
- Ptag = ConsPtag,
- Stag = ConsStag,
- type_ctor_info__update_tag_info(Ptag, Stag, Locn, RttiName,
- TagMap0, TagMap),
- ConsRep = tagged_data(Ptag, Locn, Stag)
- ; ConsTag = reserved_address(RA) ->
- ConsRep = reserved_address(RA),
- TagMap = TagMap0
- ; ConsTag = shared_with_reserved_addresses(_RAs, ThisTag) ->
+ ConsRep = du_rep(du_ll_rep(ConsPtag, sectag_none))
+ ;
+ ConsTag = shared_local_tag(ConsPtag, ConsStag)
+ ->
+ ConsRep = du_rep(du_ll_rep(ConsPtag, sectag_local(ConsStag)))
+ ;
+ ConsTag = shared_remote_tag(ConsPtag, ConsStag)
+ ->
+ ConsRep = du_rep(du_ll_rep(ConsPtag, sectag_remote(ConsStag)))
+ ;
+ ConsTag = reserved_address(ReservedAddr)
+ ->
+ ConsRep = reserved_rep(ReservedAddr)
+ ;
+ ConsTag = shared_with_reserved_addresses(_RAs, ThisTag)
+ ->
% here we can just ignore the fact that this cons_tag is
% shared with reserved addresses
- type_ctor_info__process_cons_tag(ThisTag, RttiName,
- ConsRep, TagMap0, TagMap)
+ type_ctor_info__process_cons_tag(ThisTag, ConsRep)
;
- unexpected(this_file, "cons_tag for du function symbol")
+ unexpected(this_file, "bad cons_tag for du function symbol")
).
-% Generate the tables that describe the arguments of a functor.
-
-:- pred type_ctor_info__generate_arg_info_tables(module_info::in,
- rtti_type_ctor::in, int::in, list(constructor_arg)::in,
- existq_tvars::in, maybe(rtti_name)::out, maybe(rtti_name)::out,
- list(rtti_data)::out, int::out) is det.
-
-type_ctor_info__generate_arg_info_tables(
- ModuleInfo, RttiTypeCtor, Ordinal, Args, ExistTvars,
- MaybeFieldNamesRttiName, MaybeFieldTypesRttiName, Tables,
- ContainsVarBitVector) :-
- RttiTypeCtor = rtti_type_ctor(_TypeModule, _TypeName, TypeArity),
- type_ctor_info__generate_arg_infos(Args, TypeArity, ExistTvars,
- ModuleInfo, MaybeArgNames, PseudoTypeInfos,
- 0, 0, ContainsVarBitVector, [], Tables0),
- (
- PseudoTypeInfos = [],
- MaybeFieldTypesRttiName = no,
- Tables1 = Tables0
- ;
- PseudoTypeInfos = [_|_],
- FieldTypesTable = field_types(RttiTypeCtor, Ordinal,
- PseudoTypeInfos),
- FieldTypesRttiName = field_types(Ordinal),
- MaybeFieldTypesRttiName = yes(FieldTypesRttiName),
- Tables1 = [FieldTypesTable | Tables0]
- ),
- list__filter((lambda([MaybeName::in] is semidet, MaybeName = yes(_))),
- MaybeArgNames, FieldNames),
- (
- FieldNames = [],
- MaybeFieldNamesRttiName = no,
- Tables = Tables1
- ;
- FieldNames = [_|_],
- FieldNameTable = field_names(RttiTypeCtor, Ordinal,
- MaybeArgNames),
- FieldNamesRttiName = field_names(Ordinal),
- MaybeFieldNamesRttiName = yes(FieldNamesRttiName),
- Tables = [FieldNameTable | Tables1]
- ).
-
-% For each argument of a functor, return three items of information:
-% 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).
-% The number of bits in the integer is given by contains_var_bit_vector_size;
-% 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, list(maybe(string))::out,
- list(rtti_data)::out, int::in, int::in, int::out,
- list(rtti_data)::in, list(rtti_data)::out) is det.
+:- pred type_ctor_info__generate_du_arg_info(int::in, existq_tvars::in,
+ constructor_arg::in, du_arg_info::out) is det.
-type_ctor_info__generate_arg_infos([], _, _, _, [], [],
- _, ContainsVarBitVector, ContainsVarBitVector, Tables, Tables).
-type_ctor_info__generate_arg_infos([MaybeArgSymName - ArgType | Args],
- NumUnivTvars, ExistTvars, ModuleInfo,
- [MaybeArgName | MaybeArgNames], [RttiData | RttiDatas],
- ArgNum, ContainsVarBitVector0, ContainsVarBitVector,
- Tables0, Tables) :-
+type_ctor_info__generate_du_arg_info(NumUnivTvars, ExistTvars, ConstructorArg,
+ ArgInfo) :-
+ ConstructorArg = MaybeArgSymName - ArgType,
(
MaybeArgSymName = yes(SymName),
unqualify_name(SymName, ArgName),
@@ -832,22 +585,18 @@
MaybeArgSymName = no,
MaybeArgName = no
),
- make_pseudo_type_info_and_tables(ArgType, NumUnivTvars, ExistTvars,
- RttiData, Tables0, Tables1),
- ( term__is_ground(ArgType) ->
- ContainsVarBitVector1 = ContainsVarBitVector0
- ;
- ( ArgNum >= contains_var_bit_vector_size - 1 ->
- BitNum = contains_var_bit_vector_size - 1
+ % The C runtime cannot yet handle the "self" type representation,
+ % so we do not generate it here.
+ pseudo_type_info__construct_maybe_pseudo_type_info(ArgType,
+ NumUnivTvars, ExistTvars, MaybePseudoTypeInfo),
+ (
+ MaybePseudoTypeInfo = plain(TypeInfo),
+ MaybePseudoTypeInfoOrSelf = plain(TypeInfo)
;
- BitNum = ArgNum
- ),
- ContainsVarBitVector1 = ContainsVarBitVector0 \/ (1 << BitNum)
+ MaybePseudoTypeInfo = pseudo(PseudoTypeInfo),
+ MaybePseudoTypeInfoOrSelf = pseudo(PseudoTypeInfo)
),
- type_ctor_info__generate_arg_infos(Args, NumUnivTvars,
- ExistTvars, ModuleInfo, MaybeArgNames, RttiDatas,
- ArgNum + 1, ContainsVarBitVector1, ContainsVarBitVector,
- Tables1, Tables).
+ ArgInfo = du_arg_info(MaybeArgName, MaybePseudoTypeInfoOrSelf).
% This function gives the size of the MR_du_functor_arg_type_contains_var
% field of the C type MR_DuFunctorDesc in bits.
@@ -860,13 +609,11 @@
% of the typeinfos describing the types of the existentially typed arguments
% of a functor.
-:- pred type_ctor_info__generate_type_info_locns(list(tvar)::in,
- list(class_constraint)::in, class_table::in, rtti_type_ctor::in,
- int::in, rtti_name::out, list(rtti_data)::out) is det.
-
-type_ctor_info__generate_type_info_locns(ExistTvars, Constraints, ClassTable,
- RttiTypeCtor, Ordinal, exist_info(Ordinal),
- [ExistInfo, ExistLocns]) :-
+:- pred type_ctor_info__generate_exist_into(list(tvar)::in,
+ list(class_constraint)::in, class_table::in, exist_info::out) is det.
+
+type_ctor_info__generate_exist_into(ExistTvars, Constraints, ClassTable,
+ ExistInfo) :-
list__map((pred(C::in, Ts::out) is det :- C = constraint(_, Ts)),
Constraints, ConstrainedTvars0),
list__condense(ConstrainedTvars0, ConstrainedTvars1),
@@ -886,12 +633,10 @@
find_type_info_index(Constraints, ClassTable, TIsPlain),
ConstrainedTvars, LocnMap1, LocnMap),
list__length(Constraints, TCIs),
- ExistInfo = exist_info(RttiTypeCtor, Ordinal,
- TIsPlain, TIsInTCIs, TCIs, exist_locns(Ordinal)),
list__map((pred(Tvar::in, Locn::out) is det :-
map__lookup(LocnMap, Tvar, Locn)),
- ExistTvars, Locns),
- ExistLocns = exist_locns(RttiTypeCtor, Ordinal, Locns).
+ ExistTvars, ExistLocns),
+ ExistInfo = exist_info(TIsPlain, TIsInTCIs, TCIs, ExistLocns).
:- pred find_type_info_index(list(class_constraint)::in, class_table::in,
int::in, tvar::in, map(tvar, exist_typeinfo_locn)::in,
@@ -930,106 +675,123 @@
%---------------------------------------------------------------------------%
-:- pred type_ctor_info__update_tag_info(int::in, int::in, sectag_locn::in,
- rtti_name::in, tag_map::in, tag_map::out) is det.
+:- pred type_ctor_info__make_du_ptag_ordered_table(du_functor::in,
+ map(int, sectag_table)::in, map(int, sectag_table)::out) is det.
-type_ctor_info__update_tag_info(Ptag, Stag, Locn, RttiName, TagMap0, TagMap)
- :-
- ( map__search(TagMap0, Ptag, OldLocn - OldSharerMap) ->
- ( Locn = sectag_none ->
- error("unshared ptag shared after all")
- ; OldLocn = Locn ->
- true
- ;
- error("disagreement on sectag location for ptag")
- ),
- map__det_insert(OldSharerMap, Stag, RttiName, NewSharerMap),
- map__det_update(TagMap0, Ptag, Locn - NewSharerMap, TagMap)
+type_ctor_info__make_du_ptag_ordered_table(DuFunctor, PtagTable0, PtagTable) :-
+ DuRep = DuFunctor ^ du_rep,
+ (
+ DuRep = du_ll_rep(Ptag, SectagAndLocn),
+ (
+ SectagAndLocn = sectag_none,
+ SectagLocn = sectag_none,
+ Sectag = 0
+ ;
+ SectagAndLocn = sectag_local(Sectag),
+ SectagLocn = sectag_local
+ ;
+ SectagAndLocn = sectag_remote(Sectag),
+ SectagLocn = sectag_remote
+ ),
+ ( map__search(PtagTable0, Ptag, SectagTable0) ->
+ SectagTable0 = sectag_table(Locn0, NumSharers0,
+ SectagMap0),
+ require(unify(SectagLocn, Locn0),
+ "type_ctor_info__make_du_ptag_ordered_table: sectag locn disagreement"),
+ map__det_insert(SectagMap0, Sectag, DuFunctor,
+ SectagMap),
+ SectagTable = sectag_table(Locn0, NumSharers0 + 1,
+ SectagMap),
+ map__det_update(PtagTable0, Ptag, SectagTable,
+ PtagTable)
+ ;
+ SectagMap0 = map__init,
+ map__det_insert(SectagMap0, Sectag, DuFunctor,
+ SectagMap),
+ SectagTable = sectag_table(SectagLocn, 1, SectagMap),
+ map__det_insert(PtagTable0, Ptag, SectagTable,
+ PtagTable)
+ )
;
- map__init(NewSharerMap0),
- map__det_insert(NewSharerMap0, Stag, RttiName, NewSharerMap),
- map__det_insert(TagMap0, Ptag, Locn - NewSharerMap, TagMap)
+ DuRep = du_hl_rep(_),
+ error("type_ctor_info__make_du_ptag_ordered_table: du_hl_rep")
).
-:- pred type_ctor_info__make_du_ptag_ordered_table(tag_map::in,
- int::in, int::in, rtti_type_ctor::in,
- rtti_name::out, list(rtti_data)::out, int::out) is det.
-
-type_ctor_info__make_du_ptag_ordered_table(TagMap, MinPtagValue, MaxPtagValue,
- RttiTypeCtor, PtagOrderedRttiName, Tables, NumPtags) :-
- map__to_assoc_list(TagMap, TagList),
- type_ctor_info__make_du_ptag_layouts(TagList,
- MinPtagValue, MaxPtagValue, RttiTypeCtor,
- PtagLayouts, SubTables, NumPtags),
- PtagOrderedTable = du_ptag_ordered_table(RttiTypeCtor, PtagLayouts),
- PtagOrderedRttiName = du_ptag_ordered_table,
- Tables = [PtagOrderedTable | SubTables].
-
-:- pred type_ctor_info__make_du_ptag_layouts(tag_list::in, int::in, int::in,
- rtti_type_ctor::in, list(du_ptag_layout)::out, list(rtti_data)::out,
- int::out) is det.
-
-type_ctor_info__make_du_ptag_layouts(TagList0, CurPtag, MaxPtag,
- RttiTypeCtor, PtagLayouts, Tables, NumPtags) :-
- (
- TagList0 = [],
- PtagLayouts = [],
- Tables = [],
- NumPtags = CurPtag
- ;
- TagList0 = [Ptag - (Locn - StagMap) | TagList],
- require(unify(CurPtag, Ptag),
- "missing ptag value in make_du_ptag_layout"),
- require(CurPtag =< MaxPtag,
- "ptag value exceeds maximum"),
- map__to_assoc_list(StagMap, StagList),
- list__length(StagList, StagListLength),
- type_ctor_info__make_du_stag_table(0, StagListLength - 1,
- StagList, StagRttiNames),
- StagOrderedTable = du_stag_ordered_table(RttiTypeCtor,
- Ptag, StagRttiNames),
- StagOrderedAddr = du_stag_ordered_table(Ptag),
- PtagLayout = du_ptag_layout(StagListLength, Locn,
- StagOrderedAddr),
- type_ctor_info__make_du_ptag_layouts(TagList,
- CurPtag + 1, MaxPtag, RttiTypeCtor,
- PtagLayouts1, Tables1, NumPtags),
- PtagLayouts = [PtagLayout | PtagLayouts1],
- Tables = [StagOrderedTable | Tables1]
+:- pred type_ctor_info__make_du_name_ordered_table(du_functor::in,
+ map(string, map(int, du_functor))::in,
+ map(string, map(int, du_functor))::out) is det.
+
+type_ctor_info__make_du_name_ordered_table(DuFunctor, NameTable0, NameTable) :-
+ Name = DuFunctor ^ du_name,
+ Arity = DuFunctor ^ du_orig_arity,
+ ( map__search(NameTable0, Name, NameMap0) ->
+ map__det_insert(NameMap0, Arity, DuFunctor, NameMap),
+ map__det_update(NameTable0, Name, NameMap, NameTable)
+ ;
+ NameMap = map__init_singleton(Arity, DuFunctor),
+ map__det_insert(NameTable0, Name, NameMap, NameTable)
).
-:- pred type_ctor_info__make_du_stag_table(int::in, int::in,
- assoc_list(int, rtti_name)::in, list(rtti_name)::out) is det.
-
-type_ctor_info__make_du_stag_table(CurStag, MaxStag, TagList0,
- StagRttiNames) :-
- ( CurStag =< MaxStag ->
- (
- TagList0 = [],
- error("short stag list in make_du_stag_table")
- ;
- TagList0 = [Stag - RttiName | TagList],
- require(unify(CurStag, Stag),
- "missing stag value in make_du_stag_table")
- ),
- type_ctor_info__make_du_stag_table(CurStag + 1, MaxStag,
- TagList, StagRttiNames1),
- StagRttiNames = [RttiName | StagRttiNames1]
- ;
- require(unify(TagList0, []),
- "leftover stag values in make_du_stag_table"),
- StagRttiNames = []
+:- pred type_ctor_info__make_res_name_ordered_table(maybe_reserved_functor::in,
+ map(string, map(int, maybe_reserved_functor))::in,
+ map(string, map(int, maybe_reserved_functor))::out) is det.
+
+type_ctor_info__make_res_name_ordered_table(MaybeResFunctor,
+ NameTable0, NameTable) :-
+ (
+ MaybeResFunctor = du_func(DuFunctor),
+ Name = DuFunctor ^ du_name,
+ Arity = DuFunctor ^ du_orig_arity
+ ;
+ MaybeResFunctor = res_func(ResFunctor),
+ Name = ResFunctor ^ res_name,
+ Arity = 0
+ ),
+ ( map__search(NameTable0, Name, NameMap0) ->
+ map__det_insert(NameMap0, Arity, MaybeResFunctor, NameMap),
+ map__det_update(NameTable0, Name, NameMap, NameTable)
+ ;
+ NameMap = map__init_singleton(Arity, MaybeResFunctor),
+ map__det_insert(NameTable0, Name, NameMap, NameTable)
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
-:- pred type_ctor_info__get_next_cell_number(int::in, int::out, int::out)
- is det.
+compute_contains_var_bit_vector(ArgTypes) =
+ compute_contains_var_bit_vector_2(ArgTypes, 0, 0).
+
+:- func
+compute_contains_var_bit_vector_2(
+ list(rtti_maybe_pseudo_type_info_or_self), int, int) = int.
+
+compute_contains_var_bit_vector_2([], _, Vector) = Vector.
+compute_contains_var_bit_vector_2([ArgType | ArgTypes], ArgNum, Vector0) =
+ Vector :-
+ (
+ ArgType = plain(_),
+ Vector1 = Vector0
+ ;
+ ArgType = pseudo(_),
+ Vector1 = update_contains_var_bit_vector(Vector0, ArgNum)
+ ;
+ ArgType = self,
+ % The backend currently doesn't perform the optimization that
+ % lets it avoid memory allocation on self types.
+ Vector1 = update_contains_var_bit_vector(Vector0, ArgNum)
+ ),
+ Vector = compute_contains_var_bit_vector_2(ArgTypes, ArgNum + 1,
+ Vector1).
-type_ctor_info__get_next_cell_number(CellNumber0, Next, CellNumber) :-
- CellNumber = CellNumber0 + 1,
- Next = CellNumber.
+:- func update_contains_var_bit_vector(int, int) = int.
+
+update_contains_var_bit_vector(Vector0, ArgNum) = Vector :-
+ ( ArgNum >= contains_var_bit_vector_size - 1 ->
+ BitNum = contains_var_bit_vector_size - 1
+ ;
+ BitNum = ArgNum
+ ),
+ Vector = Vector0 \/ (1 << BitNum).
%---------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
Index: java/runtime/TypeCtorRep.java
===================================================================
RCS file: /home/mercury1/repository/mercury/java/runtime/TypeCtorRep.java,v
retrieving revision 1.2
diff -u -b -r1.2 TypeCtorRep.java
--- java/runtime/TypeCtorRep.java 27 Mar 2002 05:18:44 -0000 1.2
+++ java/runtime/TypeCtorRep.java 11 May 2002 14:47:57 -0000
@@ -47,7 +47,8 @@
public static final int MR_TYPECTOR_REP_BASETYPECLASSINFO = 34;
public static final int MR_TYPECTOR_REP_TYPEDESC = 35;
public static final int MR_TYPECTOR_REP_TYPECTORDESC = 36;
- public static final int MR_TYPECTOR_REP_UNKNOWN = 37;
+ public static final int MR_TYPECTOR_REP_FOREIGN = 37;
+ public static final int MR_TYPECTOR_REP_UNKNOWN = 38;
// Instance variable for TypeCtorRep objects.
cvs diff: Diffing library
Index: library/construct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/construct.m,v
retrieving revision 1.3
diff -u -b -r1.3 construct.m
--- library/construct.m 12 Apr 2002 01:24:21 -0000 1.3
+++ library/construct.m 10 May 2002 10:34:43 -0000
@@ -371,7 +371,8 @@
int total_reserved_addrs;
const MR_ReservedAddrFunctorDesc *functor_desc;
- ra_layout = MR_type_ctor_layout(type_ctor_info).layout_reserved_addr;
+ ra_layout = MR_type_ctor_layout(type_ctor_info).
+ MR_layout_reserved_addr;
total_reserved_addrs = ra_layout->MR_ra_num_res_numeric_addrs
+ ra_layout->MR_ra_num_res_symbolic_addrs;
@@ -464,7 +465,8 @@
case MR_TYPECTOR_REP_TUPLE:
{
- int arity, i;
+ int arity;
+ int i;
MR_Word arg_list;
arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.9
diff -u -b -r1.9 deconstruct.m
--- library/deconstruct.m 12 May 2002 17:47:46 -0000 1.9
+++ library/deconstruct.m 15 May 2002 08:46:40 -0000
@@ -793,7 +793,8 @@
switch (MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
- functor_desc = MR_type_ctor_functors(type_ctor_info).functors_notag;
+ functor_desc = MR_type_ctor_functors(type_ctor_info).
+ MR_functors_notag;
exp_type_info = MR_pseudo_type_info_is_ground(
functor_desc->MR_notag_functor_arg_type);
MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
@@ -802,7 +803,8 @@
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
- functor_desc = MR_type_ctor_functors(type_ctor_info).functors_notag;
+ functor_desc = MR_type_ctor_functors(type_ctor_info).
+ MR_functors_notag;
exp_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
functor_desc->MR_notag_functor_arg_type);
@@ -843,7 +845,7 @@
switch (MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_EQUIV:
exp_type_info = MR_pseudo_type_info_is_ground(
- MR_type_ctor_layout(type_ctor_info).layout_equiv);
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = MR_TRUE;
break;
@@ -851,7 +853,7 @@
case MR_TYPECTOR_REP_EQUIV_GROUND:
exp_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_equiv);
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = MR_TRUE;
break;
@@ -933,7 +935,8 @@
case MR_TYPECTOR_REP_DU_USEREQ:
SUCCESS_INDICATOR = MR_TRUE;
Ptag = MR_tag(value);
- ptag_layout = &MR_type_ctor_layout(type_ctor_info).layout_du[Ptag];
+ ptag_layout = &MR_type_ctor_layout(type_ctor_info).
+ MR_layout_du[Ptag];
switch(ptag_layout->MR_sectag_locn) {
case MR_SECTAG_LOCAL:
Index: library/map.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/map.m,v
retrieving revision 1.80
diff -u -b -r1.80 map.m
--- library/map.m 24 May 2001 02:32:28 -0000 1.80
+++ library/map.m 11 May 2002 10:34:17 -0000
@@ -37,6 +37,8 @@
:- func map__init = map(K, V).
:- mode map__init = uo is det.
+:- func map__init_singleton(K, V) = map(K, V).
+
% Check whether a map is empty.
:- pred map__is_empty(map(_,_)).
:- mode map__is_empty(in) is semidet.
@@ -786,6 +788,9 @@
map__init = M :-
map__init(M).
+
+map__init_singleton(K, V) =
+ map__det_insert(map__init, K, V).
map__search(M, K) = V :-
map__search(M, K, V).
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.100
diff -u -b -r1.100 private_builtin.m
--- library/private_builtin.m 27 Mar 2002 05:18:45 -0000 1.100
+++ library/private_builtin.m 11 May 2002 14:48:25 -0000
@@ -651,7 +651,8 @@
static int MR_TYPECTOR_REP_BASETYPECLASSINFO =34;
static int MR_TYPECTOR_REP_TYPEDESC =35;
static int MR_TYPECTOR_REP_TYPECTORDESC =36;
-static int MR_TYPECTOR_REP_UNKNOWN =37;
+static int MR_TYPECTOR_REP_FOREIGN =37;
+static int MR_TYPECTOR_REP_UNKNOWN =38;
static int MR_SECTAG_NONE = 0;
static int MR_SECTAG_LOCAL = 1;
Index: library/rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.16
diff -u -b -r1.16 rtti_implementation.m
--- library/rtti_implementation.m 24 Apr 2002 07:37:37 -0000 1.16
+++ library/rtti_implementation.m 11 May 2002 14:52:16 -0000
@@ -18,8 +18,9 @@
% present to implement type_info comparisons and unifications (which is enough
% to get univ working).
%
-% The plan is to have RTTI functions in std_util.m call into this module
-% as they are implemented in Mercury.
+% The plan is to migrate most of the Mercury level data structures in
+% compiler/rtti.m here, and to interpret them, instead of relying on access
+% to C level data structures.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -114,6 +115,7 @@
; base_typeclass_info
; type_desc
; type_ctor_desc
+ ; foreign
; unknown.
% We keep all the other types abstract.
@@ -194,7 +196,6 @@
)
).
-
generic_unify(X, Y) :-
TypeInfo = get_type_info(X),
TypeCtorInfo = get_type_ctor_info(TypeInfo),
@@ -294,7 +295,6 @@
semidet_call_8(_::in, _::in, _::in, _::in, _::in, _::in, _::in, _::in) :-
semidet_unimplemented("semidet_call_8").
-
:- pred result_call_4(P::in, comparison_result::out,
T::in, U::in) is det.
result_call_4(_::in, (=)::out, _::in, _::in) :-
@@ -329,7 +329,6 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-
% We override the above definitions in the .NET backend.
:- pragma foreign_proc("MC++",
@@ -379,8 +378,6 @@
E, X, Y);
").
-
-
:- pragma foreign_proc("C#",
result_call_4(Pred::in, Res::out, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -542,7 +539,6 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-
% Code to perform deconstructions (XXX not yet complete).
%
% There are many cases to implement here, only the ones that were
@@ -774,14 +770,17 @@
Arity = 0,
Arguments = []
;
+ TypeCtorRep = foreign,
+ Functor = "some_foreign",
+ Arity = 0,
+ Arguments = []
+ ;
TypeCtorRep = unknown,
Functor = "some_unknown",
Arity = 0,
Arguments = []
).
-
-
% Retrieve an argument number from a term, given the functor
% descriptor.
@@ -869,13 +868,11 @@
ExtraArgs = 0
).
-
% XXX this is completely unimplemented.
:- func pseudotypeinfo_get_higher_order_arity(type_info) = int.
pseudotypeinfo_get_higher_order_arity(_) = 1 :-
det_unimplemented("pseudotypeinfo_get_higher_order_arity").
-
% Make a new type-info with the given arity, using the given type_info
% as the basis.
@@ -891,7 +888,6 @@
System.Array.Copy(OldTypeInfo, NewTypeInfo, OldTypeInfo.Length);
").
-
% Get the pseudo-typeinfo at the given index from the argument types.
:- some [T] func get_pti_from_arg_types(arg_types, int) = T.
@@ -905,7 +901,6 @@
ArgTypeInfo = ArgTypes[Index];
").
-
% Get the pseudo-typeinfo at the given index from a type-info.
:- some [T] func get_pti_from_type_info(type_info, int) = T.
@@ -919,8 +914,6 @@
PTI = TypeInfo[Index];
").
-
-
% Get the type info for a particular type variable number
% (it might be in the type_info or in the term itself).
%
@@ -956,7 +949,6 @@
)
).
-
% An unchecked cast to type_info (for pseudo-typeinfos).
:- func type_info_cast(T) = type_info.
@@ -978,7 +970,6 @@
TypeInfo_for_T = TypeInfo;
").
-
% Test whether a type info is variable.
:- pred typeinfo_is_variable(T::in, int::out) is semidet.
@@ -994,7 +985,6 @@
}
").
-
% Tests for universal and existentially quantified variables.
:- pred type_variable_is_univ_quant(int::in) is semidet.
@@ -1009,7 +999,6 @@
pseudotypeinfo_exist_var_base = 512.
pseudotypeinfo_max_var = 1024.
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
@@ -1088,7 +1077,6 @@
(MR_TypeInfo) TypeInfo);
").
-
:- pred same_pointer_value(T::in, T::in) is semidet.
:- pred same_pointer_value_untyped(T::in, U::in) is semidet.
@@ -1107,11 +1095,9 @@
SUCCESS_INDICATOR = (T1 == T2);
").
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-
:- func get_primary_tag(T) = int.
:- func get_remote_secondary_tag(T) = int.
@@ -1134,8 +1120,6 @@
Tag = (int) data[0];
").
-
-
:- type sectag_locn ---> none ; local ; remote ; variable.
:- type du_sectag_alternatives ---> du_sectag_alternatives(c_pointer).
@@ -1240,7 +1224,6 @@
").
-
:- func typeinfo_locns_index(int, exist_info) = typeinfo_locn.
typeinfo_locns_index(X::in, _::in) = (unsafe_cast(X)::out) :-
@@ -1255,7 +1238,6 @@
").
-
:- func exist_info_typeinfos_plain(exist_info) = int.
exist_info_typeinfos_plain(X::in) = (unsafe_cast(X)::out) :-
@@ -1280,10 +1262,6 @@
exist_info_field_nums.tcis];
").
-
-
-
-
:- func exist_arg_num(typeinfo_locn) = int.
exist_arg_num(X::in) = (unsafe_cast(X)::out) :-
@@ -1327,8 +1305,6 @@
Index, TypeInfo
`with_type` private_builtin__type_info(int)).
-
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1359,8 +1335,6 @@
NewTypeInfo = OldTypeInfo;
").
-
-
:- pred semidet_unimplemented(string::in) is semidet.
semidet_unimplemented(S) :-
( std_util__semidet_succeed ->
@@ -1428,8 +1402,6 @@
UnifyPred = (MR_Integer) tci->MR_type_ctor_compare_pred;
").
-
-
:- func type_ctor_rep(type_ctor_info) = type_ctor_rep.
:- pragma foreign_proc("C#",
type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
@@ -1448,7 +1420,6 @@
TypeCtorRep = MR_type_ctor_rep(tci);
").
-
:- func type_ctor_module_name(type_ctor_info) = string.
:- pragma foreign_proc("C#",
@@ -1468,8 +1439,6 @@
Name = (MR_String) MR_type_ctor_module_name(tci);
").
-
-
:- func type_ctor_name(type_ctor_info) = string.
:- pragma foreign_proc("C#",
@@ -1486,7 +1455,6 @@
MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
Name = (MR_String) MR_type_ctor_name(tci);
").
-
:- func type_layout(type_ctor_info) = type_layout.
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_construct.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_construct.c,v
retrieving revision 1.4
diff -u -b -r1.4 mercury_construct.c
--- runtime/mercury_construct.c 12 Apr 2002 01:24:22 -0000 1.4
+++ runtime/mercury_construct.c 11 May 2002 15:17:34 -0000
@@ -62,7 +62,7 @@
}
functor_desc = MR_type_ctor_functors(type_ctor_info).
- functors_du[functor_number];
+ MR_functors_du[functor_number];
construct_info->functor_info.du_functor_desc = functor_desc;
construct_info->functor_name = functor_desc->MR_du_functor_name;
construct_info->arity = functor_desc->MR_du_functor_orig_arity;
@@ -86,7 +86,7 @@
}
functor_desc = MR_type_ctor_functors(type_ctor_info).
- functors_enum[functor_number];
+ MR_functors_enum[functor_number];
construct_info->functor_info.enum_functor_desc = functor_desc;
construct_info->functor_name = functor_desc->MR_enum_functor_name;
construct_info->arity = 0;
@@ -107,7 +107,8 @@
"notag functor_number out of range");
}
- functor_desc = MR_type_ctor_functors(type_ctor_info).functors_notag;
+ functor_desc = MR_type_ctor_functors(type_ctor_info).
+ MR_functors_notag;
construct_info->functor_info.notag_functor_desc = functor_desc;
construct_info->functor_name = functor_desc->MR_notag_functor_name;
construct_info->arity = 1;
@@ -123,7 +124,7 @@
return MR_get_functor_info(
MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_equiv),
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv),
functor_number, construct_info);
case MR_TYPECTOR_REP_TUPLE:
@@ -158,6 +159,7 @@
case MR_TYPECTOR_REP_REDOIP:
case MR_TYPECTOR_REP_TRAIL_PTR:
case MR_TYPECTOR_REP_TICKET:
+ case MR_TYPECTOR_REP_FOREIGN:
return MR_FALSE;
case MR_TYPECTOR_REP_UNKNOWN:
@@ -288,7 +290,7 @@
case MR_TYPECTOR_REP_EQUIV:
functors = MR_get_num_functors(
MR_create_type_info((MR_TypeInfo *) type_info,
- MR_type_ctor_layout(type_ctor_info).layout_equiv));
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv));
break;
case MR_TYPECTOR_REP_INT:
@@ -314,6 +316,7 @@
case MR_TYPECTOR_REP_REDOIP:
case MR_TYPECTOR_REP_TRAIL_PTR:
case MR_TYPECTOR_REP_TICKET:
+ case MR_TYPECTOR_REP_FOREIGN:
functors = -1;
break;
Index: runtime/mercury_deconstruct.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deconstruct.c,v
retrieving revision 1.10
diff -u -b -r1.10 mercury_deconstruct.c
--- runtime/mercury_deconstruct.c 12 Apr 2002 01:24:23 -0000 1.10
+++ runtime/mercury_deconstruct.c 5 May 2002 05:23:09 -0000
@@ -145,7 +145,7 @@
MR_ReservedAddrTypeLayout ra_layout;
ra_layout = MR_type_ctor_layout(type_ctor_info).
- layout_reserved_addr;
+ MR_layout_reserved_addr;
data = *term_ptr;
/*
@@ -184,7 +184,7 @@
case MR_TYPECTOR_REP_DU_USEREQ:
case MR_TYPECTOR_REP_DU:
data = *term_ptr;
- du_type_layout = MR_type_ctor_layout(type_ctor_info).layout_du;
+ du_type_layout = MR_type_ctor_layout(type_ctor_info).MR_layout_du;
/* fall through */
/*
@@ -233,13 +233,13 @@
case MR_TYPECTOR_REP_EQUIV:
eqv_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_equiv);
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
return MR_named_arg_num(eqv_type_info, term_ptr, arg_name,
arg_num_ptr);
case MR_TYPECTOR_REP_EQUIV_GROUND:
eqv_type_info = MR_pseudo_type_info_is_ground(
- MR_type_ctor_layout(type_ctor_info).layout_equiv);
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
return MR_named_arg_num(eqv_type_info, term_ptr, arg_name,
arg_num_ptr);
@@ -248,7 +248,7 @@
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
notag_functor_desc = MR_type_ctor_functors(type_ctor_info).
- functors_notag;
+ MR_functors_notag;
if (notag_functor_desc->MR_notag_functor_arg_name != NULL
&& MR_streq(arg_name,
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.53
diff -u -b -r1.53 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 12 Apr 2002 01:24:23 -0000 1.53
+++ runtime/mercury_deep_copy_body.h 5 May 2002 05:19:59 -0000
@@ -61,7 +61,7 @@
MR_ReservedAddrTypeLayout ra_layout;
ra_layout =
- MR_type_ctor_layout(type_ctor_info).layout_reserved_addr;
+ MR_type_ctor_layout(type_ctor_info).MR_layout_reserved_addr;
/*
** First check if this value is one of
@@ -96,7 +96,7 @@
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
- du_type_layout = MR_type_ctor_layout(type_ctor_info).layout_du;
+ du_type_layout = MR_type_ctor_layout(type_ctor_info).MR_layout_du;
/* fallthru */
/*
@@ -270,14 +270,14 @@
case MR_TYPECTOR_REP_NOTAG_USEREQ:
new_data = copy_arg(NULL, data_ptr, NULL,
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_notag->
+ MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
MR_notag_functor_arg_type, lower_limit, upper_limit);
break;
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
type_info = MR_pseudo_type_info_is_ground(
- MR_type_ctor_layout(type_ctor_info).layout_notag
+ MR_type_ctor_layout(type_ctor_info).MR_layout_notag
->MR_notag_functor_arg_type);
goto try_again;
break;
@@ -285,13 +285,13 @@
case MR_TYPECTOR_REP_EQUIV:
new_data = copy_arg(NULL, data_ptr, NULL,
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_equiv,
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv,
lower_limit, upper_limit);
break;
case MR_TYPECTOR_REP_EQUIV_GROUND:
type_info = MR_pseudo_type_info_is_ground(
- MR_type_ctor_layout(type_ctor_info).layout_equiv);
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
goto try_again;
break;
Index: runtime/mercury_mcpp.cpp
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_mcpp.cpp,v
retrieving revision 1.13
diff -u -b -r1.13 mercury_mcpp.cpp
--- runtime/mercury_mcpp.cpp 27 Mar 2002 05:18:49 -0000 1.13
+++ runtime/mercury_mcpp.cpp 11 May 2002 14:47:07 -0000
@@ -162,7 +162,8 @@
static int MR_TYPECTOR_REP_BASETYPECLASSINFO =34;
static int MR_TYPECTOR_REP_TYPEDESC =35;
static int MR_TYPECTOR_REP_TYPECTORDESC =36;
- static int MR_TYPECTOR_REP_UNKNOWN =37;
+ static int MR_TYPECTOR_REP_FOREIGN =37;
+ static int MR_TYPECTOR_REP_UNKNOWN =38;
static int MR_SECTAG_NONE = 0;
static int MR_SECTAG_LOCAL = 1;
Index: runtime/mercury_mcpp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_mcpp.h,v
retrieving revision 1.20
diff -u -b -r1.20 mercury_mcpp.h
--- runtime/mercury_mcpp.h 24 Apr 2002 07:37:38 -0000 1.20
+++ runtime/mercury_mcpp.h 11 May 2002 14:47:25 -0000
@@ -163,7 +163,8 @@
#define MR_TYPECTOR_REP_BASETYPECLASSINFO_val 34
#define MR_TYPECTOR_REP_TYPEDESC_val 35
#define MR_TYPECTOR_REP_TYPECTORDESC_val 36
-#define MR_TYPECTOR_REP_UNKNOWN_val 37
+#define MR_TYPECTOR_REP_FOREIGN_val 37
+#define MR_TYPECTOR_REP_UNKNOWN_val 38
// XXX we should integrate this macro in with the version in
// mercury_typeinfo.h
Index: runtime/mercury_ml_expand_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_expand_body.h,v
retrieving revision 1.21
diff -u -b -r1.21 mercury_ml_expand_body.h
--- runtime/mercury_ml_expand_body.h 12 Apr 2002 01:24:23 -0000 1.21
+++ runtime/mercury_ml_expand_body.h 11 May 2002 15:18:53 -0000
@@ -284,7 +284,7 @@
case MR_TYPECTOR_REP_ENUM:
handle_functor_name(MR_type_ctor_layout(type_ctor_info).
- layout_enum[*data_word_ptr]->MR_enum_functor_name);
+ MR_layout_enum[*data_word_ptr]->MR_enum_functor_name);
handle_zero_arity_args();
break;
@@ -307,7 +307,8 @@
MR_Word data;
MR_ReservedAddrTypeLayout ra_layout;
- ra_layout = MR_type_ctor_layout(type_ctor_info).layout_reserved_addr;
+ ra_layout = MR_type_ctor_layout(type_ctor_info).
+ MR_layout_reserved_addr;
data = *data_word_ptr;
/*
@@ -363,7 +364,7 @@
/* else fall through */
case MR_TYPECTOR_REP_DU:
- du_type_layout = MR_type_ctor_layout(type_ctor_info).layout_du;
+ du_type_layout = MR_type_ctor_layout(type_ctor_info).MR_layout_du;
/* fall through */
/*
@@ -522,7 +523,7 @@
case MR_TYPECTOR_REP_NOTAG:
expand_info->arity = 1;
handle_functor_name(MR_type_ctor_layout(type_ctor_info).
- layout_notag->MR_notag_functor_name);
+ MR_layout_notag->MR_notag_functor_name);
#ifdef EXPAND_ARGS_FIELD
expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
@@ -533,16 +534,16 @@
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[0] =
MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_notag->
+ MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
MR_notag_functor_arg_type);
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_ONE_ARG
#ifdef EXPAND_NAMED_ARG
- if (MR_type_ctor_layout(type_ctor_info).layout_notag
+ if (MR_type_ctor_layout(type_ctor_info).MR_layout_notag
->MR_notag_functor_arg_name != NULL
&& MR_streq(chosen_name, MR_type_ctor_layout(type_ctor_info).
- layout_notag->MR_notag_functor_arg_name))
+ MR_layout_notag->MR_notag_functor_arg_name))
{
chosen = 0;
}
@@ -554,7 +555,7 @@
expand_info->chosen_type_info =
MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_notag->
+ MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
MR_notag_functor_arg_type);
} else {
expand_info->chosen_index_exists = MR_FALSE;
@@ -578,7 +579,7 @@
case MR_TYPECTOR_REP_NOTAG_GROUND:
expand_info->arity = 1;
handle_functor_name(MR_type_ctor_layout(type_ctor_info).
- layout_notag->MR_notag_functor_name);
+ MR_layout_notag->MR_notag_functor_name);
#ifdef EXPAND_ARGS_FIELD
expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
@@ -588,16 +589,16 @@
MR_GC_NEW_ARRAY(MR_TypeInfo, 1);
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[0] =
MR_pseudo_type_info_is_ground(
- MR_type_ctor_layout(type_ctor_info).layout_notag->
+ MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
MR_notag_functor_arg_type);
#endif /* EXPAND_ARGS_FIELD */
#ifdef EXPAND_ONE_ARG
#ifdef EXPAND_NAMED_ARG
- if (MR_type_ctor_layout(type_ctor_info).layout_notag
+ if (MR_type_ctor_layout(type_ctor_info).MR_layout_notag
->MR_notag_functor_arg_name != NULL
&& MR_streq(chosen_name, MR_type_ctor_layout(type_ctor_info).
- layout_notag->MR_notag_functor_arg_name))
+ MR_layout_notag->MR_notag_functor_arg_name))
{
chosen = 0;
}
@@ -608,7 +609,7 @@
expand_info->chosen_value_ptr = data_word_ptr;
expand_info->chosen_type_info =
MR_pseudo_type_info_is_ground(
- MR_type_ctor_layout(type_ctor_info).layout_notag
+ MR_type_ctor_layout(type_ctor_info).MR_layout_notag
->MR_notag_functor_arg_type);
} else {
expand_info->chosen_index_exists = MR_FALSE;
@@ -622,7 +623,7 @@
eqv_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_equiv);
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
EXPAND_FUNCTION_NAME(eqv_type_info, data_word_ptr, noncanon,
EXTRA_ARGS expand_info);
}
@@ -630,7 +631,7 @@
case MR_TYPECTOR_REP_EQUIV_GROUND:
EXPAND_FUNCTION_NAME(MR_pseudo_type_info_is_ground(
- MR_type_ctor_layout(type_ctor_info).layout_equiv),
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv),
data_word_ptr, noncanon, EXTRA_ARGS expand_info);
break;
@@ -1144,6 +1145,11 @@
case MR_TYPECTOR_REP_TICKET:
handle_functor_name("<<ticket>>");
+ handle_zero_arity_args();
+ break;
+
+ case MR_TYPECTOR_REP_FOREIGN:
+ handle_functor_name("<<foreign>>");
handle_zero_arity_args();
break;
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.51
diff -u -b -r1.51 mercury_tabling.c
--- runtime/mercury_tabling.c 12 Apr 2002 01:24:23 -0000 1.51
+++ runtime/mercury_tabling.c 11 May 2002 15:18:29 -0000
@@ -645,7 +645,8 @@
{
int i;
MR_ReservedAddrTypeLayout ra_layout =
- MR_type_ctor_layout(type_ctor_info).layout_reserved_addr;
+ MR_type_ctor_layout(type_ctor_info).
+ MR_layout_reserved_addr;
/*
** First check if this value is one of
@@ -687,7 +688,7 @@
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
- du_type_layout = MR_type_ctor_layout(type_ctor_info).layout_du;
+ du_type_layout = MR_type_ctor_layout(type_ctor_info).MR_layout_du;
/* fall through */
/*
@@ -793,7 +794,7 @@
eqv_type_info = MR_make_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_notag->
+ MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
MR_notag_functor_arg_type, &allocated_memory_cells);
MR_DEBUG_TABLE_ANY(table, eqv_type_info, data);
MR_deallocate(allocated_memory_cells);
@@ -803,7 +804,7 @@
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
MR_DEBUG_TABLE_ANY(table, MR_pseudo_type_info_is_ground(
- MR_type_ctor_layout(type_ctor_info).layout_notag->
+ MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
MR_notag_functor_arg_type), data);
break;
@@ -814,7 +815,7 @@
eqv_type_info = MR_make_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_equiv,
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv,
&allocated_memory_cells);
MR_DEBUG_TABLE_ANY(table, eqv_type_info, data);
MR_deallocate(allocated_memory_cells);
@@ -823,7 +824,7 @@
case MR_TYPECTOR_REP_EQUIV_GROUND:
MR_DEBUG_TABLE_ANY(table, MR_pseudo_type_info_is_ground(
- MR_type_ctor_layout(type_ctor_info).layout_equiv), data);
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv), data);
break;
case MR_TYPECTOR_REP_INT:
@@ -975,6 +976,10 @@
case MR_TYPECTOR_REP_TICKET:
MR_fatal_error("Attempt to table a saved ticket");
+ break;
+
+ case MR_TYPECTOR_REP_FOREIGN:
+ MR_fatal_error("Attempt to table a value of a foreign type");
break;
case MR_TYPECTOR_REP_UNKNOWN: /* fallthru */
Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.51
diff -u -b -r1.51 mercury_type_info.c
--- runtime/mercury_type_info.c 12 Apr 2002 01:24:24 -0000 1.51
+++ runtime/mercury_type_info.c 5 May 2002 05:22:17 -0000
@@ -370,7 +370,7 @@
maybe_equiv_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(
maybe_equiv_type_info),
- MR_type_ctor_layout(type_ctor_info).layout_equiv);
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(
maybe_equiv_type_info);
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.91
diff -u -b -r1.91 mercury_type_info.h
--- runtime/mercury_type_info.h 8 May 2002 09:33:21 -0000 1.91
+++ runtime/mercury_type_info.h 11 May 2002 14:46:47 -0000
@@ -509,6 +509,7 @@
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_BASETYPECLASSINFO),
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_TYPEDESC),
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_TYPECTORDESC),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_FOREIGN),
/*
** MR_TYPECTOR_REP_UNKNOWN should remain the last alternative;
** MR_TYPE_CTOR_STATS depends on this.
@@ -571,6 +572,7 @@
"RESERVED_ADDR_USEREQ", \
"TYPECTORINFO", \
"BASETYPECLASSINFO", \
+ "FOREIGN", \
"UNKNOWN"
#define MR_type_ctor_rep_is_basically_du(rep) \
@@ -908,24 +910,42 @@
*/
typedef union {
- void *layout_init;
- MR_DuTypeLayout layout_du;
- MR_EnumTypeLayout layout_enum;
- MR_NotagTypeLayout layout_notag;
- MR_ReservedAddrTypeLayout layout_reserved_addr;
- MR_EquivLayout layout_equiv;
+ void *MR_layout_init;
+ MR_DuTypeLayout MR_layout_du;
+ MR_EnumTypeLayout MR_layout_enum;
+ MR_NotagTypeLayout MR_layout_notag;
+ MR_ReservedAddrTypeLayout MR_layout_reserved_addr;
+ MR_EquivLayout MR_layout_equiv;
} MR_TypeLayout;
/*---------------------------------------------------------------------------*/
+typedef union {
+ MR_DuFunctorDesc *MR_maybe_res_du_ptr;
+ MR_ReservedAddrFunctorDesc *MR_maybe_res_res_ptr;
+} MR_MaybeResFunctorDescPtr;
+
+typedef struct {
+ MR_ConstString MR_maybe_res_name;
+ MR_Integer MR_maybe_res_arity;
+ MR_bool MR_maybe_res_is_res;
+ MR_MaybeResFunctorDescPtr MR_maybe_res_ptr;
+} MR_MaybeResAddrFunctorDesc;
+
+#define MR_maybe_res_du MR_maybe_res_ptr.MR_maybe_res_du_ptr
+#define MR_maybe_res_res MR_maybe_res_ptr.MR_maybe_res_res_ptr
+
/*
** This type describes the function symbols in any kind of discriminated union
-** type: du, enum and notag.
+** type: du, reserved_addr, enum and notag.
**
-** The pointer points to an array of pointers to functor descriptors.
-** There is one pointer for each function symbol, and thus the size of
-** the array is given by the num_alternatives field of the type_ctor_info.
-** The array is ordered on the name of the function symbol, and then on arity.
+** The pointer in the union points to either an array of pointers to functor
+** descriptors (for du and enum types), to an array of functor descriptors
+** (for reserved_addr types) or to a single functor descriptor (for notag
+** types). There is one functor descriptor for each function symbol, and thus
+** the size of the array is given by the num_functors field of the
+** type_ctor_info. Arrays are ordered on the name of the function symbol,
+** and then on arity.
**
** The intention is that if you have a function symbol you want to represent,
** you can do binary search on the array for the symbol name and arity.
@@ -935,10 +955,11 @@
*/
typedef union {
- void *functors_init;
- MR_DuFunctorDesc **functors_du;
- MR_EnumFunctorDesc **functors_enum;
- MR_NotagFunctorDesc *functors_notag;
+ void *MR_functors_init;
+ MR_DuFunctorDesc **MR_functors_du;
+ MR_MaybeResAddrFunctorDesc *MR_functors_res;
+ MR_EnumFunctorDesc **MR_functors_enum;
+ MR_NotagFunctorDesc *MR_functors_notag;
} MR_TypeFunctors;
/*---------------------------------------------------------------------------*/
Index: runtime/mercury_unify_compare_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_unify_compare_body.h,v
retrieving revision 1.25
diff -u -b -r1.25 mercury_unify_compare_body.h
--- runtime/mercury_unify_compare_body.h 15 May 2002 09:00:52 -0000 1.25
+++ runtime/mercury_unify_compare_body.h 15 May 2002 09:17:11 -0000
@@ -62,13 +62,13 @@
MR_save_transient_hp();
type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_equiv);
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
MR_restore_transient_hp();
goto start_label;
case MR_TYPECTOR_REP_EQUIV_GROUND:
type_info = (MR_TypeInfo)
- MR_type_ctor_layout(type_ctor_info).layout_equiv;
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv;
goto start_label;
#ifdef include_compare_rep_code
@@ -79,7 +79,7 @@
MR_save_transient_hp();
type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).layout_notag->
+ MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
MR_notag_functor_arg_type);
MR_restore_transient_hp();
goto start_label;
@@ -90,7 +90,7 @@
#endif
case MR_TYPECTOR_REP_NOTAG_GROUND:
type_info = (MR_TypeInfo) MR_type_ctor_layout(type_ctor_info).
- layout_notag->MR_notag_functor_arg_type;
+ MR_layout_notag->MR_notag_functor_arg_type;
goto start_label;
#ifdef include_compare_rep_code
@@ -144,7 +144,7 @@
\
ptag = MR_tag(data); \
ptaglayout = &MR_type_ctor_layout(type_ctor_info). \
- layout_du[ptag]; \
+ MR_layout_du[ptag]; \
data_value = (MR_Word *) MR_body(data, ptag); \
\
switch (ptaglayout->MR_sectag_locn) { \
@@ -192,7 +192,7 @@
}
ptaglayout = &MR_type_ctor_layout(type_ctor_info).
- layout_du[x_ptag];
+ MR_layout_du[x_ptag];
x_data_value = (MR_Word *) MR_body(x, x_ptag);
y_data_value = (MR_Word *) MR_body(y, y_ptag);
@@ -721,6 +721,9 @@
case MR_TYPECTOR_REP_BASETYPECLASSINFO:
MR_fatal_error(attempt_msg "base_typeclass_infos");
+
+ case MR_TYPECTOR_REP_FOREIGN:
+ MR_fatal_error(attempt_msg "terms of a foreign type");
case MR_TYPECTOR_REP_UNKNOWN:
MR_fatal_error(attempt_msg "terms of unknown type");
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list