%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2012 The University of Melbourne.
% Copyright (C) 2014-2021 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_to_mlds.m.
% Authors: fjh, zs.
%
% This module defines routines to convert from the back-end-independent
% RTTI data structures into MLDS definitions.
% The RTTI data structures are used for static data that is used
% for handling RTTI, polymorphism, and typeclasses.
%
%-----------------------------------------------------------------------------%

:- module ml_backend.rtti_to_mlds.
:- interface.

:- import_module backend_libs.
:- import_module backend_libs.rtti.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module ml_backend.ml_global_data.
:- import_module ml_backend.mlds.

:- import_module list.

%-----------------------------------------------------------------------------%

    % Add the MLDS definitions for the given rtti_data(s) to the
    % ml_global_data structure.
    %
:- pred add_rtti_datas_to_mlds(module_info::in, mlds_target_lang::in,
    list(rtti_data)::in, ml_global_data::in, ml_global_data::out) is det.
:- pred add_rtti_data_to_mlds(module_info::in, mlds_target_lang::in,
    rtti_data::in, ml_global_data::in, ml_global_data::out) is det.

    % Given a list of MLDS RTTI data definitions, return the definitions
    % such that if X appears in the initialiser for Y then X appears earlier in
    % the list than Y.
    %
    % This function returns a list of cliques so that problems with ordering
    % within cliques, if any, may be easier to discover.
    %
:- func order_mlds_rtti_defns(list(mlds_global_var_defn)) =
    list(list(mlds_global_var_defn)).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module backend_libs.type_ctor_info.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_rtti.
:- import_module libs.
:- import_module libs.globals.
:- import_module mdbcomp.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module ml_backend.ml_args_util.
:- import_module ml_backend.ml_closure_gen.
:- import_module ml_backend.ml_code_util.
:- import_module ml_backend.ml_gen_info.
:- import_module ml_backend.ml_util.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.

:- import_module assoc_list.
:- import_module bool.
:- import_module counter.
:- import_module digraph.
:- import_module int16.
:- import_module int32.
:- import_module int8.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module term_context.
:- import_module uint.
:- import_module uint16.
:- import_module uint32.
:- import_module uint8.
:- import_module univ.

%-----------------------------------------------------------------------------%

add_rtti_datas_to_mlds(ModuleInfo, Target, RttiDatas, !GlobalData) :-
    list.foldl(add_rtti_data_to_mlds(ModuleInfo, Target),
        RttiDatas, !GlobalData).

add_rtti_data_to_mlds(ModuleInfo, Target, RttiData, !GlobalData) :-
    ( if RttiData = rtti_data_pseudo_type_info(type_var(_)) then
        % These just get represented as integers, so we don't need to define
        % a structure for them; which is why rtti_data_to_id/3 does not
        % handle this case.
        true
    else
        gen_init_rtti_data_defn(ModuleInfo, Target, RttiData, !GlobalData)
    ).

:- pred rtti_name_and_init_to_defn(rtti_type_ctor::in, ctor_rtti_name::in,
    mlds_initializer::in, ml_global_data::in, ml_global_data::out) is det.

rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer, !GlobalData) :-
    RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
    rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).

:- pred rtti_id_and_init_to_defn(rtti_id::in, mlds_initializer::in,
    ml_global_data::in, ml_global_data::out) is det.

rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData) :-
    Name = gvn_rtti_var(RttiId),
    rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer, !GlobalData).

:- pred rtti_entity_name_and_init_to_defn(mlds_global_var_name::in,
    rtti_id::in, mlds_initializer::in,
    ml_global_data::in, ml_global_data::out) is det.

rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer, !GlobalData) :-
    % Generate the context.
    %
    % XXX The rtti_data ought to include a prog_context (the context of the
    % corresponding type or instance definition).
    Context = dummy_context,

    % Generate the declaration flags.
    Exported = rtti_id_is_exported(RttiId),
    (
        Exported = no,
        Access = gvar_acc_module_only
    ;
        Exported = yes,
        Access = gvar_acc_whole_program
    ),
    Flags = rtti_data_decl_flags(Access),

    % The GC never needs to trace these definitions, because they are static
    % constants, and can point only to other static constants, not to the heap.
    GCStatement = gc_no_stmt,

    % Generate the declaration body, i.e. the type and the initializer.
    MLDS_Type = mlds_rtti_type(item_type(RttiId)),
    DataDefn = mlds_global_var_defn(Name, Context, Flags, MLDS_Type,
        Initializer, GCStatement),

    ml_global_data_add_rtti_defn(DataDefn, !GlobalData).

    % Return the declaration flags appropriate for an rtti_data.
    %
:- func rtti_data_decl_flags(global_var_access) = mlds_global_var_decl_flags.

rtti_data_decl_flags(Access) = mlds_global_var_decl_flags(Access, const).

%-----------------------------------------------------------------------------%

    % Return an MLDS initializer for the given RTTI definition
    % occurring in the given module.
    %
:- pred gen_init_rtti_data_defn(module_info::in, mlds_target_lang::in,
    rtti_data::in, ml_global_data::in, ml_global_data::out) is det.

gen_init_rtti_data_defn(ModuleInfo, Target, RttiData, !GlobalData) :-
    rtti_data_to_id(RttiData, RttiId),
    Name = gvn_rtti_var(RttiId),
    (
        RttiData = rtti_data_base_typeclass_info(_InstanceModule, _ClassId,
            _InstanceStr, BaseTypeClassInfo),
        BaseTypeClassInfo = base_typeclass_info(N1, N2, N3, N4, N5, Methods),
        NumExtra = BaseTypeClassInfo ^ num_extra,
        list.map_foldl(gen_init_method(ModuleInfo, Target, NumExtra),
            Methods, MethodInitializers, !GlobalData),
        Initializer = init_array([
            gen_init_boxed_int(N1),
            gen_init_boxed_int(N2),
            gen_init_boxed_int(N3),
            gen_init_boxed_int(N4),
            gen_init_boxed_int(N5)
            | MethodInitializers
        ]),
        rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer,
            !GlobalData)
    ;
        RttiData = rtti_data_type_info(TypeInfo),
        gen_type_info_defn(ModuleInfo, Target, TypeInfo, Name,
            RttiId, !GlobalData)
    ;
        RttiData = rtti_data_pseudo_type_info(PseudoTypeInfo),
        gen_pseudo_type_info_defn(ModuleInfo, Target, PseudoTypeInfo, Name,
            RttiId, !GlobalData)
    ;
        RttiData = rtti_data_type_class_decl(TCDecl),
        gen_type_class_decl_defn(ModuleInfo, Target, TCDecl, Name,
            RttiId, !GlobalData)
    ;
        RttiData = rtti_data_type_class_instance(Instance),
        gen_type_class_instance_defn(ModuleInfo, Target, Instance, Name,
            RttiId, !GlobalData)
    ;
        RttiData = rtti_data_type_ctor_info(TypeCtorData),
        TypeCtorData = type_ctor_data(Version, TypeModule, TypeName,
            TypeArity, UnifyUniv, CompareUniv, Flags, TypeCtorDetails),
        RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName, TypeArity),
        TypeModuleName = sym_name_to_string(TypeModule),
        MaybeNumPtags = type_ctor_details_num_ptags(TypeCtorDetails),
        (
            MaybeNumPtags = yes(NumPtags),
            NumPtagsEncoding = int8.det_from_int(NumPtags)
        ;
            MaybeNumPtags = no,
            NumPtagsEncoding = -1i8
        ),
        MaybeNumFunctors = type_ctor_details_num_functors(TypeCtorDetails),
        (
            MaybeNumFunctors = yes(NumFunctors),
            NumFunctorsEncoding = NumFunctors
        ;
            MaybeNumFunctors = no,
            NumFunctorsEncoding = -1
        ),
        FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_functors),
        LayoutRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_layout),

        gen_functors_layout_info(ModuleInfo, Target, RttiTypeCtor,
            TypeCtorDetails, FunctorsInfo, LayoutInfo, NumberMapInfo,
            BaseTypeCtorInitializer, !GlobalData),

        % Note that gen_init_special_pred will by necessity add an extra
        % level of indirection to calling the special preds. However, the
        % backend compiler should be smart enough to ensure that this is
        % inlined away.
        gen_init_special_pred(ModuleInfo, Target,
            UnifyUniv, UnifyInitializer, !GlobalData),
        gen_init_special_pred(ModuleInfo, Target,
            CompareUniv, CompareInitializer, !GlobalData),

        Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
            % MR_type_ctor_arity -- XXX MAKE_FIELD_UNSIGNED
            gen_init_int(uint16.to_int(TypeArity)),
            % MR_type_ctor_version
            gen_init_uint8(Version),
            % MR_type_ctor_num_ptags
            gen_init_int8(NumPtagsEncoding),
            % MR_type_ctor_rep_CAST_ME
            gen_init_type_ctor_rep(TypeCtorData),
            % MR_type_ctor_unify_pred
            UnifyInitializer,
            % MR_type_ctor_compare_pred
            CompareInitializer,
            % MR_type_ctor_module_name
            gen_init_string(TypeModuleName),
            % MR_type_ctor_name
            gen_init_string(TypeName),
            % In the C back-end, these two "structs" are actually unions.
            % We need to use `init_struct' here so that the initializers
            % get enclosed in curly braces.
            % MR_type_ctor_functors
            init_struct(mlds_rtti_type(item_type(FunctorsRttiId)), [
                FunctorsInfo
            ]),
            % MR_type_ctor_layout
            init_struct(mlds_rtti_type(item_type(LayoutRttiId)), [
                LayoutInfo
            ]),
            % MR_type_ctor_num_functors
            gen_init_int(NumFunctorsEncoding),
            % MR_type_ctor_flags
            gen_init_uint16(encode_type_ctor_flags(Flags)),
            % MR_type_ctor_functor_number_map
            NumberMapInfo,
            % MR_type_ctor_base
            BaseTypeCtorInitializer

            % These two are commented out while the corresponding fields of the
            % MR_TypeCtorInfo_Struct type are commented out.
            % gen_init_maybe(gen_init_rtti_name(RttiTypeCtor), MaybeHashCons),
            % XXX this may need to change to call
            % gen_init_special_pred, if this is re-enabled.
            % gen_init_proc_id_from_univ(ModuleInfo, PrettyprinterProc)
        ]),
        rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer,
            !GlobalData)
    ).

%-----------------------------------------------------------------------------%

:- pred gen_type_class_decl_defn(module_info::in, mlds_target_lang::in,
    tc_decl::in, mlds_global_var_name::in, rtti_id::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_type_class_decl_defn(ModuleInfo, Target, TCDecl, Name, RttiId,
        !GlobalData) :-
    TCDecl = tc_decl(TCId, Version, Supers),
    TCId = tc_id(TCName, TVarNames, MethodIds),
    TCName = tc_name(ModuleSymName, ClassName, Arity),
    module_info_get_name(ModuleInfo, ModuleName),
    TVarNamesRttiId = tc_rtti_id(TCName, type_class_id_var_names),
    (
        TVarNames = [],
        TVarNamesInitType = mlds_rtti_type(item_type(TVarNamesRttiId)),
        TVarNamesInitializer = gen_init_null_pointer(TVarNamesInitType)
    ;
        TVarNames = [_ | _],
        gen_tc_id_var_names(TVarNamesRttiId, TVarNames, !GlobalData),
        TVarNamesInitializer = gen_init_rtti_id(ModuleName, TVarNamesRttiId)
    ),
    MethodIdsRttiId = tc_rtti_id(TCName, type_class_id_method_ids),
    (
        MethodIds = [],
        MethodIdsInitType = mlds_rtti_type(item_type(MethodIdsRttiId)),
        MethodIdsInitializer = gen_init_null_pointer(MethodIdsInitType)
    ;
        MethodIds = [_ | _],
        gen_tc_id_method_ids(MethodIdsRttiId, TCName, MethodIds, !GlobalData),
        MethodIdsInitializer = gen_init_rtti_id(ModuleName, MethodIdsRttiId)
    ),
    TCIdRttiId = tc_rtti_id(TCName, type_class_id),
    ModuleSymNameStr = sym_name_to_string(ModuleSymName),
    list.length(TVarNames, NumTVars),
    list.length(MethodIds, NumMethods),
    TCIdInitializer = init_struct(mlds_rtti_type(item_type(TCIdRttiId)), [
        gen_init_string(ModuleSymNameStr),
        gen_init_string(ClassName),
        gen_init_int(Arity),
        gen_init_int(NumTVars),
        gen_init_int(NumMethods),
        TVarNamesInitializer,
        MethodIdsInitializer
    ]),
    rtti_id_and_init_to_defn(TCIdRttiId, TCIdInitializer, !GlobalData),
    (
        Supers = []
    ;
        Supers = [_ | _],
        list.map_foldl2(
            gen_tc_constraint(ModuleInfo, Target, make_decl_super_id(TCName)),
            Supers, SuperRttiIds, counter.init(1), _, !GlobalData),
        SuperArrayRttiName = type_class_decl_supers,
        SuperArrayRttiId = tc_rtti_id(TCName, SuperArrayRttiName),
        ElementType = mlds_rtti_type(element_type(SuperArrayRttiId)),
        SuperArrayInitializer = gen_init_array(
            gen_init_cast_rtti_id(ElementType, ModuleName), SuperRttiIds),
        rtti_id_and_init_to_defn(SuperArrayRttiId, SuperArrayInitializer,
            !GlobalData)
    ),
    % XXX Is MethodIdsRttiId the right thing to take the type from?
    SupersInitType = mlds_rtti_type(item_type(MethodIdsRttiId)),
    SupersInitializer = gen_init_null_pointer(SupersInitType),
    list.length(Supers, NumSupers),
    Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
        gen_init_rtti_id(ModuleName, TCIdRttiId),
        gen_init_int(Version),
        gen_init_int(NumSupers),
        SupersInitializer
    ]),
    rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer, !GlobalData).

:- pred make_decl_super_id(tc_name::in, int::in, int::in, rtti_id::out) is det.

make_decl_super_id(TCName, TCNum, Arity, RttiId) :-
    TCRttiName = type_class_decl_super(TCNum, Arity),
    RttiId = tc_rtti_id(TCName, TCRttiName).

:- pred gen_tc_id_var_names(rtti_id::in, list(string)::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_tc_id_var_names(RttiId, Names, !GlobalData) :-
    Initializer = gen_init_array(gen_init_string, Names),
    rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).

:- pred gen_tc_id_method_ids(rtti_id::in, tc_name::in, list(tc_method_id)::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_tc_id_method_ids(RttiId, TCName, MethodIds, !GlobalData) :-
    Initializer = gen_init_array(gen_tc_id_method_id(TCName), MethodIds),
    rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).

:- func gen_tc_id_method_id(tc_name, tc_method_id) = mlds_initializer.

gen_tc_id_method_id(TCName, MethodId) = Initializer :-
    MethodId = tc_method_id(MethodName, MethodArity, PredOrFunc),
    RttiId = tc_rtti_id(TCName, type_class_id_method_ids),
    Initializer = init_struct(mlds_rtti_type(element_type(RttiId)), [
        gen_init_string(MethodName),
        gen_init_int(MethodArity),
        gen_init_pred_or_func(PredOrFunc)
    ]).

%-----------------------------------------------------------------------------%

:- pred gen_type_class_instance_defn(module_info::in, mlds_target_lang::in,
    tc_instance::in, mlds_global_var_name::in, rtti_id::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_type_class_instance_defn(ModuleInfo, Target, Instance, Name, RttiId,
        !GlobalData) :-
    Instance = tc_instance(TCName, Types, NumTypeVars,
        InstanceConstraints, _Methods),
    TCDeclRttiId = tc_rtti_id(TCName, type_class_decl),
    list.length(InstanceConstraints, NumInstanceConstraints),
    InstanceTypesTCRttiName = type_class_instance_tc_type_vector(Types),
    InstanceTypesRttiId = tc_rtti_id(TCName, InstanceTypesTCRttiName),
    InstanceConstrsTCRttiName = type_class_instance_constraints(Types),
    InstanceConstrsRttiId = tc_rtti_id(TCName, InstanceConstrsTCRttiName),
    module_info_get_name(ModuleInfo, ModuleName),

    TypeRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, Types),
    gen_pseudo_type_info_array(ModuleInfo, Target, TypeRttiDatas,
        TypesInitializer, !GlobalData),
    rtti_id_and_init_to_defn(InstanceTypesRttiId, TypesInitializer,
        !GlobalData),

    list.map_foldl2(
        gen_tc_constraint(ModuleInfo, Target,
            make_instance_constr_id(TCName, Types)),
        InstanceConstraints, TCConstrIds, counter.init(1), _, !GlobalData),
    ElementType = mlds_rtti_type(element_type(InstanceConstrsRttiId)),
    InstanceConstrsInitializer = gen_init_array(
        gen_init_cast_rtti_id(ElementType, ModuleName), TCConstrIds),
    rtti_id_and_init_to_defn(InstanceConstrsRttiId, InstanceConstrsInitializer,
        !GlobalData),

    Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
        gen_init_rtti_id(ModuleName, TCDeclRttiId),
        gen_init_int(NumTypeVars),
        gen_init_int(NumInstanceConstraints),
        gen_init_rtti_id(ModuleName, InstanceTypesRttiId),
        gen_init_rtti_id(ModuleName, InstanceConstrsRttiId)
    ]),
    rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer, !GlobalData).

:- pred make_instance_constr_id(tc_name::in, list(tc_type)::in,
    int::in, int::in, rtti_id::out) is det.

make_instance_constr_id(TCName, Types, TCNum, Arity, RttiId) :-
    RttiName = type_class_instance_constraint(Types, TCNum, Arity),
    RttiId = tc_rtti_id(TCName, RttiName).

%-----------------------------------------------------------------------------%

:- pred gen_type_info_defn(module_info::in, mlds_target_lang::in,
    rtti_type_info::in, mlds_global_var_name::in, rtti_id::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_type_info_defn(ModuleInfo, Target, RttiTypeInfo, Name, RttiId,
        !GlobalData) :-
    (
        RttiTypeInfo = plain_arity_zero_type_info(_),
        unexpected($pred, "plain_arity_zero_type_info")
    ;
        RttiTypeInfo = plain_type_info(RttiTypeCtor, ArgTypes),
        ml_global_data_get_pdup_rval_type_map(!.GlobalData, PDupRvalTypeMap),
        ( if map.search(PDupRvalTypeMap, RttiId, _) then
            % We have already generated the required global data structures.
            true
        else
            ArgRttiDatas = list.map(type_info_to_rtti_data, ArgTypes),
            RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
            list.foldl(add_rtti_data_to_mlds(ModuleInfo, Target),
                RealRttiDatas, !GlobalData),
            module_info_get_name(ModuleInfo, ModuleName),
            Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
                gen_init_rtti_name(ModuleName, RttiTypeCtor,
                    type_ctor_type_ctor_info),
                gen_init_cast_rtti_datas_array(mlds_type_info_type,
                    ModuleName, ArgRttiDatas)
            ]),
            rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer,
                !GlobalData),

            MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
            Rval = ml_const(mlconst_data_addr_rtti(MLDS_ModuleName, RttiId)),
            Type = mlds_rtti_type(item_type(RttiId)),
            RvalType = ml_rval_and_type(Rval, Type),

            ml_global_data_add_pdup_rtti_id(RttiId, RvalType, !GlobalData)
        )
    ;
        RttiTypeInfo = var_arity_type_info(VarArityId, ArgTypes),
        ml_global_data_get_pdup_rval_type_map(!.GlobalData, PDupRvalTypeMap),
        ( if map.search(PDupRvalTypeMap, RttiId, _) then
            % We have already generated the required global data structures.
            true
        else
            ArgRttiDatas = list.map(type_info_to_rtti_data, ArgTypes),
            RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
            list.foldl(add_rtti_data_to_mlds(ModuleInfo, Target),
                RealRttiDatas, !GlobalData),
            RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
            module_info_get_name(ModuleInfo, ModuleName),

            InitRttiName = gen_init_rtti_name(ModuleName, RttiTypeCtor,
                type_ctor_type_ctor_info),
            InitCastRttiDatasArray = gen_init_cast_rtti_datas_array(
                mlds_type_info_type, ModuleName, ArgRttiDatas),
            (
                Target = ml_target_java,
                % For Java we need to omit the arity argument as the
                % TypeInfo_Struct class doesn't have a constructor that
                % supports it -- see java/runtime/TypeInfo_Struct.java for
                % details.
                %
                % NOTE: this needs to be kept consistent with
                %
                %   polymorphism.polymorphism_construct_type_info/10
                %   java/runtime/TypeInfo_Struct.java
                %
                % as well as the code for handling pseudo type-infos below.
                %
                InitializerArgs = [InitRttiName, InitCastRttiDatasArray]
            ;
                ( Target = ml_target_c
                ; Target = ml_target_csharp
                ),
                InitializerArgs = [
                    InitRttiName,
                    gen_init_int(list.length(ArgTypes)),
                    InitCastRttiDatasArray]
            ),
            Initializer = init_struct(mlds_rtti_type(item_type(RttiId)),
                InitializerArgs),
            rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer,
                !GlobalData),

            MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
            Rval = ml_const(mlconst_data_addr_rtti(MLDS_ModuleName, RttiId)),
            Type = mlds_rtti_type(item_type(RttiId)),
            RvalType = ml_rval_and_type(Rval, Type),

            ml_global_data_add_pdup_rtti_id(RttiId, RvalType, !GlobalData)
        )
    ).

:- pred gen_pseudo_type_info_defn(module_info::in, mlds_target_lang::in,
    rtti_pseudo_type_info::in, mlds_global_var_name::in, rtti_id::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_pseudo_type_info_defn(ModuleInfo, Target, RttiPseudoTypeInfo, Name, RttiId,
        !GlobalData) :-
    (
        RttiPseudoTypeInfo = plain_arity_zero_pseudo_type_info(_),
        unexpected($pred, "plain_arity_zero_pseudo_type_info")
    ;
        RttiPseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, ArgTypes),
        ml_global_data_get_pdup_rval_type_map(!.GlobalData, PDupRvalTypeMap),
        ( if map.search(PDupRvalTypeMap, RttiId, _) then
            % We have already generated the required global data structures.
            true
        else
            ArgRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data,
                ArgTypes),
            RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
            list.foldl(add_rtti_data_to_mlds(ModuleInfo, Target),
                RealRttiDatas, !GlobalData),
            module_info_get_name(ModuleInfo, ModuleName),
            Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
                gen_init_rtti_name(ModuleName, RttiTypeCtor,
                    type_ctor_type_ctor_info),
                gen_init_cast_rtti_datas_array(mlds_pseudo_type_info_type,
                    ModuleName, ArgRttiDatas)
            ]),
            rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer,
                !GlobalData),

            MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
            Rval = ml_const(mlconst_data_addr_rtti(MLDS_ModuleName, RttiId)),
            Type = mlds_rtti_type(item_type(RttiId)),
            RvalType = ml_rval_and_type(Rval, Type),

            ml_global_data_add_pdup_rtti_id(RttiId, RvalType, !GlobalData)
        )
    ;
        RttiPseudoTypeInfo = var_arity_pseudo_type_info(VarArityId, ArgTypes),
        ml_global_data_get_pdup_rval_type_map(!.GlobalData, PDupRvalTypeMap),
        ( if map.search(PDupRvalTypeMap, RttiId, _) then
            % We have already generated the required global data structures.
            true
        else
            ArgRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data,
                ArgTypes),
            RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
            list.foldl(add_rtti_data_to_mlds(ModuleInfo, Target),
                RealRttiDatas, !GlobalData),
            RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
            module_info_get_name(ModuleInfo, ModuleName),
            module_info_get_globals(ModuleInfo, Globals),
            globals.get_target(Globals, TargetLang),

            InitRttiName = gen_init_rtti_name(ModuleName, RttiTypeCtor,
                type_ctor_type_ctor_info),
            InitCastRttiDatasArray = gen_init_cast_rtti_datas_array(
                mlds_pseudo_type_info_type, ModuleName, ArgRttiDatas),
            ( if TargetLang = target_java then
                % For Java we need to omit the arity argument as the
                % TypeInfo_Struct class doesn't have a constructor that
                % supports it. The TypeInfo_Struct class is used to represent
                % pseudo type-infos with the Java backend.
                % (See java/runtime/PseudoTypeInfo.java for details.)
                InitializerArgs = [InitRttiName, InitCastRttiDatasArray]
            else
                InitializerArgs = [
                    InitRttiName,
                    gen_init_int(list.length(ArgTypes)),
                    InitCastRttiDatasArray
                ]
            ),
            Initializer = init_struct(mlds_rtti_type(item_type(RttiId)),
                InitializerArgs),
            rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer,
                !GlobalData),

            MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
            Rval = ml_const(mlconst_data_addr_rtti(MLDS_ModuleName, RttiId)),
            Type = mlds_rtti_type(item_type(RttiId)),
            RvalType = ml_rval_and_type(Rval, Type),

            ml_global_data_add_pdup_rtti_id(RttiId, RvalType, !GlobalData)
        )
    ;
        RttiPseudoTypeInfo = type_var(_),
        unexpected($pred, "type_var")
    ).

%-----------------------------------------------------------------------------%

:- pred gen_functors_layout_info(module_info::in, mlds_target_lang::in,
    rtti_type_ctor::in, type_ctor_details::in,
    mlds_initializer::out, mlds_initializer::out, mlds_initializer::out,
    mlds_initializer::out, ml_global_data::in, ml_global_data::out) is det.

gen_functors_layout_info(ModuleInfo, Target, RttiTypeCtor, TypeCtorDetails,
        FunctorInitializer, LayoutInitializer, NumberMapInitializer,
        BaseTypeCtorInitializer, !GlobalData) :-
    module_info_get_name(ModuleInfo, ModuleName),
    (
        TypeCtorDetails = tcd_enum(_, _IsDummy, EnumFunctors,
            EnumByOrd, EnumByName, FunctorNumberMap, MaybeBaseTypeCtor),
        list.foldl(gen_enum_functor_desc(ModuleInfo, RttiTypeCtor),
            EnumFunctors, !GlobalData),
        gen_enum_ordinal_ordered_table(ModuleInfo, RttiTypeCtor,
            EnumByOrd, !GlobalData),
        gen_enum_name_ordered_table(ModuleInfo, RttiTypeCtor,
            EnumByName, !GlobalData),
        gen_functor_number_map(RttiTypeCtor, FunctorNumberMap, !GlobalData),
        LayoutInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_enum_ordinal_ordered_table),
        FunctorInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_enum_name_ordered_table),
        NumberMapInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_functor_number_map),
        BaseTypeCtorInitializer = gen_init_base_type_ctor(ModuleName, Target,
            MaybeBaseTypeCtor)
    ;
        TypeCtorDetails = tcd_foreign_enum(ForeignEnumLang, _,
            ForeignEnumFunctors, ForeignEnumByOrdinal, ForeignEnumByName,
            FunctorNumberMap),
        list.foldl(
            gen_foreign_enum_functor_desc(ModuleInfo, ForeignEnumLang,
                RttiTypeCtor),
            ForeignEnumFunctors, !GlobalData),
        gen_foreign_enum_ordinal_ordered_table(ModuleInfo, RttiTypeCtor,
            ForeignEnumByOrdinal, !GlobalData),
        gen_foreign_enum_name_ordered_table(ModuleInfo, RttiTypeCtor,
            ForeignEnumByName, !GlobalData),
        gen_functor_number_map(RttiTypeCtor, FunctorNumberMap, !GlobalData),
        LayoutInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_foreign_enum_ordinal_ordered_table),
        FunctorInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_foreign_enum_name_ordered_table),
        NumberMapInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_functor_number_map),
        BaseTypeCtorInitializer = gen_init_base_type_ctor(ModuleName, Target,
            no)
    ;
        TypeCtorDetails = tcd_du(_, DuFunctors, DuByPtag, DuByName,
            FunctorNumberMap, MaybeBaseTypeCtor),
        list.foldl(gen_du_functor_desc(ModuleInfo, Target, RttiTypeCtor),
            DuFunctors, !GlobalData),
        gen_du_ptag_ordered_table(ModuleInfo, RttiTypeCtor,
            DuByPtag, !GlobalData),
        gen_du_name_ordered_table(ModuleInfo, RttiTypeCtor,
            DuByName, !GlobalData),
        gen_functor_number_map(RttiTypeCtor, FunctorNumberMap, !GlobalData),
        LayoutInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_du_ptag_ordered_table),
        FunctorInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_du_name_ordered_table),
        NumberMapInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_functor_number_map),
        BaseTypeCtorInitializer = gen_init_base_type_ctor(ModuleName, Target,
            MaybeBaseTypeCtor)
    ;
        TypeCtorDetails = tcd_notag(_, NotagFunctor, MaybeBaseTypeCtor),
        gen_functor_number_map(RttiTypeCtor, [0u32], !GlobalData),
        LayoutInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_notag_functor_desc),
        FunctorInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_notag_functor_desc),
        NumberMapInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_functor_number_map),
        gen_notag_functor_desc(ModuleInfo, Target, RttiTypeCtor, NotagFunctor,
            !GlobalData),
        BaseTypeCtorInitializer = gen_init_base_type_ctor(ModuleName, Target,
            MaybeBaseTypeCtor)
    ;
        TypeCtorDetails = tcd_eqv(EqvType),
        TypeRttiData = maybe_pseudo_type_info_to_rtti_data(EqvType),
        gen_pseudo_type_info(ModuleInfo, Target, TypeRttiData,
            LayoutInitializer, !GlobalData),
        % The type is a lie, but a safe one.
        FunctorInitializer = gen_init_null_pointer(mlds_generic_type),
        NumberMapInitializer = gen_init_null_pointer(mlds_generic_type),
        BaseTypeCtorInitializer = gen_init_base_type_ctor(ModuleName, Target,
            no)
    ;
        ( TypeCtorDetails = tcd_builtin(_)
        ; TypeCtorDetails = tcd_impl_artifact(_)
        ; TypeCtorDetails = tcd_foreign(_)
        ),
        LayoutInitializer = gen_init_null_pointer(mlds_generic_type),
        FunctorInitializer = gen_init_null_pointer(mlds_generic_type),
        NumberMapInitializer = gen_init_null_pointer(mlds_generic_type),
        BaseTypeCtorInitializer = gen_init_base_type_ctor(ModuleName, Target,
            no)
    ).

%-----------------------------------------------------------------------------%

:- pred gen_enum_functor_desc(module_info::in, rtti_type_ctor::in,
    enum_functor::in, ml_global_data::in, ml_global_data::out) is det.

gen_enum_functor_desc(_ModuleInfo, RttiTypeCtor, EnumFunctor, !GlobalData) :-
    EnumFunctor = enum_functor(FunctorName, Ordinal, enum_value(Value)),
    RttiName = type_ctor_enum_functor_desc(Ordinal),
    RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
    Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
        % MR_enum_functor_name
        gen_init_string(FunctorName),
        % MR_enum_functor_value -- XXX MAKE_FIELD_UNSIGNED
        gen_init_int32(int32.cast_from_uint32(Value))
    ]),
    rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).

:- pred gen_foreign_enum_functor_desc(module_info::in, foreign_language::in,
    rtti_type_ctor::in, foreign_enum_functor::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_foreign_enum_functor_desc(_ModuleInfo, Lang, RttiTypeCtor,
        ForeignEnumFunctor, !GlobalData) :-
    ForeignEnumFunctor = foreign_enum_functor(FunctorName, Ordinal, Value),
    RttiName = type_ctor_foreign_enum_functor_desc(Ordinal),
    RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
    Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
        % MR_foreign_enum_functor_name
        gen_init_string(FunctorName),
        % MR_foreign_enum_functor_ordinal -- XXX MAKE_FIELD_UNSIGNED
        gen_init_int32(int32.cast_from_uint32(Ordinal)),
        % MR_foreign_enum_functor_value
        gen_init_foreign(Lang, Value)
    ]),
    rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).

:- pred gen_notag_functor_desc(module_info::in, mlds_target_lang::in,
    rtti_type_ctor::in, notag_functor::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_notag_functor_desc(ModuleInfo, Target, RttiTypeCtor, NotagFunctorDesc,
        !GlobalData) :-
    NotagFunctorDesc = notag_functor(FunctorName, ArgType, MaybeArgName,
        FunctorSubtypeInfo),
    ArgTypeRttiData = maybe_pseudo_type_info_to_rtti_data(ArgType),
    gen_pseudo_type_info(ModuleInfo, Target, ArgTypeRttiData, PTIInitializer,
        !GlobalData),
    RttiName = type_ctor_notag_functor_desc,
    RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
    Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
        % MR_notag_functor_name
        gen_init_string(FunctorName),
        % MR_notag_functor_arg_type
        PTIInitializer,
        % MR_notag_functor_arg_name
        gen_init_maybe(mlds_builtin_type_string, gen_init_string,
            MaybeArgName),
        % MR_notag_functor_subtype
        gen_init_functor_subtype_info(FunctorSubtypeInfo)
    ]),
    rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).

:- pred gen_du_functor_desc(module_info::in, mlds_target_lang::in,
    rtti_type_ctor::in, du_functor::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_du_functor_desc(ModuleInfo, Target, RttiTypeCtor, DuFunctor,
        !GlobalData) :-
    DuFunctor = du_functor(FunctorName, Arity, 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),
    ContainsVarBitVector = compute_contains_var_bit_vector(ArgTypes),
    module_info_get_name(ModuleInfo, ModuleName),
    (
        ArgInfos = [_ | _],
        gen_field_types(ModuleInfo, Target, RttiTypeCtor, Ordinal, ArgTypes,
            !GlobalData),
        ArgTypeInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_field_types(Ordinal))
    ;
        ArgInfos = [],
        ArgTypeInitializer = gen_init_null_pointer(
            mlds_rtti_type(item_type(
                ctor_rtti_id(RttiTypeCtor, type_ctor_field_types(0u32)))))
    ),
    (
        HaveArgNames = yes,
        gen_field_names(ModuleInfo, RttiTypeCtor, Ordinal,
            MaybeArgNames, !GlobalData),
        ArgNameInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_field_names(Ordinal))
    ;
        HaveArgNames = no,
        ArgNameInitializer = gen_init_null_pointer(
            mlds_rtti_type(item_type(
                ctor_rtti_id(RttiTypeCtor, type_ctor_field_names(0u32)))))
    ),
    gen_field_locns(ModuleInfo, RttiTypeCtor, Ordinal, ArgInfos, HaveArgLocns,
        !GlobalData),
    (
        HaveArgLocns = yes,
        ArgLocnsInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_field_locns(Ordinal))
    ;
        HaveArgLocns = no,
        ArgLocnsInitializer = gen_init_null_pointer(
            mlds_rtti_type(item_type(
                ctor_rtti_id(RttiTypeCtor, type_ctor_field_locns(0u32)))))
    ),
    (
        MaybeExistInfo = yes(ExistInfo),
        gen_exist_info(ModuleInfo, Target, RttiTypeCtor, Ordinal, ExistInfo,
            !GlobalData),
        ExistInfoInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_exist_info(Ordinal))
    ;
        MaybeExistInfo = no,
        ExistInfoInitializer = gen_init_null_pointer(
            mlds_rtti_type(item_type(
                ctor_rtti_id(RttiTypeCtor, type_ctor_exist_info(0u32)))))
    ),
    (
        Rep = du_ll_rep(Ptag, SectagAndLocn),
        Ptag = ptag(PtagUint8)
    ;
        Rep = du_hl_rep(Data),
        PtagUint8 = 0u8,
        SectagAndLocn = sectag_locn_remote_word(Data)
    ),
    (
        SectagAndLocn = sectag_locn_none,
        Locn = sectag_none,
        Stag = -1,
        NumSectagBits = 0u8
    ;
        SectagAndLocn = sectag_locn_none_direct_arg,
        Locn = sectag_none_direct_arg,
        Stag = -1,
        NumSectagBits = 0u8
    ;
        SectagAndLocn = sectag_locn_local_rest_of_word(StagUint),
        Locn = sectag_local_rest_of_word,
        Stag = uint.cast_to_int(StagUint),
        NumSectagBits = 0u8
    ;
        SectagAndLocn = sectag_locn_local_bits(StagUint, NumSectagBits, Mask),
        Locn = sectag_local_bits(NumSectagBits, Mask),
        Stag = uint.cast_to_int(StagUint)
    ;
        SectagAndLocn = sectag_locn_remote_word(StagUint),
        Locn = sectag_remote_word,
        Stag = uint.cast_to_int(StagUint),
        NumSectagBits = 0u8
    ;
        SectagAndLocn = sectag_locn_remote_bits(StagUint, NumSectagBits, Mask),
        Locn = sectag_remote_bits(NumSectagBits, Mask),
        Stag = uint.cast_to_int(StagUint)
    ),
    RttiName = type_ctor_du_functor_desc(Ordinal),
    RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
    ArityInt16 = int16.cast_from_uint16(Arity),     % XXX MAKE_FIELD_UNSIGNED
    OrdinalInt32 = int32.cast_from_uint32(Ordinal), % XXX MAKE_FIELD_UNSIGNED
    Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
        gen_init_string(FunctorName),   % MR_du_functor_name
        gen_init_int16(ArityInt16),     % MR_du_functor_orig_arity
        gen_init_uint16(ContainsVarBitVector),
                                        % MR_du_functor_arg_type_contains_var
        gen_init_sectag_locn(Locn),     % MR_du_functor_sectag_locn
        gen_init_uint8(PtagUint8),      % MR_du_functor_primary
        gen_init_int(Stag),             % MR_du_functor_secondary
        gen_init_int32(OrdinalInt32),   % MR_du_functor_ordinal
        ArgTypeInitializer,             % MR_du_functor_arg_types
        ArgNameInitializer,             % MR_du_functor_arg_names
        ArgLocnsInitializer,            % MR_du_functor_arg_locns
        ExistInfoInitializer,           % MR_du_functor_exist_info
        gen_init_functor_subtype_info(FunctorSubtypeInfo),
                                        % MR_du_functor_subtype_constraints
        gen_init_uint8(NumSectagBits)   % MR_du_functor_num_sectag_bits
    ]),
    rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).

%-----------------------------------------------------------------------------%

:- func gen_init_exist_locn(rtti_type_ctor, exist_typeinfo_locn) =
    mlds_initializer.

gen_init_exist_locn(RttiTypeCtor, ExistTypeInfoLocn) = Initializer :-
    (
        ExistTypeInfoLocn = typeinfo_in_tci(SlotInCell, SlotInTci),
        SlotInTciEncoding = int16.cast_from_uint16(SlotInTci)
    ;
        ExistTypeInfoLocn = plain_typeinfo(SlotInCell),
        SlotInTciEncoding = -1i16
    ),
    RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_exist_locn),
    Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
        % MR_exist_arg_num -- XXX MAKE_FIELD_UNSIGNED
        gen_init_int16(int16.cast_from_uint16(SlotInCell)),
        % MR_exist_offset_in_tci
        gen_init_int16(SlotInTciEncoding)
    ]).

:- pred gen_exist_locns_array(module_info::in, rtti_type_ctor::in, uint32::in,
    list(exist_typeinfo_locn)::in, ml_global_data::in, ml_global_data::out)
    is det.

gen_exist_locns_array(_ModuleInfo, RttiTypeCtor, Ordinal, Locns,
        !GlobalData) :-
    Initializer = gen_init_array(gen_init_exist_locn(RttiTypeCtor), Locns),
    RttiName = type_ctor_exist_locns(Ordinal),
    rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
        !GlobalData).

:- pred gen_tc_constraint(module_info::in, mlds_target_lang::in,
    pred(int, int, rtti_id)::in(pred(in, in, out) is det),
    tc_constraint::in, rtti_id::out, counter::in, counter::out,
    ml_global_data::in, ml_global_data::out) is det.

gen_tc_constraint(ModuleInfo, Target, MakeRttiId, Constraint, RttiId,
        !Counter, !GlobalData) :-
    Constraint = tc_constraint(TCName, Types),
    list.length(Types, Arity),
    counter.allocate(TCNum, !Counter),
    MakeRttiId(TCNum, Arity, RttiId),
    TCDeclRttiName = type_class_decl,
    module_info_get_name(ModuleInfo, ModuleName),
    TypeRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, Types),
    gen_pseudo_type_info_array(ModuleInfo, Target, TypeRttiDatas,
        PTIInitializers, !GlobalData),
    Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
        gen_init_tc_rtti_name(ModuleName, TCName, TCDeclRttiName),
        PTIInitializers
    ]),
    rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).

:- 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 gen_exist_info(module_info::in, mlds_target_lang::in,
    rtti_type_ctor::in, uint32::in, exist_info::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_exist_info(ModuleInfo, Target, RttiTypeCtor, Ordinal, ExistInfo,
        !GlobalData) :-
    ExistInfo = exist_info(Plain, InTci, Constraints, Locns),
    module_info_get_name(ModuleInfo, ModuleName),
    RttiName = type_ctor_exist_info(Ordinal),
    RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
    list.length(Constraints, Tci),
    (
        Constraints = [],
        ConstrInitializer = gen_init_null_pointer(
            mlds_rtti_type(item_type(ctor_rtti_id(RttiTypeCtor,
                type_ctor_exist_tc_constrs(Ordinal)))))
    ;
        Constraints = [_ | _],
        ConstrInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_exist_tc_constrs(Ordinal)),
        list.map_foldl2(
            gen_tc_constraint(ModuleInfo, Target,
                make_exist_tc_constr_id(RttiTypeCtor, Ordinal)),
            Constraints, TCConstrIds, counter.init(1), _, !GlobalData),
        TCConstrArrayRttiName = type_ctor_exist_tc_constrs(Ordinal),
        TCConstrArrayRttiId = ctor_rtti_id(RttiTypeCtor,
            TCConstrArrayRttiName),
        ElementType = mlds_rtti_type(element_type(TCConstrArrayRttiId)),
        TCConstrArrayInitializer = gen_init_array(
            gen_init_cast_rtti_id(ElementType, ModuleName), TCConstrIds),
        rtti_name_and_init_to_defn(RttiTypeCtor, TCConstrArrayRttiName,
            TCConstrArrayInitializer, !GlobalData)
    ),
    gen_exist_locns_array(ModuleInfo, RttiTypeCtor, Ordinal, Locns,
        !GlobalData),
    Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
        % MR_exist_typeinfos_plain -- XXX MAKE_FIELD_UNSIGNED
        gen_init_int16(int16.cast_from_uint16(Plain)),
        % MR_exist_typeinfos_in_tci -- XXX MAKE_FIELD_UNSIGNED
        gen_init_int16(int16.cast_from_uint16(InTci)),
        % MR_exist_tcis -- XXX MAKE_FIELD_UNSIGNED
        gen_init_int16(int16.det_from_int(Tci)),
        % MR_exist_typeinfo_locns
        gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_exist_locns(Ordinal)),
        % MR_exist_constraints
        ConstrInitializer
    ]),
    rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).

:- pred gen_field_types(module_info::in, mlds_target_lang::in,
    rtti_type_ctor::in, uint32::in,
    list(rtti_maybe_pseudo_type_info_or_self)::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_field_types(ModuleInfo, Target, RttiTypeCtor, Ordinal, Types,
        !GlobalData) :-
    TypeRttiDatas = list.map(maybe_pseudo_type_info_or_self_to_rtti_data,
        Types),
    gen_pseudo_type_info_array(ModuleInfo, Target, TypeRttiDatas, Initializer,
        !GlobalData),
    RttiName = type_ctor_field_types(Ordinal),
    rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
        !GlobalData).

:- pred gen_field_names(module_info::in, rtti_type_ctor::in, uint32::in,
    list(maybe(string))::in, ml_global_data::in, ml_global_data::out) is det.

gen_field_names(_ModuleInfo, RttiTypeCtor, Ordinal, MaybeNames, !GlobalData) :-
    Initializer = gen_init_array(
        gen_init_maybe(mlds_builtin_type_string, gen_init_string),
        MaybeNames),
    RttiName = type_ctor_field_names(Ordinal),
    rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
        !GlobalData).

:- pred gen_field_locns(module_info::in, rtti_type_ctor::in, uint32::in,
    list(du_arg_info)::in, bool::out, ml_global_data::in, ml_global_data::out)
    is det.

gen_field_locns(_ModuleInfo, RttiTypeCtor, Ordinal, ArgInfos, HaveArgLocns,
        !GlobalData) :-
    ( if
        some [ArgInfo] (
            list.member(ArgInfo, ArgInfos),
            ArgInfo ^ du_arg_pos_width \= apw_full(_, _)
        )
    then
        HaveArgLocns = yes,
        RttiName = type_ctor_field_locns(Ordinal),
        RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
        list.map(gen_field_locn(RttiId), ArgInfos, ArgLocnInitializers),
        Initializer = init_array(ArgLocnInitializers),
        rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData)
    else
        HaveArgLocns = no
    ).

:- pred gen_field_locn(rtti_id::in, du_arg_info::in, mlds_initializer::out)
    is det.

gen_field_locn(RttiId, ArgInfo, ArgLocnInitializer) :-
    ArgPosWidth = 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.
    (
        ArgPosWidth = apw_full(arg_only_offset(ArgOnlyOffset), _),
        Shift = 0,
        % NumBits = 0 means the argument takes a full word.
        NumBits = 0
    ;
        ArgPosWidth = apw_double(arg_only_offset(ArgOnlyOffset), _,
            DoubleWordKind),
        Shift = 0,
        % NumBits = -1, -2 and -3 mean the argument takes two words,
        % containing a float, int64 and uint64 respectively.
        (
            DoubleWordKind = dw_float,
            NumBits = -1
        ;
            DoubleWordKind = dw_int64,
            NumBits = -2
        ;
            DoubleWordKind = dw_uint64,
            NumBits = -3
        )
    ;
        (
            ArgPosWidth = apw_partial_first(arg_only_offset(ArgOnlyOffset),
                _, arg_shift(Shift), arg_num_bits(NumBits0), _, Fill)
        ;
            ArgPosWidth = apw_partial_shifted(arg_only_offset(ArgOnlyOffset),
                _, arg_shift(Shift), arg_num_bits(NumBits0), _, Fill)
        ),
        % NumBits = -4 to -9 mean the argument takes part a word
        % and contains an 8, 16 or 32 bit sized int or uint.
        (
            ( Fill = fill_enum
            ; Fill = fill_char21
            ),
            NumBits = NumBits0
        ;
            Fill = fill_int8,
            NumBits = -4
        ;
            Fill = fill_uint8,
            NumBits = -5
        ;
            Fill = fill_int16,
            NumBits = -6
        ;
            Fill = fill_uint16,
            NumBits = -7
        ;
            Fill = fill_int32,
            NumBits = -8
        ;
            Fill = fill_uint32,
            NumBits = -9
        )
    ;
        (
            ArgPosWidth = apw_none_shifted(arg_only_offset(ArgOnlyOffset), _)
        ;
            ArgPosWidth = apw_none_nowhere,
            ArgOnlyOffset = -1
        ),
        % NumBits = -10 means the argument is of a dummy type,
        % and takes no space at all.
        Shift = 0,
        NumBits = -10
    ),
    ArgLocnInitializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
        gen_init_int(ArgOnlyOffset),    % MR_arg_offset
        gen_init_int(Shift),            % MR_arg_shift
        gen_init_int(NumBits)           % MR_arg_bits
    ]).

%-----------------------------------------------------------------------------%

:- pred gen_enum_ordinal_ordered_table(module_info::in, rtti_type_ctor::in,
    map(uint32, enum_functor)::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_enum_ordinal_ordered_table(ModuleInfo, RttiTypeCtor, EnumByOrd,
        !GlobalData) :-
    map.values(EnumByOrd, Functors),
    module_info_get_name(ModuleInfo, ModuleName),
    FunctorRttiNames = list.map(enum_functor_rtti_name, Functors),
    Initializer = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
        FunctorRttiNames),
    RttiName = type_ctor_enum_ordinal_ordered_table,
    rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
        !GlobalData).

:- pred gen_enum_name_ordered_table(module_info::in, rtti_type_ctor::in,
    map(string, enum_functor)::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_enum_name_ordered_table(ModuleInfo, RttiTypeCtor, EnumByName,
        !GlobalData) :-
    map.values(EnumByName, Functors),
    module_info_get_name(ModuleInfo, ModuleName),
    FunctorRttiNames = list.map(enum_functor_rtti_name, Functors),
    Initializer = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
        FunctorRttiNames),
    RttiName = type_ctor_enum_name_ordered_table,
    rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
        !GlobalData).

:- pred gen_foreign_enum_ordinal_ordered_table(module_info::in,
    rtti_type_ctor::in, map(uint32, foreign_enum_functor)::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_foreign_enum_ordinal_ordered_table(ModuleInfo, RttiTypeCtor,
        ForeignEnumByOrdinal, !GlobalData) :-
    map.values(ForeignEnumByOrdinal, Functors),
    module_info_get_name(ModuleInfo, ModuleName),
    FunctorRttiNames = list.map(foreign_enum_functor_rtti_name, Functors),
    Initializer = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
        FunctorRttiNames),
    RttiName = type_ctor_foreign_enum_ordinal_ordered_table,
    rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
        !GlobalData).

:- pred gen_foreign_enum_name_ordered_table(module_info::in,
    rtti_type_ctor::in, map(string, foreign_enum_functor)::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_foreign_enum_name_ordered_table(ModuleInfo, RttiTypeCtor,
        ForeignEnumByName, !GlobalData) :-
    map.values(ForeignEnumByName, Functors),
    module_info_get_name(ModuleInfo, ModuleName),
    FunctorRttiNames = list.map(foreign_enum_functor_rtti_name, Functors),
    Initializer = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
        FunctorRttiNames),
    RttiName = type_ctor_foreign_enum_name_ordered_table,
    rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
        !GlobalData).

:- pred gen_du_ptag_ordered_table(module_info::in, rtti_type_ctor::in,
    map(ptag, sectag_table)::in, ml_global_data::in, ml_global_data::out)
    is det.

gen_du_ptag_ordered_table(ModuleInfo, RttiTypeCtor, PtagMap, !GlobalData) :-
    module_info_get_name(ModuleInfo, ModuleName),
    map.to_assoc_list(PtagMap, PtagList),
    list.foldl(gen_du_stag_ordered_table(ModuleName, RttiTypeCtor), PtagList,
        !GlobalData),
    (
        PtagList = [FirstPtag - _ | _],
        FirstPtag = ptag(LeastPtag)
    ;
        PtagList = [],
        unexpected($pred, "bad ptag list")
    ),
    gen_du_ptag_ordered_table_body(ModuleName, RttiTypeCtor, LeastPtag,
        PtagList, PtagInitializers),
    RttiName = type_ctor_du_ptag_ordered_table,
    Initializer = init_array(PtagInitializers),
    rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
        !GlobalData).

:- pred gen_du_ptag_ordered_table_body(module_name::in, rtti_type_ctor::in,
    uint8::in, assoc_list(ptag, sectag_table)::in, list(mlds_initializer)::out)
    is det.

gen_du_ptag_ordered_table_body(_, _, _, [], []).
gen_du_ptag_ordered_table_body(ModuleName, RttiTypeCtor, LeastPtag,
        [Ptag - SectagTable | PtagTail], [Initializer | Initializers]) :-
    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),
    RttiName = type_ctor_du_ptag_layout(Ptag),
    RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
    compute_du_ptag_layout_flags(SectagTable, Flags),
    Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
        % MR_sectag_sharers
        gen_init_uint32(NumSharers),
        % MR_sectag_locn
        gen_init_sectag_locn(SectagLocn),
        % MR_sectag_alternatives
        gen_init_rtti_name(ModuleName, RttiTypeCtor,
            type_ctor_du_stag_ordered_table(Ptag)),
        % MR_sectag_numbits
        gen_init_int8(NumSectagBits),
        % MR_du_ptag,
        gen_init_uint8(PtagUint8),
        % MR_du_ptag_flags
        gen_init_uint8(encode_du_ptag_layout_flags(Flags))
    ]),
    NextLeastPtag = PtagUint8 + 1u8,
    gen_du_ptag_ordered_table_body(ModuleName, RttiTypeCtor, NextLeastPtag,
        PtagTail, Initializers).

:- pred gen_du_stag_ordered_table(module_name::in, rtti_type_ctor::in,
    pair(ptag, sectag_table)::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_du_stag_ordered_table(ModuleName, RttiTypeCtor, Ptag - SectagTable,
        !GlobalData) :-
    SectagTable = sectag_table(_SectagLocn, _NumSectagBits, _NumSharers,
        SectagMap),
    map.values(SectagMap, SectagFunctors),
    FunctorRttiNames = list.map(du_functor_rtti_name, SectagFunctors),
    Initializer = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
        FunctorRttiNames),
    RttiName = type_ctor_du_stag_ordered_table(Ptag),
    rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
        !GlobalData).

:- pred gen_du_name_ordered_table(module_info::in, rtti_type_ctor::in,
    map(string, map(uint16, du_functor))::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_du_name_ordered_table(ModuleInfo, RttiTypeCtor, NameArityMap,
        !GlobalData) :-
    map.values(NameArityMap, ArityMaps),
    list.map(map.values, ArityMaps, FunctorLists),
    list.condense(FunctorLists, Functors),
    module_info_get_name(ModuleInfo, ModuleName),
    FunctorRttiNames = list.map(du_functor_rtti_name, Functors),
    Initializer = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
        FunctorRttiNames),
    RttiName = type_ctor_du_name_ordered_table,
    rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
        !GlobalData).

:- pred gen_functor_number_map(rtti_type_ctor::in, list(uint32)::in,
    ml_global_data::in, ml_global_data::out) is det.

gen_functor_number_map(RttiTypeCtor, FunctorNumberMap, !GlobalData) :-
    Initializer = gen_init_array(gen_init_functor_number, FunctorNumberMap),
    RttiName = type_ctor_functor_number_map,
    rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
        !GlobalData).

:- func gen_init_functor_number(uint32) = mlds_initializer.

gen_init_functor_number(NumUint32) = Init :-
    % XXX MAKE_FIELD_UNSIGNED
    Num = uint32.cast_to_int(NumUint32),
    Init = gen_init_int(Num).

%-----------------------------------------------------------------------------%

:- func gen_init_base_type_ctor(module_name, mlds_target_lang,
    maybe(type_ctor)) = mlds_initializer.

gen_init_base_type_ctor(ModuleName, Target, MaybeBaseTypeCtor) = Initializer :-
    % The MR_type_ctor_base field is only required in high-level data grades.
    ( if mlds_target_high_level_data(Target) = yes then
        (
            MaybeBaseTypeCtor = yes(BaseTypeCtor),
            BaseTypeCtor = type_ctor(SymName, Arity),
            (
                SymName = qualified(TypeModule, TypeName)
            ;
                SymName = unqualified(_),
                unexpected($pred, "base type ctor is not module qualified")
            ),
            RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName,
                uint16.det_from_int(Arity)),
            RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info),
            Initializer = gen_init_rtti_id(ModuleName, RttiId)
        ;
            MaybeBaseTypeCtor = no,
            % The type is a lie, but a safe one.
            Initializer = gen_init_null_pointer(mlds_generic_type)
        )
    else
        Initializer = no_initializer
    ).

%-----------------------------------------------------------------------------%

:- func gen_init_rtti_names_array(module_name, rtti_type_ctor,
    list(ctor_rtti_name)) = mlds_initializer.

gen_init_rtti_names_array(ModuleName, RttiTypeCtor, RttiNames) =
    gen_init_array(gen_init_rtti_name(ModuleName, RttiTypeCtor), RttiNames).

:- func gen_init_cast_rtti_datas_array(mlds_type, module_name,
    list(rtti_data)) = mlds_initializer.

gen_init_cast_rtti_datas_array(Type, ModuleName, RttiDatas) =
    gen_init_array(gen_init_cast_rtti_data(Type, ModuleName), RttiDatas).

    % Generate the MLDS initializer comprising the rtti_name
    % for a given rtti_data, converted to mlds_generic_type.
    %
:- func gen_init_cast_rtti_data(mlds_type, module_name, rtti_data) =
    mlds_initializer.

gen_init_cast_rtti_data(DestType, ModuleName, RttiData) = Initializer :-
    ( if
        RttiData = rtti_data_pseudo_type_info(type_var(VarNum))
    then
        % rtti_data_to_id/3 does not handle this case
        SrcType = mlds_builtin_type_int(int_type_int),
        Initializer = init_obj(gen_cast(SrcType, DestType,
            ml_const(mlconst_int(VarNum))))
    else if
        RttiData = rtti_data_base_typeclass_info(TCName, InstanceModuleName,
            InstanceString, _)
    then
        SrcType = mlds_rtti_type(item_type(tc_rtti_id(TCName,
            type_class_base_typeclass_info(InstanceModuleName,
                InstanceString)))),
        MLDS_ModuleName = mercury_module_name_to_mlds(InstanceModuleName),
        RttiId = tc_rtti_id(TCName, type_class_base_typeclass_info(
            InstanceModuleName, InstanceString)),
        Rval = ml_const(mlconst_data_addr_rtti(MLDS_ModuleName, RttiId)),
        Initializer = init_obj(gen_cast(SrcType, DestType, Rval))
    else
        rtti_data_to_id(RttiData, RttiId),
        Initializer = gen_init_cast_rtti_id(DestType, ModuleName, RttiId)
    ).

    % Currently casts only store the destination type.
    %
:- func gen_cast(mlds_type, mlds_type, mlds_rval) = mlds_rval.

gen_cast(_SrcType, DestType, SubRval) = ml_cast(DestType, SubRval).

    % Generate an MLDS initializer comprising just the rval
    % for a given rtti_id.
    %
:- func gen_init_rtti_id(module_name, rtti_id) = mlds_initializer.

gen_init_rtti_id(ModuleName, ctor_rtti_id(RttiTypeCtor, RttiName)) =
    gen_init_rtti_name(ModuleName, RttiTypeCtor, RttiName).
gen_init_rtti_id(ModuleName, tc_rtti_id(TCName, TCRttiName)) =
    gen_init_tc_rtti_name(ModuleName, TCName, TCRttiName).

    % Generate an MLDS initializer comprising just the rval
    % for a given rtti_name.
    %
:- func gen_init_rtti_name(module_name, rtti_type_ctor, ctor_rtti_name) =
    mlds_initializer.

gen_init_rtti_name(ModuleName, RttiTypeCtor, RttiName) =
    init_obj(gen_rtti_name(ModuleName, RttiTypeCtor, RttiName)).

    % Generate an MLDS initializer comprising just the rval
    % for a given tc_rtti_name.
    %
:- func gen_init_tc_rtti_name(module_name, tc_name, tc_rtti_name) =
    mlds_initializer.

gen_init_tc_rtti_name(ModuleName, TCName, TCRttiName) =
    init_obj(gen_tc_rtti_name(ModuleName, TCName, TCRttiName)).

    % Generate the MLDS initializer comprising the rtti_name
    % for a given rtti_name, converted to the given type.
    %
:- func gen_init_cast_rtti_id(mlds_type, module_name, rtti_id)
    = mlds_initializer.

gen_init_cast_rtti_id(DestType, ModuleName, RttiId) = Initializer :-
    SrcType = mlds_rtti_type(item_type(RttiId)),
    Initializer = init_obj(gen_cast(SrcType, DestType,
        gen_rtti_id(ModuleName, RttiId))).

    % Generate the MLDS rval for an rtti_id.
    %
:- func gen_rtti_id(module_name, rtti_id) = mlds_rval.

gen_rtti_id(ThisModuleName, ctor_rtti_id(RttiTypeCtor, RttiName)) =
    gen_rtti_name(ThisModuleName, RttiTypeCtor, RttiName).
gen_rtti_id(ThisModuleName, tc_rtti_id(TCName, TCRttiName)) =
    gen_tc_rtti_name(ThisModuleName, TCName, TCRttiName).

:- func gen_rtti_name(module_name, rtti_type_ctor, ctor_rtti_name)
    = mlds_rval.

gen_rtti_name(ThisModuleName, RttiTypeCtor0, RttiName) = Rval :-
    % Typeinfos and pseudo typeinfos are defined locally to each module.
    % Other kinds of RTTI data are defined in the module that defines
    % the type which they are for.
    ( if
        (
            RttiName = type_ctor_type_info(TypeInfo),
            ( TypeInfo = plain_type_info(_, _)
            ; TypeInfo = var_arity_type_info(_, _)
            )
        ;
            RttiName = type_ctor_pseudo_type_info(PseudoTypeInfo),
            ( PseudoTypeInfo = plain_pseudo_type_info(_, _)
            ; PseudoTypeInfo = var_arity_pseudo_type_info(_, _)
            )
        )
    then
        ModuleName = ThisModuleName,
        RttiTypeCtor = RttiTypeCtor0
    else
        RttiTypeCtor0 = rtti_type_ctor(RttiModuleName,
            RttiTypeName, RttiTypeArity),

        % Although the builtin types `int', `float', etc. are treated
        % as part of the `builtin' module, for historical reasons they
        % don't have any qualifiers at this point, so we need to add
        % the `builtin' qualifier now.
        ( if RttiModuleName = unqualified("") then
            ModuleName = mercury_public_builtin_module,
            RttiTypeCtor = rtti_type_ctor(RttiModuleName,
                RttiTypeName, RttiTypeArity)
        else
            ModuleName = RttiModuleName,
            RttiTypeCtor = RttiTypeCtor0
        )
    ),
    MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
    RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
    Rval = ml_const(mlconst_data_addr_rtti(MLDS_ModuleName, RttiId)).

:- func gen_tc_rtti_name(module_name, tc_name, tc_rtti_name) = mlds_rval.

gen_tc_rtti_name(_ThisModuleName, TCName, TCRttiName) = Rval :-
    (
        TCRttiName = type_class_base_typeclass_info(InstanceModuleName, _),
        MLDS_ModuleName = mercury_module_name_to_mlds(InstanceModuleName)
    ;
        TCRttiName = type_class_id,
        MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
    ;
        TCRttiName = type_class_decl,
        MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
    ;
        TCRttiName = type_class_decl_super(_, _),
        MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
    ;
        TCRttiName = type_class_decl_supers,
        MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
    ;
        TCRttiName = type_class_id_var_names,
        MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
    ;
        TCRttiName = type_class_id_method_ids,
        MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
    ;
        TCRttiName = type_class_instance(_Types),
        MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
    ;
        TCRttiName = type_class_instance_tc_type_vector(_Types),
        MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
    ;
        TCRttiName = type_class_instance_constraint(_Types, _, _),
        MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
    ;
        TCRttiName = type_class_instance_constraints(_Types),
        MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
    ;
        TCRttiName = type_class_instance_methods(_Types),
        MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
    ),
    RttiId = tc_rtti_id(TCName, TCRttiName),
    Rval = ml_const(mlconst_data_addr_rtti(MLDS_ModuleName, RttiId)).

:- func mlds_module_name_from_tc_name(tc_name) = mlds_module_name.

mlds_module_name_from_tc_name(TCName) = MLDS_ModuleName :-
    TCName = tc_name(ModuleName, _ClassName, _Arity),
    MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName).

%-----------------------------------------------------------------------------%

:- pred gen_pseudo_type_info(module_info::in, mlds_target_lang::in,
    rtti_data::in, mlds_initializer::out,
    ml_global_data::in, ml_global_data::out) is det.

gen_pseudo_type_info(ModuleInfo, Target, PTIRttiData, Initializer,
        !GlobalData) :-
    ( if real_rtti_data(PTIRttiData) then
        add_rtti_data_to_mlds(ModuleInfo, Target, PTIRttiData, !GlobalData)
    else
        % Since PTIRttiData does not correspond to a global data definition,
        % we have nothing to do.
        true
    ),
    module_info_get_name(ModuleInfo, ModuleName),
    Initializer = gen_init_cast_rtti_data(mlds_pseudo_type_info_type,
        ModuleName, PTIRttiData).

:- pred gen_pseudo_type_info_array(module_info::in, mlds_target_lang::in,
    list(rtti_data)::in, mlds_initializer::out,
    ml_global_data::in, ml_global_data::out) is det.

gen_pseudo_type_info_array(ModuleInfo, Target, PTIRttiDatas, Initializer,
        !GlobalData) :-
    RealRttiDatas = list.filter(real_rtti_data, PTIRttiDatas),
    list.foldl(add_rtti_data_to_mlds(ModuleInfo, Target),
        RealRttiDatas, !GlobalData),
    module_info_get_name(ModuleInfo, ModuleName),
    Initializer = gen_init_cast_rtti_datas_array(mlds_pseudo_type_info_type,
        ModuleName, PTIRttiDatas).

%-----------------------------------------------------------------------------%

:- pred gen_init_method(module_info::in, mlds_target_lang::in,
    int::in, rtti_proc_label::in, mlds_initializer::out,
    ml_global_data::in, ml_global_data::out) is det.

gen_init_method(ModuleInfo, Target, NumExtra, RttiProcLabel, Initializer,
        !GlobalData) :-
    % We can't store the address of the typeclass method directly in the
    % base_typeclass_info; instead, we need to generate a wrapper function
    % that extracts the NumExtra parameters it needs from the typeclass_info,
    % and store the address of that wrapper function in the
    % base_typeclass_info.
    %
    % Note that this means there are two levels of wrappers: the wrapper that
    % we generate here calls the procedure introduced by check_typeclass.m,
    % and that in turn calls the user's procedure. Hopefully the Mercury
    % HLDS->HLDS inlining and/or the target code compiler will be able
    % to optimize this...
    %
    gen_wrapper_func_and_initializer(ModuleInfo, Target, NumExtra,
        RttiProcLabel, typeclass_info_closure, Initializer, !GlobalData).

:- pred gen_init_special_pred(module_info::in, mlds_target_lang::in,
    univ::in, mlds_initializer::out,
    ml_global_data::in, ml_global_data::out) is det.

gen_init_special_pred(ModuleInfo, Target, RttiProcIdUniv, Initializer,
        !GlobalData) :-
    % We can't store the address of the special pred procedure directly in the
    % type_ctor_info because when the special pred is called by looking up
    % its address in the type_ctor_info it is always called with its arguments
    % boxed, but the generated special pred may operate on unboxed values,
    % hence we need to generate a wrapper function which unboxes the arguments
    % if necessary.
    det_univ_to_type(RttiProcIdUniv, RttiProcId),
    ( if RttiProcId ^ rpl_proc_arity = pred_form_arity(0) then
        % If there are no arguments, then there is no unboxing to do,
        % so we don't need a wrapper. (This case can occur with
        % --no-special-preds, where the procedure will be
        % private_builtin.unused/0.)
        % XXX --no-special-preds does not exist anymore.
        Initializer = gen_init_proc_id(ModuleInfo, RttiProcId)
    else
        NumExtra = 0,
        gen_wrapper_func_and_initializer(ModuleInfo, Target,
            NumExtra, RttiProcId, special_pred_closure, Initializer,
            !GlobalData)
    ).

:- pred gen_wrapper_func_and_initializer(module_info::in, mlds_target_lang::in,
    int::in, rtti_proc_label::in, closure_kind::in, mlds_initializer::out,
    ml_global_data::in, ml_global_data::out) is det.

gen_wrapper_func_and_initializer(ModuleInfo, Target, NumExtra, RttiProcId,
        ClosureKind, Initializer, !GlobalData) :-
    some [!Info] (
        % We start off by creating a fresh MLGenInfo here, using the pred_id
        % and proc_id of the wrapped procedure. This requires considerable
        % care. We need to call ml_gen_info_bump_counters to ensure that
        % the function label allocated for the wrapper func does not overlap
        % with any function labels used when generating code for the wrapped
        % procedure.
        %
        % The empty const struct map is a lie, but a white lie; the RTTI
        % data cannot contain any type_info_const or typeclass_info_const
        % cons_ids.

        PredId = RttiProcId ^ rpl_pred_id,
        ProcId = RttiProcId ^ rpl_proc_id,
        PredProcId = proc(PredId, ProcId),
        InSccInfo = in_scc_info(not_in_tscc,
            is_not_target_of_self_trcall, is_not_target_of_mutual_trcall, []),
        InSccMap = map.singleton(PredProcId, InSccInfo),
        init_ml_gen_tscc_info(ModuleInfo, InSccMap, tscc_self_rec_only,
            TsccInfo),
        module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo),
        !:Info = ml_gen_info_init(ModuleInfo, Target, map.init, PredProcId,
            ProcInfo, !.GlobalData, TsccInfo),
        ml_gen_info_bump_counters(!Info),

        % Now we can safely go ahead and generate the wrapper function.
        Context = dummy_context,
        ml_gen_closure_wrapper(PredId, ProcId, ClosureKind, NumExtra, Context,
            WrapperFuncRval, WrapperFuncType, !Info),
        ml_gen_info_get_closure_wrapper_defns(!.Info, ClosureWrapperDefns),
        ml_gen_info_get_global_data(!.Info, !:GlobalData),
        ml_global_data_add_closure_wrapper_func_defns(ClosureWrapperDefns,
            !GlobalData),

        % The initializer for the wrapper is just the wrapper function's
        % address, converted to mlds_generic_type (by boxing).
        Initializer = init_obj(ml_box(WrapperFuncType, WrapperFuncRval))
    ).

:- func gen_init_proc_id(module_info, rtti_proc_label) = mlds_initializer.

gen_init_proc_id(ModuleInfo, RttiProcId) = Initializer :-
    % Construct an rval for the address of this procedure
    % (this is similar to ml_gen_proc_addr_rval).
    ml_gen_pred_label_from_rtti(ModuleInfo, RttiProcId, PredLabel, PredModule),
    ProcId = RttiProcId ^ rpl_proc_id,
    ProcLabel = mlds_proc_label(PredLabel, ProcId),
    FuncLabel = mlds_func_label(ProcLabel, proc_func),
    QualFuncLabel = qual_func_label(PredModule, FuncLabel),
    Params = ml_gen_proc_params_from_rtti_no_gc_stmts(ModuleInfo, RttiProcId),
    Signature = mlds_get_func_signature(Params),
    CodeAddr = mlds_code_addr(QualFuncLabel, Signature),
    ProcAddrRval = ml_const(mlconst_code_addr(CodeAddr)),

    % Convert the procedure address to a generic type. We need to use a
    % generic type because since the actual type for the procedure will
    % depend on how many type_info parameters it takes, which will depend
    % on the type's arity.
    ProcAddrArg = ml_box(mlds_func_type(Params), ProcAddrRval),
    Initializer = init_obj(ProcAddrArg).

:- func gen_init_proc_id_from_univ(module_info, univ) =
    mlds_initializer.
:- pragma consider_used(func(gen_init_proc_id_from_univ/2)).

gen_init_proc_id_from_univ(ModuleInfo, ProcLabelUniv) = Initializer :-
    det_univ_to_type(ProcLabelUniv, ProcLabel),
    Initializer = gen_init_proc_id(ModuleInfo, ProcLabel).

    % Succeed iff the specified rtti_data is one that requires an
    % explicit mlds_defn to define it.
    %
:- pred real_rtti_data(rtti_data::in) is semidet.

real_rtti_data(RttiData) :-
    not (
        (
            RttiData = rtti_data_type_info(TypeInfo),
            TypeInfo = plain_arity_zero_type_info(_)
        ;
            RttiData = rtti_data_pseudo_type_info(PseudoTypeInfo),
            ( PseudoTypeInfo = plain_arity_zero_pseudo_type_info(_)
            ; PseudoTypeInfo = type_var(_)
            )
        )
    ).

%-----------------------------------------------------------------------------%
%
% Conversion functions for builtin enumeration types.
%
% This handles sectag_locn, functor_subtype_info and type_ctor_rep. The rvals
% generated are just named constants in the private_builtin module, which the
% Mercury runtime is expected to define.
%

:- func gen_init_pred_or_func(pred_or_func) = mlds_initializer.

gen_init_pred_or_func(PredOrFunc) = Initializer :-
    rtti.pred_or_func_to_target_string(PredOrFunc, TargetPrefixes, Name),
    Initializer = gen_init_builtin_const(TargetPrefixes, Name).

:- func gen_init_sectag_locn(sectag_locn) = mlds_initializer.

gen_init_sectag_locn(Locn) = Initializer :-
    rtti.sectag_locn_to_string(Locn, TargetPrefixes, Name),
    Initializer = gen_init_builtin_const(TargetPrefixes, Name).

:- func gen_init_functor_subtype_info(functor_subtype_info) = mlds_initializer.

gen_init_functor_subtype_info(Info) = Initializer :-
    rtti.functor_subtype_info_to_string(Info, TargetPrefixes,
        Name),
    Initializer = gen_init_builtin_const(TargetPrefixes, Name).

:- func gen_init_type_ctor_rep(type_ctor_data) = mlds_initializer.

gen_init_type_ctor_rep(TypeCtorData) = Initializer :-
    rtti.type_ctor_rep_to_string(TypeCtorData, TargetPrefixes, Name),
    Initializer = gen_init_builtin_const(TargetPrefixes, Name).

%-----------------------------------------------------------------------------%

%-----------------------------------------------------------------------------%
%
% Ordering RTTI definitions.
%

order_mlds_rtti_defns(Defns) = OrdDefns :-
    some [!Graph] (
        digraph.init(!:Graph),
        list.foldl2(add_rtti_defn_nodes, Defns, !Graph, map.init, NameMap),
        list.foldl(add_rtti_defn_arcs, Defns, !Graph),
        digraph.atsort(!.Graph, RevOrdSets)
    ),
    list.reverse(RevOrdSets, OrdSets),
    list.map(set.to_sorted_list, OrdSets, OrdLists),
    list.map(list.filter_map(map.search(NameMap)), OrdLists, OrdDefns).

:- pred add_rtti_defn_nodes(mlds_global_var_defn::in,
    digraph(mlds_global_var_name)::in, digraph(mlds_global_var_name)::out,
    map(mlds_global_var_name, mlds_global_var_defn)::in,
    map(mlds_global_var_name, mlds_global_var_defn)::out) is det.

add_rtti_defn_nodes(GlobalVarDefn, !Graph, !NameMap) :-
    GlobalVarName = GlobalVarDefn ^ mgvd_name,
    digraph.add_vertex(GlobalVarName, _, !Graph),
    map.det_insert(GlobalVarName, GlobalVarDefn, !NameMap).

:- pred add_rtti_defn_arcs(mlds_global_var_defn::in,
    digraph(mlds_global_var_name)::in, digraph(mlds_global_var_name)::out)
    is det.

add_rtti_defn_arcs(GlobalVarDefn, !Graph) :-
    GlobalVarDefn =
        mlds_global_var_defn(GlobalVarName, _, _, Type, Initializer, _GCStmt),
    ( if Type = mlds_rtti_type(_) then
        add_rtti_defn_arcs_initializer(GlobalVarName, Initializer, !Graph)
    else
        unexpected($pred, "expected rtti entity_data")
    ).

:- pred add_rtti_defn_arcs_initializer(mlds_global_var_name::in,
    mlds_initializer::in,
    digraph(mlds_global_var_name)::in, digraph(mlds_global_var_name)::out)
    is det.

add_rtti_defn_arcs_initializer(DefnGlobalVarName, Initializer, !Graph) :-
    (
        Initializer = init_obj(Rval),
        add_rtti_defn_arcs_rval(DefnGlobalVarName, Rval, !Graph)
    ;
        ( Initializer = init_struct(_, Initializers)
        ; Initializer = init_array(Initializers)
        ),
        list.foldl(add_rtti_defn_arcs_initializer(DefnGlobalVarName),
            Initializers, !Graph)
    ;
        Initializer = no_initializer
    ).

:- pred add_rtti_defn_arcs_rval(mlds_global_var_name::in, mlds_rval::in,
    digraph(mlds_global_var_name)::in, digraph(mlds_global_var_name)::out)
    is det.

add_rtti_defn_arcs_rval(DefnGlobalVarName, Rval, !Graph) :-
    (
        Rval = ml_lval(Lval),
        add_rtti_defn_arcs_lval(DefnGlobalVarName, Lval, !Graph)
    ;
        Rval = ml_const(Const),
        add_rtti_defn_arcs_const(DefnGlobalVarName, Const, !Graph)
    ;
        ( Rval = ml_mkword(_Tag, SubRvalA)
        ; Rval = ml_box(_, SubRvalA)
        ; Rval = ml_unbox(_, SubRvalA)
        ; Rval = ml_cast(_, SubRvalA)
        ; Rval = ml_unop(_, SubRvalA)
        ; Rval = ml_vector_common_row_addr(_, SubRvalA)
        ),
        add_rtti_defn_arcs_rval(DefnGlobalVarName, SubRvalA, !Graph)
    ;
        Rval = ml_binop(_, SubRvalA, SubRvalB),
        add_rtti_defn_arcs_rval(DefnGlobalVarName, SubRvalA, !Graph),
        add_rtti_defn_arcs_rval(DefnGlobalVarName, SubRvalB, !Graph)
    ;
        Rval = ml_mem_addr(SubLval),
        add_rtti_defn_arcs_lval(DefnGlobalVarName, SubLval, !Graph)
    ;
        ( Rval = ml_scalar_common(_)
        ; Rval = ml_scalar_common_addr(_)
        ; Rval = ml_self(_)
        )
    ).

:- pred add_rtti_defn_arcs_lval(mlds_global_var_name::in, mlds_lval::in,
    digraph(mlds_global_var_name)::in, digraph(mlds_global_var_name)::out)
    is det.

add_rtti_defn_arcs_lval(DefnGlobalVarName, Lval, !Graph) :-
    (
        ( Lval = ml_field(_, SubRval, _, _, _)
        ; Lval = ml_mem_ref(SubRval, _)
        ),
        add_rtti_defn_arcs_rval(DefnGlobalVarName, SubRval, !Graph)
    ;
        ( Lval = ml_target_global_var_ref(env_var_ref(_))
        ; Lval = ml_local_var(_, _)
        ; Lval = ml_global_var(_, _)
        )
    ).

:- pred add_rtti_defn_arcs_const(mlds_global_var_name::in,
    mlds_rval_const::in,
    digraph(mlds_global_var_name)::in, digraph(mlds_global_var_name)::out)
    is det.

add_rtti_defn_arcs_const(DefnGlobalVarName, Const, !Graph) :-
    (
        Const = mlconst_data_addr_rtti(_, RttiId),
        GlobalVarName = gvn_rtti_var(RttiId),
        digraph.add_vertices_and_edge(DefnGlobalVarName, GlobalVarName, !Graph)
    ;
        ( Const = mlconst_true
        ; Const = mlconst_false
        ; Const = mlconst_int(_)
        ; Const = mlconst_uint(_)
        ; Const = mlconst_int8(_)
        ; Const = mlconst_uint8(_)
        ; Const = mlconst_int16(_)
        ; Const = mlconst_uint16(_)
        ; Const = mlconst_int32(_)
        ; Const = mlconst_uint32(_)
        ; Const = mlconst_int64(_)
        ; Const = mlconst_uint64(_)
        ; Const = mlconst_enum(_, _)
        ; Const = mlconst_char(_)
        ; Const = mlconst_foreign(_, _, _)
        ; Const = mlconst_float(_)
        ; Const = mlconst_string(_)
        ; Const = mlconst_multi_string(_)
        ; Const = mlconst_named_const(_, _)
        ; Const = mlconst_code_addr(_)
        ; Const = mlconst_data_addr_local_var(_)
        ; Const = mlconst_data_addr_global_var(_, _)
        ; Const = mlconst_data_addr_tabling(_, _)
        ; Const = mlconst_null(_)
        )
    ).

%-----------------------------------------------------------------------------%
:- end_module ml_backend.rtti_to_mlds.
%-----------------------------------------------------------------------------%
