%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1999-2012 The University of Melbourne.
% Copyright (C) 2013-2026 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: ml_code_util.m.
% Main author: fjh.
%
% This module is part of the MLDS code generator; it contains utility
% predicates.
%
%---------------------------------------------------------------------------%

:- module ml_backend.ml_code_util.
:- interface.

:- import_module backend_libs.
:- import_module backend_libs.builtin_ops.
:- import_module hlds.
:- import_module hlds.code_model.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_rtti.
:- import_module hlds.pred_proc_id.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module ml_backend.ml_gen_info.
:- import_module ml_backend.ml_global_data.
:- import_module ml_backend.mlds.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.var_table.

:- import_module assoc_list.
:- import_module bool.
:- import_module list.
:- import_module maybe.

%---------------------------------------------------------------------------%
%
% Various utility routines used for MLDS code generation.
%

    % Generate an MLDS assignment statement.
    %
:- func ml_gen_assign(mlds_lval, mlds_rval, prog_context) = mlds_stmt.

    % Generate a block statement, i.e. `{ <Decls>; <Stmts>; }'.
    % But if the block consists only of a single statement with no
    % declarations, then just return that statement.
    %
:- func ml_gen_block(list(mlds_local_var_defn), list(mlds_function_defn),
    list(mlds_stmt), prog_context) = mlds_stmt.

:- type gen_pred ==
    pred(list(mlds_local_var_defn), list(mlds_function_defn), list(mlds_stmt),
        ml_gen_info, ml_gen_info).
:- inst gen_pred == (pred(out, out, out, in, out) is det).

    % Given closures to generate code for two conjuncts, generate code
    % for their conjunction.
    %
:- pred ml_combine_conj(code_model::in, prog_context::in,
    gen_pred::in(gen_pred), gen_pred::in(gen_pred),
    list(mlds_local_var_defn)::out, list(mlds_function_defn)::out,
    list(mlds_stmt)::out, ml_gen_info::in, ml_gen_info::out) is det.

    % Given a function label and the statement which will comprise
    % the function body for that function, generate an mlds_function_defn
    % which defines that function.
    %
:- pred ml_gen_nondet_label_func(ml_gen_info::in, mlds_maybe_aux_func_id::in,
    mlds_func_source::in, prog_context::in, mlds_stmt::in,
    mlds_function_defn::out) is det.

    % Given maybe_aux_func_id part of the function label, the function flags,
    % the function parameters, and the statement which will comprise
    % the function body for that function, generate an mlds_function_defn
    % which defines that function.
    %
:- pred ml_gen_label_func(ml_gen_info::in, mlds_maybe_aux_func_id::in,
    mlds_function_decl_flags::in, mlds_func_source::in, mlds_func_params::in,
    prog_context::in, mlds_stmt::in, mlds_function_defn::out) is det.

%---------------------------------------------------------------------------%
%
% Routines for generating expressions.
%

:- func ml_int_tag_to_rval_const(int_tag, mer_type, mlds_type) = mlds_rval.

%---------------------------------------------------------------------------%
%
% Routines for generating types.
%

:- func var_table_entry_to_mlds_type(module_info, var_table_entry) = mlds_type.

    % Convert a Mercury type to an MLDS type.
    %
:- pred ml_gen_mlds_type(ml_gen_info::in, mer_type::in, mlds_type::out) is det.

    % Convert the element type for an array_index operator to an MLDS type.
    %
:- func ml_gen_array_elem_type(array_elem_type) = mlds_type.

    % Allocate one or several fresh type variables, with kind `star',
    % to use as the Mercury types of boxed objects (e.g. to get the
    % argument types for tuple constructors or closure constructors).
    % Note that this should only be used in cases where the tvarset
    % doesn't matter.
    %
:- func ml_make_boxed_type = mer_type.
:- func ml_make_boxed_types(arity) = list(mer_type).

    % Return the interface id corresponding to the
    % `jmercury.runtime.MercuryType' interface.
    %
:- func ml_java_mercury_type_interface = mlds_interface_id.

    % Return the class id corresponding to the
    % `jmercury.runtime.MercuryEnum' class.
    %
:- func ml_java_mercury_enum_class = mlds_class_id.

%---------------------------------------------------------------------------%
%
% Routines for generating labels and entity names.
%

    % Generate the mlds_function_name and module name for the entry point
    % function corresponding to a given procedure.
    %
:- pred ml_gen_proc_label(module_info::in, pred_proc_id::in,
    mlds_module_name::out, mlds_plain_func_name::out) is det.

    % Generate an mlds_function_name for a continuation function with the
    % given sequence number. The pred_id and proc_id specify the procedure
    % that this continuation function is part of.
    %
:- func ml_gen_nondet_label(module_info, pred_proc_id,
    mlds_maybe_aux_func_id) = mlds_plain_func_name.

    % Allocate a new function label and return an rval containing the
    % function's address. If parameters are not given, we assume it is
    % a continuation function, and give it the appropriate arguments
    % (depending on whether we are doing nested functions or not).
    %
:- pred ml_gen_new_func_label(maybe(mlds_func_params)::in,
    mlds_maybe_aux_func_id::out, mlds_rval::out,
    ml_gen_info::in, ml_gen_info::out) is det.

    % Generate the mlds_pred_label and module name for a given procedure.
    %
:- pred ml_gen_pred_label(module_info::in, pred_proc_id::in,
    mlds_pred_label::out, mlds_module_name::out) is det.

:- pred ml_gen_pred_label_from_rtti(module_info::in, rtti_proc_label::in,
    mlds_pred_label::out, mlds_module_name::out) is det.

    % Allocate a new label name, for use in label statements.
    %
:- pred ml_gen_new_label(mlds_label::out,
    ml_gen_info::in, ml_gen_info::out) is det.

%---------------------------------------------------------------------------%
%
% Routines for dealing with variables.
%

    % Generate a list of the mlds_lvals corresponding to a given list
    % of prog_vars.
    %
:- pred ml_gen_var_direct_list(ml_gen_info::in, list(prog_var)::in,
    list(mlds_lval)::out) is det.

    % Generate the mlds_lval corresponding to a given prog_var.
    %
:- pred ml_gen_var_direct(ml_gen_info::in, prog_var::in,
    mlds_lval::out) is det.
:- pred ml_gen_var(ml_gen_info::in, prog_var::in, var_table_entry::in,
    mlds_lval::out) is det.

    % Generate the mlds_lval corresponding to a given prog_var,
    % with a given type.
    %
:- pred ml_gen_var_with_type(ml_gen_info::in, prog_var::in, mer_type::in,
    mlds_lval::out) is det.

    % Lookup the type of a variable.
    %
:- pred ml_variable_type_direct(ml_gen_info::in, prog_var::in,
    mer_type::out) is det.

    % Generate the MLDS variable names for a list of variables.
    %
:- func ml_gen_local_var_names(var_table::in, list(prog_var)::in)
    = (list(mlds_local_var_name)::out(list_skel(lvn_prog_var))) is det.

    % Generate the MLDS variable name for a variable.
    %
:- func ml_gen_local_var_name(prog_var::in, var_table_entry::in)
    = (mlds_local_var_name::out(lvn_prog_var)) is det.

    % Generate a declaration for an MLDS variable, given its HLDS type.
    %
:- pred ml_gen_local_var_decl(mlds_local_var_name::in, mer_type::in,
    prog_context::in, mlds_local_var_defn::out,
    ml_gen_info::in, ml_gen_info::out) is det.

    % Generate a declaration for an MLDS variable, given its MLDS type
    % and the code to trace it for accurate GC (if needed).
    %
:- func ml_gen_mlds_var_decl(mlds_local_var_name, mlds_type,
    mlds_gc_statement, prog_context) = mlds_local_var_defn.

    % Generate a declaration for an MLDS variable, given its MLDS type
    % and initializer, and given the code to trace it for accurate GC
    % (if needed).
    %
:- func ml_gen_mlds_var_decl_init(mlds_local_var_name, mlds_type,
    mlds_initializer, mlds_gc_statement, prog_context) = mlds_local_var_defn.

    % Return the declaration flags appropriate for a public field
    % in the derived constructor class of a discriminated union.
    %
:- func ml_gen_public_field_decl_flags = mlds_field_var_decl_flags.

%---------------------------------------------------------------------------%
%
% Routines for dealing with fields.
%
    % ml_gen_hld_field_name(MaybeFieldName, MaybeBaseCtorArg, ArgNum) =
    %   FieldName:
    %
    % Generate an MLDS field name for the target language type that represents
    % the function symbol's cell when we are generating code with
    % --high-level-data.
    %
    % MaybeFieldName is the user-specified field name (if any).
    % MaybeBaseCtorArg says whether this is a field in a subtype, and if so,
    % the field name (if any) of the corresponding constructor argument in the
    % base type.
    % ArgNum is the argument number (starting from one).
    %
:- func ml_gen_hld_field_name(maybe(ctor_field_name), maybe_base_ctor_arg, int)
    = mlds_field_var_name.

    % Succeed iff the specified type must be boxed when used as a field.
    % XXX Currently we box such types even for the other MLDS based back-ends
    % that don't need it, e.g. the .NET back-end.
    %
:- pred ml_must_box_field_type(module_info::in, mer_type::in, arg_width::in)
    is semidet.

:- pred ml_gen_box_const_rval(module_info::in, prog_context::in,
    mlds_type::in, arg_width::in, mlds_rval::in, mlds_rval::out,
    ml_global_data::in, ml_global_data::out) is det.

    % Given a source type and a destination type, and given an source rval
    % holding a value of the source type, produce an rval that converts
    % the source rval to the destination type, by boxing or unboxing it,
    % possibly with an additional cast.
    %
    % The second version assumes that the box_policy is bp_native_if_possible.
    % (Only one caller calls the general version; all the others call
    % the second version.)
    %
:- pred ml_gen_box_or_unbox_rval(module_info::in, mer_type::in, mer_type::in,
    box_policy::in, mlds_rval::in, mlds_rval::out) is det.
:- pred ml_gen_box_or_unbox_rval_native(module_info::in,
    mer_type::in, mer_type::in, mlds_rval::in, mlds_rval::out) is det.

    % ml_gen_box_or_unbox_lval(CallerType, CalleeType, VarLval, VarName,
    %   Context, ForClosureWrapper, ArgNum,
    %   ArgLval, ConvDecls, ConvInputStmts, ConvOutputStmts):
    %
    % This is like `ml_gen_box_or_unbox_rval', except that it works on lvals
    % rather than rvals. Given a source type and a destination type,
    % a source lval holding a value of the source type, and a name to base
    % the name of the local temporary variable on, this procedure produces
    % an lval of the destination type, the declaration for the local temporary
    % used (if any), code to assign from the source lval (suitable converted)
    % to the destination lval, and code to assign from the destination lval
    % (suitable converted) to the source lval.
    %
    % If ForClosureWrapper = yes, then the type_info for type variables
    % in CallerType may not be available in the current procedure, so the GC
    % tracing code for the ConvDecls (if any) should obtain the type_info
    % from the ArgNum-th entry in the `type_params' local.
    % (If ForClosureWrapper = no, then ArgNum is unused.)
    %
:- pred ml_gen_box_or_unbox_lval(mer_type::in, mer_type::in, box_policy::in,
    mlds_lval::in, mlds_local_var_name::in, prog_context::in, bool::in,
    int::in, mlds_lval::out, list(mlds_local_var_defn)::out,
    list(mlds_stmt)::out, list(mlds_stmt)::out,
    ml_gen_info::in, ml_gen_info::out) is det.

    % ml_gen_local_for_output_arg(VarName, Type, ArgNum, Context,
    %   LocalVarDefn):
    %
    % Generate a declaration for a local variable with the specified
    % VarName and Type. However, don't use the normal GC tracing code;
    % instead, generate GC tracing code that gets the typeinfo from
    % the ArgNum-th entry in `type_params'.
    %
:- pred ml_gen_local_for_output_arg(mlds_local_var_name::in, mer_type::in,
    int::in, prog_context::in, mlds_local_var_defn::out,
    ml_gen_info::in, ml_gen_info::out) is det.

%---------------------------------------------------------------------------%
%
% Routines for handling success and failure.
%

    % Generate code to succeed in the given code_model.
    %
:- pred ml_gen_success(code_model::in, prog_context::in, list(mlds_stmt)::out,
    ml_gen_info::in, ml_gen_info::out) is det.

    % Generate code to fail in the given code_model.
    %
:- pred ml_gen_failure(code_model::in, prog_context::in, list(mlds_stmt)::out,
    ml_gen_info::in, ml_gen_info::out) is det.

    % Generate the declaration for the built-in `succeeded' flag.
    % (`succeeded' is a boolean variable used to record
    % the success or failure of model_semi procedures.)
    %
:- func ml_gen_succeeded_var_decl(prog_context) = mlds_local_var_defn.

    % Return the lval for the `succeeded' flag.
    % (`succeeded' is a boolean variable used to record
    % the success or failure of model_semi procedures.)
    %
:- pred ml_success_lval(mlds_lval::out,
    ml_gen_info::in, ml_gen_info::out) is det.

    % Return an rval which will test the value of the `succeeded' flag.
    % (`succeeded' is a boolean variable used to record
    % the success or failure of model_semi procedures.)
    %
:- pred ml_gen_test_success(mlds_rval::out,
    ml_gen_info::in, ml_gen_info::out) is det.

    % Generate code to set the `succeeded' flag to the specified truth value.
    %
:- pred ml_gen_set_success(mlds_rval::in, prog_context::in, mlds_stmt::out,
    ml_gen_info::in, ml_gen_info::out) is det.

    % Generate the declaration for the specified `cond' variable.
    % (`cond' variables are boolean variables used to record
    % the success or failure of model_non conditions of if-then-elses.)
    %
:- func ml_gen_cond_var_decl(cond_seq, prog_context) = mlds_local_var_defn.

    % Return the lval for the specified `cond' flag.
    % (`cond' variables are boolean variables used to record
    % the success or failure of model_non conditions of if-then-elses.)
    %
:- pred ml_cond_var_lval(cond_seq::in, mlds_lval::out) is det.

    % Return an rval which will test the value of the specified `cond'
    % variable. (`cond' variables are boolean variables used to record
    % the success or failure of model_non conditions of if-then-elses.)
    %
:- pred ml_gen_test_cond_var(cond_seq::in, mlds_rval::out) is det.

    % Generate code to set the specified `cond' variable to the
    % specified truth value.
    %
:- pred ml_gen_set_cond_var(cond_seq::in, mlds_rval::in, prog_context::in,
    mlds_stmt::out) is det.

    % Return the success continuation that was passed as the current function's
    % argument(s). The success continuation consists of two parts, the `cont'
    % argument, and the `cont_env' argument. The `cont' argument is a
    % continuation function that will be called when a model_non goal succeeds.
    % The `cont_env' argument is a pointer to the environment (set of local
    % variables in the containing procedure) for the continuation function.
    % (If we are using gcc nested function, the `cont_env' is not used.)
    % The output variable lvals and types need to be supplied when generating
    % a continuation using --nondet-copy-out, otherwise they should be empty.
    %
:- pred ml_initial_cont(ml_gen_info::in, assoc_list(mlds_lval, mer_type)::in,
    success_cont::out) is det.

    % Generate code to call the current success continuation.
    % This is used for generating success when in a model_non context.
    %
:- pred ml_gen_call_current_success_cont(ml_gen_info::in, prog_context::in,
    mlds_stmt::out) is det.

%---------------------------------------------------------------------------%
%
% Routines for dealing with the environment pointer used for nested functions.
%

    % Return an rval for a pointer to the current environment (the set of local
    % variables in the containing procedure). Note that we generate this
    % as a dangling reference. The ml_elim_nested pass will insert the
    % declaration of the env_ptr variable. At this point, the type of these
    % rvals is `mlds_unknown_type'.
    %
:- pred ml_get_env_ptr(mlds_rval::out) is det.

    % Return an mlds_argument for a pointer to the current environment
    % (the set of local variables in the containing procedure).
    %
:- pred ml_declare_env_ptr_arg(mlds_argument::out) is det.

%---------------------------------------------------------------------------%
%
% Magic numbers relating to the representation of
% typeclass_infos, base_typeclass_infos, and closures.
%

    % This function returns the offset to add to the argument number
    % of a closure arg to get its field number.
    %
:- func ml_closure_arg_offset = int.

    % This function returns the offset to add to the argument number
    % of a typeclass_info arg to get its field number.
    %
:- func ml_typeclass_info_arg_offset = int.

    % This function returns the offset to add to the method number for a type
    % class method to get its field number within the base_typeclass_info.
    %
:- func ml_base_typeclass_info_method_offset = int.

%---------------------------------------------------------------------------%
%
% Routines for dealing with lookup tables.
%

:- pred ml_generate_constants_for_arms(list(prog_var)::in, list(hlds_goal)::in,
    list(list(mlds_rval))::out, ml_gen_info::in, ml_gen_info::out) is semidet.

:- pred ml_generate_constants_for_arm(list(prog_var)::in, hlds_goal::in,
    list(mlds_rval)::out, ml_gen_info::in, ml_gen_info::out) is semidet.

:- pred ml_generate_field_assign(mlds_lval::in, mlds_type::in,
    mlds_field_id::in, mlds_vector_common::in, mlds_type::in,
    mlds_rval::in, prog_context::in, mlds_stmt::out) is det.

:- pred ml_generate_field_assigns(list(prog_var)::in, list(mlds_type)::in,
    list(mlds_field_id)::in, mlds_vector_common::in, mlds_type::in,
    mlds_rval::in, prog_context::in, list(mlds_stmt)::out,
    ml_gen_info::in, ml_gen_info::out) is det.

%---------------------------------------------------------------------------%
%
% Miscellaneous routines.
%

    % Add the qualifier `builtin' to any unqualified name.
    % Although the builtin types `int', `float', etc. are treated as part
    % of the `builtin' module, for historical reasons they don't have
    % any qualifiers in the HLDS, so we need to add the `builtin'
    % qualifier before converting such names to MLDS.
    %
:- func fixup_builtin_module(module_name) = module_name.

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

:- implementation.

:- import_module hlds.pred_name.
:- import_module hlds.type_classify.
:- import_module hlds.type_util.
:- import_module libs.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.prim_data.
:- import_module ml_backend.ml_accurate_gc.
:- import_module ml_backend.ml_code_gen.
:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.java_names.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_type_test.
:- import_module parse_tree.prog_type_unify.
:- import_module parse_tree.set_of_var.

:- import_module map.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module term.
:- import_module varset.

%---------------------------------------------------------------------------%
%
% Code for various utility routines.
%

ml_gen_assign(Lval, Rval, Context) = Stmt :-
    Assign = assign(Lval, Rval),
    Stmt = ml_stmt_atomic(Assign, Context).

ml_gen_block(LocalVarDefns, FuncDefns, Stmts, Context) = Block :-
    ( if
        LocalVarDefns = [],
        FuncDefns = [],
        Stmts = [SingleStmt]
    then
        Block = SingleStmt
    else
        Block = ml_stmt_block(LocalVarDefns, FuncDefns, Stmts, Context)
    ).

ml_combine_conj(FirstCodeModel, Context, DoGenFirst, DoGenRest,
        LocalVarDefns, FuncDefns, Stmts, !Info) :-
    (
        % model_det goal:
        %     <First, Rest>
        % ===>
        %     <do First>
        %     <Rest>
        %
        FirstCodeModel = model_det,
        DoGenFirst(FirstLocalVarDefns, FirstFuncDefns, FirstStmts, !Info),
        DoGenRest(RestLocalVarDefns, RestFuncDefns, RestStmts, !Info),
        LocalVarDefns = FirstLocalVarDefns ++ RestLocalVarDefns,
        FuncDefns = FirstFuncDefns ++ RestFuncDefns,
        Stmts = FirstStmts ++ RestStmts
    ;
        % model_semi goal:
        %     <Goal, Goals>
        % ===>
        %     MR_bool succeeded;
        %
        %     <succeeded = Goal>;
        %     if (succeeded) {
        %         <Goals>;
        %     }
        % except that we hoist any declarations generated for <Goals>
        % to the outer scope, rather than inside the `if', so that they remain
        % in scope for any later goals which follow this (this is needed for
        % declarations of static consts).
        % XXX We haven't put static consts into blocks for a long time;
        % they are now in the global data field in !Info.

        FirstCodeModel = model_semi,
        DoGenFirst(FirstLocalVarDefns, FirstFuncDefns, FirstStmts, !Info),
        ml_gen_test_success(Succeeded, !Info),
        DoGenRest(RestLocalVarDefns, RestFuncDefns, RestStmts, !Info),
        ThenStmt = ml_gen_block([], [], RestStmts, Context),
        ITEStmt = ml_stmt_if_then_else(Succeeded, ThenStmt, no, Context),
        LocalVarDefns = FirstLocalVarDefns ++ RestLocalVarDefns,
        FuncDefns = FirstFuncDefns ++ RestFuncDefns,
        Stmts = FirstStmts ++ [ITEStmt]
    ;
        % model_non goal:
        %     <First, Rest>
        % ===>
        %     succ_func() {
        %         <Rest && SUCCEED()>;
        %     }
        %
        %     <First && succ_func()>;
        %
        % except that we hoist any declarations generated for <First>
        % to the top of the scope, rather than inside or after the
        % succ_func(), so that they remain in scope for any code
        % following them.
        %
        % XXX The pattern above leads to deep nesting for long conjunctions;
        % we should avoid that.
        %

        FirstCodeModel = model_non,

        % Allocate a name for the `succ_func'.
        ml_gen_new_func_label(no, RestFuncLabel, RestFuncLabelRval, !Info),

        % Generate <First && succ_func()>.
        ml_get_env_ptr(EnvPtrRval),
        SuccessCont = success_cont(RestFuncLabelRval, EnvPtrRval, []),
        ml_gen_info_push_success_cont(SuccessCont, !Info),
        DoGenFirst(FirstLocalVarDefns, FirstFuncDefns, FirstStmts, !Info),
        ml_gen_info_pop_success_cont(!Info),

        % Generate the `succ_func'.
        % Do not take any information about packed args into the new function
        % depth, since that may cause dangling cross-function references
        % when the new function depth is flattened out.
        ml_gen_info_set_packed_word_map(map.init, !Info),
        ml_gen_info_increment_func_nest_depth(!Info),
        DoGenRest(RestLocalVarDefns, RestFuncDefns, RestStmts, !Info),
        ml_gen_info_decrement_func_nest_depth(!Info),
        % Do not take any information about packed args out of the new function
        % depth, for the same reason.
        ml_gen_info_set_packed_word_map(map.init, !Info),

        RestStmt = ml_gen_block(RestLocalVarDefns, RestFuncDefns, RestStmts,
            Context),
        ml_gen_nondet_label_func(!.Info, RestFuncLabel,
            mlds_func_source_continuation, Context, RestStmt, RestFunc),

        LocalVarDefns = FirstLocalVarDefns,
        FuncDefns = FirstFuncDefns ++ [RestFunc],
        Stmts = FirstStmts
    ).

ml_gen_nondet_label_func(Info, MaybeAux, Source, Context, Stmt, Func) :-
    ml_declare_env_ptr_arg(EnvPtrArg),
    FuncParams = mlds_func_params([EnvPtrArg], []),
    DeclFlags = mlds_function_decl_flags(func_private, per_instance),
    ml_gen_label_func(Info, MaybeAux, DeclFlags, Source, FuncParams, Context,
        Stmt, Func).

ml_gen_label_func(Info, MaybeAux, DeclFlags, Source, FuncParams,
        Context, Stmt, Func) :-
    % Compute the function name.
    ml_gen_info_get_module_info(Info, ModuleInfo),
    ml_gen_info_get_pred_proc_id(Info, PredProcId),
    FuncName = ml_gen_nondet_label(ModuleInfo, PredProcId, MaybeAux),

    % Compute the function definition.
    Body = body_defined_here(Stmt),
    EnvVarNames = set.init,
    Func = mlds_function_defn(mlds_function_name(FuncName), Context,
        DeclFlags, Source, FuncParams, Body, EnvVarNames, no).

%---------------------------------------------------------------------------%
%
% Code for generating expressions.
%

ml_int_tag_to_rval_const(IntTag, MerType, MLDS_Type) = Rval :-
    % Keep this code in sync with ml_generate_test_rval_is_int_tag
    % in ml_unify_gen_test.m.
    (
        IntTag = int_tag_int(Int),
        ( if MerType = int_type then
            Const = mlconst_int(Int)
        else if MerType = char_type then
            Const = mlconst_char(Int)
        else
            Const = mlconst_enum(Int, MLDS_Type)
        )
    ;
        IntTag = int_tag_uint(UInt),
        Const = mlconst_uint(UInt)
    ;
        IntTag = int_tag_int8(Int8),
        Const = mlconst_int8(Int8)
    ;
        IntTag = int_tag_uint8(UInt8),
        Const = mlconst_uint8(UInt8)
    ;
        IntTag = int_tag_int16(Int16),
        Const = mlconst_int16(Int16)
    ;
        IntTag = int_tag_uint16(UInt16),
        Const = mlconst_uint16(UInt16)
    ;
        IntTag = int_tag_int32(Int32),
        Const = mlconst_int32(Int32)
    ;
        IntTag = int_tag_uint32(UInt32),
        Const = mlconst_uint32(UInt32)
    ;
        IntTag = int_tag_int64(Int64),
        Const = mlconst_int64(Int64)
    ;
        IntTag = int_tag_uint64(UInt64),
        Const = mlconst_uint64(UInt64)
    ),
    Rval = ml_const(Const).

%---------------------------------------------------------------------------%
%
% Code for generating types.
%

var_table_entry_to_mlds_type(ModuleInfo, Entry) = MLDSType :-
    MLDSType = mercury_type_to_mlds_type(ModuleInfo, Entry ^ vte_type).

ml_gen_mlds_type(Info, Type, MLDS_Type) :-
    ml_gen_info_get_module_info(Info, ModuleInfo),
    MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type).

ml_gen_array_elem_type(ElemType) = MLDS_Type :-
    (
        ElemType = array_elem_scalar(ScalarElem),
        MLDS_Type = ml_gen_scalar_array_elem_type(ScalarElem)
    ;
        ElemType = array_elem_struct(_ScalarElems),
        unexpected($pred, "struct")
    ).

:- func ml_gen_scalar_array_elem_type(scalar_array_elem_type) = mlds_type.

ml_gen_scalar_array_elem_type(scalar_elem_string) = mlds_builtin_type_string.
ml_gen_scalar_array_elem_type(scalar_elem_int) =
    mlds_builtin_type_int(int_type_int).
ml_gen_scalar_array_elem_type(scalar_elem_generic) = mlds_generic_type.

ml_make_boxed_type = BoxedType :-
    varset.init(TypeVarSet0),
    varset.new_var(BoxedTypeVar, TypeVarSet0, _TypeVarSet),
    prog_type.var_to_type(map.init, BoxedTypeVar, BoxedType).

ml_make_boxed_types(Arity) = BoxedTypes :-
    varset.init(TypeVarSet0),
    varset.new_vars(Arity, BoxedTypeVars, TypeVarSet0, _TypeVarSet),
    prog_type.var_list_to_type_list(map.init, BoxedTypeVars, BoxedTypes).

ml_java_mercury_type_interface = TypeInterfaceDefn :-
    InterfaceModuleName =
        mercury_module_name_to_mlds(java_mercury_runtime_package_name),
    TypeInterfaceDefn = mlds_interface_id(InterfaceModuleName, "MercuryType").

ml_java_mercury_enum_class = EnumClassId :-
    InterfaceModuleName =
        mercury_module_name_to_mlds(java_mercury_runtime_package_name),
    EnumClass =
        qual_class_name(InterfaceModuleName, module_qual, "MercuryEnum"),
    EnumClassId = mlds_class_id(EnumClass, 0).

%---------------------------------------------------------------------------%
%
% Code for generating mlds_function_names.
%

ml_gen_proc_label(ModuleInfo, PredProcId, MLDS_ModuleName, MLDS_Name) :-
    ml_gen_func_label(ModuleInfo, PredProcId, proc_func, MLDS_ModuleName,
        MLDS_Name).

ml_gen_nondet_label(ModuleInfo, PredProcId, MaybeAux) = MLDS_Name :-
    ml_gen_func_label(ModuleInfo, PredProcId, MaybeAux,
        _MLDS_ModuleName, MLDS_Name).

:- pred ml_gen_func_label(module_info::in, pred_proc_id::in,
    mlds_maybe_aux_func_id::in,
    mlds_module_name::out, mlds_plain_func_name::out) is det.

ml_gen_func_label(ModuleInfo, PredProcId, MaybeAux, ModuleName, FuncName) :-
    ml_gen_pred_label(ModuleInfo, PredProcId, PredLabel, ModuleName),
    PredProcId = proc(PredId, ProcId),
    ProcLabel = mlds_proc_label(PredLabel, ProcId),
    FuncLabel = mlds_func_label(ProcLabel, MaybeAux),
    FuncName = mlds_plain_func_name(FuncLabel, PredId).

ml_gen_new_func_label(MaybeParams, MaybeAux, FuncLabelRval, !Info) :-
    ml_gen_info_new_aux_func_id(MaybeAux, !Info),
    ml_gen_info_get_module_info(!.Info, ModuleInfo),
    ml_gen_info_get_pred_proc_id(!.Info, PredProcId),
    ml_gen_pred_label(ModuleInfo, PredProcId, PredLabel, PredModule),
    (
        MaybeParams = yes(Params),
        Signature = mlds_get_func_signature(Params)
    ;
        MaybeParams = no,
        ArgTypes = [mlds_generic_env_ptr_type],
        Signature = mlds_func_signature(ArgTypes, [])
    ),
    PredProcId = proc(_PredId, ProcId),
    ProcLabel = mlds_proc_label(PredLabel, ProcId),
    FuncLabel = mlds_func_label(ProcLabel, MaybeAux),
    QualFuncLabel = qual_func_label(PredModule, FuncLabel),
    FuncLabelRval = ml_const(mlconst_code_addr(
        mlds_code_addr(QualFuncLabel, Signature))).

ml_gen_pred_label(ModuleInfo, PredProcId, MLDS_PredLabel, MLDS_Module) :-
    PredProcId = proc(PredId, ProcId),
    RttiProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
    ml_gen_pred_label_from_rtti(ModuleInfo, RttiProcLabel,
        MLDS_PredLabel, MLDS_Module).

ml_gen_pred_label_from_rtti(_ModuleInfo, RttiProcLabel, MLDS_PredLabel,
        MLDS_Module) :-
    RttiProcLabel = rtti_proc_label(PredOrFunc, ThisModule, PredModule,
        PredName, PredFormArity, _ArgTypes, _PredId, ProcId,
        _HeadVarsWithNames, _TopFunctorModes, _Detism,
        PredIsImported, _PredIsPseudoImported,
        Origin, _ProcIsExported, _ProcIsImported),
    ( if Origin = origin_compiler(made_for_uci(SpecialPred, TypeCtor)) then
        ( if
            % All type_ctors other than tuples here should be module qualified,
            % since builtin types are handled separately in polymorphism.m.
            TypeCtor = type_ctor(TypeCtorSymName, TypeArity),
            (
                TypeCtorSymName = unqualified(TypeName),
                type_ctor_is_tuple(TypeCtor),
                TypeModule = mercury_public_builtin_module
            ;
                TypeCtorSymName = qualified(TypeModule, TypeName)
            )
        then
            ( if
                ThisModule \= TypeModule,
                SpecialPred = spec_pred_unify,
                not in_in_unification_proc_id(ProcId)
            then
                % This is a locally-defined instance of a unification procedure
                % for a type defined in some other module.
                DefiningModule = ThisModule,
                MaybeDeclaringModule = yes(TypeModule)
            else
                % The module declaring the type is the same as the module
                % defining this special pred.
                DefiningModule = TypeModule,
                MaybeDeclaringModule = no
            ),
            MLDS_PredLabel = mlds_special_pred_label(PredName,
                MaybeDeclaringModule, TypeName, TypeArity)
        else
            unexpected($pred,
                "cannot make label for special pred `" ++ PredName ++ "'")
        )
    else
        ( if
            % Work out which module supplies the code for the predicate.
            ThisModule \= PredModule,
            PredIsImported = no
        then
            % This predicate is a specialized version of a pred from a
            % `.opt' file.
            DefiningModule = ThisModule,
            MaybeDeclaringModule = yes(PredModule)
        else
            % The predicate was declared in the same module that it is
            % defined in
            DefiningModule = PredModule,
            MaybeDeclaringModule = no
        ),
        MLDS_PredLabel = mlds_user_pred_label(PredOrFunc, MaybeDeclaringModule,
            PredName, PredFormArity)
    ),
    MLDS_Module = mercury_module_name_to_mlds(DefiningModule).

ml_gen_new_label(Label, !Info) :-
    ml_gen_info_new_label(LabelNum, !Info),
    Label = mlds_label("label_" ++ string.uint_to_string(LabelNum)).

%---------------------------------------------------------------------------%
%
% Code for dealing with variables.
%

ml_gen_var_direct_list(_Info, [], []).
ml_gen_var_direct_list(Info, [Var | Vars], [Lval | Lvals]) :-
    ml_gen_var_direct(Info, Var, Lval),
    ml_gen_var_direct_list(Info, Vars, Lvals).

ml_gen_var_direct(Info, Var, Lval) :-
    % First check the var_lvals override mapping; if an lval has been set
    % for this variable, use it.
    ml_gen_info_get_var_lvals(Info, VarLvals),
    ( if map.search(VarLvals, Var, VarLval) then
        Lval = VarLval
    else
        % Otherwise just look up the variable's type and generate an lval
        % for it using the ordinary algorithm.
        ml_gen_info_get_var_table(Info, VarTable),
        lookup_var_entry(VarTable, Var, Entry),
        do_gen_var(Info, Var, Entry, Lval)
    ).

ml_gen_var(Info, Var, Entry, Lval) :-
    % First check the var_lvals override mapping; if an lval has been set
    % for this variable, use it.
    ml_gen_info_get_var_lvals(Info, VarLvals),
    ( if map.search(VarLvals, Var, VarLval) then
        Lval = VarLval
    else
        % Otherwise just look up the variable's type and generate an lval
        % for it using the ordinary algorithm.
        do_gen_var(Info, Var, Entry, Lval)
    ).

:- pred do_gen_var(ml_gen_info::in, prog_var::in, var_table_entry::in,
    mlds_lval::out) is det.

do_gen_var(Info, Var, Entry, Lval) :-
    Entry = vte(_, Type, IsDummy),
    ml_gen_mlds_type(Info, Type, MLDS_Type),
    (
        IsDummy = is_dummy_type,
        % The variable won't have been declared, so we need to generate
        % a dummy lval for this variable.
        Lval = ml_global_var(global_dummy_var, MLDS_Type)
    ;
        IsDummy = is_not_dummy_type,
        VarName = ml_gen_local_var_name(Var, Entry),
        VarLval = ml_local_var(VarName, MLDS_Type),
        % Output variables may be passed by reference...
        ml_gen_info_get_byref_output_vars(Info, ByRefOutputVars),
        ( if set_of_var.member(ByRefOutputVars, Var) then
            Lval = ml_mem_ref(ml_lval(VarLval), MLDS_Type)
        else
            Lval = VarLval
        )
    ).

ml_gen_var_with_type(Info, Var, Type, Lval) :-
    % NOTE The value of Type here may *differ* from the type recorded
    % for Var in the var_table field of !.Info. Out of an abundance of caution,
    % we recompute IsDummy for it as well.
    ml_gen_info_get_module_info(Info, ModuleInfo),
    IsDummy = is_type_a_dummy(ModuleInfo, Type),
    ml_gen_mlds_type(Info, Type, MLDS_Type),
    (
        IsDummy = is_dummy_type,
        % The variable won't have been declared, so we need to generate
        % a dummy lval for this variable.
        Lval = ml_global_var(global_dummy_var, MLDS_Type)
    ;
        IsDummy = is_not_dummy_type,
        % The name part of the var table entry for var does not depend
        % on which form of the var's type we are after.
        ml_gen_info_get_var_table(Info, VarTable),
        lookup_var_entry(VarTable, Var, Entry),
        VarName = ml_gen_local_var_name(Var, Entry),
        VarLval = ml_local_var(VarName, MLDS_Type),

        % Output variables may be passed by reference...
        ml_gen_info_get_byref_output_vars(Info, ByRefOutputVars),
        ( if set_of_var.member(ByRefOutputVars, Var) then
            Lval = ml_mem_ref(ml_lval(VarLval), MLDS_Type)
        else
            Lval = VarLval
        )
    ).

ml_variable_type_direct(Info, Var, Type) :-
    ml_gen_info_get_var_table(Info, VarTable),
    lookup_var_entry(VarTable, Var, Entry),
    Type = Entry ^ vte_type.

ml_gen_local_var_names(_, []) = [].
ml_gen_local_var_names(VarTable, [Var | Vars])
        = [MLDSVarName | MLDSVarNames] :-
    lookup_var_entry(VarTable, Var, VarEntry),
    MLDSVarName = ml_gen_local_var_name(Var, VarEntry),
    MLDSVarNames = ml_gen_local_var_names(VarTable, Vars).

ml_gen_local_var_name(Var, Entry) = MLDSVarName :-
    VarName = Entry ^ vte_name,
    term.var_to_int(Var, VarNumber),
    MLDSVarName = lvn_prog_var(VarName, VarNumber).

ml_gen_local_var_decl(VarName, Type, Context, Defn, !Info) :-
    ml_gen_info_get_module_info(!.Info, ModuleInfo),
    ml_gen_gc_statement(VarName, Type, Context, GCStmt, !Info),
    Defn = ml_gen_mlds_var_decl(VarName,
        mercury_type_to_mlds_type(ModuleInfo, Type), GCStmt, Context).

ml_gen_mlds_var_decl(DataName, MLDS_Type, GCStmt, Context) =
    ml_gen_mlds_var_decl_init(DataName, MLDS_Type, no_initializer, GCStmt,
        Context).

ml_gen_mlds_var_decl_init(DataName, MLDS_Type, Initializer, GCStmt, Context) =
    mlds_local_var_defn(DataName, Context, MLDS_Type, Initializer, GCStmt).

ml_gen_public_field_decl_flags =
    mlds_field_var_decl_flags(per_instance, modifiable).

%---------------------------------------------------------------------------%
%
% Code for dealing with fields.
%

ml_gen_hld_field_name(MaybeFieldName, MaybeBaseCtorArg, ArgNum) =
        FieldVarName :-
    % Subtypes share the data representation with their base types.
    % If this is the field of a subtype, we must translate the reference to the
    % corresponding constructor arg in the base type (which may or may not
    % have a field name).
    (
        MaybeBaseCtorArg = no_base_ctor_arg,
        FieldNameToUse = MaybeFieldName
    ;
        MaybeBaseCtorArg = base_ctor_arg(MaybeBaseFieldName),
        FieldNameToUse = MaybeBaseFieldName
    ),
    % Use the field name if we have one, otherwise we just use `F' followed by
    % the field number.
    (
        FieldNameToUse = yes(ctor_field_name(QualifiedFieldName,
            _FieldNameCtxt)),
        FieldName = unqualify_name(QualifiedFieldName)
    ;
        FieldNameToUse = no,
        FieldName = "F" ++ string.int_to_string(ArgNum)
    ),
    FieldVarName = fvn_du_ctor_field_hld(FieldName).

ml_must_box_field_type(ModuleInfo, Type, Width) :-
    module_info_get_globals(ModuleInfo, Globals),
    globals.get_target(Globals, Target),
    (
        ( Target = target_c
        ; Target = target_csharp
        ),
        classify_type(ModuleInfo, Type) = Category,
        globals.lookup_bool_option(Globals, unboxed_float, UnboxedFloat),
        globals.lookup_bool_option(Globals, unboxed_int64s, UnboxedInt64s),
        MustBox = ml_must_box_field_type_category(Category, UnboxedFloat,
            UnboxedInt64s, Width)
    ;
        Target = target_java,
        MustBox = no
    ),
    MustBox = yes.

:- func ml_must_box_field_type_category(type_ctor_category, bool, bool,
    arg_width) = bool.

ml_must_box_field_type_category(CtorCat, UnboxedFloat, UnboxedInt64s, Width)
        = MustBox :-
    (
        CtorCat = ctor_cat_builtin(cat_builtin_int(IntType)),
        (
            ( IntType = int_type_int
            ; IntType = int_type_uint
            ; IntType = int_type_int8
            ; IntType = int_type_uint8
            ; IntType = int_type_int16
            ; IntType = int_type_uint16
            ; IntType = int_type_int32
            ; IntType = int_type_uint32
            ),
            MustBox = no
        ;
            ( IntType = int_type_int64
            ; IntType = int_type_uint64
            ),
            (
                UnboxedInt64s = yes,
                MustBox = no
            ;
                UnboxedInt64s = no,
                (
                    Width = aw_full_word,
                    MustBox = yes
                ;
                    Width = aw_double_word,
                    unexpected($pred, "double word for 64-bit integer")
                ;
                    Width = aw_partial_word,
                    unexpected($pred, "partial word for 64-bit integer")
                ;
                    Width = aw_none,
                    unexpected($pred, "none for 64-bit integer")
                )
            )
        )
    ;
        ( CtorCat = ctor_cat_builtin(cat_builtin_string)
        ; CtorCat = ctor_cat_builtin_dummy
        ; CtorCat = ctor_cat_higher_order
        ; CtorCat = ctor_cat_tuple
        ; CtorCat = ctor_cat_enum(_)
        ; CtorCat = ctor_cat_system(_)
        ; CtorCat = ctor_cat_variable
        ; CtorCat = ctor_cat_void
        ; CtorCat = ctor_cat_user(_)
        ),
        MustBox = no
    ;
        CtorCat = ctor_cat_builtin(cat_builtin_char),
        MustBox = yes
    ;
        CtorCat = ctor_cat_builtin(cat_builtin_float),
        (
            UnboxedFloat = yes,
            MustBox = no
        ;
            UnboxedFloat = no,
            (
                Width = aw_full_word,
                MustBox = yes
            ;
                Width = aw_double_word,
                MustBox = no
            ;
                Width = aw_partial_word,
                unexpected($pred, "partial word for float")
            ;
                Width = aw_none,
                unexpected($pred, "none for float")
            )
        )
    ).

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

ml_gen_box_const_rval(ModuleInfo, Context, MLDS_Type, Width, Rval, BoxedRval,
        !GlobalData) :-
    ( if
        ( MLDS_Type = mercury_nb_type(type_variable(_, _), _)
        ; MLDS_Type = mlds_generic_type
        )
    then
        BoxedRval = Rval
    else if
        % For the MLDS->C back-end, we need to handle constant floats,
        % int64s and uint64s specially. Boxed floats, int64s and uint64s
        % normally get heap allocated, whereas for other types boxing
        % is just a cast (casts are OK in static initializers, but calls
        % to malloc() are not).
        (
            MLDS_Type = mlds_builtin_type_float,
            ConstVarKind = mgcv_float
        ;
            MLDS_Type = mlds_builtin_type_int(IntType),
            ( IntType = int_type_int64, ConstVarKind = mgcv_int64
            ; IntType = int_type_uint64, ConstVarKind = mgcv_uint64
            )
        ),
        ml_global_data_get_target(!.GlobalData, ml_target_c)
    then
        ( if
            (
                ConstVarKind = mgcv_float,
                ml_global_data_have_unboxed_floats(!.GlobalData,
                    do_not_have_unboxed_floats)
            ;
                ( ConstVarKind = mgcv_int64
                ; ConstVarKind = mgcv_uint64
                ),
                ml_global_data_have_unboxed_int64s(!.GlobalData,
                    do_not_have_unboxed_int64s)
            ),
            arg_width_is_double(Width, no)
        then
            % Generate a local static constant for this float, int64 or uint64.
            module_info_get_name(ModuleInfo, ModuleName),
            MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
            Initializer = init_obj(Rval),
            ml_gen_static_scalar_const_addr(MLDS_ModuleName, ConstVarKind,
                MLDS_Type, Initializer, Context, ConstAddrRval, !GlobalData),

            % Return as the boxed rval the address of that constant,
            % cast to mlds_generic_type.
            BoxedRval = ml_cast(mlds_generic_type, ConstAddrRval)
        else
            % This is not a real box, but a cast. The "box" is required as it
            % may be further cast to pointer types.
            BoxedRval = ml_box(MLDS_Type, Rval)
        )
    else
        BoxedRval = ml_box(MLDS_Type, Rval)
    ).

:- pred arg_width_is_double(arg_width::in, bool::out) is det.

arg_width_is_double(ArgWidth, DoubleWidth) :-
    (
        ArgWidth = aw_double_word,
        DoubleWidth = yes
    ;
        ( ArgWidth = aw_full_word
        ; ArgWidth = aw_partial_word
        ; ArgWidth = aw_none
        ),
        DoubleWidth = no
    ).

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

ml_gen_box_or_unbox_rval(ModuleInfo, SourceType, DestType, BoxPolicy, VarRval,
        ArgRval) :-
    % Convert VarRval, of type SourceType, to ArgRval, of type DestType.
    (
        BoxPolicy = bp_always_boxed,
        ArgRval = VarRval
    ;
        BoxPolicy = bp_native_if_possible,
        ml_gen_box_or_unbox_rval_native(ModuleInfo, SourceType, DestType,
            VarRval, ArgRval)
    ).

ml_gen_box_or_unbox_rval_native(ModuleInfo, SourceType, DestType,
        VarRval, ArgRval) :-
    % We have special box/unbox rules for 2x2=4 situations:
    %
    % 1a convert from a type variable to something else
    % 1b convert to a type variable from something else
    % 2a convert from int64/uint64/float to something else
    % 2b convert to int64/uint64/float from something else
    %
    % By the definition of "something else", it is not possible for
    % the SourceType/DestType combination to match both 1a and 1b.
    %
    % It is possible for the SourceType/DestType combination to match
    % both 1a and 2b, or 1b and 2a. In these cases, the 1a or 2a rule has
    % precedence. This is the reason for the second test of DestType
    % in the code handling 2a below.
    %
    % It is not possible for the SourceType/DestType combination to match
    % both 2a and 2b, because any such change of type is beyond the scope
    % of a box or unbox operation.
    ( if
        (
            SourceType = type_variable(_, _),
            DestType \= type_variable(_, _),
            % Converting from polymorphic type to concrete type: unbox.
            MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType),
            ArgRvalPrime = ml_unbox(MLDS_DestType, VarRval)
        ;
            SourceType = builtin_type(SourceBuiltinType),
            (
                SourceBuiltinType = builtin_type_int(IntType),
                ( IntType = int_type_int64
                ; IntType = int_type_uint64
                )
            ;
                SourceBuiltinType = builtin_type_float
            ),
            DestType \= builtin_type(SourceBuiltinType),
            % Leave this to the DestType = type_variable(_, _) code below.
            DestType \= type_variable(_, _),
            % Converting from int64/uint64/float: box, then cast the result.
            MLDS_SourceType =
                mercury_type_to_mlds_type(ModuleInfo, SourceType),
            MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType),
            ArgRvalPrime = ml_cast(MLDS_DestType,
                ml_box(MLDS_SourceType, VarRval))
        )
    then
        ArgRvalPrime = ArgRval
    else if
        (
            DestType = type_variable(_, _),
            SourceType \= type_variable(_, _),
            % Converting from concrete type to polymorphic type: box.
            MLDS_SourceType =
                mercury_type_to_mlds_type(ModuleInfo, SourceType),
            ArgRvalPrime = ml_box(MLDS_SourceType, VarRval)
        ;
            DestType = builtin_type(DestBuiltinType),
            (
                DestBuiltinType = builtin_type_int(IntType),
                ( IntType = int_type_int64
                ; IntType = int_type_uint64
                )
            ;
                DestBuiltinType = builtin_type_float
            ),
            SourceType \= builtin_type(DestBuiltinType),
            % We have already tested for SourceType = type_variable(_, _).
            % Converting to int64/uint64/float: cast to mlds_generic_type,
            % and then unbox.
            MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType),
            ArgRvalPrime = ml_unbox(MLDS_DestType,
                ml_cast(mlds_generic_type, VarRval))
        )
    then
        ArgRvalPrime = ArgRval
    else
        ml_gen_box_or_unbox_rval_native_std(ModuleInfo, SourceType, DestType,
            VarRval, ArgRval)
    ).

:- pred ml_gen_box_or_unbox_rval_native_std(module_info::in,
    mer_type::in, mer_type::in, mlds_rval::in, mlds_rval::out) is det.
:- pragma inline(pred(ml_gen_box_or_unbox_rval_native_std/5)).

ml_gen_box_or_unbox_rval_native_std(ModuleInfo, SourceType, DestType,
        VarRval, ArgRval) :-
    ( if
        type_unify(SourceType, DestType, [], map.init, _),
        not unifiable_types_still_need_cast(SourceType, DestType)
    then
        % If converting from one concrete type to the same type,
        % leave the rval unchanged.
        ArgRval = VarRval
    else
        % If converting from one concrete type to a different one, then cast.
        % This is needed to handle construction/deconstruction unifications
        % for no_tag types.
        MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType),
        ArgRval = ml_cast(MLDS_DestType, VarRval)
    ).

:- pred unifiable_types_still_need_cast(mer_type::in, mer_type::in) is semidet.
:- pragma inline(pred(unifiable_types_still_need_cast/2)).

unifiable_types_still_need_cast(SourceType, DestType) :-
    % XXX This exception from the "unifiable types do not need a cast"
    % path above was part of the implementation of arrays for .NET
    % added by trd in commit d4965acd721e480a31d618dadc95818cb4516df7.
    % A bootcheck in hlc.gc works just fine without this exception,
    % but the exception is still needed in java and csharp grades.
    %
    % Tyson's original comment, which was probably talking only about
    % the .NET backend, was:
    % If converting from an array(T) to array(X) where X is a concrete
    % instance, we should insert a cast to the concrete instance.
    % Also when converting to array(T) from array(X) we should cast
    % to array(T).
    type_to_ctor_and_args(SourceType, SourceTypeCtor, SourceTypeArgs),
    type_to_ctor_and_args(DestType, DestTypeCtor, DestTypeArgs),
    (
        type_ctor_is_array(SourceTypeCtor),
        SourceTypeArgs = [type_variable(_, _)]
    ;
        type_ctor_is_array(DestTypeCtor),
        DestTypeArgs = [type_variable(_, _)]
    ),
    % Don't insert redundant casts if the types are the same, since
    % the extra assignments introduced can inhibit tail call
    % optimisation.
    SourceType \= DestType.

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

ml_gen_box_or_unbox_lval(CallerType, CalleeType, BoxPolicy, VarLval, VarName,
        Context, ForClosureWrapper, ArgNum, ArgLval, ConvDecls,
        ConvInputStmts, ConvOutputStmts, !Info) :-
    % First see if we can just convert the lval as an rval;
    % if no boxing/unboxing is required, then ml_box_or_unbox_rval
    % will return its argument unchanged, and so we are done.
    ml_gen_info_get_module_info(!.Info, ModuleInfo),
    ml_gen_box_or_unbox_rval(ModuleInfo, CalleeType, CallerType, BoxPolicy,
        ml_lval(VarLval), BoxedRval),
    ( if BoxedRval = ml_lval(VarLval) then
        ArgLval = VarLval,
        ConvDecls = [],
        ConvInputStmts = [],
        ConvOutputStmts = []
    else
        % If that didn't work, then we need to declare a fresh variable
        % to use as the arg, and to generate statements to box/unbox
        % that fresh arg variable and assign it to/from the output
        % argument whose address we were passed.

        % Generate a declaration for the fresh variable.
        %
        % Note that generating accurate GC tracing code for this variable
        % requires some care, because CalleeType might be a type variable
        % from the callee, not from the caller, and we can't generate
        % type_infos for type variables from the callee. Hence we need to call
        % the version of ml_gen_gc_statement which takes two types.
        % The CalleeType is used to determine the type for the temporary
        % variable declaration, but the CallerType is used to construct
        % the type_info.

        ml_gen_info_new_conv_var(ConvVarSeq, !Info),
        ConvVarSeq = conv_seq(ConvVarNum),
        ( if VarName = lvn_prog_var(ProgVarName, ProgVarNum) then
            ArgVarName =
                lvn_prog_var_conv(ConvVarNum, ProgVarName, ProgVarNum)
        else
            VarNameStr = ml_local_var_name_to_string(VarName),
            ArgVarName =
                lvn_comp_var(lvnc_non_prog_var_conv(ConvVarNum, VarNameStr))
        ),
        ml_gen_mlds_type(!.Info, CalleeType, MLDS_CalleeType),
        (
            ForClosureWrapper = yes,
            % For closure wrappers, the argument type_infos are stored in
            % the `type_params' local, so we need to handle the GC tracing
            % code specially.
            ( if CallerType = type_variable(_, _) then
                ml_gen_local_for_output_arg(ArgVarName, CalleeType, ArgNum,
                    Context, ArgVarDecl, !Info)
            else
                unexpected($pred,
                    "invalid CalleeType for closure wrapper")
            )
        ;
            ForClosureWrapper = no,
            ml_gen_gc_statement_poly(ArgVarName, CalleeType, CallerType,
                Context, GC_Stmts, !Info),
            ArgVarDecl = ml_gen_mlds_var_decl(ArgVarName, MLDS_CalleeType,
                GC_Stmts, Context)
        ),
        ConvDecls = [ArgVarDecl],

        % Create the lval for the variable and use it for the argument lval.
        ArgLval = ml_local_var(ArgVarName, MLDS_CalleeType),

        CallerIsDummy = is_type_a_dummy(ModuleInfo, CallerType),
        (
            CallerIsDummy = is_dummy_type,
            % If it is a dummy argument type (e.g. io.state),
            % then we don't need to bother assigning it.
            ConvInputStmts = [],
            ConvOutputStmts = []
        ;
            CallerIsDummy = is_not_dummy_type,
            % Generate statements to box/unbox the fresh variable and assign it
            % to/from the output argument whose address we were passed.

            % Assign to the freshly generated arg variable.
            ml_gen_box_or_unbox_rval(ModuleInfo, CallerType, CalleeType,
                BoxPolicy, ml_lval(VarLval), ConvertedVarRval),
            AssignInputStmt = ml_gen_assign(ArgLval, ConvertedVarRval,
                Context),
            ConvInputStmts = [AssignInputStmt],

            % Assign from the freshly generated arg variable.
            ml_gen_box_or_unbox_rval(ModuleInfo, CalleeType, CallerType,
                BoxPolicy, ml_lval(ArgLval), ConvertedArgRval),
            AssignOutputStmt = ml_gen_assign(VarLval, ConvertedArgRval,
                Context),
            ConvOutputStmts = [AssignOutputStmt]
        )
    ).

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

ml_gen_local_for_output_arg(VarName, Type, ArgNum, Context, LocalVarDefn,
        !Info) :-
    % Generate a declaration for a corresponding local variable.
    % However, don't use the normal GC tracing code; instead, we need to get
    % the typeinfo from `type_params', using the following code:
    %
    %   MR_TypeInfo     type_info;
    %   MR_MemoryList   allocated_memory_cells = NULL;
    %   type_info = MR_make_type_info_maybe_existq(type_params,
    %       closure_layout->MR_closure_arg_pseudo_type_info[<ArgNum> - 1],
    %           NULL, NULL, &allocated_memory_cells);
    %
    %   private_builtin__gc_trace_1_0(type_info, &<VarName>);
    %
    %   MR_deallocate(allocated_memory_cells);
    %

    ClosureLayoutPtrName = lvn_comp_var(lvnc_closure_layout_ptr),
    % This type is really `const MR_Closure_Layout *', but there is no easy
    % way to represent that in the MLDS; using MR_Box instead works fine.
    ClosureLayoutPtrType = mlds_generic_type,
    ClosureLayoutPtrLval =
        ml_local_var(ClosureLayoutPtrName, ClosureLayoutPtrType),

    TypeParamsName = lvn_comp_var(lvnc_type_params),
    % This type is really MR_TypeInfoParams, but there is no easy way to
    % represent that in the MLDS; using MR_Box instead works fine.
    TypeParamsType = mlds_generic_type,
    TypeParamsLval = ml_local_var(TypeParamsName, TypeParamsType),

    TypeInfoName = lvn_comp_var(lvnc_type_info),
    % The type for this should match the type of the first argument
    % of private_builtin.gc_trace/1, i.e. `mutvar(T)', which is a no_tag type
    % whose representation is c_pointer.
    ml_gen_info_get_module_info(!.Info, ModuleInfo),
    TypeInfoMercuryType = c_pointer_type,
    TypeInfoType = mercury_type_to_mlds_type(ModuleInfo, TypeInfoMercuryType),
    TypeInfoLval = ml_local_var(TypeInfoName, TypeInfoType),
    TypeInfoDecl = ml_gen_mlds_var_decl(TypeInfoName, TypeInfoType,
        gc_no_stmt, Context),

    ml_gen_gc_statement_with_typeinfo(VarName, Type, ml_lval(TypeInfoLval),
        Context, GCStmt0, !Info),

    (
        ( GCStmt0 = gc_trace_code(CallTraceFuncCode)
        ; GCStmt0 = gc_initialiser(CallTraceFuncCode)
        ),
        MakeTypeInfoCodeC = inline_target_code(ml_target_c, [
            raw_target_code("{\n"),
            raw_target_code("MR_MemoryList allocated_mem = NULL;\n"),
            target_code_output(TypeInfoLval),
            raw_target_code(" = (MR_C_Pointer) " ++
                "MR_make_type_info_maybe_existq(\n\t"),
            target_code_input(ml_lval(TypeParamsLval)),
            raw_target_code(", ((MR_Closure_Layout *)\n\t"),
            target_code_input(ml_lval(ClosureLayoutPtrLval)),
            raw_target_code(string.format(")->" ++
                "MR_closure_arg_pseudo_type_info[%d - 1],\n\t" ++
                "NULL, NULL, &allocated_mem);\n",
                [i(ArgNum)]))
        ]),
        MakeTypeInfoCode = ml_stmt_atomic(MakeTypeInfoCodeC, Context),
        DeallocateCodeC = inline_target_code(ml_target_c, [
            raw_target_code("MR_deallocate(allocated_mem);\n"),
            raw_target_code("}\n")
        ]),
        DeallocateCode = ml_stmt_atomic(DeallocateCodeC, Context),
        % XXX MLDS_DEFN
        GCTraceCode = ml_stmt_block([TypeInfoDecl], [],
            [MakeTypeInfoCode, CallTraceFuncCode, DeallocateCode], Context),
        GCStmt = gc_trace_code(GCTraceCode)
    ;
        GCStmt0 = gc_no_stmt,
        GCStmt = GCStmt0
    ),
    LocalVarDefn = ml_gen_mlds_var_decl(VarName,
        mercury_type_to_mlds_type(ModuleInfo, Type), GCStmt, Context).

%---------------------------------------------------------------------------%
%
% Code for handling success and failure.
%

ml_gen_success(CodeModel, Context, Stmts, !Info) :-
    (
        CodeModel = model_det,
        %
        % det succeed:
        %   <do true>
        % ===>
        %   /* just fall through */
        %
        Stmts = []
    ;
        CodeModel = model_semi,
        %
        % semidet succeed:
        %   <do true>
        % ===>
        %   succeeded = MR_TRUE;
        %
        ml_gen_set_success(ml_const(mlconst_true), Context, SetSuccessTrue,
            !Info),
        Stmts = [SetSuccessTrue]
    ;
        CodeModel = model_non,
        %
        % nondet succeed:
        %   <true && SUCCEED()>
        % ===>
        %   SUCCEED()
        %
        ml_gen_call_current_success_cont(!.Info, Context, CallCont),
        Stmts = [CallCont]
    ).

ml_gen_failure(CodeModel, Context, Stmts, !Info) :-
    (
        CodeModel = model_det,
        unexpected($pred, "`fail' has determinism `det'")
    ;
        CodeModel = model_semi,
        %
        % semidet fail:
        %   <do fail>
        % ===>
        %   succeeded = MR_FALSE;
        %
        ml_gen_set_success(ml_const(mlconst_false), Context, SetSuccessFalse,
            !Info),
        Stmts = [SetSuccessFalse]
    ;
        CodeModel = model_non,
        %
        % nondet fail:
        %   <fail && SUCCEED()>
        % ===>
        %   /* just fall through */
        %
        Stmts = []
    ).

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

ml_gen_succeeded_var_decl(Context) =
    ml_gen_mlds_var_decl(lvn_comp_var(lvnc_succeeded), mlds_native_bool_type,
        gc_no_stmt, Context).

ml_success_lval(SucceededLval, !Info) :-
    SucceededLval =
        ml_local_var(lvn_comp_var(lvnc_succeeded), mlds_native_bool_type),
    ml_gen_info_set_used_succeeded_var(yes, !Info).

ml_gen_test_success(SucceededRval, !Info) :-
    ml_success_lval(SucceededLval, !Info),
    SucceededRval = ml_lval(SucceededLval).

ml_gen_set_success(Value, Context, Stmt, !Info) :-
    ml_success_lval(Succeeded, !Info),
    Stmt = ml_gen_assign(Succeeded, Value, Context).

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

    % Generate the name for the specified `cond_<N>' variable.
    %
:- func ml_gen_cond_var_name(cond_seq) = mlds_local_var_name.

ml_gen_cond_var_name(CondSeq) = VarName :-
    CondSeq = cond_seq(CondNum),
    VarName = lvn_comp_var(lvnc_cond(CondNum)).

ml_gen_cond_var_decl(CondSeq, Context) =
    ml_gen_mlds_var_decl(ml_gen_cond_var_name(CondSeq), mlds_native_bool_type,
        gc_no_stmt, Context).

ml_cond_var_lval(CondSeq, CondVarLval) :-
    CondVarLval =
        ml_local_var(ml_gen_cond_var_name(CondSeq), mlds_native_bool_type).

ml_gen_test_cond_var(CondVar, CondVarRval) :-
    ml_cond_var_lval(CondVar, CondVarLval),
    CondVarRval = ml_lval(CondVarLval).

ml_gen_set_cond_var(CondVar, Value, Context, Stmt) :-
    ml_cond_var_lval(CondVar, CondVarLval),
    Stmt = ml_gen_assign(CondVarLval, Value, Context).

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

ml_initial_cont(Info, OutputVarLvalsTypes, Cont) :-
    % We expect OutputVarLvalsTypes to be empty if `--nondet-copy-out'
    % is not enabled.
    ml_gen_info_get_module_info(Info, ModuleInfo),
    ml_skip_dummy_argument_types(ModuleInfo,
        OutputVarLvalsTypes, OutputVarLvalsMLDSTypes),

    assoc_list.values(OutputVarLvalsMLDSTypes, OutputVarMLDSTypes),
    ContLval = ml_local_var(lvn_comp_var(lvnc_cont),
        mlds_cont_type(OutputVarMLDSTypes)),
    ContEnvLval = ml_local_var(lvn_comp_var(lvnc_cont_env_ptr),
        mlds_generic_env_ptr_type),
    Cont = success_cont(ml_lval(ContLval), ml_lval(ContEnvLval),
        OutputVarLvalsMLDSTypes).

:- pred ml_skip_dummy_argument_types(module_info::in,
    assoc_list(mlds_lval, mer_type)::in,
    assoc_list(mlds_lval, mlds_type)::out) is det.

ml_skip_dummy_argument_types(_, [], []).
ml_skip_dummy_argument_types(ModuleInfo, [Lval - Type | LvalsTypes],
        LvalsMLDSTypes) :-
    ml_skip_dummy_argument_types(ModuleInfo, LvalsTypes, TailLvalsMLDSTypes),
    IsDummy = is_type_a_dummy(ModuleInfo, Type),
    (
        IsDummy = is_dummy_type,
        LvalsMLDSTypes = TailLvalsMLDSTypes
    ;
        IsDummy = is_not_dummy_type,
        MLDSType = mercury_type_to_mlds_type(ModuleInfo, Type),
        LvalsMLDSTypes = [Lval - MLDSType |  TailLvalsMLDSTypes]
    ).

ml_gen_call_current_success_cont(Info, Context, Stmt) :-
    ml_gen_info_current_success_cont(Info, SuccCont),
    SuccCont = success_cont(FuncRval, EnvPtrRval, ArgTypesLvals0),

    assoc_list.keys_and_values(ArgTypesLvals0, ArgLvals0, ArgTypes0),
    ArgRvals0 = list.map(func(Lval) = ml_lval(Lval), ArgLvals0),
    ArgRvals = ArgRvals0 ++ [EnvPtrRval],
    RetLvals = [],

    ArgTypes = ArgTypes0 ++ [mlds_generic_env_ptr_type],
    RetTypes = [],
    Signature = mlds_func_signature(ArgTypes, RetTypes),

    CallKind = ordinary_call,
    Stmt = ml_stmt_call(Signature, FuncRval, ArgRvals, RetLvals,
        CallKind, Context).

%---------------------------------------------------------------------------%
%
% Routines for dealing with the environment pointer used for nested functions.
%

ml_get_env_ptr(ml_lval(EnvPtrLval)) :-
    EnvPtrLval = ml_local_var(lvn_comp_var(lvnc_env_ptr), mlds_unknown_type).

ml_declare_env_ptr_arg(Arg) :-
    VarName = lvn_comp_var(lvnc_env_ptr_arg),
    Type = mlds_generic_env_ptr_type,
    % When targeting C, we always allocate continuation environments
    % on the stack, where our accurage GC does not need to trace it.
    % When targeting C# or Java, we use the target's builtin GC,
    % so again, there is no need for any info meant for our own
    % accurate GC system.
    GCStatement = gc_no_stmt,
    Arg = mlds_argument(VarName, Type, GCStatement).

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

    % This function returns the offset to add to the argument
    % number of a closure arg to get its field number.
    %   field 0 is the closure layout
    %   field 1 is the closure address
    %   field 2 is the number of arguments
    %   field 3 is the 1st argument field
    %   field 4 is the 2nd argument field,
    %   etc.
    % Hence the offset to add to the argument number
    % to get the field number is 2.
    %
ml_closure_arg_offset = 2.

    % This function returns the offset to add to the argument
    % number of a typeclass_info arg to get its field number.
    % The Nth extra argument to pass to the method is
    % in field N of the typeclass_info, so the offset is zero.
    %
ml_typeclass_info_arg_offset = 0.

    % This function returns the offset to add to the method number
    % for a type class method to get its field number within the
    % base_typeclass_info.
    %   field 0 is num_extra
    %   field 1 is num_constraints
    %   field 2 is num_superclasses
    %   field 3 is class_arity
    %   field 4 is num_methods
    %   field 5 is the 1st method
    %   field 6 is the 2nd method
    %   etc.
    %   (See the base_typeclass_info type in rtti.m or the
    %   description in notes/type_class_transformation.html for
    %   more information about the layout of base_typeclass_infos.)
    % Hence the offset is 4.
    %
ml_base_typeclass_info_method_offset = 4.

%---------------------------------------------------------------------------%
%
% Routines for dealing with lookup tables.
%

ml_generate_constants_for_arms(_Vars, [], [], !Info).
ml_generate_constants_for_arms(Vars, [Goal | Goals], [Soln | Solns], !Info) :-
    ml_generate_constants_for_arm(Vars, Goal, Soln, !Info),
    ml_generate_constants_for_arms(Vars, Goals, Solns, !Info).

ml_generate_constants_for_arm(Vars, Goal, Soln, !Info) :-
    ml_gen_info_get_const_var_map(!.Info, InitConstVarMap),
    ml_gen_goal(model_det, Goal, _LocalVarDefns, _FuncDefns, _Stmts, !Info),
    ml_gen_info_get_const_var_map(!.Info, FinalConstVarMap),
    list.map(search_ground_rval(FinalConstVarMap), Vars, Soln),
    ml_gen_info_set_const_var_map(InitConstVarMap, !Info).

:- pred search_ground_rval(ml_ground_term_map::in, prog_var::in,
    mlds_rval::out) is semidet.

search_ground_rval(FinalConstVarMap, Var, Rval) :-
    map.search(FinalConstVarMap, Var, GroundTerm),
    GroundTerm = ml_ground_term(Rval, _, _).

ml_generate_field_assign(OutVarLval, FieldType, FieldId, VectorCommon,
        StructType, IndexRval, Context, Stmt) :-
    BaseRval = ml_vector_common_row_addr(VectorCommon, IndexRval),
    FieldLval = ml_field(yes(ptag(0u8)), BaseRval, StructType,
        FieldId, FieldType),
    AtomicStmt = assign(OutVarLval, ml_lval(FieldLval)),
    Stmt = ml_stmt_atomic(AtomicStmt, Context).

ml_generate_field_assigns(OutVars, FieldTypes, FieldIds, VectorCommon,
        StructType, IndexRval, Context, Stmts, !Info) :-
    ( if
        OutVars = [],
        FieldTypes = [],
        FieldIds = []
    then
        Stmts = []
    else if
        OutVars = [HeadOutVar | TailOutVars],
        FieldTypes = [HeadFieldType | TailFieldTypes],
        FieldIds = [HeadFieldId | TailFieldIds]
    then
        ml_gen_var_direct(!.Info, HeadOutVar, HeadOutVarLval),
        ml_generate_field_assign(HeadOutVarLval, HeadFieldType, HeadFieldId,
            VectorCommon, StructType, IndexRval, Context, HeadStmt),
        ml_generate_field_assigns(TailOutVars, TailFieldTypes, TailFieldIds,
            VectorCommon, StructType, IndexRval, Context, TailStmts,
            !Info),
        Stmts = [HeadStmt | TailStmts]
    else
        unexpected($pred, "mismatched lists")
    ).

%---------------------------------------------------------------------------%
%
% Miscellaneous routines.
%

fixup_builtin_module(ModuleName0) = ModuleName :-
    ( if ModuleName0 = unqualified("") then
        ModuleName = mercury_public_builtin_module
    else
        ModuleName = ModuleName0
    ).

%---------------------------------------------------------------------------%
:- end_module ml_backend.ml_code_util.
%---------------------------------------------------------------------------%
