[m-dev.] for review: cleanup of type_ctor_infos, part 2
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Feb 25 16:10:13 AEDT 2000
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.98
diff -u -b -r1.98 opt_debug.m
--- compiler/opt_debug.m 2000/01/14 01:10:35 1.98
+++ compiler/opt_debug.m 2000/02/21 10:34:44
@@ -15,7 +15,7 @@
:- interface.
:- import_module vn_type, vn_table, livemap.
-:- import_module llds, builtin_ops, atsort.
+:- import_module llds, rtti, builtin_ops, atsort.
:- import_module io, bool, list, assoc_list, std_util.
@@ -136,9 +136,18 @@
:- pred opt_debug__dump_const(rval_const, string).
:- mode opt_debug__dump_const(in, out) is det.
+:- pred opt_debug__dump_data_addr(data_addr, string).
+:- mode opt_debug__dump_data_addr(in, out) is det.
+
:- pred opt_debug__dump_data_name(data_name, string).
:- mode opt_debug__dump_data_name(in, out) is det.
+:- pred opt_debug__dump_rtti_type_id(rtti_type_id, string).
+:- mode opt_debug__dump_rtti_type_id(in, out) is det.
+
+:- pred opt_debug__dump_rtti_name(rtti_name, string).
+:- mode opt_debug__dump_rtti_name(in, out) is det.
+
:- pred opt_debug__dump_unop(unary_op, string).
:- mode opt_debug__dump_unop(in, out) is det.
@@ -700,19 +709,28 @@
opt_debug__dump_const(code_addr_const(CodeAddr), Str) :-
opt_debug__dump_code_addr(CodeAddr, C_str),
string__append_list(["code_addr_const(", C_str, ")"], Str).
-opt_debug__dump_const(data_addr_const(data_addr(BaseName, VarName)), Str) :-
- opt_debug__dump_data_name(VarName, N_str),
- prog_out__sym_name_to_string(BaseName, BaseName_str),
+opt_debug__dump_const(data_addr_const(DataAddr), Str) :-
+ opt_debug__dump_data_addr(DataAddr, DataAddr_str),
string__append_list(
- ["data_addr_const(", BaseName_str, ", ", N_str, ")"], Str).
+ ["data_addr_const(", DataAddr_str, ")"], Str).
opt_debug__dump_const(label_entry(Label), Str) :-
opt_debug__dump_label(Label, LabelStr),
string__append_list(["label_entry(", LabelStr, ")"], Str).
+
+opt_debug__dump_data_addr(data_addr(ModuleName, DataName), Str) :-
+ prog_out__sym_name_to_string(ModuleName, ModuleName_str),
+ opt_debug__dump_data_name(DataName, DataName_str),
+ string__append_list(
+ ["data_addr(", ModuleName_str, ", ", DataName_str, ")"], Str).
+opt_debug__dump_data_addr(rtti_addr(RttiTypeId, DataName), Str) :-
+ opt_debug__dump_rtti_type_id(RttiTypeId, RttiTypeId_str),
+ opt_debug__dump_rtti_name(DataName, DataName_str),
+ string__append_list(
+ ["rtti_addr(", RttiTypeId_str, ", ", DataName_str, ")"], Str).
+
opt_debug__dump_data_name(common(N), Str) :-
string__int_to_string(N, N_str),
string__append("common", N_str, Str).
-opt_debug__dump_data_name(type_ctor(BaseData, TypeName, TypeArity), Str) :-
- llds_out__make_type_ctor_name(BaseData, TypeName, TypeArity, Str).
opt_debug__dump_data_name(base_typeclass_info(ClassId, InstanceNum), Str) :-
llds_out__make_base_typeclass_info_name(ClassId, InstanceNum, Str).
opt_debug__dump_data_name(module_layout, "module_layout").
@@ -725,6 +743,49 @@
opt_debug__dump_data_name(tabling_pointer(ProcLabel), Str) :-
opt_debug__dump_proclabel(ProcLabel, ProcLabelStr),
string__append_list(["tabling_pointer(", ProcLabelStr, ")"], Str).
+
+opt_debug__dump_rtti_type_id(rtti_type_id(ModuleName, TypeName, Arity), Str) :-
+ llds_out__sym_name_mangle(ModuleName, ModuleName_str),
+ llds_out__name_mangle(TypeName, TypeName_str),
+ string__int_to_string(Arity, Arity_str),
+ string__append_list(["rtti_type_id(", ModuleName_str, ", ",
+ TypeName_str, Arity_str, ")"], Str).
+
+opt_debug__dump_rtti_name(exist_locns(Ordinal), Str) :-
+ string__int_to_string(Ordinal, Ordinal_str),
+ string__append("exist_locns_", Ordinal_str, Str).
+opt_debug__dump_rtti_name(exist_info(Ordinal), Str) :-
+ string__int_to_string(Ordinal, Ordinal_str),
+ string__append("exist_info_", Ordinal_str, Str).
+opt_debug__dump_rtti_name(field_names(Ordinal), Str) :-
+ string__int_to_string(Ordinal, Ordinal_str),
+ string__append("field_names_", Ordinal_str, Str).
+opt_debug__dump_rtti_name(enum_functor_desc(Ordinal), Str) :-
+ string__int_to_string(Ordinal, Ordinal_str),
+ string__append("enum_functor_desc_", Ordinal_str, Str).
+opt_debug__dump_rtti_name(notag_functor_desc, Str) :-
+ Str = "notag_functor_desc_".
+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(enum_name_ordered_table, Str) :-
+ Str = "enum_name_ordered_table".
+opt_debug__dump_rtti_name(enum_value_ordered_table, Str) :-
+ Str = "enum_value_ordered_table".
+opt_debug__dump_rtti_name(du_name_ordered_table, Str) :-
+ Str = "du_name_ordered_table".
+opt_debug__dump_rtti_name(du_stag_ordered_table(Ptag), Str) :-
+ string__int_to_string(Ptag, Ptag_str),
+ string__append("du_stag_ordered_table_", Ptag_str, Str).
+opt_debug__dump_rtti_name(du_ptag_layout(Ptag), Str) :-
+ string__int_to_string(Ptag, Ptag_str),
+ string__append("du_ptag_layout_", Ptag_str, Str).
+opt_debug__dump_rtti_name(du_ptag_ordered_table, Str) :-
+ Str = "du_ptag_ordered_table".
+opt_debug__dump_rtti_name(type_ctor_info, Str) :-
+ Str = "type_ctor_info".
+opt_debug__dump_rtti_name(type_hashcons_pointer, Str) :-
+ Str = "type_hashcons_pointer".
opt_debug__dump_unop(mktag, "mktag").
opt_debug__dump_unop(tag, "tag").
Index: compiler/rtti.m
===================================================================
RCS file: rtti.m
diff -N rtti.m
--- /dev/null Thu Sep 2 15:00:04 1999
+++ rtti.m Tue Feb 22 14:12:39 2000
@@ -0,0 +1,560 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Definitions of data structures for representing run-time type information
+% within the compiler.
+%
+% Eventually, this module will be independent of whether we are compiling
+% to LLDS or MLDS. For the time being, it depends on LLDS.
+%
+% Author: zs.
+
+%-----------------------------------------------------------------------------%
+
+:- module rtti.
+
+:- interface.
+
+:- import_module llds, prog_data.
+:- import_module bool, list, std_util.
+
+:- type sectag_locn
+ ---> sectag_none
+ ; sectag_local
+ ; sectag_remote.
+
+:- type equality_axioms
+ ---> standard
+ ; user_defined.
+
+ % 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)
+ ; notag(equality_axioms)
+ ; equiv
+ ; unknown.
+
+:- type type_ctor_layout_info
+ ---> enum_layout(
+ rtti_name
+ )
+ ; notag_layout(
+ rtti_name
+ )
+ ; du_layout(
+ rtti_name
+ )
+ ; equiv_layout(
+ rval
+ )
+ ; no_layout.
+
+:- type type_ctor_functors_info
+ ---> enum_functors(
+ rtti_name
+ )
+ ; notag_functors(
+ rtti_name
+ )
+ ; du_functors(
+ rtti_name
+ )
+ ; no_functors.
+
+:- type exist_typeinfo_locn
+ ---> plain_typeinfo(
+ int % The typeinfo is stored
+ % directly in the cell, at this
+ % offset.
+ )
+ ; typeinfo_in_tci(
+ int, % The typeinfo is stored
+ % indirectly in the typeclass
+ % info stored at this offset
+ % in the cell.
+ int % To find the typeinfo inside
+ % the typeclass info structure,
+ % give this integer to the
+ % MR_typeclass_info_type_info
+ % macro.
+ ).
+
+:- type rtti_type_id
+ ---> rtti_type_id(
+ module_name, % module name
+ string, % type ctor's name
+ arity % type ctor's arity
+ ).
+
+ % Global data generated by the compiler. Usually readonly,
+ % with one exception: data containing code addresses must
+ % be initialized.
+:- type rtti_data
+ ---> exist_locns(
+ rtti_type_id, % identifies the type
+ int, % identifies functor in type
+
+ % The remaining argument of this function symbol
+ % corresponds to an array of MR_ExistTypeInfoLocns.
+
+ list(exist_typeinfo_locn)
+ )
+ ; exist_info(
+ rtti_type_id, % 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_id, % identifies the type
+ int, % identifies functor in type
+
+ list(maybe(string)) % gives the field names
+ )
+ ; enum_functor_desc(
+ rtti_type_id, % 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_id, % identifies the type
+
+ % The remaining arguments of this function symbol
+ % correspond one-to-one to the fields of
+ % MR_NotagFunctorDesc.
+
+ string, % functor name
+ rval % pseudo typeinfo of argument
+ )
+ ; du_functor_desc(
+ rtti_type_id, % identifies the type
+
+ % The remaining arguments of this function symbol
+ % correspond one-to-one to the fields of
+ % MR_DuFunctorDesc.
+
+ 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 arity
+ rval, % a vector of length arity
+ % containing the pseudo
+ % typeinfos of the arguments
+ maybe(rtti_name), % possibly a vector of length
+ % arity containing the names
+ % of the arguments, if any
+ maybe(rtti_name) % information about the
+ % existentially quantified
+ % type variables, if any
+ )
+ ; enum_name_ordered_table(
+ rtti_type_id, % 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_id, % identifies the type
+
+ % The remaining argument of this function symbol
+ % corresponds to the MR_EnumTypeLayout C type.
+
+ list(rtti_name)
+ )
+ ; du_name_ordered_table(
+ rtti_type_id, % 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_id, % 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_layout(
+ rtti_type_id, % identifies the type
+ int, % primary tag value
+
+ % The rest of the arguments of this function symbol
+ % correspond one-to-one to the fields of the
+ % MR_DuPtagTypeLayout C type.
+
+ 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
+ )
+ ; du_ptag_ordered_table(
+ rtti_type_id, % identifies the type
+
+ % The remaining argument of this function symbol
+ % corresponds to the elements of the MR_DuTypeLayout
+ % C type. A `no' represents a NULL pointer.
+
+ list(maybe(rtti_name))
+ )
+ ; type_ctor_info(
+ % The arguments of this function symbol correspond
+ % one-to-one to the fields of the MR_TypeCtorInfo
+ % C type.
+
+ rtti_type_id, % identifies the type
+ maybe(code_addr), % unify
+ maybe(code_addr), % index
+ maybe(code_addr), % compare
+ type_ctor_rep,
+ maybe(code_addr), % solver
+ maybe(code_addr), % init
+ int, % RTTI version number
+ 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(code_addr) % prettyprinter
+ ).
+
+:- type rtti_name
+ ---> exist_locns(int) % functor ordinal
+ ; exist_info(int) % functor ordinal
+ ; field_names(int) % functor ordinal
+ ; enum_functor_desc(int) % functor ordinal
+ ; notag_functor_desc
+ ; du_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_layout(int) % primary tag
+ ; du_ptag_ordered_table
+ ; type_ctor_info
+ ; type_hashcons_pointer.
+
+ % Create a C variable name for a record of the locations of the
+ % typeinfos for a functor's existentially typed arguments.
+
+:- pred rtti__make_exist_locns_name(rtti_type_id::in, int::in,
+ string::out) is det.
+
+ % Create a C variable name for a summary record of a functor's
+ % existentially typed arguments.
+
+:- pred rtti__make_exist_info_name(rtti_type_id::in, int::in,
+ string::out) is det.
+
+ % Create a C variable name for the array listing the names
+ % of the fields of a function symbol.
+
+:- pred rtti__make_field_names_name(rtti_type_id::in, int::in,
+ string::out) is det.
+
+ % Create a C variable name for an enum functor descriptor.
+
+:- pred rtti__make_enum_functor_desc_name(rtti_type_id::in, int::in,
+ string::out) is det.
+
+ % Create a C variable name for a notag functor descriptor.
+
+:- pred rtti__make_notag_functor_desc_name(rtti_type_id::in,
+ string::out) is det.
+
+ % Create a C variable name for a du functor descriptor.
+
+:- pred rtti__make_du_functor_desc_name(rtti_type_id::in, int::in,
+ string::out) is det.
+
+ % Create a C variable name for a list of enum functor descriptors
+ % ordered on name.
+
+:- pred rtti__make_enum_name_ordered_table_name(rtti_type_id::in,
+ string::out) is det.
+
+ % Create C variable a name for a list of enum functor descriptors
+ % ordered on value.
+
+:- pred rtti__make_enum_value_ordered_table_name(rtti_type_id::in,
+ string::out) is det.
+
+ % Create a C variable name for a list of du functor descriptors
+ % ordered on name.
+
+:- pred rtti__make_du_name_ordered_table_name(rtti_type_id::in,
+ string::out) is det.
+
+ % Create C variable a name for a list of du functor descriptors
+ % sharing a primary tag ordered on value.
+
+:- pred rtti__make_du_stag_ordered_table_name(rtti_type_id::in,
+ int::in, string::out) is det.
+
+ % Create C variable a name for a list of du_ptag_layouts.
+
+:- pred rtti__make_du_ptag_ordered_table_name(rtti_type_id::in,
+ string::out) is det.
+
+ % Create a C variable name for a du_ptag_layout
+
+:- pred rtti__make_du_ptag_layout_name(rtti_type_id::in, int::in,
+ string::out) is det.
+
+ % Create a C variable name for a type_ctor_info
+
+:- pred rtti__make_type_ctor_info_name(rtti_type_id::in,
+ string::out) is det.
+
+ % Create a C variable name for a hashcons pointer
+
+:- pred rtti__make_type_hashcons_pointer_name(rtti_type_id::in,
+ string::out) is det.
+
+:- pred rtti_addr_to_string(rtti_type_id::in, rtti_name::in, string::out)
+ is det.
+
+:- pred rtti__sectag_locn_to_string(sectag_locn::in, string::out) is det.
+
+:- pred rtti__type_ctor_rep_to_string(type_ctor_rep::in, string::out) is det.
+
+:- pred rtti__name_would_include_code_address(rtti_name::in, bool::out) is det.
+
+:- implementation.
+
+:- import_module llds_out.
+:- import_module string.
+
+rtti__make_exist_locns_name(RttiTypeId, Ordinal, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__int_to_string(Ordinal, O_str),
+ string__append_list([ModuleName, "__exist_locns_", TypeName,
+ "_", A_str, "_", O_str], Str).
+
+rtti__make_exist_info_name(RttiTypeId, Ordinal, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__int_to_string(Ordinal, O_str),
+ string__append_list([ModuleName, "__exist_info_", TypeName,
+ "_", A_str, "_", O_str], Str).
+
+rtti__make_field_names_name(RttiTypeId, Ordinal, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__int_to_string(Ordinal, O_str),
+ string__append_list([ModuleName, "__field_names_", TypeName,
+ "_", A_str, "_", O_str], Str).
+
+rtti__make_enum_functor_desc_name(RttiTypeId, Ordinal, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__int_to_string(Ordinal, O_str),
+ string__append_list([ModuleName, "__enum_functor_desc_", TypeName,
+ "_", A_str, "_", O_str], Str).
+
+rtti__make_notag_functor_desc_name(RttiTypeId, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__append_list([ModuleName, "__notag_functor_desc_", TypeName,
+ "_", A_str], Str).
+
+rtti__make_du_functor_desc_name(RttiTypeId, Ordinal, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__int_to_string(Ordinal, O_str),
+ string__append_list([ModuleName, "__du_functor_desc_", TypeName,
+ "_", A_str, "_", O_str], Str).
+
+rtti__make_enum_name_ordered_table_name(RttiTypeId, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__append_list([ModuleName, "__enum_name_ordered_", TypeName,
+ "_", A_str], Str).
+
+rtti__make_enum_value_ordered_table_name(RttiTypeId, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__append_list([ModuleName, "__enum_value_ordered_", TypeName,
+ "_", A_str], Str).
+
+rtti__make_du_name_ordered_table_name(RttiTypeId, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__append_list([ModuleName, "__du_name_ordered_", TypeName,
+ "_", A_str], Str).
+
+rtti__make_du_stag_ordered_table_name(RttiTypeId, Ptag, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__int_to_string(Ptag, P_str),
+ string__append_list([ModuleName, "__du_stag_ordered_", TypeName,
+ "_", A_str, "_", P_str], Str).
+
+rtti__make_du_ptag_ordered_table_name(RttiTypeId, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__append_list([ModuleName, "__du_ptag_ordered_", TypeName,
+ "_", A_str], Str).
+
+rtti__make_du_ptag_layout_name(RttiTypeId, Ptag, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__int_to_string(Ptag, P_str),
+ string__append_list([ModuleName, "__du_ptag_layout_", TypeName,
+ "_", A_str, "_", P_str], Str).
+
+rtti__make_type_ctor_info_name(RttiTypeId, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__append_list([ModuleName, "__type_ctor_info_", TypeName,
+ "_", A_str], Str).
+
+rtti__make_type_hashcons_pointer_name(RttiTypeId, Str) :-
+ RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
+ llds_out__sym_name_mangle(ModuleName0, ModuleName),
+ llds_out__name_mangle(TypeName0, TypeName),
+ string__int_to_string(TypeArity, A_str),
+ string__append_list([ModuleName, "__hashcons_ptr_", TypeName,
+ "_", A_str], Str).
+
+rtti_addr_to_string(RttiTypeId, RttiName, Str) :-
+ (
+ RttiName = exist_locns(Ordinal),
+ rtti__make_exist_locns_name(RttiTypeId, Ordinal, Str)
+ ;
+ RttiName = exist_info(Ordinal),
+ rtti__make_exist_info_name(RttiTypeId, Ordinal, Str)
+ ;
+ RttiName = field_names(Ordinal),
+ rtti__make_field_names_name(RttiTypeId, Ordinal, Str)
+ ;
+ RttiName = enum_functor_desc(Ordinal),
+ rtti__make_enum_functor_desc_name(RttiTypeId, Ordinal, Str)
+ ;
+ RttiName = notag_functor_desc,
+ rtti__make_notag_functor_desc_name(RttiTypeId, Str)
+ ;
+ RttiName = du_functor_desc(Ordinal),
+ rtti__make_du_functor_desc_name(RttiTypeId, Ordinal, Str)
+ ;
+ RttiName = enum_name_ordered_table,
+ rtti__make_enum_name_ordered_table_name(RttiTypeId, Str)
+ ;
+ RttiName = enum_value_ordered_table,
+ rtti__make_enum_value_ordered_table_name(RttiTypeId, Str)
+ ;
+ RttiName = du_name_ordered_table,
+ rtti__make_du_name_ordered_table_name(RttiTypeId, Str)
+ ;
+ RttiName = du_stag_ordered_table(Ptag),
+ rtti__make_du_stag_ordered_table_name(RttiTypeId, Ptag,
+ Str)
+ ;
+ RttiName = du_ptag_layout(Ptag),
+ rtti__make_du_ptag_layout_name(RttiTypeId, Ptag, Str)
+ ;
+ RttiName = du_ptag_ordered_table,
+ rtti__make_du_ptag_ordered_table_name(RttiTypeId, Str)
+ ;
+ RttiName = type_ctor_info,
+ rtti__make_type_ctor_info_name(RttiTypeId, Str)
+ ;
+ RttiName = type_hashcons_pointer,
+ rtti__make_type_hashcons_pointer_name(RttiTypeId, Str)
+ ).
+
+rtti__sectag_locn_to_string(sectag_none, "MR_SECTAG_NONE").
+rtti__sectag_locn_to_string(sectag_local, "MR_SECTAG_LOCAL").
+rtti__sectag_locn_to_string(sectag_remote, "MR_SECTAG_REMOTE").
+
+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(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),
+ "MR_TYPECTOR_REP_NOTAG").
+rtti__type_ctor_rep_to_string(notag(user_defined),
+ "MR_TYPECTOR_REP_NOTAG_USEREQ").
+rtti__type_ctor_rep_to_string(equiv,
+ "MR_TYPECTOR_REP_EQUIV").
+rtti__type_ctor_rep_to_string(unknown,
+ "MR_TYPECTOR_REP_UNKNOWN").
+
+rtti__name_would_include_code_address(exist_locns(_), no).
+rtti__name_would_include_code_address(exist_info(_), no).
+rtti__name_would_include_code_address(field_names(_), no).
+rtti__name_would_include_code_address(enum_functor_desc(_), no).
+rtti__name_would_include_code_address(notag_functor_desc, no).
+rtti__name_would_include_code_address(du_functor_desc(_), no).
+rtti__name_would_include_code_address(enum_name_ordered_table, no).
+rtti__name_would_include_code_address(enum_value_ordered_table, no).
+rtti__name_would_include_code_address(du_name_ordered_table, no).
+rtti__name_would_include_code_address(du_stag_ordered_table(_), no).
+rtti__name_would_include_code_address(du_ptag_layout(_), no).
+rtti__name_would_include_code_address(du_ptag_ordered_table, no).
+rtti__name_would_include_code_address(type_ctor_info, yes).
+rtti__name_would_include_code_address(type_hashcons_pointer, no).
Index: compiler/rtti_out.m
===================================================================
RCS file: rtti_out.m
diff -N rtti_out.m
--- /dev/null Thu Sep 2 15:00:04 1999
+++ rtti_out.m Wed Feb 23 10:11:56 2000
@@ -0,0 +1,596 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Definitions of data structures for representing run-time type information
+% within the compiler, and code to output them.
+%
+% Eventually, this module will be independent of whether we are compiling
+% to LLDS or MLDS. For the time being, it depends on LLDS.
+%
+% Author: zs.
+
+%-----------------------------------------------------------------------------%
+
+:- module rtti_out.
+
+:- interface.
+
+:- import_module rtti, llds_util.
+:- import_module bool, io.
+
+:- pred output_rtti_data_decl(rtti_data::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+:- pred output_rtti_data_defn(rtti_data::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+:- pred rtti_out__init_rtti_data_if_nec(rtti_data::in,
+ io__state::di, io__state::uo) is det.
+
+:- pred output_rtti_addr(rtti_type_id::in, rtti_name::in,
+ io__state::di, io__state::uo) is det.
+
+:- pred output_rtti_addr_scope_type_name(rtti_type_id::in, rtti_name::in,
+ bool::in, io__state::di, io__state::uo) is det.
+
+:- pred rtti_data_to_name(rtti_data::in, rtti_type_id::out, rtti_name::out)
+ is det.
+
+:- pred rtti_name_linkage(rtti_name::in, linkage::out) is det.
+
+:- pred rtti_name_c_type(rtti_name::in, string::out, string::out) is det.
+
+:- implementation.
+
+:- import_module llds, llds_out, prog_out, options, globals.
+:- import_module string, list, require, std_util.
+
+%-----------------------------------------------------------------------------%
+
+output_rtti_data_defn(exist_locns(RttiTypeId, Ordinal, Locns),
+ DeclSet0, DeclSet) -->
+ output_generic_rtti_data_defn_start(RttiTypeId, exist_locns(Ordinal),
+ DeclSet0, DeclSet),
+ io__write_string(" = {\n"),
+ output_exist_locns(Locns),
+ io__write_string("};\n").
+output_rtti_data_defn(exist_info(RttiTypeId, Ordinal, Plain, InTci, Tci,
+ Locns), DeclSet0, DeclSet) -->
+ output_rtti_addr_decls(RttiTypeId, Locns, "", "", 0, _,
+ DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeId, 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),
+ io__write_string(",\n\t"),
+ output_rtti_addr(RttiTypeId, Locns),
+ io__write_string("\n};\n").
+output_rtti_data_defn(field_names(RttiTypeId, Ordinal, MaybeNames),
+ DeclSet0, DeclSet) -->
+ output_generic_rtti_data_defn_start(RttiTypeId, field_names(Ordinal),
+ DeclSet0, DeclSet),
+ io__write_string(" = {\n"),
+ output_maybe_strings(MaybeNames),
+ io__write_string("};\n").
+output_rtti_data_defn(enum_functor_desc(RttiTypeId, FunctorName, Ordinal),
+ DeclSet0, DeclSet) -->
+ output_generic_rtti_data_defn_start(RttiTypeId,
+ enum_functor_desc(Ordinal), DeclSet0, DeclSet),
+ io__write_string(" = {\n\t"""),
+ io__write_string(FunctorName),
+ io__write_string(""",\n\t"),
+ io__write_int(Ordinal),
+ io__write_string("\n};\n").
+output_rtti_data_defn(notag_functor_desc(RttiTypeId, FunctorName, ArgType),
+ DeclSet0, DeclSet) -->
+ output_rval_decls(ArgType, "", "", 0, _, DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeId, notag_functor_desc,
+ DeclSet1, DeclSet),
+ io__write_string(" = {\n\t"""),
+ io__write_string(FunctorName),
+ io__write_string(""",\n\t (MR_PseudoTypeInfo) "),
+ output_rval(ArgType),
+ io__write_string("\n};\n").
+output_rtti_data_defn(du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag,
+ Locn, Ordinal, Arity, ArgTypes, MaybeNames, MaybeExist),
+ DeclSet0, DeclSet) -->
+ output_rval_decls(ArgTypes, "", "", 0, _, DeclSet0, DeclSet1),
+ (
+ { MaybeNames = yes(NamesInfo1) },
+ output_rtti_addr_decls(RttiTypeId, NamesInfo1, "", "",
+ 0, _, DeclSet1, DeclSet2)
+ ;
+ { MaybeNames = no },
+ { DeclSet2 = DeclSet1 }
+ ),
+ (
+ { MaybeExist = yes(ExistInfo1) },
+ output_rtti_addr_decls(RttiTypeId, ExistInfo1, "", "",
+ 0, _, DeclSet2, DeclSet3)
+ ;
+ { MaybeExist = no },
+ { DeclSet3 = DeclSet2 }
+ ),
+ output_generic_rtti_data_defn_start(RttiTypeId,
+ du_functor_desc(Ordinal), DeclSet3, DeclSet),
+ io__write_string(" = {\n\t"""),
+ io__write_string(FunctorName),
+ io__write_string(""",\n\t"),
+ io__write_int(Ptag),
+ io__write_string(",\n\t"),
+ io__write_int(Stag),
+ io__write_string(",\n\t"),
+ { rtti__sectag_locn_to_string(Locn, LocnStr) },
+ io__write_string(LocnStr),
+ io__write_string(",\n\t"),
+ io__write_int(Ordinal),
+ io__write_string(",\n\t"),
+ io__write_int(Arity),
+ io__write_string(",\n\t(MR_PseudoTypeInfo *) "),
+ output_rval(ArgTypes),
+ io__write_string(",\n\t"),
+ (
+ { MaybeNames = yes(NamesInfo2) },
+ output_rtti_addr(RttiTypeId, NamesInfo2)
+ ;
+ { MaybeNames = no },
+ io__write_string("NULL")
+ ),
+ io__write_string(",\n\t"),
+ (
+ { MaybeExist = yes(ExistInfo2) },
+ io__write_string("&"),
+ output_rtti_addr(RttiTypeId, ExistInfo2)
+ ;
+ { MaybeExist = no },
+ io__write_string("NULL")
+ ),
+ io__write_string("\n};\n").
+output_rtti_data_defn(enum_name_ordered_table(RttiTypeId, Functors),
+ DeclSet0, DeclSet) -->
+ output_rtti_addrs_decls(RttiTypeId, Functors, "", "", 0, _,
+ DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeId,
+ enum_name_ordered_table, DeclSet1, DeclSet),
+ io__write_string(" = {\n"),
+ output_rtti_addrs(RttiTypeId, Functors),
+ io__write_string("};\n").
+output_rtti_data_defn(enum_value_ordered_table(RttiTypeId, Functors),
+ DeclSet0, DeclSet) -->
+ output_rtti_addrs_decls(RttiTypeId, Functors, "", "", 0, _,
+ DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeId,
+ enum_value_ordered_table, DeclSet1, DeclSet),
+ io__write_string(" = {\n"),
+ output_rtti_addrs(RttiTypeId, Functors),
+ io__write_string("};\n").
+output_rtti_data_defn(du_name_ordered_table(RttiTypeId, Functors),
+ DeclSet0, DeclSet) -->
+ output_rtti_addrs_decls(RttiTypeId, Functors, "", "", 0, _,
+ DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeId,
+ du_name_ordered_table, DeclSet1, DeclSet),
+ io__write_string(" = {\n"),
+ output_rtti_addrs(RttiTypeId, Functors),
+ io__write_string("};\n").
+output_rtti_data_defn(du_stag_ordered_table(RttiTypeId, Ptag, Sharers),
+ DeclSet0, DeclSet) -->
+ output_rtti_addrs_decls(RttiTypeId, Sharers, "", "", 0, _,
+ DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeId,
+ du_stag_ordered_table(Ptag), DeclSet1, DeclSet),
+ io__write_string(" = {\n"),
+ output_rtti_addrs(RttiTypeId, Sharers),
+ io__write_string("\n};\n").
+output_rtti_data_defn(du_ptag_layout(RttiTypeId, Ptag, NumSharers, Locn,
+ Descriptors), DeclSet0, DeclSet) -->
+ output_rtti_addr_decls(RttiTypeId, Descriptors, "", "", 0, _,
+ DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeId,
+ du_ptag_layout(Ptag), DeclSet1, DeclSet),
+ io__write_string(" = {\n\t"),
+ io__write_int(NumSharers),
+ io__write_string(",\n\t"),
+ { rtti__sectag_locn_to_string(Locn, LocnStr) },
+ io__write_string(LocnStr),
+ io__write_string(",\n\t(MR_DuFunctorDesc **) "),
+ output_rtti_addr(RttiTypeId, Descriptors),
+ io__write_string("\n};\n").
+output_rtti_data_defn(du_ptag_ordered_table(RttiTypeId, PtagLayouts),
+ DeclSet0, DeclSet) -->
+ output_maybe_rtti_addrs_decls(RttiTypeId, PtagLayouts, "", "",
+ 0, _, DeclSet0, DeclSet1),
+ output_generic_rtti_data_defn_start(RttiTypeId,
+ du_ptag_ordered_table, DeclSet1, DeclSet),
+ io__write_string(" = {\n"),
+ output_maybe_rtti_addrs(RttiTypeId, PtagLayouts),
+ io__write_string("\n};\n").
+output_rtti_data_defn(type_ctor_info(RttiTypeId, Unify, Index, Compare,
+ CtorRep, Solver, Init, Version, NumFunctors,
+ FunctorsInfo, LayoutInfo, MaybeHashCons,
+ Prettyprinter), DeclSet0, DeclSet) -->
+ output_generic_rtti_data_defn_start(RttiTypeId,
+ type_ctor_info, DeclSet0, DeclSet),
+ io__write_string(" = {\n\t"),
+ { RttiTypeId = rtti_type_id(Module, Type, TypeArity) },
+ io__write_int(TypeArity),
+ io__write_string(",\n\t"),
+ output_maybe_code_addr(Unify),
+ io__write_string(",\n\t"),
+ output_maybe_code_addr(Index),
+ io__write_string(",\n\t"),
+ output_maybe_code_addr(Compare),
+ io__write_string(",\n\t"),
+ { rtti__type_ctor_rep_to_string(CtorRep, CtorRepStr) },
+ io__write_string(CtorRepStr),
+ io__write_string(",\n\t"),
+ output_maybe_code_addr(Solver),
+ io__write_string(",\n\t"),
+ output_maybe_code_addr(Init),
+ io__write_string(",\n\t"""),
+ { prog_out__sym_name_to_string(Module, ModuleName) },
+ io__write_string(ModuleName),
+ io__write_string(""",\n\t"""),
+ io__write_string(Type),
+ io__write_string(""",\n\t"),
+ io__write_int(Version),
+ io__write_string(",\n\t"),
+ io__write_int(NumFunctors),
+ io__write_string(",\n\t"),
+ (
+ { FunctorsInfo = enum_functors(EnumFunctorsInfo) },
+ io__write_string("{ (Integer) "),
+ output_rtti_addr(RttiTypeId, EnumFunctorsInfo),
+ io__write_string(" }")
+ ;
+ { FunctorsInfo = notag_functors(NotagFunctorsInfo) },
+ io__write_string("{ (Integer) &"),
+ output_rtti_addr(RttiTypeId, NotagFunctorsInfo),
+ io__write_string(" }")
+ ;
+ { FunctorsInfo = du_functors(DuFunctorsInfo) },
+ io__write_string("{ (Integer) "),
+ output_rtti_addr(RttiTypeId, DuFunctorsInfo),
+ io__write_string(" }")
+ ;
+ { FunctorsInfo = no_functors },
+ io__write_string("{ 0 }")
+ ),
+ io__write_string(",\n\t"),
+ (
+ { LayoutInfo = enum_layout(EnumLayoutInfo) },
+ io__write_string("{ (Integer) "),
+ output_rtti_addr(RttiTypeId, EnumLayoutInfo),
+ io__write_string(" }")
+ ;
+ { LayoutInfo = notag_layout(NotagLayoutInfo) },
+ io__write_string("{ (Integer) &"),
+ output_rtti_addr(RttiTypeId, NotagLayoutInfo),
+ io__write_string(" }")
+ ;
+ { LayoutInfo = du_layout(DuLayoutInfo) },
+ io__write_string("{ (Integer) "),
+ output_rtti_addr(RttiTypeId, DuLayoutInfo),
+ io__write_string(" }")
+ ;
+ { LayoutInfo = equiv_layout(EquivRval) },
+ io__write_string("{ (Integer) "),
+ output_rval(EquivRval),
+ io__write_string(" }")
+ ;
+ { LayoutInfo = no_layout },
+ io__write_string("{ 0 }")
+ ),
+ io__write_string(",\n\t"),
+ (
+ { MaybeHashCons = yes(HashConsDataAddr) },
+ io__write_string("&"),
+ output_rtti_addr(RttiTypeId, HashConsDataAddr)
+ ;
+ { MaybeHashCons = no },
+ io__write_string("NULL")
+ ),
+ io__write_string(",\n\t"),
+ output_maybe_code_addr(Prettyprinter),
+ io__write_string("\n};\n").
+
+%-----------------------------------------------------------------------------%
+
+output_rtti_data_decl(RttiData, DeclSet0, DeclSet) -->
+ { rtti_data_to_name(RttiData, RttiTypeId, RttiName) },
+ output_generic_rtti_data_decl(RttiTypeId, RttiName,
+ DeclSet0, DeclSet).
+
+rtti_data_to_name(exist_locns(RttiTypeId, Ordinal, _),
+ RttiTypeId, exist_locns(Ordinal)).
+rtti_data_to_name(exist_info(RttiTypeId, Ordinal, _, _, _, _),
+ RttiTypeId, exist_info(Ordinal)).
+rtti_data_to_name(field_names(RttiTypeId, Ordinal, _),
+ RttiTypeId, field_names(Ordinal)).
+rtti_data_to_name(enum_functor_desc(RttiTypeId, _, Ordinal),
+ RttiTypeId, enum_functor_desc(Ordinal)).
+rtti_data_to_name(notag_functor_desc(RttiTypeId, _, _),
+ RttiTypeId, notag_functor_desc).
+rtti_data_to_name(du_functor_desc(RttiTypeId, _, _, _, _, Ordinal, _, _, _, _),
+ RttiTypeId, du_functor_desc(Ordinal)).
+rtti_data_to_name(enum_name_ordered_table(RttiTypeId, _),
+ RttiTypeId, enum_name_ordered_table).
+rtti_data_to_name(enum_value_ordered_table(RttiTypeId, _),
+ RttiTypeId, enum_value_ordered_table).
+rtti_data_to_name(du_name_ordered_table(RttiTypeId, _),
+ RttiTypeId, du_name_ordered_table).
+rtti_data_to_name(du_stag_ordered_table(RttiTypeId, Ptag, _),
+ RttiTypeId, du_stag_ordered_table(Ptag)).
+rtti_data_to_name(du_ptag_layout(RttiTypeId, Ptag, _, _, _),
+ RttiTypeId, du_ptag_layout(Ptag)).
+rtti_data_to_name(du_ptag_ordered_table(RttiTypeId, _),
+ RttiTypeId, du_ptag_ordered_table).
+rtti_data_to_name(type_ctor_info(RttiTypeId, _,_,_,_,_,_,_,_,_,_,_,_),
+ RttiTypeId, type_ctor_info).
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_generic_rtti_data_decl(rtti_type_id::in, rtti_name::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_generic_rtti_data_decl(RttiTypeId, RttiName, DeclSet0, DeclSet) -->
+ output_rtti_addr_scope_type_name(RttiTypeId, RttiName, no),
+ io__write_string(";\n"),
+ { DataAddr = rtti_addr(RttiTypeId, RttiName) },
+ { decl_set_insert(DeclSet0, data_addr(DataAddr), DeclSet) }.
+
+:- pred output_generic_rtti_data_defn_start(rtti_type_id::in, rtti_name::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_generic_rtti_data_defn_start(RttiTypeId, RttiName, DeclSet0, DeclSet) -->
+ io__write_string("\n"),
+ output_rtti_addr_scope_type_name(RttiTypeId, RttiName, yes),
+ { DataAddr = rtti_addr(RttiTypeId, RttiName) },
+ { decl_set_insert(DeclSet0, data_addr(DataAddr), DeclSet) }.
+
+output_rtti_addr_scope_type_name(RttiTypeId, RttiName, BeingDefined) -->
+ { rtti_name_linkage(RttiName, Linkage) },
+ globals__io_get_globals(Globals),
+ { c_data_linkage_string(Globals, Linkage, BeingDefined, LinkageStr) },
+ io__write_string(LinkageStr),
+
+ { rtti_name_would_include_code_addr(RttiName, InclCodeAddr) },
+ { c_data_const_string(Globals, InclCodeAddr, ConstStr) },
+ io__write_string(ConstStr),
+
+ { rtti_name_c_type(RttiName, CType, Suffix) },
+ io__write_string(CType),
+ io__write_string(" "),
+ output_rtti_addr(RttiTypeId, RttiName),
+ io__write_string(Suffix).
+
+%-----------------------------------------------------------------------------%
+
+rtti_out__init_rtti_data_if_nec(Data) -->
+ (
+ { Data = type_ctor_info(RttiTypeId, _,_,_,_,_,_,_,_,_,_,_,_) }
+ ->
+ io__write_string("\t\tMR_INIT_TYPE_CTOR_INFO(\n\t\t"),
+ output_rtti_addr(RttiTypeId, type_ctor_info),
+ io__write_string(",\n\t\t\t"),
+ { RttiTypeId = rtti_type_id(ModuleName, TypeName, Arity) },
+ { llds_out__sym_name_mangle(ModuleName, ModuleNameString) },
+ { string__append(ModuleNameString, "__", UnderscoresModule) },
+ (
+ { string__append(UnderscoresModule, _, TypeName) }
+ ->
+ []
+ ;
+ io__write_string(UnderscoresModule)
+ ),
+ { llds_out__name_mangle(TypeName, MangledTypeName) },
+ io__write_string(MangledTypeName),
+ io__write_string("_"),
+ io__write_int(Arity),
+ io__write_string("_0);\n")
+ ;
+ []
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_maybe_rtti_addrs_decls(rtti_type_id::in,
+ list(maybe(rtti_name))::in, string::in, string::in, int::in, int::out,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_maybe_rtti_addrs_decls(_, [], _, _, N, N, DeclSet, DeclSet) --> [].
+output_maybe_rtti_addrs_decls(RttiTypeId, [MaybeRttiName | RttiNames],
+ FirstIndent, LaterIndent, N0, N, DeclSet0, DeclSet) -->
+ (
+ { MaybeRttiName = yes(RttiName) },
+ output_data_addr_decls(rtti_addr(RttiTypeId, RttiName),
+ FirstIndent, LaterIndent, N0, N1, DeclSet0, DeclSet1)
+ ;
+ { MaybeRttiName = no },
+ { N1 = N0 },
+ { DeclSet1 = DeclSet0 }
+ ),
+ output_maybe_rtti_addrs_decls(RttiTypeId, RttiNames,
+ FirstIndent, LaterIndent, N1, N, DeclSet1, DeclSet).
+
+:- pred output_rtti_addrs_decls(rtti_type_id::in, list(rtti_name)::in,
+ string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_rtti_addrs_decls(_, [], _, _, N, N, DeclSet, DeclSet) --> [].
+output_rtti_addrs_decls(RttiTypeId, [RttiName | RttiNames],
+ FirstIndent, LaterIndent, N0, N, DeclSet0, DeclSet) -->
+ output_data_addr_decls(rtti_addr(RttiTypeId, RttiName),
+ FirstIndent, LaterIndent, N0, N1, DeclSet0, DeclSet1),
+ output_rtti_addrs_decls(RttiTypeId, RttiNames,
+ FirstIndent, LaterIndent, N1, N, DeclSet1, DeclSet).
+
+:- pred output_rtti_addr_decls(rtti_type_id::in, rtti_name::in,
+ string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_rtti_addr_decls(RttiTypeId, RttiName, FirstIndent, LaterIndent,
+ N0, N1, DeclSet0, DeclSet1) -->
+ output_data_addr_decls(rtti_addr(RttiTypeId, RttiName),
+ FirstIndent, LaterIndent, N0, N1, DeclSet0, DeclSet1).
+
+:- pred output_maybe_rtti_addrs(rtti_type_id::in, list(maybe(rtti_name))::in,
+ io__state::di, io__state::uo) is det.
+
+output_maybe_rtti_addrs(_, []) --> [].
+output_maybe_rtti_addrs(RttiTypeId, [MaybeRttiName | MaybeRttiNames]) -->
+ io__write_string("\t"),
+ (
+ { MaybeRttiName = yes(RttiName) },
+ io__write_string("&"),
+ output_rtti_addr(RttiTypeId, RttiName)
+ ;
+ { MaybeRttiName = no },
+ io__write_string("NULL")
+ ),
+ (
+ { MaybeRttiNames = [] },
+ io__write_string("\n")
+ ;
+ { MaybeRttiNames = [_|_] },
+ io__write_string(",\n"),
+ output_maybe_rtti_addrs(RttiTypeId, MaybeRttiNames)
+ ).
+
+:- pred output_rtti_addrs(rtti_type_id::in, list(rtti_name)::in,
+ io__state::di, io__state::uo) is det.
+
+output_rtti_addrs(_, []) --> [].
+output_rtti_addrs(RttiTypeId, [RttiName | RttiNames]) -->
+ io__write_string("\t&"),
+ output_rtti_addr(RttiTypeId, RttiName),
+ (
+ { RttiNames = [] },
+ io__write_string("\n")
+ ;
+ { RttiNames = [_|_] },
+ io__write_string(",\n"),
+ output_rtti_addrs(RttiTypeId, RttiNames)
+ ).
+
+output_rtti_addr(RttiTypeId, RttiName) -->
+ io__write_string(mercury_data_prefix),
+ { rtti_addr_to_string(RttiTypeId, RttiName, Str) },
+ io__write_string(Str).
+
+:- pred output_maybe_strings(list(maybe(string))::in,
+ io__state::di, io__state::uo) is det.
+
+output_maybe_strings([]) -->
+ { error("reached empty list of maybe strings") }.
+output_maybe_strings([MaybeName | MaybeNames]) -->
+ io__write_string("\t"),
+ (
+ { MaybeName = yes(Name) },
+ io__write_string(""""),
+ io__write_string(Name),
+ io__write_string("""")
+ ;
+ { MaybeName = no },
+ io__write_string("NULL")
+ ),
+ (
+ { MaybeNames = [] },
+ io__write_string("\n")
+ ;
+ { MaybeNames = [_|_] },
+ io__write_string(",\n"),
+ output_maybe_strings(MaybeNames)
+ ).
+
+:- pred output_exist_locns(list(exist_typeinfo_locn)::in,
+ io__state::di, io__state::uo) is det.
+
+output_exist_locns([]) -->
+ { error("reached empty list of exist locns") }.
+output_exist_locns([Locn | Locns]) -->
+ io__write_string("\t"),
+ (
+ { Locn = plain_typeinfo(SlotInCell) },
+ io__write_string("{ "),
+ io__write_int(SlotInCell),
+ io__write_string(", -1 }")
+ ;
+ { Locn = typeinfo_in_tci(SlotInCell, SlotInTci) },
+ io__write_string("{ "),
+ io__write_int(SlotInCell),
+ io__write_string(", "),
+ io__write_int(SlotInTci),
+ io__write_string(" }")
+ ),
+ (
+ { Locns = [] },
+ io__write_string("\n")
+ ;
+ { Locns = [_|_] },
+ io__write_string(",\n"),
+ output_exist_locns(Locns)
+ ).
+
+:- pred output_maybe_code_addr(maybe(code_addr)::in,
+ io__state::di, io__state::uo) is det.
+
+output_maybe_code_addr(yes(CodeAddr)) -->
+ output_code_addr(CodeAddr).
+output_maybe_code_addr(no) -->
+ io__write_string("NULL").
+
+:- pred rtti_name_would_include_code_addr(rtti_name::in, bool::out) is det.
+
+rtti_name_would_include_code_addr(exist_locns(_), no).
+rtti_name_would_include_code_addr(exist_info(_), no).
+rtti_name_would_include_code_addr(field_names(_), no).
+rtti_name_would_include_code_addr(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(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_layout(_), no).
+rtti_name_would_include_code_addr(du_ptag_ordered_table, no).
+rtti_name_would_include_code_addr(type_ctor_info, yes).
+rtti_name_would_include_code_addr(type_hashcons_pointer, no).
+
+rtti_name_linkage(exist_locns(_), static).
+rtti_name_linkage(exist_info(_), static).
+rtti_name_linkage(field_names(_), static).
+rtti_name_linkage(enum_functor_desc(_), static).
+rtti_name_linkage(notag_functor_desc, static).
+rtti_name_linkage(du_functor_desc(_), static).
+rtti_name_linkage(enum_name_ordered_table, static).
+rtti_name_linkage(enum_value_ordered_table, static).
+rtti_name_linkage(du_name_ordered_table, static).
+rtti_name_linkage(du_stag_ordered_table(_), static).
+rtti_name_linkage(du_ptag_layout(_), static).
+rtti_name_linkage(du_ptag_ordered_table, static).
+rtti_name_linkage(type_ctor_info, extern).
+rtti_name_linkage(type_hashcons_pointer, static).
+
+rtti_name_c_type(exist_locns(_), "MR_DuExistLocn", "[]").
+rtti_name_c_type(exist_info(_), "MR_DuExistInfo", "").
+rtti_name_c_type(field_names(_), "ConstString", "[]").
+rtti_name_c_type(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(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_layout(_), "MR_DuPtagLayout", "").
+rtti_name_c_type(du_ptag_ordered_table, "MR_DuPtagLayout *", "[]").
+rtti_name_c_type(type_ctor_info, "struct MR_TypeCtorInfo_Struct",
+ "").
+rtti_name_c_type(type_hashcons_pointer, "union MR_TableNode_Union **", "").
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.43
diff -u -b -r1.43 stack_layout.m
--- compiler/stack_layout.m 2000/01/14 01:10:43 1.43
+++ compiler/stack_layout.m 2000/02/21 09:32:01
@@ -254,7 +254,7 @@
:- import_module globals, options, llds_out, trace.
:- import_module hlds_data, hlds_pred, base_type_layout, prog_data, prog_out.
-:- import_module (inst), code_util.
+:- import_module rtti, (inst), code_util.
:- import_module assoc_list, bool, string, int, require.
:- import_module map, term, set.
@@ -1295,7 +1295,7 @@
% variables that are and aren't in scope; we can take the
% variable number directly from the procedure's tvar set.
ExistQTvars = [],
- base_type_layout__max_varint(Max),
+ base_type_layout__pseudo_typeinfo_max_var(Max),
NumUnivQTvars = Max - 1,
base_type_layout__construct_typed_pseudo_type_info(Type,
@@ -1318,41 +1318,41 @@
:- mode stack_layout__represent_live_value_type(in, out, out, in, out) is det.
stack_layout__represent_live_value_type(succip, Rval, data_ptr) -->
- { TypeCtor = type_ctor(info, "succip", 0) },
- { AddrConst = data_addr_const(data_addr(unqualified(""), TypeCtor)) },
- { Rval = const(AddrConst) }.
+ { RttiTypeId = rtti_type_id(unqualified(""), "succip", 0) },
+ { DataAddr = rtti_addr(RttiTypeId, type_ctor_info) },
+ { Rval = const(data_addr_const(DataAddr)) }.
stack_layout__represent_live_value_type(hp, Rval, data_ptr) -->
- { TypeCtor = type_ctor(info, "hp", 0) },
- { AddrConst = data_addr_const(data_addr(unqualified(""), TypeCtor)) },
- { Rval = const(AddrConst) }.
+ { RttiTypeId = rtti_type_id(unqualified(""), "hp", 0) },
+ { DataAddr = rtti_addr(RttiTypeId, type_ctor_info) },
+ { Rval = const(data_addr_const(DataAddr)) }.
stack_layout__represent_live_value_type(curfr, Rval, data_ptr) -->
- { TypeCtor = type_ctor(info, "curfr", 0) },
- { AddrConst = data_addr_const(data_addr(unqualified(""), TypeCtor)) },
- { Rval = const(AddrConst) }.
+ { RttiTypeId = rtti_type_id(unqualified(""), "curfr", 0) },
+ { DataAddr = rtti_addr(RttiTypeId, type_ctor_info) },
+ { Rval = const(data_addr_const(DataAddr)) }.
stack_layout__represent_live_value_type(maxfr, Rval, data_ptr) -->
- { TypeCtor = type_ctor(info, "maxfr", 0) },
- { AddrConst = data_addr_const(data_addr(unqualified(""), TypeCtor)) },
- { Rval = const(AddrConst) }.
+ { RttiTypeId = rtti_type_id(unqualified(""), "maxfr", 0) },
+ { DataAddr = rtti_addr(RttiTypeId, type_ctor_info) },
+ { Rval = const(data_addr_const(DataAddr)) }.
stack_layout__represent_live_value_type(redofr, Rval, data_ptr) -->
- { TypeCtor = type_ctor(info, "redofr", 0) },
- { AddrConst = data_addr_const(data_addr(unqualified(""), TypeCtor)) },
- { Rval = const(AddrConst) }.
+ { RttiTypeId = rtti_type_id(unqualified(""), "redofr", 0) },
+ { DataAddr = rtti_addr(RttiTypeId, type_ctor_info) },
+ { Rval = const(data_addr_const(DataAddr)) }.
stack_layout__represent_live_value_type(redoip, Rval, data_ptr) -->
- { TypeCtor = type_ctor(info, "redoip", 0) },
- { AddrConst = data_addr_const(data_addr(unqualified(""), TypeCtor)) },
- { Rval = const(AddrConst) }.
+ { RttiTypeId = rtti_type_id(unqualified(""), "redoip", 0) },
+ { DataAddr = rtti_addr(RttiTypeId, type_ctor_info) },
+ { Rval = const(data_addr_const(DataAddr)) }.
stack_layout__represent_live_value_type(trail_ptr, Rval, data_ptr) -->
- { TypeCtor = type_ctor(info, "trail_ptr", 0) },
- { AddrConst = data_addr_const(data_addr(unqualified(""), TypeCtor)) },
- { Rval = const(AddrConst) }.
+ { RttiTypeId = rtti_type_id(unqualified(""), "trail_ptr", 0) },
+ { DataAddr = rtti_addr(RttiTypeId, type_ctor_info) },
+ { Rval = const(data_addr_const(DataAddr)) }.
stack_layout__represent_live_value_type(ticket, Rval, data_ptr) -->
- { TypeCtor = type_ctor(info, "ticket", 0) },
- { AddrConst = data_addr_const(data_addr(unqualified(""), TypeCtor)) },
- { Rval = const(AddrConst) }.
+ { RttiTypeId = rtti_type_id(unqualified(""), "ticket", 0) },
+ { DataAddr = rtti_addr(RttiTypeId, type_ctor_info) },
+ { Rval = const(data_addr_const(DataAddr)) }.
stack_layout__represent_live_value_type(unwanted, Rval, data_ptr) -->
- { TypeCtor = type_ctor(info, "succip", 0) },
- { AddrConst = data_addr_const(data_addr(unqualified(""), TypeCtor)) },
- { Rval = const(AddrConst) }.
+ { RttiTypeId = rtti_type_id(unqualified(""), "unwanted", 0) },
+ { DataAddr = rtti_addr(RttiTypeId, type_ctor_info) },
+ { Rval = const(data_addr_const(DataAddr)) }.
stack_layout__represent_live_value_type(var(_, _, Type, _), Rval, LldsType)
-->
stack_layout__get_cell_number(CNum0),
@@ -1363,7 +1363,7 @@
% variables that are and aren't in scope; we can take the
% variable number directly from the procedure's tvar set.
{ ExistQTvars = [] },
- { base_type_layout__max_varint(Max) },
+ { base_type_layout__pseudo_typeinfo_max_var(Max) },
{ NumUnivQTvars = Max - 1 },
{ base_type_layout__construct_typed_pseudo_type_info(Type,
NumUnivQTvars, ExistQTvars,
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.104
diff -u -b -r1.104 unify_gen.m
--- compiler/unify_gen.m 2000/01/14 01:10:46 1.104
+++ compiler/unify_gen.m 2000/02/21 09:32:01
@@ -37,7 +37,7 @@
:- implementation.
-:- import_module builtin_ops.
+:- import_module rtti, builtin_ops.
:- import_module hlds_module, hlds_pred, prog_data, prog_out, code_util.
:- import_module mode_util, type_util, code_aux, hlds_out, tree, arg_info.
:- import_module globals, options, continuation_info, stack_layout.
@@ -344,8 +344,9 @@
{ error("unify_gen: type-info constant has args") }
),
{ Code = empty },
- code_info__cache_expression(Var, const(data_addr_const(data_addr(
- ModuleName, type_ctor(info, TypeName, TypeArity))))).
+ { RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity) },
+ { DataAddr = rtti_addr(RttiTypeId, type_ctor_info) },
+ code_info__cache_expression(Var, const(data_addr_const(DataAddr))).
unify_gen__generate_construction_2(base_typeclass_info_constant(ModuleName,
ClassId, Instance), Var, Args, _Modes, _, Code) -->
( { Args = [] } ->
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list