mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 17:33:38 +00:00
Code Issues Projects Releases Wiki Activity
Files
e00722533b25ea353e4c3adcc178f00a92fcfbf3
mercury/compiler/rtti_out.m
Julien Fischer f5e71b1e90 Fix copyright notices in recently modified files. 
compiler/*.m:
library/*.m:
mdbcomp/*.m:
runtime/*.[ch]:
    As above.

    Fix spelling in some spots.
2024-02-20 15:09:17 +11:00

2140 lines
85 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2000-2007, 2009-2011 The University of Melbourne.
% Copyright (C) 2014-2024 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: rtti_out.m.
% Main author: zs.
%
% This module contains code to output the RTTI data structures defined in
% rtti.m as C code.
%
% This module is part of the LLDS back-end. The decl_set data type that it
% uses, which is defined in llds_out.m, represents a set of LLDS declarations,
% and thus depends on the LLDS. Also the code to output code_addrs depends on
% the LLDS.
%
% The MLDS back-end does not use this module; instead it converts the RTTI
% data structures to MLDS (and then to C or Java, etc.).
%
%-----------------------------------------------------------------------------%
:- module ll_backend.rtti_out.
:- interface.
:- import_module backend_libs.
:- import_module backend_libs.rtti.
:- import_module ll_backend.llds_out.
:- import_module ll_backend.llds_out.llds_out_util.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module bool.
:- import_module io.
:- import_module list.
%-----------------------------------------------------------------------------%
% Output a C declaration for the rtti_datas.
%
:- pred output_rtti_data_decl_list(llds_out_info::in,
io.text_output_stream::in, list(rtti_data)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
% Output a C declaration for the rtti_data.
%
:- pred output_rtti_data_decl(llds_out_info::in,
io.text_output_stream::in, rtti_data::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
% Output a C definition for the rtti_data.
%
:- pred output_rtti_data_defn(llds_out_info::in,
io.text_output_stream::in, rtti_data::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
% Output C code (e.g. a call to the MR_INIT_TYPE_CTOR_INFO() macro)
% to initialize the rtti_data if necessary.
%
:- pred init_rtti_data_if_nec(io.text_output_stream::in, rtti_data::in,
io::di, io::uo) is det.
% Output C code (e.g. a call to MR_register_type_ctor_info()) to register
% the rtti_data in the type tables, if it represents a data structure
% that should be so registered.
%
:- pred register_rtti_data_if_nec(io.text_output_stream::in, rtti_data::in,
io::di, io::uo) is det.
% Output a C expression holding the address of the C name of the specified
% rtti_data, preceded by the string in the first argument (that string will
% usually be a C cast).
%
:- pred output_cast_addr_of_rtti_data(string::in, rtti_data::in,
io.text_output_stream::in, io::di, io::uo) is det.
% Output a C expression holding the address of the C name of
% the specified rtti_data.
%
:- pred output_addr_of_rtti_data(io.text_output_stream::in,
rtti_data::in, io::di, io::uo) is det.
% Output the C name of the rtti_data specified by the given rtti_id.
%
:- pred output_rtti_id(io.text_output_stream::in, rtti_id::in,
io::di, io::uo) is det.
% Output the C storage class, C type, and C name of the rtti_data
% specified by the given rtti_id for use in a declaration or
% definition. The bool should be `yes' iff it is for a definition.
%
:- pred output_rtti_id_storage_type_name(llds_out_info::in,
io.text_output_stream::in, rtti_id::in, bool::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
% Output the C storage class, C type, and C name of the rtti_data
% specified by the given rtti_id for use in a declaration or
% definition. The bool should be `yes' iff it is for a definition.
%
:- pred output_rtti_id_storage_type_name_no_decl(llds_out_info::in,
io.text_output_stream::in, rtti_id::in, bool::in, io::di, io::uo) is det.
:- func tabling_struct_data_addr_string(proc_label, proc_tabling_struct_id)
= string.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module backend_libs.c_util.
:- import_module backend_libs.name_mangle.
:- import_module backend_libs.type_ctor_info.
:- import_module hlds.
:- import_module hlds.hlds_rtti.
:- import_module libs.
:- import_module libs.globals.
:- import_module ll_backend.code_util.
:- import_module ll_backend.layout_out.
:- import_module ll_backend.llds.
:- import_module ll_backend.llds_out.llds_out_code_addr.
:- import_module ll_backend.llds_out.llds_out_data.
:- import_module ll_backend.llds_out.llds_out_file.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.parse_tree_output.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_foreign.
:- import_module assoc_list.
:- import_module counter.
:- import_module int.
:- import_module int16.
:- import_module int32.
:- import_module int8.
:- import_module map.
:- import_module maybe.
:- import_module multi_map.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module uint.
:- import_module uint16.
:- import_module uint32.
:- import_module uint8.
:- import_module univ.
%-----------------------------------------------------------------------------%
output_rtti_data_decl_list(Info, Stream, RttiDatas, !DeclSet, !IO) :-
classify_rtti_datas_to_decl(RttiDatas, multi_map.init, GroupMap),
multi_map.to_assoc_list(GroupMap, GroupList),
list.foldl2(output_rtti_data_decl_group(Info, Stream), GroupList,
!DeclSet, !IO).
:- type data_group
---> data_group(
data_c_type :: string,
data_is_array :: is_array,
data_linkage :: linkage
).
:- pred classify_rtti_datas_to_decl(list(rtti_data)::in,
multi_map(data_group, rtti_id)::in,
multi_map(data_group, rtti_id)::out) is det.
classify_rtti_datas_to_decl([], !GroupMap).
classify_rtti_datas_to_decl([RttiData | RttiDatas], !GroupMap) :-
( if RttiData = rtti_data_pseudo_type_info(type_var(_)) then
% These just get represented as integers, so we don't need to declare
% them. Also rtti_data_to_id/3 does not handle this case.
true
else
rtti_data_to_id(RttiData, RttiId),
rtti_id_c_type(RttiId, CType, IsArray),
rtti_id_linkage(RttiId, Linkage),
Group = data_group(CType, IsArray, Linkage),
multi_map.add(Group, RttiId, !GroupMap)
),
classify_rtti_datas_to_decl(RttiDatas, !GroupMap).
:- pred output_rtti_data_decl_group(llds_out_info::in,
io.text_output_stream::in, pair(data_group, list(rtti_id))::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_rtti_data_decl_group(Info, Stream, Group - RttiIds, !DeclSet, !IO) :-
% ChunkSize should be as large as possible to reduce the size of the
% file being generated, but small enough not to overload the fixed
% limits of our target C compilers.
ChunkSize = 10,
% The process of creating the multi_map reverses the order of rtti_ids,
% we now undo this reversal.
list.chunk(list.reverse(RttiIds), ChunkSize, RttiIdChunks),
list.foldl2(output_rtti_data_decl_chunk(Info, Stream, Group), RttiIdChunks,
!DeclSet, !IO).
:- pred output_rtti_data_decl_chunk(llds_out_info::in,
io.text_output_stream::in, data_group::in, list(rtti_id)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_rtti_data_decl_chunk(Info, Stream, Group, RttiIds, !DeclSet, !IO) :-
(
% Pick a representative RttiId. All the operations we perform on it
% below would have the same result regardless of which one we picked.
RttiIds = [RttiId | _]
;
RttiIds = [],
unexpected($pred, "empty list")
),
Group = data_group(CType, IsArray, Linkage),
io.nl(Stream, !IO),
output_rtti_type_decl(Stream, RttiId, !DeclSet, !IO),
Globals = Info ^ lout_globals,
LinkageStr = c_data_linkage_string(Linkage, no),
InclCodeAddr = rtti_id_would_include_code_addr(RttiId),
ConstStr = c_data_const_string(Globals, InclCodeAddr),
io.format(Stream, "%s%s%s\n", [s(LinkageStr), s(ConstStr), s(CType)], !IO),
output_rtti_data_decl_chunk_entries(Stream, IsArray, RttiIds,
!DeclSet, !IO).
:- pred output_rtti_data_decl_chunk_entries(io.text_output_stream::in,
is_array::in, list(rtti_id)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_rtti_data_decl_chunk_entries(_, _IsArray, [], !DeclSet, !IO) :-
unexpected($pred, "empty list").
output_rtti_data_decl_chunk_entries(Stream, IsArray, [RttiId | RttiIds],
!DeclSet, !IO) :-
decl_set_insert(decl_rtti_id(RttiId), !DeclSet),
io.write_string(Stream, "\t", !IO),
output_rtti_id(Stream, RttiId, !IO),
(
IsArray = is_array,
io.write_string(Stream, "[]", !IO)
;
IsArray = not_array
),
(
RttiIds = [_ | _],
io.write_string(Stream, ",\n", !IO),
output_rtti_data_decl_chunk_entries(Stream, IsArray, RttiIds,
!DeclSet, !IO)
;
RttiIds = [],
io.write_string(Stream, ";\n", !IO)
).
%-----------------------------------------------------------------------------%
output_rtti_data_decl(Info, Stream, RttiData, !DeclSet, !IO) :-
( if RttiData = rtti_data_pseudo_type_info(type_var(_)) then
% These just get represented as integers, so we don't need to declare
% them. Also rtti_data_to_id/3 does not handle this case.
true
else
rtti_data_to_id(RttiData, RttiId),
output_generic_rtti_data_decl(Info, Stream, RttiId, !DeclSet, !IO)
).
%-----------------------------------------------------------------------------%
output_rtti_data_defn(Info, Stream, RttiDefn, !DeclSet, !IO) :-
(
RttiDefn = rtti_data_type_info(TypeInfo),
output_type_info_defn(Info, Stream, TypeInfo, !DeclSet, !IO)
;
RttiDefn = rtti_data_pseudo_type_info(PseudoTypeInfo),
output_pseudo_type_info_defn(Info, Stream, PseudoTypeInfo,
!DeclSet, !IO)
;
RttiDefn = rtti_data_type_ctor_info(TypeCtorData),
output_type_ctor_data_defn(Info, Stream, TypeCtorData, !DeclSet, !IO)
;
RttiDefn = rtti_data_base_typeclass_info(TCName, InstanceModuleName,
InstanceString, BaseTypeClassInfo),
output_base_typeclass_info_defn(Info, Stream, TCName,
InstanceModuleName, InstanceString, BaseTypeClassInfo,
!DeclSet, !IO)
;
RttiDefn = rtti_data_type_class_decl(TCDecl),
output_type_class_decl_defn(Info, Stream, TCDecl, !DeclSet, !IO)
;
RttiDefn = rtti_data_type_class_instance(InstanceDecl),
output_type_class_instance_defn(Info, Stream, InstanceDecl,
!DeclSet, !IO)
).
%-----------------------------------------------------------------------------%
:- pred output_base_typeclass_info_defn(llds_out_info::in,
io.text_output_stream::in, tc_name::in, module_name::in, string::in,
base_typeclass_info::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_base_typeclass_info_defn(Info, Stream, TCName, InstanceModuleName,
InstanceString, BaseTypeClassInfo, !DeclSet, !IO) :-
BaseTypeClassInfo = base_typeclass_info(N1, N2, N3, N4, N5, Methods),
CodeAddrs = list.map(make_code_addr, Methods),
list.foldl2(output_record_code_addr_decls(Info, Stream), CodeAddrs,
!DeclSet, !IO),
io.write_string(Stream, "\n", !IO),
RttiId = tc_rtti_id(TCName,
type_class_base_typeclass_info(InstanceModuleName, InstanceString)),
output_rtti_id_storage_type_name(Info, Stream, RttiId, yes, !DeclSet, !IO),
% XXX It would be nice to avoid generating redundant declarations
% of base_typeclass_infos, but currently we don't.
io.write_string(Stream, " = {\n", !IO),
IntToSlot = (func(N) = string.format("\t(MR_Code *) %d,\n", [i(N)])),
NumSlots = list.map(IntToSlot, [N1, N2, N3, N4, N5]),
list.foldl(io.write_string(Stream), NumSlots, !IO),
write_out_list(output_static_code_addr, ",\n\t", CodeAddrs, Stream, !IO),
io.write_string(Stream, "\n};\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_type_class_decl_defn(llds_out_info::in,
io.text_output_stream::in, tc_decl::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_class_decl_defn(Info, Stream, TCDecl, !DeclSet, !IO) :-
TCDecl = tc_decl(TCId, Version, Supers),
TCId = tc_id(TCName, TVarNames, MethodIds),
TCName = tc_name(ModuleSymName, ClassName, Arity),
TCIdVarNamesRttiName = type_class_id_var_names,
TCIdVarNamesRttiId = tc_rtti_id(TCName, TCIdVarNamesRttiName),
TCIdMethodIdsRttiName = type_class_id_method_ids,
TCIdMethodIdsRttiId = tc_rtti_id(TCName, TCIdMethodIdsRttiName),
TCIdRttiName = type_class_id,
TCIdRttiId = tc_rtti_id(TCName, TCIdRttiName),
TCDeclSupersRttiName = type_class_decl_supers,
TCDeclSupersRttiId = tc_rtti_id(TCName, TCDeclSupersRttiName),
TCDeclRttiName = type_class_decl,
TCDeclRttiId = tc_rtti_id(TCName, TCDeclRttiName),
(
TVarNames = []
;
TVarNames = [_ | _],
output_generic_rtti_data_defn_start(Info, Stream, TCIdVarNamesRttiId,
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
list.foldl(output_type_class_id_tvar_name(Stream), TVarNames, !IO),
io.write_string(Stream, "};\n", !IO)
),
(
MethodIds = []
;
MethodIds = [_ | _],
output_generic_rtti_data_defn_start(Info, Stream, TCIdMethodIdsRttiId,
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
list.foldl(output_type_class_id_method_id(Stream), MethodIds, !IO),
io.write_string(Stream, "};\n", !IO)
),
list.length(TVarNames, NumTVarNames),
list.length(MethodIds, NumMethodIds),
output_generic_rtti_data_defn_start(Info, Stream, TCIdRttiId,
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t", !IO),
output_quoted_string_c(Stream, sym_name_to_string(ModuleSymName), !IO),
io.write_string(Stream, ",\n\t", !IO),
output_quoted_string_c(Stream, ClassName, !IO),
io.write_string(Stream, ",\n\t", !IO),
io.write_int(Stream, Arity, !IO),
io.write_string(Stream, ",\n\t", !IO),
io.write_int(Stream, NumTVarNames, !IO),
io.write_string(Stream, ",\n\t", !IO),
io.write_int(Stream, NumMethodIds, !IO),
io.write_string(Stream, ",\n\t", !IO),
(
TVarNames = [],
io.write_string(Stream, "NULL", !IO)
;
TVarNames = [_ | _],
output_rtti_id(Stream, TCIdVarNamesRttiId, !IO)
),
io.write_string(Stream, ",\n\t", !IO),
(
MethodIds = [],
io.write_string(Stream, "NULL", !IO)
;
MethodIds = [_ | _],
output_rtti_id(Stream, TCIdMethodIdsRttiId, !IO)
),
io.write_string(Stream, "\n};\n", !IO),
(
Supers = []
;
Supers = [_ | _],
list.map_foldl3(
output_type_class_constraint(Info, Stream,
make_tc_decl_super_id(TCName)),
Supers, SuperIds, counter.init(1), _, !DeclSet, !IO),
output_generic_rtti_data_defn_start(Info, Stream, TCDeclSupersRttiId,
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ", SuperIds,
Stream, !IO),
io.write_string(Stream, "};\n", !IO)
),
list.length(Supers, NumSupers),
output_generic_rtti_data_defn_start(Info, Stream, TCDeclRttiId,
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t&", !IO),
output_rtti_id(Stream, TCIdRttiId, !IO),
io.write_string(Stream, ",\n\t", !IO),
io.write_int(Stream, Version, !IO),
io.write_string(Stream, ",\n\t", !IO),
io.write_int(Stream, NumSupers, !IO),
io.write_string(Stream, ",\n\t", !IO),
(
Supers = [],
io.write_string(Stream, "NULL", !IO)
;
Supers = [_ | _],
output_rtti_id(Stream, TCDeclSupersRttiId, !IO)
),
io.write_string(Stream, "\n};\n", !IO).
:- pred output_type_class_id_tvar_name(io.text_output_stream::in,
string::in, io::di, io::uo) is det.
output_type_class_id_tvar_name(Stream, TVarName, !IO) :-
io.write_string(Stream, "\t", !IO),
output_quoted_string_c(Stream, TVarName, !IO),
io.write_string(Stream, ",\n", !IO).
:- pred output_type_class_id_method_id(io.text_output_stream::in,
tc_method_id::in, io::di, io::uo) is det.
output_type_class_id_method_id(Stream, MethodId, !IO) :-
MethodId =
tc_method_id(MethodName, pred_form_arity(MethodArity), PredOrFunc),
io.write_string(Stream, "\t{ ", !IO),
output_quoted_string_c(Stream, MethodName, !IO),
io.write_string(Stream, ", ", !IO),
io.write_int(Stream, MethodArity, !IO),
io.write_string(Stream, ", ", !IO),
io.write_string(Stream, mr_pred_or_func_to_string(PredOrFunc), !IO),
io.write_string(Stream, " },\n", !IO).
:- pred make_tc_decl_super_id(tc_name::in, int::in, int::in, rtti_id::out)
is det.
make_tc_decl_super_id(TCName, Ordinal, NumTypes, RttiId) :-
RttiId = tc_rtti_id(TCName, type_class_decl_super(Ordinal, NumTypes)).
%-----------------------------------------------------------------------------%
:- pred output_type_class_instance_defn(llds_out_info::in,
io.text_output_stream::in, tc_instance::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_class_instance_defn(Info, Stream, Instance, !DeclSet, !IO) :-
Instance = tc_instance(TCName, TCTypes, NumTypeVars, Constraints,
_MethodProcLabels),
list.foldl2(output_maybe_pseudo_type_info_defn(Info, Stream), TCTypes,
!DeclSet, !IO),
TCTypeRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, TCTypes),
TCInstanceTypesRttiId = tc_rtti_id(TCName,
type_class_instance_tc_type_vector(TCTypes)),
output_generic_rtti_data_defn_start(Info, Stream, TCInstanceTypesRttiId,
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", TCTypeRttiDatas,
Stream, !IO),
io.write_string(Stream, "};\n", !IO),
TCInstanceConstraintsRttiId = tc_rtti_id(TCName,
type_class_instance_constraints(TCTypes)),
(
Constraints = []
;
Constraints = [_ | _],
list.map_foldl3(
output_type_class_constraint(Info, Stream,
make_tc_instance_constraint_id(TCName, TCTypes)),
Constraints, ConstraintIds, counter.init(1), _, !DeclSet, !IO),
output_generic_rtti_data_defn_start(Info, Stream,
TCInstanceConstraintsRttiId, !DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ",
ConstraintIds, Stream, !IO),
io.write_string(Stream, "};\n", !IO)
),
% TCInstanceMethodsRttiId = tc_rtti_id(
% type_class_instance_methods(TCName, TCTypes)),
% (
% MethodProcLabels = []
% ;
% MethodProcLabels = [_ | _],
% MethodCodeAddrs = list.map(make_code_addr, MethodProcLabels),
% list.foldl2(output_code_addr_decls, MethodCodeAddrs,
% !DeclSet, !IO),
% output_generic_rtti_data_defn_start(TCInstanceMethodsRttiId,
% !DeclSet, !IO),
% io.write_string(" = {\n", !IO),
% list.foldl(output_code_addr_in_list, MethodCodeAddrs, !IO),
% io.write_string("};\n", !IO)
% ),
TCDeclRttiId = tc_rtti_id(TCName, type_class_decl),
output_record_rtti_id_decls(Info, Stream, TCDeclRttiId, "", "", 0, _,
!DeclSet, !IO),
TCInstanceRttiId = tc_rtti_id(TCName, type_class_instance(TCTypes)),
output_generic_rtti_data_defn_start(Info, Stream, TCInstanceRttiId,
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t&", !IO),
output_rtti_id(Stream, TCDeclRttiId, !IO),
io.write_string(Stream, ",\n\t", !IO),
io.write_int(Stream, NumTypeVars, !IO),
io.write_string(Stream, ",\n\t", !IO),
io.write_int(Stream, list.length(Constraints), !IO),
io.write_string(Stream, ",\n\t", !IO),
output_rtti_id(Stream, TCInstanceTypesRttiId, !IO),
io.write_string(Stream, ",\n\t", !IO),
(
Constraints = [],
io.write_string(Stream, "NULL", !IO)
;
Constraints = [_ | _],
output_rtti_id(Stream, TCInstanceConstraintsRttiId, !IO)
),
% io.write_string(Stream, ",\n\t", !IO),
% (
% MethodProcLabels = [],
% io.write_string(Stream, "NULL", !IO)
% ;
% MethodProcLabels = [_ | _],
% io.write_string(Stream, "&", !IO),
% output_rtti_id(Stream, TCInstanceMethodsRttiId, !IO)
% ),
io.write_string(Stream, "\n};\n", !IO).
:- pred make_tc_instance_constraint_id(tc_name::in, list(tc_type)::in,
int::in, int::in, rtti_id::out) is det.
make_tc_instance_constraint_id(TCName, TCTypes, Ordinal, NumTypes, RttiId) :-
RttiId = tc_rtti_id(TCName,
type_class_instance_constraint(TCTypes, Ordinal, NumTypes)).
:- pred output_code_addr_in_list(io.text_output_stream::in, code_addr::in,
io::di, io::uo) is det.
:- pragma consider_used(pred(output_code_addr_in_list/4)).
output_code_addr_in_list(Stream, CodeAddr, !IO) :-
io.write_string(Stream, "\t", !IO),
output_static_code_addr(CodeAddr, Stream, !IO),
io.write_string(Stream, ",\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_type_class_constraint(llds_out_info::in,
io.text_output_stream::in,
pred(int, int, rtti_id)::in(pred(in, in, out) is det),
tc_constraint::in, rtti_id::out, counter::in, counter::out,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_class_constraint(Info, Stream, MakeRttiId, Constraint,
TCDeclSuperRttiId, !Counter, !DeclSet, !IO) :-
Constraint = tc_constraint(TCName, Types),
list.length(Types, NumTypes),
counter.allocate(TCNum, !Counter),
MakeRttiId(TCNum, NumTypes, TCDeclSuperRttiId),
TCDeclRttiId = tc_rtti_id(TCName, type_class_decl),
output_generic_rtti_data_decl(Info, Stream, TCDeclRttiId, !DeclSet, !IO),
list.foldl2(output_maybe_pseudo_type_info_defn(Info, Stream), Types,
!DeclSet, !IO),
TypeRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, Types),
output_generic_rtti_data_defn_start(Info, Stream, TCDeclSuperRttiId,
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t&", !IO),
output_rtti_id(Stream, TCDeclRttiId, !IO),
io.write_string(Stream, ",\n\t{\n", !IO),
output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", TypeRttiDatas,
Stream, !IO),
io.write_string(Stream, "\t}\n};\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_maybe_pseudo_type_info_or_self_defn(llds_out_info::in,
io.text_output_stream::in, rtti_maybe_pseudo_type_info_or_self::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_maybe_pseudo_type_info_or_self_defn(Info, Stream, MaybePseudoTypeInfo,
!DeclSet, !IO) :-
(
MaybePseudoTypeInfo = arg_plain(TypeInfo),
output_type_info_defn(Info, Stream, TypeInfo, !DeclSet, !IO)
;
MaybePseudoTypeInfo = arg_pseudo(PseudoTypeInfo),
output_pseudo_type_info_defn(Info, Stream, PseudoTypeInfo,
!DeclSet, !IO)
;
MaybePseudoTypeInfo = arg_self
).
:- pred output_maybe_pseudo_type_info_defn(llds_out_info::in,
io.text_output_stream::in, rtti_maybe_pseudo_type_info::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_maybe_pseudo_type_info_defn(Info, Stream, MaybePseudoTypeInfo,
!DeclSet, !IO) :-
(
MaybePseudoTypeInfo = plain(TypeInfo),
output_type_info_defn(Info, Stream, TypeInfo, !DeclSet, !IO)
;
MaybePseudoTypeInfo = pseudo(PseudoTypeInfo),
output_pseudo_type_info_defn(Info, Stream, PseudoTypeInfo,
!DeclSet, !IO)
).
:- pred output_type_info_defn(llds_out_info::in,
io.text_output_stream::in, rtti_type_info::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_info_defn(Info, Stream, TypeInfo, !DeclSet, !IO) :-
( if
rtti_data_to_id(rtti_data_type_info(TypeInfo), RttiId),
decl_set_is_member(decl_rtti_id(RttiId), !.DeclSet)
then
true
else
do_output_type_info_defn(Info, Stream, TypeInfo, !DeclSet, !IO)
).
:- pred do_output_type_info_defn(llds_out_info::in,
io.text_output_stream::in, rtti_type_info::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
do_output_type_info_defn(Info, Stream, TypeInfo, !DeclSet, !IO) :-
(
TypeInfo = plain_arity_zero_type_info(RttiTypeCtor),
TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info),
output_record_rtti_id_decls(Info, Stream, TypeCtorRttiId, "", "", 0, _,
!DeclSet, !IO)
;
TypeInfo = plain_type_info(RttiTypeCtor, Args),
TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info),
output_record_rtti_id_decls(Info, Stream, TypeCtorRttiId,
"", "", 0, _, !DeclSet, !IO),
ArgRttiDatas = list.map(type_info_to_rtti_data, Args),
output_type_ctor_arg_defns_and_decls(Info, Stream, ArgRttiDatas,
!DeclSet, !IO),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_type_info(TypeInfo)),
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t&", !IO),
output_ctor_rtti_id(Stream, RttiTypeCtor,
type_ctor_type_ctor_info, !IO),
io.write_string(Stream, ",\n{", !IO),
output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas,
Stream, !IO),
io.write_string(Stream, "}};\n", !IO)
;
TypeInfo = var_arity_type_info(RttiVarArityId, Args),
RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId),
TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info),
output_record_rtti_id_decls(Info, Stream, TypeCtorRttiId, "", "", 0, _,
!DeclSet, !IO),
ArgRttiDatas = list.map(type_info_to_rtti_data, Args),
output_type_ctor_arg_defns_and_decls(Info, Stream, ArgRttiDatas,
!DeclSet, !IO),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_type_info(TypeInfo)),
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t&", !IO),
output_ctor_rtti_id(Stream, RttiTypeCtor,
type_ctor_type_ctor_info, !IO),
io.write_string(Stream, ",\n\t", !IO),
list.length(Args, Arity),
io.write_int(Stream, Arity, !IO),
io.write_string(Stream, ",\n{", !IO),
output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas,
Stream, !IO),
io.write_string(Stream, "}};\n", !IO)
).
:- pred output_pseudo_type_info_defn(llds_out_info::in,
io.text_output_stream::in, rtti_pseudo_type_info::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_pseudo_type_info_defn(Info, Stream, PseudoTypeInfo, !DeclSet, !IO) :-
( if
PseudoTypeInfo = type_var(_)
then
true
else if
rtti_data_to_id(rtti_data_pseudo_type_info(PseudoTypeInfo), RttiId),
decl_set_is_member(decl_rtti_id(RttiId), !.DeclSet)
then
true
else
do_output_pseudo_type_info_defn(Info, Stream, PseudoTypeInfo,
!DeclSet, !IO)
).
:- pred do_output_pseudo_type_info_defn(llds_out_info::in,
io.text_output_stream::in, rtti_pseudo_type_info::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
do_output_pseudo_type_info_defn(Info, Stream, PseudoTypeInfo, !DeclSet, !IO) :-
(
PseudoTypeInfo = plain_arity_zero_pseudo_type_info(RttiTypeCtor),
TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info),
output_record_rtti_id_decls(Info, Stream, TypeCtorRttiId, "", "", 0, _,
!DeclSet, !IO)
;
PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, Args),
TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info),
output_record_rtti_id_decls(Info, Stream, TypeCtorRttiId, "", "", 0, _,
!DeclSet, !IO),
ArgRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, Args),
output_type_ctor_arg_defns_and_decls(Info, Stream, ArgRttiDatas,
!DeclSet, !IO),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor,
type_ctor_pseudo_type_info(PseudoTypeInfo)),
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t&", !IO),
output_ctor_rtti_id(Stream, RttiTypeCtor,
type_ctor_type_ctor_info, !IO),
io.write_string(Stream, ",\n{", !IO),
output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgRttiDatas,
Stream, !IO),
io.write_string(Stream, "}};\n", !IO)
;
PseudoTypeInfo = var_arity_pseudo_type_info(RttiVarArityId, Args),
RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId),
TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info),
output_record_rtti_id_decls(Info, Stream, TypeCtorRttiId, "", "", 0, _,
!DeclSet, !IO),
ArgRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, Args),
output_type_ctor_arg_defns_and_decls(Info, Stream, ArgRttiDatas,
!DeclSet, !IO),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor,
type_ctor_pseudo_type_info(PseudoTypeInfo)),
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t&", !IO),
output_ctor_rtti_id(Stream, RttiTypeCtor,
type_ctor_type_ctor_info, !IO),
io.write_string(Stream, ",\n\t", !IO),
list.length(Args, Arity),
io.write_int(Stream, Arity, !IO),
io.write_string(Stream, ",\n{", !IO),
output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgRttiDatas,
Stream, !IO),
io.write_string(Stream, "}};\n", !IO)
;
PseudoTypeInfo = type_var(_)
).
:- pred output_type_ctor_arg_defns_and_decls(llds_out_info::in,
io.text_output_stream::in, list(rtti_data)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_ctor_arg_defns_and_decls(Info, Stream, ArgRttiDatas,
!DeclSet, !IO) :-
% 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(Info, Stream), ArgRttiDatas,
!DeclSet, !IO),
output_record_rtti_datas_decls(Info, Stream, ArgRttiDatas, "", "", 0, _,
!DeclSet, !IO).
%-----------------------------------------------------------------------------%
:- pred output_type_ctor_data_defn(llds_out_info::in,
io.text_output_stream::in, type_ctor_data::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_ctor_data_defn(Info, Stream, TypeCtorData, !DeclSet, !IO) :-
RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData),
TypeCtorData = type_ctor_data(Version, Module, TypeName, TypeArity,
UnifyUniv, CompareUniv, Flags, TypeCtorDetails),
output_type_ctor_details_defn(Info, Stream, RttiTypeCtor, TypeCtorDetails,
MaybeFunctorsName, MaybeLayoutName, HaveFunctorNumberMap,
!DeclSet, !IO),
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],
list.foldl2(output_record_code_addr_decls(Info, Stream), CodeAddrs,
!DeclSet, !IO),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), !DeclSet, !IO),
io.write_string(Stream, " = {\n\t", !IO),
% MR_type_ctor_arity -- XXX MAKE_FIELD_UNSIGNED
io.write_int(Stream, uint16.to_int(TypeArity), !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_version
io.write_uint8(Stream, Version, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_num_ptags
MaybeNumPtags = type_ctor_details_num_ptags(TypeCtorDetails),
(
MaybeNumPtags = yes(NumPtags),
NumPtagsEncoding = int8.det_from_int(NumPtags)
;
MaybeNumPtags = no,
NumPtagsEncoding = -1i8
),
io.write_int8(Stream, NumPtagsEncoding, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_rep_CAST_ME
rtti.type_ctor_rep_to_string(TypeCtorData, _TargetPrefixes, CtorRepStr),
io.write_string(Stream, CtorRepStr, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_unify_pred
output_static_code_addr(UnifyCodeAddr, Stream, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_compare_pred
output_static_code_addr(CompareCodeAddr, Stream, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_module_name
output_quoted_string_c(Stream, sym_name_to_string(Module), !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_name
output_quoted_string_c(Stream, TypeName, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_functors
(
MaybeFunctorsName = yes(FunctorsName),
FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, FunctorsName),
io.write_string(Stream, "{ ", !IO),
output_cast_addr_of_rtti_id("(void *) ", FunctorsRttiId, Stream, !IO),
io.write_string(Stream, " }", !IO)
;
MaybeFunctorsName = no,
io.write_string(Stream, "{ 0 }", !IO)
),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_layout
(
MaybeLayoutName = yes(LayoutName),
LayoutRttiId = ctor_rtti_id(RttiTypeCtor, LayoutName),
io.write_string(Stream, "{ ", !IO),
output_cast_addr_of_rtti_id("(void *) ", LayoutRttiId, Stream, !IO),
io.write_string(Stream, " }", !IO)
;
MaybeLayoutName = no,
io.write_string(Stream, "{ 0 }", !IO)
),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_num_functors -- XXX MAKE_FIELD_UNSIGNED
MaybeNumFunctors = type_ctor_details_num_functors(TypeCtorDetails),
(
MaybeNumFunctors = yes(NumFunctors),
NumFunctorsEncoding = int32.det_from_int(NumFunctors)
;
MaybeNumFunctors = no,
NumFunctorsEncoding = -1i32
),
io.write_int32(Stream, NumFunctorsEncoding, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_flags
io.write_uint16(Stream, encode_type_ctor_flags(Flags), !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_type_ctor_functor_number_map
(
HaveFunctorNumberMap = yes,
FunctorNumberMapRttiId =
ctor_rtti_id(RttiTypeCtor, type_ctor_functor_number_map),
output_rtti_id(Stream, FunctorNumberMapRttiId, !IO)
;
HaveFunctorNumberMap = no,
io.write_string(Stream, "NULL", !IO)
),
% 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_ctor_rtti_id(RttiTypeCtor, HashConsDataAddr)
% ;
% { MaybeHashCons = no },
% io.write_string("NULL")
% ),
% io.write_string(",\n\t"),
% output_maybe_static_code_addr(Prettyprinter),
io.write_string(Stream, "\n};\n", !IO).
:- pred output_type_ctor_details_defn(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in, type_ctor_details::in,
maybe(ctor_rtti_name)::out, maybe(ctor_rtti_name)::out, bool::out,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_ctor_details_defn(Info, Stream, RttiTypeCtor, TypeCtorDetails,
MaybeFunctorsName, MaybeLayoutName, HaveFunctorNumberMap,
!DeclSet, !IO) :-
(
TypeCtorDetails = tcd_enum(_, _IsDummy, EnumFunctors,
EnumByOrd, EnumByName, FunctorNumberMap, _MaybeBaseTypeCtor),
% MaybeBaseTypeCtor is not required for low-level data.
list.foldl2(output_enum_functor_defn(Info, Stream, RttiTypeCtor),
EnumFunctors, !DeclSet, !IO),
output_enum_ordinal_ordered_table(Info, Stream, RttiTypeCtor,
EnumByOrd, !DeclSet, !IO),
output_enum_name_ordered_table(Info, Stream, RttiTypeCtor, EnumByName,
!DeclSet, !IO),
output_functor_number_map(Info, Stream, RttiTypeCtor, FunctorNumberMap,
!DeclSet, !IO),
MaybeLayoutName = yes(type_ctor_enum_ordinal_ordered_table),
MaybeFunctorsName = yes(type_ctor_enum_name_ordered_table),
HaveFunctorNumberMap = yes
;
TypeCtorDetails = tcd_foreign_enum(Lang, _, ForeignEnumFunctors,
ForeignEnumByOrdinal, ForeignEnumByName, FunctorNumberMap),
expect(unify(Lang, lang_c), $pred,
"language other than C for foreign enumeration"),
list.foldl2(
output_foreign_enum_functor_defn(Info, Stream, RttiTypeCtor),
ForeignEnumFunctors, !DeclSet, !IO),
output_foreign_enum_ordinal_ordered_table(Info, Stream, RttiTypeCtor,
ForeignEnumByOrdinal, !DeclSet, !IO),
output_foreign_enum_name_ordered_table(Info, Stream, RttiTypeCtor,
ForeignEnumByName, !DeclSet, !IO),
output_functor_number_map(Info, Stream, RttiTypeCtor, FunctorNumberMap,
!DeclSet, !IO),
MaybeLayoutName = yes(type_ctor_foreign_enum_ordinal_ordered_table),
MaybeFunctorsName = yes(type_ctor_foreign_enum_name_ordered_table),
HaveFunctorNumberMap = yes
;
TypeCtorDetails = tcd_du(_, DuFunctors, DuByRep, DuByName,
FunctorNumberMap, _MaybeBaseTypeCtor),
% MaybeBaseTypeCtor is not required for low-level data.
list.foldl2(output_du_functor_defn(Info, Stream, RttiTypeCtor),
DuFunctors, !DeclSet, !IO),
output_du_ptag_ordered_table(Info, Stream, RttiTypeCtor, DuByRep,
!DeclSet, !IO),
output_du_name_ordered_table(Info, Stream, RttiTypeCtor, DuByName,
!DeclSet, !IO),
output_functor_number_map(Info, Stream, RttiTypeCtor, FunctorNumberMap,
!DeclSet, !IO),
MaybeLayoutName = yes(type_ctor_du_ptag_ordered_table),
MaybeFunctorsName = yes(type_ctor_du_name_ordered_table),
HaveFunctorNumberMap = yes
;
TypeCtorDetails = tcd_notag(_, NotagFunctor, _MaybeBaseTypeCtor),
% MaybeBaseTypeCtor is not required for low-level data.
output_notag_functor_defn(Info, Stream, RttiTypeCtor, NotagFunctor,
!DeclSet, !IO),
output_functor_number_map(Info, Stream, RttiTypeCtor, [0u32],
!DeclSet, !IO),
MaybeLayoutName = yes(type_ctor_notag_functor_desc),
MaybeFunctorsName = yes(type_ctor_notag_functor_desc),
HaveFunctorNumberMap = yes
;
TypeCtorDetails = tcd_eqv(EqvType),
output_maybe_pseudo_type_info_defn(Info, Stream, EqvType,
!DeclSet, !IO),
TypeData = maybe_pseudo_type_info_to_rtti_data(EqvType),
output_record_rtti_data_decls(Info, Stream, TypeData, "", "", 0, _,
!DeclSet, !IO),
(
EqvType = plain(TypeInfo),
LayoutName = type_ctor_type_info(TypeInfo)
;
EqvType = pseudo(PseudoTypeInfo),
LayoutName = type_ctor_pseudo_type_info(PseudoTypeInfo)
),
MaybeLayoutName = yes(LayoutName),
MaybeFunctorsName = no,
HaveFunctorNumberMap = no
;
( TypeCtorDetails = tcd_builtin(_)
; TypeCtorDetails = tcd_impl_artifact(_)
; TypeCtorDetails = tcd_foreign(_)
),
MaybeLayoutName = no,
MaybeFunctorsName = no,
HaveFunctorNumberMap = no
).
%-----------------------------------------------------------------------------%
:- pred output_enum_functor_defn(llds_out_info::in, io.text_output_stream::in,
rtti_type_ctor::in, enum_functor::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_enum_functor_defn(Info, Stream, RttiTypeCtor, EnumFunctor,
!DeclSet, !IO) :-
EnumFunctor = enum_functor(FunctorName, Ordinal, enum_value(Value)),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_enum_functor_desc(Ordinal)),
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t", !IO),
% MR_enum_functor_name
output_quoted_string_c(Stream, FunctorName, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_enum_functor_value -- XXX MAKE_FIELD_UNSIGNED
io.write_int32(Stream, int32.cast_from_uint32(Value), !IO),
io.write_string(Stream, "\n};\n", !IO).
:- pred output_foreign_enum_functor_defn(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in, foreign_enum_functor::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_foreign_enum_functor_defn(Info, Stream, RttiTypeCtor,
ForeignEnumFunctor, !DeclSet, !IO) :-
ForeignEnumFunctor = foreign_enum_functor(FunctorName, FunctorOrdinal,
FunctorValue),
RttiId = ctor_rtti_id(RttiTypeCtor,
type_ctor_foreign_enum_functor_desc(FunctorOrdinal)),
output_generic_rtti_data_defn_start(Info, Stream, RttiId, !DeclSet, !IO),
io.write_string(Stream, " = {\n\t", !IO),
% MR_foreign_enum_functor_name
output_quoted_string_c(Stream, FunctorName, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_foreign_enum_functor_ordinal -- XXX MAKE_FIELD_UNSIGNED
io.write_int32(Stream, int32.cast_from_uint32(FunctorOrdinal), !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_foreign_enum_functor_value
io.write_string(Stream, FunctorValue, !IO),
io.write_string(Stream, "\n};\n", !IO).
:- pred output_notag_functor_defn(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in, notag_functor::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_notag_functor_defn(Info, Stream, RttiTypeCtor, NotagFunctor,
!DeclSet, !IO) :-
NotagFunctor = notag_functor(FunctorName, ArgType, MaybeArgName,
FunctorSubtypeInfo),
output_maybe_pseudo_type_info_defn(Info, Stream, ArgType, !DeclSet, !IO),
ArgTypeData = maybe_pseudo_type_info_to_rtti_data(ArgType),
output_record_rtti_data_decls(Info, Stream, ArgTypeData, "", "", 0, _,
!DeclSet, !IO),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_notag_functor_desc),
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t", !IO),
% MR_notag_functor_name
output_quoted_string_c(Stream, FunctorName, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_notag_functor_arg_type
(
ArgType = plain(ArgTypeInfo),
output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ",
rtti_data_type_info(ArgTypeInfo), Stream, !IO)
;
ArgType = pseudo(ArgPseudoTypeInfo),
% We need to cast the argument to MR_PseudoTypeInfo in case
% it turns out to be a small integer, not a pointer.
output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ",
rtti_data_pseudo_type_info(ArgPseudoTypeInfo), Stream, !IO)
),
io.write_string(Stream, ",\n\t", !IO),
% MR_notag_functor_arg_name
(
MaybeArgName = yes(ArgName),
io.write_string(Stream, """", !IO),
io.write_string(Stream, ArgName, !IO),
io.write_string(Stream, """", !IO)
;
MaybeArgName = no,
io.write_string(Stream, "NULL", !IO)
),
io.write_string(Stream, ",\n\t", !IO),
% MR_notag_functor_subtype
functor_subtype_info_to_string(FunctorSubtypeInfo, _,
FunctorSubtypeInfoStr),
io.write_string(Stream, FunctorSubtypeInfoStr, !IO),
io.write_string(Stream, "\n};\n", !IO).
:- pred output_du_functor_defn(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in, du_functor::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_du_functor_defn(Info, Stream, RttiTypeCtor, DuFunctor, !DeclSet, !IO) :-
DuFunctor = du_functor(FunctorName, OrigArity, Ordinal, Rep,
ArgInfos, MaybeExistInfo, FunctorSubtypeInfo),
ArgTypes = list.map(du_arg_info_type, ArgInfos),
MaybeArgNames = list.map(du_arg_info_name, ArgInfos),
HaveArgNames = (if list.member(yes(_), MaybeArgNames) then yes else no),
(
ArgInfos = [_ | _],
output_du_arg_types(Info, Stream, RttiTypeCtor, Ordinal, ArgTypes,
!DeclSet, !IO)
;
ArgInfos = []
),
(
HaveArgNames = yes,
output_du_arg_names(Info, Stream, RttiTypeCtor, Ordinal, MaybeArgNames,
!DeclSet, !IO)
;
HaveArgNames = no
),
output_du_arg_locns(Info, Stream, RttiTypeCtor, Ordinal, ArgInfos,
HaveArgLocns, !DeclSet, !IO),
(
MaybeExistInfo = yes(ExistInfo),
output_exist_info(Info, Stream, RttiTypeCtor, Ordinal, ExistInfo,
!DeclSet, !IO)
;
MaybeExistInfo = no
),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_du_functor_desc(Ordinal)),
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t", !IO),
% MR_du_functor_name
output_quoted_string_c(Stream, FunctorName, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_functor_orig_arity -- XXX MAKE_FIELD_UNSIGNED
io.write_int16(Stream, int16.cast_from_uint16(OrigArity), !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_functor_arg_type_contains_var
ContainsVarBitVector = compute_contains_var_bit_vector(ArgTypes),
io.write_uint16(Stream, ContainsVarBitVector, !IO),
io.write_string(Stream, ",\n\t", !IO),
(
Rep = du_ll_rep(Ptag, SectagAndLocn)
;
Rep = du_hl_rep(_),
unexpected($pred, "du_hl_rep")
),
Ptag = ptag(PtagUint8),
(
SectagAndLocn = sectag_locn_none,
Locn = "MR_SECTAG_NONE",
StagEncoding = -1i32,
NumSectagBits = 0u8
;
SectagAndLocn = sectag_locn_none_direct_arg,
Locn = "MR_SECTAG_NONE_DIRECT_ARG",
StagEncoding = -1i32,
NumSectagBits = 0u8
;
SectagAndLocn = sectag_locn_local_rest_of_word(StagUint),
Locn = "MR_SECTAG_LOCAL_REST_OF_WORD",
StagEncoding = int32.det_from_int(uint.cast_to_int(StagUint)),
NumSectagBits = 0u8
;
SectagAndLocn = sectag_locn_local_bits(StagUint, NumSectagBits, _Mask),
Locn = "MR_SECTAG_LOCAL_BITS",
StagEncoding = int32.det_from_int(uint.cast_to_int(StagUint))
;
SectagAndLocn = sectag_locn_remote_word(StagUint),
Locn = "MR_SECTAG_REMOTE_FULL_WORD",
StagEncoding = int32.det_from_int(uint.cast_to_int(StagUint)),
NumSectagBits = 0u8
;
SectagAndLocn = sectag_locn_remote_bits(StagUint, NumSectagBits,
_Mask),
Locn = "MR_SECTAG_REMOTE_BITS",
StagEncoding = int32.det_from_int(uint.cast_to_int(StagUint))
),
% MR_du_functor_sectag_locn
io.write_string(Stream, Locn, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_functor_primary
io.write_uint8(Stream, PtagUint8, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_functor_secondary -- XXX MAKE_FIELD_UNSIGNED
io.write_int32(Stream, StagEncoding, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_functor_ordinal -- XXX MAKE_FIELD_UNSIGNED
io.write_int32(Stream, int32.cast_from_uint32(Ordinal), !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_functor_arg_types
io.write_string(Stream, "(MR_PseudoTypeInfo *) ", !IO), % cast away const
(
ArgInfos = [_ | _],
output_addr_of_ctor_rtti_id(RttiTypeCtor,
type_ctor_field_types(Ordinal), Stream, !IO)
;
ArgInfos = [],
io.write_string(Stream, "NULL", !IO)
),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_functor_arg_names
(
HaveArgNames = yes,
output_addr_of_ctor_rtti_id(RttiTypeCtor,
type_ctor_field_names(Ordinal), Stream, !IO)
;
HaveArgNames = no,
io.write_string(Stream, "NULL", !IO)
),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_functor_arg_locns
(
HaveArgLocns = yes,
output_addr_of_ctor_rtti_id(RttiTypeCtor,
type_ctor_field_locns(Ordinal), Stream, !IO)
;
HaveArgLocns = no,
io.write_string(Stream, "NULL", !IO)
),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_functor_exist_info
(
MaybeExistInfo = yes(_),
output_addr_of_ctor_rtti_id(RttiTypeCtor,
type_ctor_exist_info(Ordinal), Stream, !IO)
;
MaybeExistInfo = no,
io.write_string(Stream, "NULL", !IO)
),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_functor_subtype
functor_subtype_info_to_string(FunctorSubtypeInfo, _,
FunctorSubtypeInfoStr),
io.write_string(Stream, FunctorSubtypeInfoStr, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_functor_num_sectag_bits
io.write_uint8(Stream, NumSectagBits, !IO),
io.write_string(Stream, "\n};\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_exist_locns_array(llds_out_info::in, io.text_output_stream::in,
rtti_type_ctor::in, uint32::in, list(exist_typeinfo_locn)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_exist_locns_array(Info, Stream, RttiTypeCtor, Ordinal, Locns,
!DeclSet, !IO) :-
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_exist_locns(Ordinal)),
!DeclSet, !IO),
(
% ANSI/ISO C doesn't allow empty arrays, so
% place a dummy value in the array if necessary.
Locns = [],
io.write_string(Stream, "= { {0, 0} };\n", !IO)
;
Locns = [_ | _],
io.write_string(Stream, " = {\n", !IO),
output_exist_locns(Locns, Stream, !IO),
io.write_string(Stream, "};\n", !IO)
).
:- pred make_exist_tc_constr_id(rtti_type_ctor::in, uint32::in,
int::in, int::in, rtti_id::out) is det.
make_exist_tc_constr_id(RttiTypeCtor, Ordinal, TCNum, Arity, RttiId) :-
RttiName = type_ctor_exist_tc_constr(Ordinal, TCNum, Arity),
RttiId = ctor_rtti_id(RttiTypeCtor, RttiName).
:- pred output_exist_constraints_data(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in, uint32::in,
list(tc_constraint)::in, decl_set::in, decl_set::out,
io::di, io::uo) is det.
output_exist_constraints_data(Info, Stream, RttiTypeCtor, Ordinal, Constraints,
!DeclSet, !IO) :-
list.map_foldl3(output_type_class_constraint(Info, Stream,
make_exist_tc_constr_id(RttiTypeCtor, Ordinal)),
Constraints, ConstraintIds, counter.init(1), _, !DeclSet, !IO),
RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_exist_tc_constrs(Ordinal)),
output_generic_rtti_data_defn_start(Info, Stream, RttiId, !DeclSet, !IO),
io.write_string(Stream, " = {\n\t", !IO),
output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ",
ConstraintIds, Stream, !IO),
io.write_string(Stream, "\n};\n", !IO).
:- pred output_exist_info(llds_out_info::in, io.text_output_stream::in,
rtti_type_ctor::in, uint32::in, exist_info::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_exist_info(Info, Stream, RttiTypeCtor, Ordinal, ExistInfo,
!DeclSet, !IO) :-
ExistInfo = exist_info(Plain, InTci, Constraints, Locns),
output_exist_locns_array(Info, Stream, RttiTypeCtor, Ordinal, Locns,
!DeclSet, !IO),
(
Constraints = [_ | _],
output_exist_constraints_data(Info, Stream, RttiTypeCtor,
Ordinal, Constraints, !DeclSet, !IO)
;
Constraints = []
),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_exist_info(Ordinal)),
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t", !IO),
% MR_exist_typeinfos_plain -- XXX MAKE_FIELD_UNSIGNED
io.write_int16(Stream, int16.cast_from_uint16(Plain), !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_exist_typeinfos_in_tci -- XXX MAKE_FIELD_UNSIGNED
io.write_int16(Stream, int16.cast_from_uint16(InTci), !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_exist_tcis
list.length(Constraints, Tci),
io.write_int16(Stream, int16.det_from_int(Tci), !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_exist_typeinfo_locns
output_ctor_rtti_id(Stream, RttiTypeCtor,
type_ctor_exist_locns(Ordinal), !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_exist_constraints
(
Constraints = [_ | _],
output_ctor_rtti_id(Stream, RttiTypeCtor,
type_ctor_exist_tc_constrs(Ordinal), !IO)
;
Constraints = [],
io.write_string(Stream, "NULL", !IO)
),
io.write_string(Stream, "\n};\n", !IO).
:- pred output_du_arg_types(llds_out_info::in, io.text_output_stream::in,
rtti_type_ctor::in, uint32::in,
list(rtti_maybe_pseudo_type_info_or_self)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_du_arg_types(Info, Stream, RttiTypeCtor, Ordinal, ArgTypes,
!DeclSet, !IO) :-
list.foldl2(output_maybe_pseudo_type_info_or_self_defn(Info, Stream),
ArgTypes, !DeclSet, !IO),
ArgTypeDatas = list.map(maybe_pseudo_type_info_or_self_to_rtti_data,
ArgTypes),
output_record_rtti_datas_decls(Info, Stream, ArgTypeDatas, "", "", 0, _,
!DeclSet, !IO),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_field_types(Ordinal)),
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
expect(list.is_not_empty(ArgTypes), $pred, "empty list"),
output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgTypeDatas,
Stream, !IO),
io.write_string(Stream, "};\n", !IO).
:- pred output_du_arg_names(llds_out_info::in, io.text_output_stream::in,
rtti_type_ctor::in, uint32::in, list(maybe(string))::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_du_arg_names(Info, Stream, RttiTypeCtor, Ordinal, MaybeNames,
!DeclSet, !IO) :-
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_field_names(Ordinal)),
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
expect(list.is_not_empty(MaybeNames), $pred, "empty list"),
output_maybe_quoted_strings(MaybeNames, Stream, !IO),
io.write_string(Stream, "};\n", !IO).
:- pred output_du_arg_locns(llds_out_info::in, io.text_output_stream::in,
rtti_type_ctor::in, uint32::in, list(du_arg_info)::in, bool::out,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_du_arg_locns(Info, Stream, RttiTypeCtor, Ordinal, ArgInfos,
HaveArgLocns, !DeclSet, !IO) :-
( if
some [ArgInfo] (
list.member(ArgInfo, ArgInfos),
ArgInfo = du_arg_info(_, _, Width),
Width \= apw_full(_, _)
)
then
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_field_locns(Ordinal)),
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
output_du_arg_locns_loop(Stream, ArgInfos, !IO),
io.write_string(Stream, "};\n", !IO),
HaveArgLocns = yes
else
HaveArgLocns = no
).
:- pred output_du_arg_locns_loop(io.text_output_stream::in,
list(du_arg_info)::in, io::di, io::uo) is det.
output_du_arg_locns_loop(_, [], !IO).
output_du_arg_locns_loop(Stream, [ArgInfo | ArgInfos], !IO) :-
ArgWidth = ArgInfo ^ du_arg_pos_width,
% The meanings of the various special values of MR_arg_bits
% are documented next to the definition of the MR_DuArgLocn type
% in mercury_type_info.h.
(
ArgWidth = apw_full(arg_only_offset(ArgOnlyOffset), _CellOffset),
% NumBits = 0 means the argument takes a full word.
Shift = 0,
NumBits = 0
;
ArgWidth = apw_double(arg_only_offset(ArgOnlyOffset), _CellOffset,
DoubleWordKind),
% NumBits = -1, -2 and -3 are all special cases, meaning
% double words containing floats, int64s and uint64s respectively.
Shift = 0,
(
DoubleWordKind = dw_float,
NumBits = -1
;
DoubleWordKind = dw_int64,
NumBits = -2
;
DoubleWordKind = dw_uint64,
NumBits = -3
)
;
(
ArgWidth = apw_partial_first(arg_only_offset(ArgOnlyOffset), _,
arg_shift(Shift), arg_num_bits(NumBits0), _Mask, Fill)
;
ArgWidth = apw_partial_shifted(arg_only_offset(ArgOnlyOffset), _,
arg_shift(Shift), arg_num_bits(NumBits0), _Mask, Fill)
),
(
( Fill = fill_enum
; Fill = fill_char21
),
NumBits = NumBits0
;
Fill = fill_int8,
% NumBits = -4 is a special case meaning "int8".
NumBits = -4
;
Fill = fill_uint8,
% NumBits = -5 is a special case meaning "uint8".
NumBits = -5
;
Fill = fill_int16,
% NumBits = -6 is a special case meaning "int16".
NumBits = -6
;
Fill = fill_uint16,
% NumBits = -7 is a special case meaning "uint16".
NumBits = -7
;
Fill = fill_int32,
% NumBits = -8 is a special case meaning "int32".
NumBits = -8
;
Fill = fill_uint32,
% NumBits = -9 is a special case meaning "uint32".
NumBits = -9
)
;
(
ArgWidth = apw_none_shifted(arg_only_offset(ArgOnlyOffset), _)
;
ArgWidth = apw_none_nowhere,
ArgOnlyOffset = -1
),
% NumBits = -10 is a special case meaning "dummy argument".
Shift = 0,
NumBits = -10
),
% MR_arg_offset, MR_arg_shift, MR_arg_bits
io.format(Stream, "\t{ %d, %d, %d },\n",
[i(ArgOnlyOffset), i(Shift), i(NumBits)], !IO),
output_du_arg_locns_loop(Stream, ArgInfos, !IO).
%-----------------------------------------------------------------------------%
:- pred output_enum_ordinal_ordered_table(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in,
map(uint32, enum_functor)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_enum_ordinal_ordered_table(Info, Stream, RttiTypeCtor, FunctorMap,
!DeclSet, !IO) :-
Functors = map.values(FunctorMap),
FunctorRttiNames = list.map(enum_functor_rtti_name, Functors),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_enum_ordinal_ordered_table),
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames,
Stream, !IO),
io.write_string(Stream, "};\n", !IO).
:- pred output_enum_name_ordered_table(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in,
map(string, enum_functor)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_enum_name_ordered_table(Info, Stream, RttiTypeCtor, FunctorMap,
!DeclSet, !IO) :-
Functors = map.values(FunctorMap),
FunctorRttiNames = list.map(enum_functor_rtti_name, Functors),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_enum_name_ordered_table),
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames,
Stream, !IO),
io.write_string(Stream, "};\n", !IO).
:- pred output_foreign_enum_ordinal_ordered_table(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in,
map(uint32, foreign_enum_functor)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_foreign_enum_ordinal_ordered_table(Info, Stream, RttiTypeCtor,
FunctorMap, !DeclSet, !IO) :-
Functors = map.values(FunctorMap),
FunctorRttiNames = list.map(foreign_enum_functor_rtti_name, Functors),
RttiId = ctor_rtti_id(RttiTypeCtor,
type_ctor_foreign_enum_ordinal_ordered_table),
output_generic_rtti_data_defn_start(Info, Stream, RttiId, !DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames,
Stream, !IO),
io.write_string(Stream, "};\n", !IO).
:- pred output_foreign_enum_name_ordered_table(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in,
map(string, foreign_enum_functor)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_foreign_enum_name_ordered_table(Info, Stream, RttiTypeCtor, FunctorMap,
!DeclSet, !IO) :-
Functors = map.values(FunctorMap),
FunctorRttiNames = list.map(foreign_enum_functor_rtti_name, Functors),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_foreign_enum_name_ordered_table),
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames,
Stream, !IO),
io.write_string(Stream, "};\n", !IO).
:- pred output_du_name_ordered_table(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in,
map(string, map(uint16, du_functor))::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_du_name_ordered_table(Info, Stream, RttiTypeCtor, NameArityMap,
!DeclSet, !IO) :-
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(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_du_name_ordered_table),
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames,
Stream, !IO),
io.write_string(Stream, "};\n", !IO).
:- pred output_du_stag_ordered_table(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in,
pair(ptag, sectag_table)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_du_stag_ordered_table(Info, Stream, RttiTypeCtor, Ptag - SectagTable,
!DeclSet, !IO) :-
SectagTable = sectag_table(_SectagLocn, _NumSectagBits, _NumSharers,
SectagMap),
map.values(SectagMap, SectagFunctors),
FunctorNames = list.map(du_functor_rtti_name, SectagFunctors),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_du_stag_ordered_table(Ptag)),
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorNames, Stream, !IO),
io.write_string(Stream, "\n};\n", !IO).
:- pred output_du_ptag_ordered_table(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in, map(ptag, sectag_table)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_du_ptag_ordered_table(Info, Stream, RttiTypeCtor, PtagMap,
!DeclSet, !IO) :-
map.to_assoc_list(PtagMap, PtagList),
list.foldl2(output_du_stag_ordered_table(Info, Stream, RttiTypeCtor),
PtagList, !DeclSet, !IO),
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_du_ptag_ordered_table),
!DeclSet, !IO),
io.write_string(Stream, " = {\n", !IO),
(
PtagList = [FirstPtag - _ | _],
FirstPtag = ptag(LeastPtag)
;
PtagList = [],
unexpected($pred, "bad ptag list")
),
output_du_ptag_ordered_table_body(Stream, RttiTypeCtor, PtagList,
LeastPtag, !IO),
io.write_string(Stream, "\n};\n", !IO).
:- pred output_du_ptag_ordered_table_body(io.text_output_stream::in,
rtti_type_ctor::in, assoc_list(ptag, sectag_table)::in, uint8::in,
io::di, io::uo) is det.
output_du_ptag_ordered_table_body(_, _, [], _, !IO).
output_du_ptag_ordered_table_body(Stream, RttiTypeCtor,
[Ptag - SectagTable | PtagTail], LeastPtag, !IO) :-
Ptag = ptag(PtagUint8),
% ptags for a subtype may start higher than zero, and may skip values.
expect(LeastPtag =< PtagUint8, $pred, "ptag mismatch"),
SectagTable = sectag_table(SectagLocn, NumSectagBits, NumSharers,
_SectagMap),
compute_du_ptag_layout_flags(SectagTable, Flags),
io.write_string(Stream, "\t{ ", !IO),
% MR_sectag_sharers
io.write_uint32(Stream, NumSharers, !IO),
io.write_string(Stream, ", ", !IO),
% MR_sectag_locn
rtti.sectag_locn_to_string(SectagLocn, _TargetPrefixes, LocnStr),
io.write_string(Stream, LocnStr, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_sectag_alternatives
output_ctor_rtti_id(Stream, RttiTypeCtor,
type_ctor_du_stag_ordered_table(Ptag), !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_sectag_numbits
io.write_int8(Stream, NumSectagBits, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_ptag
io.write_uint8(Stream, PtagUint8, !IO),
io.write_string(Stream, ",\n\t", !IO),
% MR_du_ptag_flags
io.write_uint8(Stream, encode_du_ptag_layout_flags(Flags), !IO),
(
PtagTail = [],
io.write_string(Stream, " }\n", !IO)
;
PtagTail = [_ | _],
io.write_string(Stream, " },\n", !IO),
NextLeastPtag = PtagUint8 + 1u8,
output_du_ptag_ordered_table_body(Stream, RttiTypeCtor, PtagTail,
NextLeastPtag, !IO)
).
%-----------------------------------------------------------------------------%
:- func make_code_addr(rtti_proc_label) = code_addr.
make_code_addr(ProcLabel) =
make_entry_label_from_rtti(ProcLabel, for_from_everywhere).
%-----------------------------------------------------------------------------%
:- pred output_functor_number_map(llds_out_info::in,
io.text_output_stream::in, rtti_type_ctor::in,
list(uint32)::in, decl_set::in, decl_set::out, io::di, io::uo) is det.
output_functor_number_map(Info, Stream, RttiTypeCtor, FunctorNumberMap,
!DeclSet, !IO) :-
output_generic_rtti_data_defn_start(Info, Stream,
ctor_rtti_id(RttiTypeCtor, type_ctor_functor_number_map),
!DeclSet, !IO),
io.write_string(Stream, " = {\n\t", !IO),
write_out_list(output_functor_number_map_value, ",\n\t",
FunctorNumberMap, Stream, !IO),
io.write_string(Stream, "\n};\n\t", !IO).
:- pred output_functor_number_map_value(uint32::in, io.text_output_stream::in,
io::di, io::uo) is det.
output_functor_number_map_value(NumUint32, Stream, !IO) :-
% XXX MAKE_FIELD_UNSIGNED
Num = uint32.cast_to_int(NumUint32),
io.write_int(Stream, Num, !IO).
%-----------------------------------------------------------------------------%
:- pred output_generic_rtti_data_decl(llds_out_info::in,
io.text_output_stream::in, rtti_id::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_generic_rtti_data_decl(Info, Stream, RttiId, !DeclSet, !IO) :-
output_rtti_id_storage_type_name(Info, Stream, RttiId, no, !DeclSet, !IO),
io.write_string(Stream, ";\n", !IO),
decl_set_insert(decl_rtti_id(RttiId), !DeclSet).
:- pred output_generic_rtti_data_defn_start(llds_out_info::in,
io.text_output_stream::in, rtti_id::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_generic_rtti_data_defn_start(Info, Stream, RttiId, !DeclSet, !IO) :-
io.write_string(Stream, "\n", !IO),
output_rtti_id_storage_type_name(Info, Stream, RttiId, yes, !DeclSet, !IO),
decl_set_insert(decl_rtti_id(RttiId), !DeclSet).
%-----------------------------------------------------------------------------%
init_rtti_data_if_nec(Stream, Data, !IO) :-
(
Data = rtti_data_type_ctor_info(TypeCtorData),
RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData),
io.write_string(Stream, "\tMR_INIT_TYPE_CTOR_INFO(\n\t\t", !IO),
output_ctor_rtti_id(Stream, RttiTypeCtor,
type_ctor_type_ctor_info, !IO),
io.write_string(Stream, ",\n\t\t", !IO),
RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, Arity),
ModuleNameString = sym_name_mangle(ModuleName),
string.append(ModuleNameString, "__", UnderscoresModule),
( if string.append(UnderscoresModule, _, TypeName) then
true
else
io.write_string(Stream, UnderscoresModule, !IO)
),
MangledTypeName = name_mangle(TypeName),
io.write_string(Stream, MangledTypeName, !IO),
io.write_string(Stream, "_", !IO),
io.write_uint16(Stream, Arity, !IO),
io.write_string(Stream, "_0);\n", !IO)
;
Data = rtti_data_base_typeclass_info(TCName, _ModuleName, ClassArity,
base_typeclass_info(_N1, _N2, _N3, _N4, _N5, Methods)),
io.write_string(Stream, "#ifndef MR_STATIC_CODE_ADDRESSES\n", !IO),
% The field number for the first method is 5, since the methods are
% stored after N1 .. N5, and fields are numbered from 0.
FirstFieldNum = 5,
CodeAddrs = list.map(make_code_addr, Methods),
output_init_method_pointers(Stream, FirstFieldNum, CodeAddrs,
TCName, ClassArity, !IO),
io.write_string(Stream, "#endif /* MR_STATIC_CODE_ADDRESSES */\n", !IO)
;
Data = rtti_data_type_class_instance(_),
io.write_string(Stream, "#ifndef MR_STATIC_CODE_ADDRESSES\n", !IO),
io.write_string(Stream, "#error ""type_class_instance " ++
"not yet supported without static code addresses""\n", !IO),
io.write_string(Stream, "#endif /* MR_STATIC_CODE_ADDRESSES */\n", !IO)
;
( Data = rtti_data_type_info(_)
; Data = rtti_data_pseudo_type_info(_)
; Data = rtti_data_type_class_decl(_)
)
).
register_rtti_data_if_nec(Stream, Data, !IO) :-
(
Data = rtti_data_type_ctor_info(TypeCtorData),
RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData),
RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info),
io.write_string(Stream, "\t{\n\t", !IO),
io.write_string(Stream, "\tMR_register_type_ctor_info(\n\t\t&", !IO),
output_rtti_id(Stream, RttiId, !IO),
io.write_string(Stream, ");\n\t}\n", !IO)
;
Data = rtti_data_type_class_decl(TCDecl),
TCDecl = tc_decl(TCId, _, _),
TCId = tc_id(TCName, _, _),
RttiId = tc_rtti_id(TCName, type_class_decl),
io.write_string(Stream, "\t{\n\t", !IO),
io.write_string(Stream, "\tMR_register_type_class_decl(\n\t\t&", !IO),
output_rtti_id(Stream, RttiId, !IO),
io.write_string(Stream, ");\n\t}\n", !IO)
;
Data = rtti_data_type_class_instance(TCInstance),
TCInstance = tc_instance(TCName, TCTypes, _, _, _),
RttiId = tc_rtti_id(TCName, type_class_instance(TCTypes)),
io.write_string(Stream, "\t{\n\t", !IO),
io.write_string(Stream, "\tMR_register_type_class_instance(\n\t\t&",
!IO),
output_rtti_id(Stream, RttiId, !IO),
io.write_string(Stream, ");\n\t}\n", !IO)
;
( Data = rtti_data_type_info(_)
; Data = rtti_data_pseudo_type_info(_)
; Data = rtti_data_base_typeclass_info(_, _, _, _)
)
).
:- pred output_init_method_pointers(io.text_output_stream::in, int::in,
list(code_addr)::in, tc_name::in, string::in, io::di, io::uo) is det.
output_init_method_pointers(_, _, [], _, _, !IO).
output_init_method_pointers(Stream, FieldNum, [Arg | Args], TCName,
InstanceStr, !IO) :-
PrefixNameStr =
make_base_typeclass_info_name_with_data_prefix(TCName, InstanceStr),
io.format(Stream, "\t\tMR_field(MR_mktag(0), %s , %d) =\n\t\t\t",
[s(PrefixNameStr), i(FieldNum)], !IO),
output_code_addr(Stream, Arg, !IO),
io.write_string(Stream, ";\n", !IO),
output_init_method_pointers(Stream, FieldNum + 1, Args, TCName,
InstanceStr, !IO).
%-----------------------------------------------------------------------------%
:- pred output_record_rtti_datas_decls(llds_out_info::in,
io.text_output_stream::in, list(rtti_data)::in, string::in, string::in,
int::in, int::out, decl_set::in, decl_set::out, io::di, io::uo) is det.
output_record_rtti_datas_decls(_, _, [], _, _, !N, !DeclSet, !IO).
output_record_rtti_datas_decls(Info, Stream, [RttiData | RttiDatas],
FirstIndent, LaterIndent, !N, !DeclSet, !IO) :-
output_record_rtti_data_decls(Info, Stream, RttiData,
FirstIndent, LaterIndent, !N, !DeclSet, !IO),
output_record_rtti_datas_decls(Info, Stream, RttiDatas,
FirstIndent, LaterIndent, !N, !DeclSet, !IO).
:- pred output_record_rtti_data_decls(llds_out_info::in,
io.text_output_stream::in, rtti_data::in, string::in, string::in,
int::in, int::out, decl_set::in, decl_set::out, io::di, io::uo) is det.
output_record_rtti_data_decls(Info, Stream, RttiData, FirstIndent, LaterIndent,
!N, !DeclSet, !IO) :-
( if RttiData = rtti_data_pseudo_type_info(type_var(_)) then
% These just get represented as integers, so we don't need to declare
% them. Also rtti_data_to_id/3 does not handle this case.
true
else
rtti_data_to_id(RttiData, RttiId),
output_record_rtti_id_decls(Info, Stream, RttiId,
FirstIndent, LaterIndent, !N, !DeclSet, !IO)
).
:- pred output_record_rtti_id_decls(llds_out_info::in,
io.text_output_stream::in, rtti_id::in, string::in, string::in,
int::in, int::out, decl_set::in, decl_set::out, io::di, io::uo) is det.
output_record_rtti_id_decls(Info, Stream, RttiId, FirstIndent, LaterIndent,
!N, !DeclSet, !IO) :-
output_record_data_id_decls_format(Info, Stream, rtti_data_id(RttiId),
FirstIndent, LaterIndent, !N, !DeclSet, !IO).
:- pred output_cast_addr_of_rtti_ids(string::in, list(rtti_id)::in,
io.text_output_stream::in, io::di, io::uo) is det.
output_cast_addr_of_rtti_ids(_, [], Stream, !IO) :-
io.write_string(Stream,
"\t/* Dummy entry, since ISO C forbids zero-sized arrays */\n", !IO),
io.write_string(Stream, "\t0\n", !IO).
output_cast_addr_of_rtti_ids(Cast, [TCRttiName | TCRttiNames], Stream, !IO) :-
io.write_string(Stream, "\t", !IO),
write_out_list(output_cast_addr_of_rtti_id(Cast),
",\n\t", [TCRttiName | TCRttiNames], Stream, !IO),
io.write_string(Stream, "\n", !IO).
:- pred output_addr_of_ctor_rtti_names(rtti_type_ctor::in,
list(ctor_rtti_name)::in, io.text_output_stream::in,
io::di, io::uo) is det.
output_addr_of_ctor_rtti_names(_, [], _, !IO).
output_addr_of_ctor_rtti_names(RttiTypeCtor, [RttiName | RttiNames],
Stream, !IO) :-
io.write_string(Stream, "\t", !IO),
write_out_list(output_addr_of_ctor_rtti_id(RttiTypeCtor),
",\n\t", [RttiName | RttiNames], Stream, !IO),
io.write_string(Stream, "\n", !IO).
:- pred output_cast_addr_of_rtti_datas(string::in, list(rtti_data)::in,
io.text_output_stream::in, io::di, io::uo) is det.
output_cast_addr_of_rtti_datas(_, [], Stream, !IO) :-
io.write_string(Stream,
"\t/* Dummy entry, since ISO C forbids zero-sized arrays */\n", !IO),
io.write_string(Stream, "\t0\n", !IO).
output_cast_addr_of_rtti_datas(Cast, [RttiData | RttiDatas], Stream, !IO) :-
io.write_string(Stream, "\t", !IO),
write_out_list(output_cast_addr_of_rtti_data(Cast),
",\n\t", [RttiData | RttiDatas], Stream, !IO),
io.write_string(Stream, "\n", !IO).
output_cast_addr_of_rtti_data(Cast, RttiData, Stream, !IO) :-
io.write_string(Stream, Cast, !IO),
output_addr_of_rtti_data(Stream, RttiData, !IO).
output_addr_of_rtti_data(Stream, RttiData, !IO) :-
( if RttiData = rtti_data_pseudo_type_info(type_var(VarNum)) then
% rtti_data_to_id/3 does not handle this case
io.write_int(Stream, VarNum, !IO)
else
rtti_data_to_id(RttiData, RttiId),
output_addr_of_rtti_id(Stream, RttiId, !IO)
).
:- pred output_cast_addr_of_rtti_id(string::in, rtti_id::in,
io.text_output_stream::in, io::di, io::uo) is det.
output_cast_addr_of_rtti_id(Cast, RttiId, Stream, !IO) :-
io.write_string(Stream, Cast, !IO),
output_addr_of_rtti_id(Stream, RttiId, !IO).
:- pred output_addr_of_rtti_id(io.text_output_stream::in, rtti_id::in,
io::di, io::uo) is det.
output_addr_of_rtti_id(Stream, RttiId, !IO) :-
% All RttiIds are references to memory, with one exception: type variables.
( if
RttiId = ctor_rtti_id(_, type_ctor_pseudo_type_info(type_var(VarNum)))
then
io.write_int(Stream, VarNum, !IO)
else
% If the RttiName is not an array, then we need to use `&'
% to take its address.
IsArray = rtti_id_has_array_type(RttiId),
(
IsArray = is_array,
output_rtti_id(Stream, RttiId, !IO)
;
IsArray = not_array,
io.write_string(Stream, "&", !IO),
output_rtti_id(Stream, RttiId, !IO)
)
).
:- pred output_addr_of_ctor_rtti_id(rtti_type_ctor::in, ctor_rtti_name::in,
io.text_output_stream::in, io::di, io::uo) is det.
output_addr_of_ctor_rtti_id(RttiTypeCtor, RttiName, Stream, !IO) :-
output_addr_of_rtti_id(Stream, ctor_rtti_id(RttiTypeCtor, RttiName), !IO).
output_rtti_id(Stream, RttiId, !IO) :-
rtti.id_to_c_identifier(RttiId, Str),
io.write_string(Stream, mercury_data_prefix, !IO),
io.write_string(Stream, Str, !IO).
:- pred output_ctor_rtti_id(io.text_output_stream::in,
rtti_type_ctor::in, ctor_rtti_name::in, io::di, io::uo) is det.
output_ctor_rtti_id(Stream, RttiTypeCtor, RttiName, !IO) :-
output_rtti_id(Stream, ctor_rtti_id(RttiTypeCtor, RttiName), !IO).
%-----------------------------------------------------------------------------%
:- pred output_maybe_quoted_string(maybe(string)::in,
io.text_output_stream::in, io::di, io::uo) is det.
output_maybe_quoted_string(MaybeName, Stream, !IO) :-
(
MaybeName = yes(Name),
output_quoted_string_c(Stream, Name, !IO)
;
MaybeName = no,
io.write_string(Stream, "NULL", !IO)
).
:- pred output_maybe_quoted_strings(list(maybe(string))::in,
io.text_output_stream::in, io::di, io::uo) is det.
output_maybe_quoted_strings(MaybeNames, Stream, !IO) :-
io.write_string(Stream, "\t", !IO),
write_out_list(output_maybe_quoted_string, ",\n\t", MaybeNames,
Stream, !IO),
io.write_string(Stream, "\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_exist_locn(exist_typeinfo_locn::in, io.text_output_stream::in,
io::di, io::uo) is det.
output_exist_locn(Locn, Stream, !IO) :-
(
Locn = plain_typeinfo(SlotInCell),
io.write_string(Stream, "{ ", !IO),
% MR_exist_arg_num -- XXX MAKE_FIELD_UNSIGNED
io.write_int16(Stream, int16.cast_from_uint16(SlotInCell), !IO),
% MR_exist_offset_in_tci
io.write_string(Stream, ", -1 }", !IO)
;
Locn = typeinfo_in_tci(SlotInCell, SlotInTci),
io.write_string(Stream, "{ ", !IO),
% MR_exist_arg_num -- XXX MAKE_FIELD_UNSIGNED
io.write_int16(Stream, int16.cast_from_uint16(SlotInCell), !IO),
io.write_string(Stream, ", ", !IO),
% MR_exist_offset_in_tci -- XXX MAKE_FIELD_UNSIGNED
io.write_int16(Stream, int16.cast_from_uint16(SlotInTci), !IO),
io.write_string(Stream, " }", !IO)
).
:- pred output_exist_locns(list(exist_typeinfo_locn)::in,
io.text_output_stream::in, io::di, io::uo) is det.
output_exist_locns(Locns, Stream, !IO) :-
io.write_string(Stream, "\t", !IO),
write_out_list(output_exist_locn, ",\n\t", Locns, Stream, !IO),
io.write_string(Stream, "\n", !IO).
:- pred output_maybe_static_code_addr(maybe(code_addr)::in,
io.text_output_stream::in, io::di, io::uo) is det.
:- pragma consider_used(pred(output_maybe_static_code_addr/4)).
output_maybe_static_code_addr(yes(CodeAddr), Stream, !IO) :-
output_static_code_addr(CodeAddr, Stream, !IO).
output_maybe_static_code_addr(no, Stream, !IO) :-
io.write_string(Stream, "NULL", !IO).
:- pred output_static_code_addr(code_addr::in, io.text_output_stream::in,
io::di, io::uo) is det.
output_static_code_addr(CodeAddr, Stream, !IO) :-
io.write_string(Stream, "MR_MAYBE_STATIC_CODE(", !IO),
output_code_addr(Stream, CodeAddr, !IO),
io.write_string(Stream, ")", !IO).
%-----------------------------------------------------------------------------%
:- pred rtti_id_linkage(rtti_id::in, linkage::out) is det.
rtti_id_linkage(RttiId, Linkage) :-
IsArray = rtti_id_has_array_type(RttiId),
(
IsArray = is_array,
% ANSI/ISO C doesn't allow forward declarations of static data
% with incomplete types (in this case array types without an explicit
% array size), so make the declarations extern.
Linkage = extern
;
IsArray = not_array,
Exported = rtti_id_is_exported(RttiId),
( Exported = yes, Linkage = extern
; Exported = no, Linkage = static
)
).
%-----------------------------------------------------------------------------%
output_rtti_id_storage_type_name(Info, Stream, RttiId, BeingDefined,
!DeclSet, !IO) :-
output_rtti_type_decl(Stream, RttiId, !DeclSet, !IO),
rtti_id_linkage(RttiId, Linkage),
LinkageStr = c_data_linkage_string(Linkage, BeingDefined),
Globals = Info ^ lout_globals,
InclCodeAddr = rtti_id_would_include_code_addr(RttiId),
ConstStr = c_data_const_string(Globals, InclCodeAddr),
rtti_id_c_type(RttiId, CType, IsArray),
io.format(Stream, "%s%s%s ", [s(LinkageStr), s(ConstStr), s(CType)], !IO),
output_rtti_id(Stream, RttiId, !IO),
(
IsArray = is_array,
io.write_string(Stream, "[]", !IO)
;
IsArray = not_array
).
% 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(io.text_output_stream::in, rtti_id::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_rtti_type_decl(Stream, RttiId, !DeclSet, !IO) :-
( if
RttiId = ctor_rtti_id(_, RttiName),
rtti_type_ctor_template_arity(RttiName, Arity),
Arity > max_always_declared_arity_type_ctor
then
DeclId = decl_type_info_like_struct(Arity),
( if decl_set_insert_new(DeclId, !DeclSet) then
Template =
"#ifndef MR_TYPE_INFO_LIKE_STRUCTS_FOR_ARITY_%d_GUARD
#define MR_TYPE_INFO_LIKE_STRUCTS_FOR_ARITY_%d_GUARD
MR_DECLARE_ALL_TYPE_INFO_LIKE_STRUCTS_FOR_ARITY(%d);
#endif
",
io.format(Stream, Template, [i(Arity), i(Arity), i(Arity)], !IO)
else
true
)
else if
RttiId = tc_rtti_id(_, TCRttiName),
rtti_type_class_constraint_template_arity(TCRttiName, Arity),
Arity > max_always_declared_arity_type_class_constraint
then
DeclId = decl_typeclass_constraint_struct(Arity),
( if decl_set_insert_new(DeclId, !DeclSet) then
Template =
"#ifndef MR_TYPECLASS_CONSTRAINT_STRUCT_%d_GUARD
#define MR_TYPECLASS_CONSTRAINT_STRUCT_%d_GUARD
MR_DEFINE_TYPECLASS_CONSTRAINT_STRUCT(MR_TypeClassConstraint_%d, %d);
#endif
",
io.format(Stream, Template,
[i(Arity), i(Arity), i(Arity), i(Arity)], !IO)
else
true
)
else
true
).
:- pred rtti_type_ctor_template_arity(ctor_rtti_name::in, int::out) is semidet.
rtti_type_ctor_template_arity(RttiName, NumArgTypes) :-
(
RttiName = type_ctor_type_info(TypeInfo),
require_complete_switch [TypeInfo]
(
( TypeInfo = plain_type_info(_, ArgTypes)
; TypeInfo = var_arity_type_info(_, ArgTypes)
),
list.length(ArgTypes, NumArgTypes)
;
TypeInfo = plain_arity_zero_type_info(_),
NumArgTypes = 0
)
;
RttiName = type_ctor_pseudo_type_info(PseudoTypeInfo),
require_complete_switch [PseudoTypeInfo]
(
( PseudoTypeInfo = plain_pseudo_type_info(_, ArgTypes)
; PseudoTypeInfo = var_arity_pseudo_type_info(_, ArgTypes)
),
list.length(ArgTypes, NumArgTypes)
;
PseudoTypeInfo = plain_arity_zero_pseudo_type_info(_),
NumArgTypes = 0
;
PseudoTypeInfo = type_var(_),
fail
)
).
:- func max_always_declared_arity_type_ctor = int.
max_always_declared_arity_type_ctor = 20.
:- pred rtti_type_class_constraint_template_arity(tc_rtti_name::in, int::out)
is semidet.
rtti_type_class_constraint_template_arity(TCRttiName, Arity) :-
( TCRttiName = type_class_decl_super(_, Arity)
; TCRttiName = type_class_instance_constraint(_, _, Arity)
).
:- func max_always_declared_arity_type_class_constraint = int.
max_always_declared_arity_type_class_constraint = 10.
%-----------------------------------------------------------------------------%
output_rtti_id_storage_type_name_no_decl(Info, Stream, RttiId, BeingDefined,
!IO) :-
decl_set_init(DeclSet0),
output_rtti_id_storage_type_name(Info, Stream, RttiId, BeingDefined,
DeclSet0, _, !IO).
%-----------------------------------------------------------------------------%
tabling_struct_data_addr_string(ProcLabel, Id) =
mercury_var_prefix ++ "_proc" ++ tabling_info_id_str(Id) ++ "__" ++
proc_label_to_c_string(do_not_add_label_prefix, ProcLabel).
%-----------------------------------------------------------------------------%
:- end_module ll_backend.rtti_out.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink