%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2009-2012 The University of Melbourne.
% Copyright (C) 2013-2018, 2020-2024, 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_proc_gen.m.
% Main author: fjh.
%

:- module ml_backend.ml_proc_gen.
:- interface.

:- import_module hlds.
:- import_module hlds.hlds_module.
:- 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.error_spec.

:- import_module io.
:- import_module list.

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

    % Generate MLDS definitions for all the non-imported predicates
    % (and functions) in the HLDS.
    %
:- pred ml_gen_preds(io.text_output_stream::in, mlds_target_lang::in,
    ml_const_struct_map::in, list(mlds_function_defn)::out,
    ml_global_data::in, ml_global_data::out,
    module_info::in, module_info::out,
    list(diag_spec)::in, list(diag_spec)::out) is det.

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

:- implementation.

:- import_module hlds.code_model.
:- import_module hlds.hlds_dependency_graph.
:- import_module hlds.hlds_desc.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_proc_util.
:- import_module hlds.mark_tail_calls.
:- import_module hlds.passes_aux.
:- import_module hlds.quantification.
:- import_module hlds.status.
:- import_module libs.
:- import_module libs.dependency_graph.
:- import_module libs.globals.
:- import_module libs.optimization_options.
:- import_module ml_backend.ml_args_util.
:- import_module ml_backend.ml_code_gen.
:- import_module ml_backend.ml_code_util.
:- import_module ml_backend.ml_unused_assign.
:- import_module ml_backend.ml_util.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.prog_data_pragma.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_type_unify.
:- import_module parse_tree.set_of_var.
:- import_module parse_tree.var_table.

:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module term_context.

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

ml_gen_preds(ProgressStream, Target, ConstStructMap, FuncDefns,
        !GlobalData, !ModuleInfo, !Specs) :-
    module_info_get_pred_id_table(!.ModuleInfo, PredIdTable0),
    map.to_sorted_assoc_list(PredIdTable0, PredIdInfos0),
    % For the reason documented by the comment on requantify_codegen_proc,
    % we must requantify the body of every procedure we intend to generate
    % code for. We don't *have* to put the requantified proc_infos back
    % into !ModuleInfo; we *could* call requantify_proc_general from
    % the initial part of ml_gen_proc. That would work in every way but one:
    % it would make it harder to debug the MLDS code generator. This is
    % because the MLDS code we generate for a procedure *has* to be for
    % the requantified version of the procedure body, but unless we put
    % that version back into !ModuleInfo, neither any pre-code-gen nor
    % any post-code-gen HLDS dumps would contain that version. Putting
    % the requantified proc_infos back into !ModuleInfo here makes them
    % available in the post-code-gen HLDS dump.
    ml_find_and_requantify_procs_for_code_gen(PredIdInfos0, [], RevPredIdInfos,
        [], PredProcIds),
    map.from_rev_sorted_assoc_list(RevPredIdInfos, PredIdTable),
    module_info_set_pred_id_table(PredIdTable, !ModuleInfo),

    set.list_to_set(PredProcIds, CodeGenPredProcIds),
    DepInfo = build_proc_dependency_graph(!.ModuleInfo, CodeGenPredProcIds,
        only_all_calls),
    get_bottom_up_sccs_with_entry_points(!.ModuleInfo, DepInfo,
        BottomUpSCCsWithEntryPoints),

    % Optimize tail calls only if asked.
    module_info_get_globals(!.ModuleInfo, Globals),
    globals.get_opt_tuple(Globals, OptTuple),
    TailCalls = OptTuple ^ ot_opt_mlds_tailcalls,
    (
        TailCalls = opt_mlds_tailcalls,
        OptTailCalls = tail_call_opt_in_code_gen
    ;
        TailCalls = do_not_opt_mlds_tailcalls,
        OptTailCalls = no_tail_call_opt_in_code_gen
    ),
    get_default_warn_parms(Globals, DefaultWarnParams),
    ml_gen_sccs(ProgressStream, !.ModuleInfo, OptTailCalls, DefaultWarnParams,
        Target, ConstStructMap, BottomUpSCCsWithEntryPoints,
        [], FuncDefns, !GlobalData, !Specs).

:- pred ml_find_and_requantify_procs_for_code_gen(
    assoc_list(pred_id, pred_info)::in,
    assoc_list(pred_id, pred_info)::in, assoc_list(pred_id, pred_info)::out,
    list(pred_proc_id)::in, list(pred_proc_id)::out) is det.

ml_find_and_requantify_procs_for_code_gen([],
        !RevPredIdInfos, !CodeGenPredProcIds).
ml_find_and_requantify_procs_for_code_gen([PredIdInfo0 | PredIdInfos0],
        !RevPredIdInfos, !CodeGenPredProcIds) :-
    PredIdInfo0 = PredId - PredInfo0,
    pred_info_get_status(PredInfo0, PredStatus),
    ( if
        (
            PredStatus = pred_status(status_imported(_))
        ;
            % We generate incorrect and unnecessary code for the external
            % special preds which are pseudo_imported, so just ignore them.
            is_unify_index_or_compare_pred(PredInfo0),
            PredStatus =
                pred_status(status_external(status_pseudo_imported))
        )
    then
        PredIdInfo = PredIdInfo0
    else
        % Generate MLDS definitions for all the non-imported procedures
        % of a given predicate (or function).
        %
        % If a type is imported, the compiler will generate the (in,in) mode
        % of its unify and compare predicates in its home module, but if this
        % module needs one of these predicates in a more specialize mode
        % (e.g. one in which an input argument is known to be bound to one
        % of a small subset of the possible function symbols), it has to create
        % code for it itself. Such procedures are pseudo imported, which means
        % that their procedure 0 (the procedure implementing the (in,in) mode)
        % is imported, but any other procedures are not.

        ( if PredStatus = pred_status(status_external(_)) then
            ProcIds = pred_info_all_proc_ids(PredInfo0)
        else
            ProcIds = pred_info_will_codegen_proc_ids(PredInfo0)
        ),
        pred_info_get_proc_table(PredInfo0, ProcTable0),
        list.foldl(requantify_codegen_proc, ProcIds, ProcTable0, ProcTable),
        pred_info_set_proc_table(ProcTable, PredInfo0, PredInfo),
        PredIdInfo = PredId - PredInfo,

        PredProcIds = list.map((func(ProcId) = proc(PredId, ProcId)), ProcIds),
        !:CodeGenPredProcIds = PredProcIds ++ !.CodeGenPredProcIds
    ),
    !:RevPredIdInfos = [PredIdInfo | !.RevPredIdInfos],
    ml_find_and_requantify_procs_for_code_gen(PredIdInfos0,
        !RevPredIdInfos, !CodeGenPredProcIds).

    % The specification of the HLDS allows goal_infos to overestimate
    % the set of non-locals. Such overestimates are bad for us for two reasons:
    %
    % - If the non-locals of the top-level goal contained any variables other
    %   than head vars, those variables would not be declared.
    %
    % - The code of goal_expr_find_subgoal_nonlocals depends on the nonlocals
    %   sets of goals being exactly correct, since this is the only way it can
    %   avoid traversing the entirety of the goals themselves. Such traversals
    %   can be very expensive on large goals, since it would have to be done
    %   repeatedly, once for each containing goal. Quantification does just one
    %   traversal.
    %
:- pred requantify_codegen_proc(proc_id::in, proc_table::in, proc_table::out)
    is det.

requantify_codegen_proc(ProcId, !ProcTable) :-
    map.lookup(!.ProcTable, ProcId, ProcInfo0),
    requantify_proc_general(ord_nl_no_lambda, ProcInfo0, ProcInfo),
    map.det_update(ProcId, ProcInfo, !ProcTable).

:- type maybe_tail_call_opt_in_code_gen
    --->    no_tail_call_opt_in_code_gen
    ;       tail_call_opt_in_code_gen.

:- pred ml_gen_sccs(io.text_output_stream::in, module_info::in,
    maybe_tail_call_opt_in_code_gen::in, warn_non_tail_rec_params::in,
    mlds_target_lang::in, ml_const_struct_map::in,
    list(scc_with_entry_points)::in,
    list(mlds_function_defn)::in, list(mlds_function_defn)::out,
    ml_global_data::in, ml_global_data::out,
    list(diag_spec)::in, list(diag_spec)::out) is det.

ml_gen_sccs(_, _, _, _, _, _, [], !FuncDefns, !GlobalData, !Specs).
ml_gen_sccs(ProgressStream, ModuleInfo, OptTailCalls, DefaultWarnParams,
        Target, ConstStructMap, [SCCE | SCCEs],
        !FuncDefns, !GlobalData, !Specs) :-
    ml_gen_scc(ProgressStream, ModuleInfo, OptTailCalls, DefaultWarnParams,
        Target, ConstStructMap, SCCE, !FuncDefns, !GlobalData, !Specs),
    ml_gen_sccs(ProgressStream, ModuleInfo, OptTailCalls, DefaultWarnParams,
        Target, ConstStructMap, SCCEs, !FuncDefns, !GlobalData, !Specs).

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

:- pred ml_gen_scc(io.text_output_stream::in, module_info::in,
    maybe_tail_call_opt_in_code_gen::in, warn_non_tail_rec_params::in,
    mlds_target_lang::in, ml_const_struct_map::in, scc_with_entry_points::in,
    list(mlds_function_defn)::in, list(mlds_function_defn)::out,
    ml_global_data::in, ml_global_data::out,
    list(diag_spec)::in, list(diag_spec)::out) is det.

ml_gen_scc(ProgressStream, ModuleInfo, OptTailCalls, DefaultWarnParams, Target,
        ConstStructMap, SCCE, !FuncDefns, !GlobalData, !Specs) :-
    ml_gen_scc_code(ProgressStream, ModuleInfo, OptTailCalls, Target,
        ConstStructMap, SCCE, InSccMap, !FuncDefns, !GlobalData),
    map.foldl_values(gather_nontail_rec_calls, InSccMap, [], NonTailRecCalls),
    ( if
        % If we were trying to implement recursive calls as tail calls, ...
        OptTailCalls = tail_call_opt_in_code_gen,
        % ... but some recursive calls turned out NOT to be implementable
        % as tail calls, ...
        NonTailRecCalls = [_ | _]
    then
        % ... then generate messages for them, if the appropriate settings
        % call for such messages.
        %
        % Having a list of all the non-tail recursive calls in the SCC
        % in one place should allow a future diff to report, in cases
        % where the caller and callee are in different TSCCs, exactly
        % which recursive calls being non-tail calls prevent them from
        % being in the same TSCC.
        list.foldl(report_nontail_rec_call(ModuleInfo, DefaultWarnParams),
            NonTailRecCalls, !Specs)
    else
        true
    ).

:- pred gather_nontail_rec_calls(in_scc_info::in,
    list(nontail_rec_call)::in, list(nontail_rec_call)::out) is det.

gather_nontail_rec_calls(InSccInfo, !NonTailRecCalls) :-
    !:NonTailRecCalls =
        InSccInfo ^ isi_is_target_of_non_tail_rec ++ !.NonTailRecCalls.

:- pred report_nontail_rec_call(module_info::in,
    warn_non_tail_rec_params::in, nontail_rec_call::in,
    list(diag_spec)::in, list(diag_spec)::out) is det.

report_nontail_rec_call(ModuleInfo, DefaultWarnParams, NonTailRecCall,
        !Specs) :-
    NonTailRecCall = nontail_rec_call(Caller, Callee, Features, Context,
        Reason, Obviousness, Status),
    (
        Status = nontail_rec_call_warn_disabled
    ;
        Status = nontail_rec_call_warn_enabled,
        module_info_pred_proc_info(ModuleInfo, Caller, _PredInfo, ProcInfo),
        maybe_override_warn_params_for_proc(ProcInfo,
            DefaultWarnParams, ProcWarnParams),
        maybe_report_nontail_recursive_call(ModuleInfo, ProcWarnParams,
            Caller, Callee, Features, Context, Reason, Obviousness, !Specs)
    ).

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

:- pred ml_gen_scc_code(io.text_output_stream::in, module_info::in,
    maybe_tail_call_opt_in_code_gen::in, mlds_target_lang::in,
    ml_const_struct_map::in, scc_with_entry_points::in, in_scc_map::out,
    list(mlds_function_defn)::in, list(mlds_function_defn)::out,
    ml_global_data::in, ml_global_data::out) is det.

ml_gen_scc_code(ProgressStream, ModuleInfo, OptTailCalls, Target,
        ConstStructMap, SCCE, !:InSccMap, !FuncDefns, !GlobalData) :-
    SCCE = scc_with_entry_points(PredProcIds, CalledFromHigherSCCs,
        ExportedProcs),
    set.union(CalledFromHigherSCCs, ExportedProcs, SCCEntryProcs),

    set.fold(add_to_in_scc_map, PredProcIds, map.init, !:InSccMap),
    (
        OptTailCalls = no_tail_call_opt_in_code_gen,
        set.foldl3(
            ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target,
                ConstStructMap, no_tail_rec),
            PredProcIds, !FuncDefns, !GlobalData, !InSccMap)
    ;
        OptTailCalls = tail_call_opt_in_code_gen,
        partition_scc_procs(ModuleInfo, set.to_sorted_list(PredProcIds),
            NonePredProcIdInfos, SelfPredProcIdInfos0,
            MutualDetPredProcIdInfos0, MutualSemiPredProcIdInfos0),

        % The predicates called by ml_gen_tscc always generate gc_no_stmt
        % as the gc annotation on MLDS function parameters. Until this
        % limitation is fixed, don't give any work to ml_gen_tscc in
        % circumstances where it would bite.
        module_info_get_globals(ModuleInfo, Globals),
        globals.get_gc_method(Globals, GC),
        ( if GC = gc_accurate then
            SelfPredProcIdInfos = SelfPredProcIdInfos0 ++
                MutualDetPredProcIdInfos0 ++ MutualSemiPredProcIdInfos0,
            MutualDetPredProcIdInfos = [],
            MutualSemiPredProcIdInfos = []
        else
            SelfPredProcIdInfos = SelfPredProcIdInfos0,
            MutualDetPredProcIdInfos = MutualDetPredProcIdInfos0,
            MutualSemiPredProcIdInfos = MutualSemiPredProcIdInfos0
        ),

        % Translate the procedures we cannot apply tail call optimization to.
        list.foldl3(
            ml_gen_proc(ProgressStream, ModuleInfo, Target, ConstStructMap,
                no_tail_rec),
            NonePredProcIdInfos, !FuncDefns, !GlobalData, !InSccMap),

        % Translate the procedures to which we can apply only self-tail-call
        % optimization.
        list.foldl3(
            ml_gen_proc(ProgressStream, ModuleInfo, Target, ConstStructMap,
                self_tail_rec),
            SelfPredProcIdInfos, !FuncDefns, !GlobalData, !InSccMap),

        % Translate the procedures to which we can apply mutual-tail-call
        % optimization as well.
        DetTSCCDepInfo = build_proc_dependency_graph(ModuleInfo,
            set.list_to_set(
                list.map(project_pred_proc_id_info_id,
                    MutualDetPredProcIdInfos)),
            only_tail_calls),
        SemiTSCCDepInfo = build_proc_dependency_graph(ModuleInfo,
            set.list_to_set(
                list.map(project_pred_proc_id_info_id,
                    MutualSemiPredProcIdInfos)),
            only_tail_calls),
        get_bottom_up_sccs_with_entry_points(ModuleInfo, DetTSCCDepInfo,
            DetTSCCEntries),
        get_bottom_up_sccs_with_entry_points(ModuleInfo, SemiTSCCDepInfo,
            SemiTSCCEntries),
        partition_tsccs(DetTSCCEntries,
            DetLonePredProcIds, DetNonTrivialTSCCEntries),
        partition_tsccs(SemiTSCCEntries,
            SemiLonePredProcIds, SemiNonTrivialTSCCEntries),
        list.foldl3(
            ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target,
                ConstStructMap, self_tail_rec),
            DetLonePredProcIds, !FuncDefns, !GlobalData, !InSccMap),
        list.foldl3(
            ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target,
                ConstStructMap, self_tail_rec),
            SemiLonePredProcIds, !FuncDefns, !GlobalData, !InSccMap),
        list.foldl3(
            ml_gen_tscc(ProgressStream, ModuleInfo, Target, ConstStructMap,
                SCCEntryProcs, tscc_det),
            DetNonTrivialTSCCEntries, !FuncDefns, !GlobalData, !InSccMap),
        list.foldl3(
            ml_gen_tscc(ProgressStream, ModuleInfo, Target, ConstStructMap,
                SCCEntryProcs, tscc_semi),
            SemiNonTrivialTSCCEntries, !FuncDefns, !GlobalData, !InSccMap)
    ).

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

:- pred add_to_in_scc_map(pred_proc_id::in, in_scc_map::in, in_scc_map::out)
    is det.

add_to_in_scc_map(PredProcId, !InSccMap) :-
    InSccInfo = in_scc_info(not_in_tscc,
        is_not_target_of_self_trcall, is_not_target_of_mutual_trcall, []),
    map.det_insert(PredProcId, InSccInfo, !InSccMap).

:- pred reset_in_scc_map(in_scc_map::in, in_scc_map::out) is det.

reset_in_scc_map(!InSccMap) :-
    map.map_values_only(reset_scc_info, !InSccMap).

:- pred reset_scc_info(in_scc_info::in, in_scc_info::out) is det.

reset_scc_info(!InSccInfo) :-
    !InSccInfo ^ isi_maybe_in_tscc := not_in_tscc.

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

:- type pred_proc_id_info
    --->    pred_proc_id_info(
                pred_proc_id,
                pred_info,
                proc_info,
                prog_context
            ).

:- func project_pred_proc_id_info_id(pred_proc_id_info) = pred_proc_id.

project_pred_proc_id_info_id(PredProcIdInfo) = PredProcId :-
    PredProcIdInfo = pred_proc_id_info(PredProcId, _, _, _).

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

    % Partition the procedures in an SCC into the following four categories.
    %
    % - Those that don't contain any tail calls (NoneIdInfos).
    % - Those that in which we can only optimize self recursive tail calls,
    %   either because they don't contain any mutually tail recursive calls,
    %   or because we can't (yet) optimize the mutually tail recursive calls
    %   they do contain (SelfIdInfos).
    % - Those model_det procedures in which we can optimize mutually tail
    %   recursive calls (MutualDetIdInfos).
    % - Those model_semi procedures in which we can optimize mutually tail
    %   recursive calls (MutualSemiIdInfos).
    %
:- pred partition_scc_procs(module_info::in, list(pred_proc_id)::in,
    list(pred_proc_id_info)::out, list(pred_proc_id_info)::out,
    list(pred_proc_id_info)::out, list(pred_proc_id_info)::out) is det.

partition_scc_procs(_ModuleInfo, [], [], [], [], []).
partition_scc_procs(ModuleInfo, [PredProcId | PredProcIds],
        !:NoneIdInfos, !:SelfIdInfos,
        !:MutualDetIdInfos, !:MutualSemiIdInfos) :-
    partition_scc_procs(ModuleInfo, PredProcIds,
        !:NoneIdInfos, !:SelfIdInfos, !:MutualDetIdInfos, !:MutualSemiIdInfos),
    module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
    proc_info_get_goal(ProcInfo, Goal),
    Goal = hlds_goal(_GoalExpr, GoalInfo),
    ProcContext = goal_info_get_context(GoalInfo),
    IdInfo = pred_proc_id_info(PredProcId, PredInfo, ProcInfo, ProcContext),
    proc_info_get_has_tail_rec_call(ProcInfo, HasTailRecCall),
    HasTailRecCall =
        has_tail_rec_call(HasSelfTailRecCall, HasMutualTailRecCall),
    CodeModel = proc_info_interface_code_model(ProcInfo),
    (
        ( CodeModel = model_det
        ; CodeModel = model_semi
        ),
        proc_info_interface_determinism(ProcInfo, Detism),
        determinism_components(Detism, _CanFail, SolnCount),
        ( if
            HasMutualTailRecCall = has_mutual_tail_rec_call,
            % To prevent control just falling through to the next procedure
            % body once it reaches the end of the previous procedure body
            % in the TSCC, we put a goto or break statement at the end of each
            % procedure body. This will generate an error from some target
            % language compilers (e.g. Java) if its knows that this statement
            % is not reachable.
            SolnCount \= at_most_zero
        then
            (
                CodeModel = model_det,
                !:MutualDetIdInfos = [IdInfo | !.MutualDetIdInfos]
            ;
                CodeModel = model_semi,
                !:MutualSemiIdInfos = [IdInfo | !.MutualSemiIdInfos]
            )
        else
            (
                HasSelfTailRecCall = has_self_tail_rec_call,
                !:SelfIdInfos = [IdInfo | !.SelfIdInfos]
            ;
                HasSelfTailRecCall = has_no_self_tail_rec_call,
                !:NoneIdInfos = [IdInfo | !.NoneIdInfos]
            )
        )
    ;
        CodeModel = model_non,
        % Mutual tail recursion optimization does not apply to model_non
        % procedures (at least not yet). It would be nice to teach this module
        % how to exploit such opportunities, but applying mutual tail recursion
        % optimization to only det and semidet procedures does capture
        % *almost all* of the available benefit.
        (
            HasSelfTailRecCall = has_self_tail_rec_call,
            !:SelfIdInfos = [IdInfo | !.SelfIdInfos]
        ;
            HasSelfTailRecCall = has_no_self_tail_rec_call,
            !:NoneIdInfos = [IdInfo | !.NoneIdInfos]
        )
    ).

:- pred partition_tsccs(list(scc_with_entry_points)::in,
    list(pred_proc_id)::out, list(scc_with_entry_points)::out) is det.

partition_tsccs([], [], []).
partition_tsccs([TSCC | TSCCs], !:LonePredProcIds, !:NonTrivialTSCCS) :-
    partition_tsccs(TSCCs, !:LonePredProcIds, !:NonTrivialTSCCS),
    TSCC = scc_with_entry_points(TSCCPredProcIdsSet, _, _),
    set.to_sorted_list(TSCCPredProcIdsSet, TSCCPredProcIds),
    (
        TSCCPredProcIds = [],
        unexpected($pred, "empty TSCC")
    ;
        TSCCPredProcIds = [TSCCPredProcId],
        !:LonePredProcIds = [TSCCPredProcId | !.LonePredProcIds]
    ;
        TSCCPredProcIds = [_, _ | _],
        !:NonTrivialTSCCS = [TSCC | !.NonTrivialTSCCS]
    ).

%---------------------------------------------------------------------------%
%
% Code for handling individual procedures.
%

:- pred ml_gen_proc_lookup(io.text_output_stream::in, module_info::in,
    mlds_target_lang::in, ml_const_struct_map::in,
    none_or_self_tail_rec::in, pred_proc_id::in,
    list(mlds_function_defn)::in, list(mlds_function_defn)::out,
    ml_global_data::in, ml_global_data::out,
    in_scc_map::in, in_scc_map::out) is det.

ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target, ConstStructMap,
        NoneOrSelf, PredProcId, !FuncDefns, !GlobalData, !InSccMap) :-
    module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
    proc_info_get_goal(ProcInfo, Goal),
    Goal = hlds_goal(_GoalExpr, GoalInfo),
    ProcContext = goal_info_get_context(GoalInfo),
    PredProcIdInfo =
        pred_proc_id_info(PredProcId, PredInfo, ProcInfo, ProcContext),
    ml_gen_proc(ProgressStream, ModuleInfo, Target, ConstStructMap,
        NoneOrSelf, PredProcIdInfo, !FuncDefns, !GlobalData, !InSccMap).

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

:- type none_or_self_tail_rec
    --->    no_tail_rec
    ;       self_tail_rec.

:- pred ml_gen_proc(io.text_output_stream::in, module_info::in,
    mlds_target_lang::in, ml_const_struct_map::in,
    none_or_self_tail_rec::in, pred_proc_id_info::in,
    list(mlds_function_defn)::in, list(mlds_function_defn)::out,
    ml_global_data::in, ml_global_data::out,
    in_scc_map::in, in_scc_map::out) is det.

ml_gen_proc(ProgressStream, ModuleInfo, Target, ConstStructMap, NoneOrSelf,
        PredProcIdInfo, !FuncDefns, !GlobalData, !InSccMap) :-
    PredProcIdInfo =
        pred_proc_id_info(PredProcId, PredInfo, ProcInfo, ProcContext),
    trace [io(!IO)] (
        maybe_write_proc_progress_message(ProgressStream, ModuleInfo,
            "Generating MLDS code for", PredProcId, !IO)
    ),

    some [!Info] (
        reset_in_scc_map(!InSccMap),
        compute_initial_tail_rec_map_for_none_or_self(ModuleInfo, NoneOrSelf,
            PredProcId, !InSccMap),
        init_ml_gen_tscc_info(ModuleInfo, !.InSccMap, tscc_self_rec_only,
            TsccInfo0),
        !:Info = ml_gen_info_init(ModuleInfo, Target, ConstStructMap,
            PredProcId, ProcInfo, !.GlobalData, TsccInfo0),

        pred_info_get_status(PredInfo, PredStatus),
        ( if PredStatus = pred_status(status_external(_)) then
            % For Mercury procedures declared `:- pragma external_{pred/func}',
            % we generate an MLDS definition with no function body.
            % The MLDS -> target code pass can treat this accordingly.
            % For example, for C it outputs a function declaration with no
            % corresponding definition, making sure that the function is
            % declared as `extern' rather than `static'.
            ml_gen_info_proc_params(PredProcId, _Tuples, FuncParams,
                _ByRefOutputVars, _CopiedOutputVars, !.Info, _Info),
            FuncBody = body_external,
            set.init(EnvVarNames),
            ClosureWrapperFuncDefns = []
        else
            % Set up the initial success continuation, if any.
            % Also figure out which output variables are returned by value
            % (rather than being passed by reference) and remove them from
            % the byref_output_vars field in the ml_gen_info.
            CodeModel = proc_info_interface_code_model(ProcInfo),
            ml_gen_info_proc_params(PredProcId, ArgTuples, FuncParams,
                ByRefOutputVars, CopiedOutputVars, !.Info, _Info),
            set_of_var.list_to_set(ByRefOutputVars, ByRefOutputVarsSet),
            ml_gen_info_set_byref_output_vars(ByRefOutputVarsSet, !Info),
            (
                ( CodeModel = model_det
                ; CodeModel = model_semi
                )
            ;
                CodeModel = model_non,
                list.map(get_var_mlds_lval_and_type(!.Info),
                    CopiedOutputVars, OutputVarLvalTypes),
                ml_initial_cont(!.Info, OutputVarLvalTypes, InitialCont),
                ml_gen_info_push_success_cont(InitialCont, !Info)
            ),

            proc_info_get_goal(ProcInfo, Goal),
            ml_gen_info_get_tail_rec_info(!.Info, TailRecInfo1),
            TailRecInfo1 = tail_rec_info(InSccMap1, LoopKind1, TsccKind1),
            map.lookup(InSccMap1, PredProcId, InSccInfo1),
            MaybeInScc1 = InSccInfo1 ^ isi_maybe_in_tscc,
            (
                MaybeInScc1 = not_in_tscc,
                map.init(SeenAtLabelMap)
            ;
                MaybeInScc1 = in_tscc(IdInTscc, Args),
                (
                    LoopKind1 = tail_rec_loop_while_continue,
                    (
                        TsccKind1 = tscc_self_rec_only,
                        map.init(SeenAtLabelMap)
                    ;
                        TsccKind1 = tscc_self_and_mutual_rec,
                        unexpected($pred, "tscc_self_and_mutual_rec")
                    )
                ;
                    LoopKind1 = tail_rec_loop_label_goto,
                    StartLabel = generate_tail_rec_start_label(TsccKind1,
                        IdInTscc),
                    LocalVars = list.map(project_mlds_argument_name, Args),
                    SeenAtLabelMap =
                        map.singleton(StartLabel, set.list_to_set(LocalVars))
                )
            ),
            ml_gen_proc_body(CodeModel, ArgTuples, CopiedOutputVars, Goal,
                SeenAtLabelMap, LocalVarDefns0, FuncDefns, GoalStmts0, !Info),
            list.map(get_var_rval(!.Info),
                CopiedOutputVars, CopiedOutputVarRvals),
            ml_append_return_statement(CodeModel, ProcContext,
                CopiedOutputVarRvals, GoalStmts0, GoalStmts),
            ml_gen_local_var_defns_for_copied_output_vars(!.Info, ProcContext,
                ArgTuples, CopiedOutputVars, OutputVarLocalDefns, !Info),
            ml_gen_maybe_local_var_defn_for_succeeded(!.Info, ProcContext,
                SucceededVarDefns),
            LocalVarDefns = SucceededVarDefns ++ OutputVarLocalDefns ++
                LocalVarDefns0,

            ml_gen_info_final(!.Info, EnvVarNames,
                ClosureWrapperFuncDefns, !:GlobalData, TsccInfo),
            TailRecInfo = TsccInfo ^ mgti_tail_rec_info,
            !:InSccMap = TailRecInfo ^ tri_in_scc_map,
            construct_func_body_maybe_wrap_in_loop(PredProcId, CodeModel,
                ProcContext, LocalVarDefns, FuncDefns, GoalStmts,
                TailRecInfo, FuncBody)
        )
    ),

    construct_func_defn(ModuleInfo, PredProcIdInfo, FuncParams, FuncBody,
        EnvVarNames, FuncDefn),
    !:FuncDefns = ClosureWrapperFuncDefns ++ [FuncDefn | !.FuncDefns].

:- pred get_var_mlds_lval_and_type(ml_gen_info::in, prog_var::in,
    pair(mlds_lval, mer_type)::out) is det.

get_var_mlds_lval_and_type(Info, Var, VarLval - VarType) :-
    ml_gen_info_get_var_table(Info, VarTable),
    lookup_var_entry(VarTable, Var, VarEntry),
    ml_gen_var(Info, Var, VarEntry, VarLval),
    VarType = VarEntry ^ vte_type.

:- pred get_var_rval(ml_gen_info::in, prog_var::in, mlds_rval::out) is det.

get_var_rval(Info, Var, VarRval) :-
    ml_gen_var_direct(Info, Var, VarLval),
    VarRval = ml_lval(VarLval).

:- pred compute_initial_tail_rec_map_for_none_or_self(module_info::in,
    none_or_self_tail_rec::in, pred_proc_id::in,
    in_scc_map::in, in_scc_map::out) is det.

compute_initial_tail_rec_map_for_none_or_self(ModuleInfo, NoneOrSelf,
        PredProcId, !InSccMap) :-
    (
        NoneOrSelf = no_tail_rec
        % Nothing to do.
    ;
        NoneOrSelf = self_tail_rec,
        InputParams =
            ml_gen_proc_params_inputs_only_no_gc_stmts(ModuleInfo, PredProcId),
        map.lookup(!.InSccMap, PredProcId, InSccInfo0),
        InSccInfo = InSccInfo0 ^ isi_maybe_in_tscc :=
            in_tscc(proc_id_in_tscc(1), InputParams),
        map.det_update(PredProcId, InSccInfo, !InSccMap)
    ).

:- pred construct_func_body_maybe_wrap_in_loop(pred_proc_id::in,
    code_model::in, prog_context::in, list(mlds_local_var_defn)::in,
    list(mlds_function_defn)::in, list(mlds_stmt)::in, tail_rec_info::in,
    mlds_function_body::out) is det.

construct_func_body_maybe_wrap_in_loop(PredProcId, CodeModel, Context,
        LocalVarDefns, FuncDefns, GoalStmts, TailRecInfo, FuncBody) :-
    TailRecInfo = tail_rec_info(InSccMap, LoopKind, TsccKind),
    expect(unify(TsccKind, tscc_self_rec_only), $pred,
        "TsccKind != tscc_self_rec_only"),
    map.lookup(InSccMap, PredProcId, InSccInfo),
    InSccInfo = in_scc_info(MaybeInTscc,
        IsTargetOfSelfTRCall, _IsTargetOfMutualTRCall, _IsTargetOfNonTailRec),
    ( if
        IsTargetOfSelfTRCall = is_target_of_self_trcall,
        % We cannot have done self-tail-recursion if MaybeInTscc = not_in_tscc,
        % though the compiler doesn't know that.
        MaybeInTscc = in_tscc(IdInTscc, TsccInArgs)
    then
        ( CodeModel = model_det,  CodeModelStr = "model_det"
        ; CodeModel = model_semi, CodeModelStr = "model_semi"
        ; CodeModel = model_non,  CodeModelStr = "model_non"
        ),
        string.format("setup for %s tailcalls optimized into a loop",
            [s(CodeModelStr)], CommentStr),
        Comment = comment(CommentStr),
        CommentStmt = ml_stmt_atomic(Comment, Context),
        (
            LoopKind = tail_rec_loop_while_continue,
            BreakStmt = ml_stmt_goto(goto_break_loop, Context),
            LoopBodyStmt = ml_stmt_block(LocalVarDefns, FuncDefns,
                [CommentStmt] ++ GoalStmts ++ [BreakStmt], Context),
            % Since TsccKind = tscc_self_rec_only, we don't need to include
            % the procedure selector variable in the loop local vars.
            InputArgLocalVars =
                list.map(project_mlds_argument_name, TsccInArgs),
            FuncBodyStmt = ml_stmt_while(may_loop_zero_times,
                ml_const(mlconst_true), LoopBodyStmt,
                InputArgLocalVars, Context)
        ;
            LoopKind = tail_rec_loop_label_goto,
            StartLabel = generate_tail_rec_start_label(TsccKind, IdInTscc),
            LoopTopLabelStmt = ml_stmt_label(StartLabel, Context),
            FuncBodyStmt = ml_stmt_block(LocalVarDefns, FuncDefns,
                [CommentStmt, LoopTopLabelStmt] ++ GoalStmts, Context)
        )
    else
        FuncBodyStmt =
            ml_gen_block(LocalVarDefns, FuncDefns, GoalStmts, Context)
    ),
    FuncBody = body_defined_here(FuncBodyStmt).

:- pred construct_func_defn(module_info::in, pred_proc_id_info::in,
    mlds_func_params::in, mlds_function_body::in, set(string)::in,
    mlds_function_defn::out) is det.

construct_func_defn(ModuleInfo, PredProcIdInfo, FuncParams, FuncBody,
        EnvVarNames, FuncDefn) :-
    PredProcIdInfo = pred_proc_id_info(PredProcId, _PredInfo, ProcInfo,
        _ProcContext),
    PredProcId = proc(PredId, ProcId),
    ml_gen_proc_label(ModuleInfo, PredProcId, _ModuleName, PlainFuncName),
    proc_info_get_context(ProcInfo, ProcContext),
    DeclFlags = ml_gen_proc_decl_flags(ModuleInfo, PredId, ProcId),
    Source = mlds_func_source_proc(PredProcId),
    MaybeRequireTailrecInfoFD = no,
    FuncDefn = mlds_function_defn(mlds_function_name(PlainFuncName),
        ProcContext, DeclFlags, Source, FuncParams, FuncBody,
        EnvVarNames, MaybeRequireTailrecInfoFD).

%---------------------------------------------------------------------------%
%
% Code for handling TSCCs (shorthand for via-tail-call SCCs, i.e. SCCs
% computed by taking only *tail* calls into account).
%
% The scheme followed by ml_gen_tscc and its subcontractors is documented
% in notes/mlds_tail_recursion.html.
%

:- type tscc_code_model
    --->    tscc_det
    ;       tscc_semi.

:- pred ml_gen_tscc(io.text_output_stream::in, module_info::in,
    mlds_target_lang::in, ml_const_struct_map::in, set(pred_proc_id)::in,
    tscc_code_model::in, scc_with_entry_points::in,
    list(mlds_function_defn)::in, list(mlds_function_defn)::out,
    ml_global_data::in, ml_global_data::out,
    in_scc_map::in, in_scc_map::out) is det.

ml_gen_tscc(ProgressStream, ModuleInfo, Target, ConstStructMap,
        _SCCEntryPredProcIds, TsccCodeModel, TSCCE,
        !FuncDefns, !GlobalData, !InSccMap) :-
    TSCCE = scc_with_entry_points(PredProcIds, _CalledFromHigherTSCCs,
        _ExportedTSCCPredProcIds),
    PredProcIdList = set.to_sorted_list(PredProcIds),
    (
        PredProcIdList = [],
        unexpected($pred, "empty TSCC")
    ;
        PredProcIdList = [SinglePredProcId],
        % For a TSCC containing just one procedure, we neither need nor want
        % the extra overhead required for managing *mutual* tail recursion.
        ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target, ConstStructMap,
            self_tail_rec, SinglePredProcId, !FuncDefns, !GlobalData,
            !InSccMap)
    ;
        PredProcIdList = [_, _ | _],
        % Try to compile each procedure in the TSCC into the MLDS code
        % fragment that will go under "top_of_proc_i" for each i.
        %
        % Caveat 1:
        % By definition, every procedure in the TSCC has at least one
        % mutually-tail-recursive call to it from another procedure
        % in the TSCC. However, the TSCC is computed from the HLDS.
        % Some calls that look like tail calls in the HLDS turn out
        % *not* to be tail calls in the MLDS, because they pass as input
        % arguments the addresses of local variables in the caller's stack
        % frame, addresses that would become dangling references if the
        % call were made a tail call. If it turns out that *none* of the
        % mutually-tail-recursive calls in the HLDS to a procedure
        % turn out to be mutually-tail-recursive calls in the MLDS,
        % then including that procedure in the scheme we use above
        % would be a waste; it would just incur overhead for no gain
        % in either stack usage or speed. ml_gen_tscc_trial will return
        % the identities of such procedures in NoMutualPredProcIds.
        % All the procedures in MutualPredProcIds will have mutually-tail-
        % recursive calls to them in the *M*LDS. (Therefore MutualPredProcIds
        % may have 0 elements, or 2, or 3, or any other number except 1.)
        %
        % Caveat 2:
        % If the MLDS code we generated for any of MutualPredProcIds contained
        % any function definitions nested inside of them, then we have
        % a problem. The scheme shown above would create M copies of each
        % such nested function definition, with M > 1. In the usual case of
        % us generating non-nested code, ml_elim_nested.m would hoist out
        % such nested definitions M times, leading to the M copies of the
        % hoisted-out definitions. Therefore, until we teach ml_elim_nested.m
        % not to do that, we abandon the optimization of mutually recursive
        % tail calls in the presence of such nested function definitions.
        %
        % Caveat 3.
        % The code in mark_tail_calls.m looks for tail calls by looking
        % at the argument lists of procedures. These argument lists treat
        % a variable representing the result of functions the same as
        % a variable representing the last argument of a predicate.
        % On the other hand, on the C backend, the MLDS uses two *different*
        % mechanisms to return these arguments; it returns function results
        % via return statements, while it uses pass-by-reference for all
        % other output arguments. Currently, ml_gen_tscc_trial handles this
        % by returning CanGenerateTscc = can_not_generate_code_for_tscc
        % if the procedures in the TSCC it is given don't all have the same
        % vector of return values.
        % XXX When a TSCC contains both predicates and functions, the two
        % must present different signatures to their callers *outside* the
        % TSCC, because those callers expect those different signatures.
        % However, *inside* the TSCC, we could generate code that ignores
        % the distinction, the obvious way of doing that being to use
        % the tail call version of the calling convention intended for
        % predicates for all intra-TSCC tail calls. However, using different
        % conventions for intra- and inter-TSCC parameter passing would
        % complicate the code both here and in ml_args_util.m, and for now
        % at least, I (zs) don't see that the potential benefits justify
        % the costs.
        %
        ml_gen_tscc_trial(ProgressStream, ModuleInfo, Target, ConstStructMap,
            TsccCodeModel, PredProcIds, _NonTailEntryPredProcIds,
            NoMutualPredProcIds, MutualPredProcIds, MutualPredProcCodes,
            CanGenerateTscc, MutualEnvVarNames, MutualClosureWrapperFuncDefns,
            LoopKind, !.InSccMap, TrialInSccMap,
            !.GlobalData, TrialGlobalData),
        (
            CanGenerateTscc = can_not_generate_code_for_tscc,
            OutsideTsccPredProcIds = PredProcIds
        ;
            CanGenerateTscc = can_generate_code_for_tscc,
            OutsideTsccPredProcIds = NoMutualPredProcIds,
            !:InSccMap = TrialInSccMap,
            !:GlobalData = TrialGlobalData,

            % Caveat 4:
            % XXX We SHOULD add to TSCCEntryPredProcIds the procedures in
            % PredProcIds that are called from the procedures in SCC that are
            % NOT in this TSCC. We do that for procedures that are in the
            % SAME SET of TSCCs, but that leaves out the procedures that are
            % in the OTHER set of TSCCs (one model_det, one model_semi),
            % and the procedures that are not candidates for mutual tail
            % recursion optimization. Until we fix that, we can't intersect
            % MutualPredProcIds with MutualEntryPredProcIds before passing
            % its list form to list.map below.
            %
            % This means that the commented-out code below calculating
            % the various kinds of entry procedures can't (yet) be used.
%           TSCCEntryPredProcIds =
%               set.union(CalledFromHigherTSCCs, ExportedTSCCPredProcIds),
%           SCCEntryPredProcIdsInTSCC =
%               set.intersect(PredProcIds, SCCEntryPredProcIds),
%           ExternalEntryPredProcIds =
%               set.union(SCCEntryPredProcIdsInTSCC, TSCCEntryPredProcIds),
%
%           MutualEntryPredProcIds =
%               set.difference(
%                   set.union(ExternalEntryPredProcIds,
%                       NonTailEntryPredProcIds),
%                   NoMutualPredProcIds),
%           some [!StartCommentStmts] (
%               !:StartCommentStmts = [],
%               describe_pred_proc_ids(ModuleInfo,
%                   "TSCC PredProcIds", PredProcIds,
%                   !StartCommentStmts),
%               describe_pred_proc_ids(ModuleInfo,
%                   "TSCCEntryPredProcIds", TSCCEntryPredProcIds,
%                   !StartCommentStmts),
%               describe_pred_proc_ids(ModuleInfo,
%                   "ExternalEntryPredProcIds", ExternalEntryPredProcIds,
%                   !StartCommentStmts),
%               describe_pred_proc_ids(ModuleInfo,
%                   "NonTailEntryPredProcIds", NonTailEntryPredProcIds,
%                   !StartCommentStmts),
%               describe_pred_proc_ids(ModuleInfo,
%                   "MutualEntryPredProcIds", MutualEntryPredProcIds,
%                   !StartCommentStmts),
%               BlankStmt = ml_stmt_atomic(comment(""), term.context_init),
%               !:StartCommentStmts = !.StartCommentStmts ++ [BlankStmt],
%               StartCommentStmts = !.StartCommentStmts
%           ),
            StartCommentStmts = [],

            list.map(
                construct_tscc_entry_proc(ProgressStream, ModuleInfo, LoopKind,
                    MutualPredProcCodes, MutualEnvVarNames, StartCommentStmts),
                set.to_sorted_list(MutualPredProcIds), TSCCFuncDefns),
            !:FuncDefns = MutualClosureWrapperFuncDefns ++ TSCCFuncDefns ++
                !.FuncDefns
        ),

        list.foldl3(
            ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target,
                ConstStructMap, self_tail_rec),
            set.to_sorted_list(OutsideTsccPredProcIds),
            !FuncDefns, !GlobalData, !InSccMap)
    ).

:- type can_we_generate_code_for_tscc
    --->    can_not_generate_code_for_tscc
    ;       can_generate_code_for_tscc.

    % Generate a representation of the codes to go under each "top_of_proc_i"
    % label in the scheme above, but also return the information our caller
    % needs to prepare for handling caveats 1 and 2.
    %
:- pred ml_gen_tscc_trial(io.text_output_stream::in, module_info::in,
    mlds_target_lang::in, ml_const_struct_map::in, tscc_code_model::in,
    set(pred_proc_id)::in, set(pred_proc_id)::out,
    set(pred_proc_id)::out, set(pred_proc_id)::out, list(pred_proc_code)::out,
    can_we_generate_code_for_tscc::out, set(string)::out,
    list(mlds_function_defn)::out, tail_rec_loop_kind::out,
    in_scc_map::in, in_scc_map::out,
    ml_global_data::in, ml_global_data::out) is det.

ml_gen_tscc_trial(ProgressStream, ModuleInfo, Target, ConstStructMap,
        TsccCodeModel, PredProcIds, NonTailEntryPredProcIds,
        NoMutualPredProcIds, MutualPredProcIds, MutualPredProcCodes,
        CanGenerateTscc, MutualEnvVarNames,
        MutualClosureWrapperFuncDefns, LoopKind, !InSccMap, !GlobalData) :-
    % Compute the information we need for generating tail calls
    % to any of the procedures in the TSCC.
    reset_in_scc_map(!InSccMap),
    list.map_foldl6(compute_initial_tail_rec_map_for_mutual(ModuleInfo),
        set.to_sorted_list(PredProcIds), PredProcIdArgsInfos,
        1, _, maybe.no, _, can_generate_code_for_tscc, CanGenerateTscc0,
        map.init, _OutArgNames, !InSccMap, map.init, SeenAtLabelMap),

    % Translate each procedure in the TSCC into a representation of the
    % code that will go under "top_of_proc_i".
    init_ml_gen_tscc_info(ModuleInfo, !.InSccMap, tscc_self_and_mutual_rec,
        TsccInfo0),
    list.map_foldl2(
        ml_gen_tscc_proc_code(ProgressStream, ModuleInfo, Target,
            ConstStructMap, TsccCodeModel, SeenAtLabelMap),
        PredProcIdArgsInfos, PredProcCodes,
        !GlobalData, TsccInfo0, TsccInfo),

    TailRecInfo = TsccInfo ^ mgti_tail_rec_info,
    !:InSccMap = TailRecInfo ^ tri_in_scc_map,
    LoopKind = TailRecInfo ^ tri_loop_kind,
    map.foldl2(accumulate_entry_procs, !.InSccMap,
        set.init, NonTailEntryPredProcIds, set.init, NoMutualPredProcIds0),
    % Returning NoMutualPredProcIds separately from MutualPredProcIds
    % handles caveat 1.
    separate_mutually_recursive_procs(NoMutualPredProcIds0, PredProcCodes,
        NoMutualPredProcIds, MutualPredProcIds, MutualPredProcCodes,
        MutualContainsNestedFuncs, MutualClosureWrapperFuncDefns,
        MutualEnvVarNames),

    ( if
        % Handle caveat 2.
        MutualContainsNestedFuncs = does_not_contain_nested_funcs,
        % Handle caveat 3.
        CanGenerateTscc0 = can_generate_code_for_tscc
    then
        CanGenerateTscc = can_generate_code_for_tscc
    else
        CanGenerateTscc = can_not_generate_code_for_tscc
    ).

:- pred accumulate_entry_procs(pred_proc_id::in, in_scc_info::in,
    set(pred_proc_id)::in, set(pred_proc_id)::out,
    set(pred_proc_id)::in, set(pred_proc_id)::out) is det.

accumulate_entry_procs(PredProcId, InSccInfo,
        !NonTailEntryPredProcIds, !NoMutualTailRecPredProcIds) :-
    IsTargetOfNonTRCalls = InSccInfo ^ isi_is_target_of_non_tail_rec,
    (
        IsTargetOfNonTRCalls = []
    ;
        IsTargetOfNonTRCalls = [_ | _],
        set.insert(PredProcId, !NonTailEntryPredProcIds)
    ),
    IsTargetOfMutualTRCall = InSccInfo ^ isi_is_target_of_mutual_tr,
    (
        IsTargetOfMutualTRCall = is_not_target_of_mutual_trcall,
        set.insert(PredProcId, !NoMutualTailRecPredProcIds)
    ;
        IsTargetOfMutualTRCall = is_target_of_mutual_trcall
    ).

    % separate_mutually_recursive_procs(NoMutualTailRecProcs, PredProcCodes,
    %     NoMutualPredProcIds, MutualPredProcIds, MutualPredProcCodes,
    %     MutualContainsNestedFuncs, MutualClosureWrapperFuncDefns,
    %     MutualEnvVarNames, MutualTailRecSpecs):
    %
    % Given a list of procedures we have generated code for (PredProcCodes),
    % divide the procedures in it into two partitions: those whose ids
    % occur in NoMutualTailRecProcs, whose ids are returned in
    % NoMutualPredProcIds, and those whose ids do not occur there
    % whose ids are returned in MutualPredProcIds, and whose other info
    % is returned in the other output arguments whose names start with Mutual.
    %
:- pred separate_mutually_recursive_procs(set(pred_proc_id)::in,
    list(pred_proc_code)::in,
    set(pred_proc_id)::out, set(pred_proc_id)::out, list(pred_proc_code)::out,
    maybe_contains_nested_funcs::out, list(mlds_function_defn)::out,
    set(string)::out) is det.

separate_mutually_recursive_procs(_NoMutualTailRecProcs, [],
        set.init, set.init, [], does_not_contain_nested_funcs, [], set.init).
separate_mutually_recursive_procs(NoMutualTailRecProcs,
        [PredProcCode | PredProcCodes],
        !:NoMutualPredProcIds, !:MutualPredProcIds, !:MutualPredProcCodes,
        !:MutualContainsNestedFuncs, !:MutualClosureWrapperFuncDefns,
        !:MutualEnvVarNames) :-
    separate_mutually_recursive_procs(NoMutualTailRecProcs, PredProcCodes,
        !:NoMutualPredProcIds, !:MutualPredProcIds, !:MutualPredProcCodes,
        !:MutualContainsNestedFuncs, !:MutualClosureWrapperFuncDefns,
        !:MutualEnvVarNames),
    PredProcCode = pred_proc_code(PredProcIdArgsInfo,
        _FuncParams, _LocalVarDefns, FuncDefns, DescCommentStmt, GoalStmts,
        ProcClosureWrapperFuncDefns, ProcEnvVarNames),
    PredProcId = PredProcIdArgsInfo ^ ppiai_pred_proc_id,
    ( if set.member(PredProcId, NoMutualTailRecProcs) then
        set.insert(PredProcId, !NoMutualPredProcIds)
    else
        ( if
            (
                FuncDefns = [_ | _]
            ;
                list.foldl(does_stmt_contain_nested_func_defn,
                    [DescCommentStmt | GoalStmts],
                    does_not_contain_nested_funcs, ContainsNestedFuncs),
                ContainsNestedFuncs = contains_nested_funcs
            )
        then
            !:MutualContainsNestedFuncs = contains_nested_funcs
        else
            true
        ),
        set.insert(PredProcId, !MutualPredProcIds),
        !:MutualPredProcCodes = [PredProcCode | !.MutualPredProcCodes],
        !:MutualClosureWrapperFuncDefns =
            ProcClosureWrapperFuncDefns ++ !.MutualClosureWrapperFuncDefns,
        set.union(ProcEnvVarNames, !MutualEnvVarNames)
    ).

    % The pred_proc_id_args_info structure contains the information we generate
    % about a procedure's arguments. We set this up *before* we generate code
    % for any procedure in the TSCC, because any procedure may contain tail
    % recursive calls to any other procedure in the TSCC, and to generate
    % the right code for such tail recursive calls, we need to know the
    % sequence of the *input* arguments of the callee.
    %
    % That sequence is not stored here; since it is needed *only* for
    % generating code for tail calls, it is stored in the data structure
    % used for that purpose (the tail_rec_info slot of the ml_gen_info).
    % However, when we compute this sequence, it is convenient to compute,
    % at the same time, all the *other* information we will need later
    % about the procedure's arguments, and that is what is stored here.
:- type pred_proc_id_args_info
    --->    pred_proc_id_args_info(
                % Various aspects of the identity of this procedure.
                ppiai_pred_proc_id              :: pred_proc_id,
                ppiai_pred_info                 :: pred_info,
                ppiai_proc_info                 :: proc_info,
                ppiai_proc_context              :: prog_context,
                ppiai_id_in_tscc                :: proc_id_in_tscc,

                % The variable names of the procedure's arguments,
                % their types and modes.
                ppiai_arg_tuples                :: list(var_mvar_type_mode),

                % Argument definitions for the TSCC variables for all
                % the arguments of the procedure, both input and output,
                % in their original order, and the types of the returned
                % arguments.
                ppiai_tscc_func_params          :: mlds_func_params,

                % The vector of rvals to return in the procedure's return
                % statement, together with their types.
                ppiai_return_rvals_types        :: assoc_list(mlds_rval,
                                                    mlds_type),

                % The lvn_tscc_proc_input_var variables for the input arguments
                % of procedure i in the TSCC will be defined
                %
                % - in the argument list of the MLDS function,
                %   if the MLDS function is for procedure j with i = j; and
                %
                % - at the top of the body of the MLDS function,
                %   if the MLDS function is for procedure j with i != j.
                %
                % The lvn_tscc_output_var variables for the byref output
                % arguments will always be defined in the argument list
                % of the MLDS function. The tscc variables for the copied-out
                % output arguments will always be defined at the top of
                % the body of the MLDS function.

                % Local variable definitions of the own variables for
                % all the arguments of the procedure. These go at the top
                % of the wrapped procedure.
                ppiai_own_local_var_defns       :: list(mlds_local_var_defn),

                % Local variable definitions of the tscc variables
                % for the input arguments of the procedure only.
                % These go at the top of the container function
                % for every procedure *other* than this one.
                % (In the container function for this procedure,
                % the variables that these would define are defined
                % in the function's signature instead.)
                ppiai_tscc_in_local_var_defns   :: list(mlds_local_var_defn),

                % The names of the variables defined in the previous field.
                % Needed in some cases for transmission to ml_unused_assign.m.
                ppiai_tscc_in_local_vars        :: list(mlds_local_var_name),

                % Local variable definitions of the tscc out variables
                % for the output arguments of the procedure only.
                % These go at the top of this procedure's container function.
                % (The container procedure of every other function
                % will have its own identical list of definitions.)
                ppiai_tscc_out_value_local_var_defns
                                                :: list(mlds_local_var_defn),

                % Statements that, for each input argument of the procedure,
                % assign the tscc in variable for that argument to the own
                % variable for that argument. These statements go at the
                % top of the wrapped procedure.
                ppiai_copy_tscc_in_to_own_copy  :: list(mlds_stmt),

                % Statements that, for each output argument of the procedure
                % (including the implicit argument for success indication
                % in model semi procedures), assign the own variable for that
                % argument to the tscc out variable for that argument.
                % These statements go at the end of the wrapped procedure.
                ppiai_copy_own_to_tscc_out_copy :: list(mlds_stmt),

                % Statements that, for each output argument of the procedure
                % that is returned by reference, store the value computed
                % for the argument (in the argument's tscc out variable)
                % in the memory location that the argument's tscc out ptr
                % variable indicates is where that argument should be put.
                % These statements go at the end of the container procedure.
                ppiai_copy_out_through_ptr      :: list(mlds_stmt)
            ).

    % Compute the map that tells the code generator how to translate
    % tail recursive calls to any procedure in the TSCC, and return
    % the other information about the argument lists of the procedures in the
    % TSCC that is convenient to compute at the same time.
    %
:- pred compute_initial_tail_rec_map_for_mutual(module_info::in,
    pred_proc_id::in, pred_proc_id_args_info::out, int::in, int::out,
    maybe(assoc_list(mlds_local_var_name, mlds_type))::in,
    maybe(assoc_list(mlds_local_var_name, mlds_type))::out,
    can_we_generate_code_for_tscc::in, can_we_generate_code_for_tscc::out,
    map(int, string)::in, map(int, string)::out,
    in_scc_map::in, in_scc_map::out,
    seen_at_label_map::in, seen_at_label_map::out) is det.

compute_initial_tail_rec_map_for_mutual(ModuleInfo,
        PredProcId, PredProcIdArgsInfo, !ProcNum, !MaybeOutVarsTypes,
        !CanGenerateTscc, !OutArgNames, !InSccMap, !SeenAtLabelMap) :-
    ThisProcNum = !.ProcNum,
    IdInTscc = proc_id_in_tscc(ThisProcNum),
    !:ProcNum = !.ProcNum + 1,

    module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
    pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
    CodeModel = proc_info_interface_code_model(ProcInfo),
    proc_info_get_var_table(ProcInfo, VarTable),
    proc_info_get_headvars(ProcInfo, HeadVars),
    pred_info_get_arg_types(PredInfo, HeadTypes),
    proc_info_get_argmodes(ProcInfo, HeadModes),

    proc_info_get_goal(ProcInfo, Goal),
    Goal = hlds_goal(_GoalExpr, GoalInfo),
    ProcContext = goal_info_get_context(GoalInfo),

    ml_gen_tscc_arg_params(ModuleInfo, PredOrFunc, CodeModel,
        ProcContext, IdInTscc, VarTable, HeadVars, HeadTypes, HeadModes,
        ArgTuples, !OutArgNames,
        TsccInArgs, FuncParams, ReturnRvalsTypes, OutVarsTypes,
        OwnLocalVarDefns, TsccInLocalVarDefns, TsccValueLocalVarDefns,
        CopyTsccToOwnStmts, CopyOwnToTsccStmts, CopyOutValThroughPtrStmts),
    TsccInLocalVars = list.map(
        (func(LocalVarDefn) = LocalVarDefn ^ mlvd_name), TsccInLocalVarDefns),
    (
        !.MaybeOutVarsTypes = no,
        !:MaybeOutVarsTypes = yes(OutVarsTypes)
    ;
        !.MaybeOutVarsTypes = yes(OldOutVarsTypes),
        ( if OutVarsTypes = OldOutVarsTypes then
            true
        else
            % The different procedures in the TSCC have different vectors of
            % output arguments.
            !:CanGenerateTscc = can_not_generate_code_for_tscc
        )
    ),
    PredProcIdArgsInfo = pred_proc_id_args_info(PredProcId, PredInfo, ProcInfo,
        ProcContext, IdInTscc, ArgTuples, FuncParams, ReturnRvalsTypes,
        OwnLocalVarDefns, TsccInLocalVarDefns, TsccInLocalVars,
        TsccValueLocalVarDefns, CopyTsccToOwnStmts, CopyOwnToTsccStmts,
        CopyOutValThroughPtrStmts),
    map.lookup(!.InSccMap, PredProcId, InSccInfo0),
    InSccInfo = InSccInfo0 ^ isi_maybe_in_tscc :=
        in_tscc(IdInTscc, TsccInArgs),
    map.det_update(PredProcId, InSccInfo, !InSccMap),
    TsccKind = tscc_self_and_mutual_rec,
    StartLabel = generate_tail_rec_start_label(TsccKind, IdInTscc),
    map.det_insert(StartLabel, set.list_to_set(TsccInLocalVars),
        !SeenAtLabelMap).

    % Each value of this type records the results of invoking the code
    % generator on the body of procedure in a TSCC.
    %
:- type pred_proc_code
    --->    pred_proc_code(
                ppc_id_args_info            :: pred_proc_id_args_info,
                ppc_func_params             :: mlds_func_params,
                ppc_local_var_defns         :: list(mlds_local_var_defn),
                ppc_local_func_defns        :: list(mlds_function_defn),
                ppc_desc_comment_stmt       :: mlds_stmt,
                ppc_goal_stmts              :: list(mlds_stmt),
                ppc_closure_wrapper_funcs   :: list(mlds_function_defn),
                ppc_env_var_names           :: set(string)
            ).

    % Translate the body of the given procedure to MLDS, and return the
    % results in a form that our caller can join together with the MLDS code
    % we get for the *other* procedures in the TSCC.
    %
:- pred ml_gen_tscc_proc_code(io.text_output_stream::in, module_info::in,
    mlds_target_lang::in, ml_const_struct_map::in, tscc_code_model::in,
    seen_at_label_map::in, pred_proc_id_args_info::in, pred_proc_code::out,
    ml_global_data::in, ml_global_data::out,
    ml_gen_tscc_info::in, ml_gen_tscc_info::out) is det.

ml_gen_tscc_proc_code(ProgressStream, ModuleInfo, Target, ConstStructMap,
        TsccCodeModel, SeenAtLabelMap, PredProcIdArgsInfo, PredProcCode,
        !GlobalData, !TsccInfo) :-
    PredProcIdArgsInfo = pred_proc_id_args_info(PredProcId, PredInfo, ProcInfo,
        ProcContext, ProcIdInTscc, ArgTuples, _FuncParams, _ReturnRvalsTypes,
        _OwnLocalVarDefns, _TsscInLocalVarDefns, _TsscInLocalVars,
        _TsccOutLocalVarDefns, _CopyTsccInToOwnStmts, _CopyOwnToTsccOutStmts,
        _CopyOutValThroughPtrStmts),

    trace [io(!IO)] (
        maybe_write_proc_progress_message(ProgressStream, ModuleInfo,
            "Generating in-TSCC MLDS code for", PredProcId, !IO)
    ),

    some [!Info] (
        !:Info = ml_gen_info_init(ModuleInfo, Target, ConstStructMap,
            PredProcId, ProcInfo, !.GlobalData, !.TsccInfo),

        pred_info_get_status(PredInfo, PredStatus),
        ( if PredStatus = pred_status(status_external(_)) then
            % External predicates don't have bodies, so they can't contain
            % tail calls (or any other kind of calls), so they cannot be
            % in a non-singleton TSCC.
            unexpected($pred, "status_external")
        else
            true
        ),

        PredProcId = proc(_PredId, ProcId),
        ProcDesc = describe_proc(include_module_name, PredInfo, ProcId),
        ProcIdInTscc = proc_id_in_tscc(ProcNumInTscc),
        ProcDescComment = string.format("proc %d in TSCC: %s",
            [i(ProcNumInTscc), s(ProcDesc)]),
        CommentStmt = ml_stmt_atomic(comment(ProcDescComment), ProcContext),

        ml_gen_info_proc_params(PredProcId, ProcArgTuples, FuncParams,
            ByRefOutputVars, CopiedOutputVars0, !Info),
        expect(unify(ArgTuples, ProcArgTuples), $pred,
            "ArgTuples != ProcArgTuples"),
        % The container procedure will take care of any output arguments
        % returned by reference. The wrapped procedures return the values
        % of all output arguments to the container functions by value,
        % so set up the code generator state accordingly.
        CopiedOutputVars = ByRefOutputVars ++ CopiedOutputVars0,
        set_of_var.init(ByRefOutputVarsSet),
        ml_gen_info_set_byref_output_vars(ByRefOutputVarsSet, !Info),
        (
            TsccCodeModel = tscc_det,
            CodeModel = model_det,
            InitSucceededStmts = []
        ;
            TsccCodeModel = tscc_semi,
            CodeModel = model_semi,
            % In some model_semi predicates, the only goal in their body
            % that can fail is a tail recursive call. The InitSucceededStmt
            % ensures that the success indicator variable (a) gets declared,
            % and (b) contains a meaningful and correct value on execution
            % paths that don't include the tail recursive call.
            ml_gen_set_success(ml_const(mlconst_true), ProcContext,
                InitSucceededStmt, !Info),
            InitSucceededStmts = [InitSucceededStmt]
        ),
        proc_info_get_goal(ProcInfo, Goal),
        ml_gen_proc_body(CodeModel, ArgTuples, CopiedOutputVars, Goal,
            SeenAtLabelMap, LocalVarDefns0, FuncDefns, GoalStmts0, !Info),
        GoalStmts = InitSucceededStmts ++ GoalStmts0,
        ml_gen_maybe_local_var_defn_for_succeeded(!.Info, ProcContext,
            SucceededVarDefns),
        LocalVarDefns = SucceededVarDefns ++ LocalVarDefns0,

        ml_gen_info_final(!.Info, EnvVarNames,
            ClosureWrapperFuncDefns, !:GlobalData, !:TsccInfo),

        PredProcCode = pred_proc_code(PredProcIdArgsInfo, FuncParams,
            LocalVarDefns, FuncDefns, CommentStmt, GoalStmts,
            ClosureWrapperFuncDefns, EnvVarNames)
    ).

    % Given the results of translating each procedure in a TSCC into MLDS code,
    % wrap them up in an MLDS function that implements EntryProc.
    %
:- pred construct_tscc_entry_proc(io.text_output_stream::in, module_info::in,
    tail_rec_loop_kind::in, list(pred_proc_code)::in, set(string)::in,
    list(mlds_stmt)::in, pred_proc_id::in, mlds_function_defn::out) is det.

construct_tscc_entry_proc(ProgressStream, ModuleInfo, LoopKind, PredProcCodes,
        EnvVarNames, EntryProcDescComments, EntryProc, FuncDefn) :-
    trace [io(!IO)] (
        maybe_write_proc_progress_message(ProgressStream, ModuleInfo,
            "Generating MLDS code for", EntryProc, !IO)
    ),

    list.map_foldl2(construct_func_body_for_tscc(EntryProc),
        PredProcCodes, ProcStmtInfos,
        no, MaybeEntryProcInfo, [], NonEntryTsccInLocalVarDefns),
    (
        MaybeEntryProcInfo = no,
        unexpected($pred, "MaybeEntryProcInfo = no")
    ;
        MaybeEntryProcInfo = yes(EntryProcInfo),
        EntryProcInfo = entry_proc_info(EntryIdInTscc, EntryPredProcIdInfo,
            EntryProcParams, EntryReturnRvalsTypes,
            EntryTsccOutLocalVarDefns, EntryCopyOutValThroughPtrStmts),
        assoc_list.keys(EntryReturnRvalsTypes, EntryReturnRvals)
    ),
    EntryPredProcIdInfo = pred_proc_id_info(_EntryPredProcId,
        _EntryPredInfo, _EntryProcInfo, EntryProcContext),
    make_container_proc(LoopKind, EntryCopyOutValThroughPtrStmts,
        EntryReturnRvals, EntryIdInTscc, EntryProcContext, ProcStmtInfos,
        ContainerVarDefns, Stmts),
    FuncBodyLocalVarDefns = ContainerVarDefns ++
        NonEntryTsccInLocalVarDefns ++ EntryTsccOutLocalVarDefns,

    EntryIdInTscc = proc_id_in_tscc(EntryIdInTsccNum),
    EntryProcDesc = describe_proc_from_id(include_module_name,
        ModuleInfo, EntryProc),
    Comment0 = string.format("The code for TSCC PROC %d: %s.",
        [i(EntryIdInTsccNum), s(EntryProcDesc)]),
    CommentStmt0 = ml_stmt_atomic(comment(Comment0), EntryProcContext),
    Comment1 = "Setup for mutual tailcalls optimized into a loop.",
    CommentStmt1 = ml_stmt_atomic(comment(Comment1), EntryProcContext),
    Comment2 = "The mutually recursive procedures are:",
    CommentStmt2 = ml_stmt_atomic(comment(Comment2), EntryProcContext),
    EmptyComment = comment(""),
    EmptyCommentStmt = ml_stmt_atomic(EmptyComment, EntryProcContext),
    ProcDescCommentStmts =
        list.map(func(PPC) = PPC ^ ppc_desc_comment_stmt, PredProcCodes),

    FuncBodyStmts =
        [CommentStmt0, CommentStmt1, CommentStmt2, EmptyCommentStmt
            | ProcDescCommentStmts]
        ++ [EmptyCommentStmt | EntryProcDescComments] ++ Stmts,

    FuncBodyStmt = ml_stmt_block(FuncBodyLocalVarDefns, [],
        FuncBodyStmts, EntryProcContext),
    FuncBody = body_defined_here(FuncBodyStmt),
    construct_func_defn(ModuleInfo, EntryPredProcIdInfo, EntryProcParams,
        FuncBody, EnvVarNames, FuncDefn).

:- type entry_proc_info
    --->    entry_proc_info(
                proc_id_in_tscc,
                pred_proc_id_info,
                mlds_func_params,
                assoc_list(mlds_rval, mlds_type),
                list(mlds_local_var_defn),
                list(mlds_stmt)
            ).

:- type proc_stmt_info
    --->    proc_stmt_info(
                proc_id_in_tscc,
                list(mlds_local_var_name),  % The TSCC input arguments.
                mlds_stmt,
                prog_context
            ).

    % Given PredProcCode, the results of translating procedure PredProcId
    % in a TSCC into MLDS code, stitch these results together in a way
    % that is appropriate to go under the "top_of_proc_i" for PredProcId
    % in the MLDS function that implements EntryProc.
    %
    % Some aspects of the appropriate form depend on whether PredProcId =
    % EntryProc, so we cannot put the same code under "top_of_proc_i"
    % in *all* the MLDS functions we generate for a TSCC.
    %
:- pred construct_func_body_for_tscc(pred_proc_id::in,
    pred_proc_code::in, proc_stmt_info::out,
    maybe(entry_proc_info)::in, maybe(entry_proc_info)::out,
    list(mlds_local_var_defn)::in, list(mlds_local_var_defn)::out) is det.

construct_func_body_for_tscc(EntryProc, PredProcCode,
        ProcStmtInfo, !MaybeEntryProcInfo, !NonEntryTsccInLocalVarDefns) :-
    PredProcCode = pred_proc_code(PredProcIdArgsInfo, _FuncParams,
        GoalLocalVarDefns, GoalFuncDefns, _DescCommentStmt, GoalStmts,
        _ClosureWrapperFuncDefns, _EnvVarNames),
    PredProcIdArgsInfo = pred_proc_id_args_info(PredProcId,
        PredInfo, ProcInfo, ProcContext, IdInTscc, _ArgTuples,
        FuncParams, ReturnRvalsTypes, OwnLocalVarDefns,
        TsccInLocalVarDefns, TsccInLocalVars, TsccOutLocalVarDefns,
        CopyTsccInToOwnStmts, CopyOwnToTsccOutStmts,
        CopyOutValThroughPtrStmts),
    ( if PredProcId = EntryProc then
        expect(unify(!.MaybeEntryProcInfo, no), $pred,
            "!.MaybeEntryProcInfo != no"),
        PredProcIdInfo = pred_proc_id_info(PredProcId, PredInfo, ProcInfo,
            ProcContext),
        EntryProcInfo = entry_proc_info(IdInTscc, PredProcIdInfo,
            FuncParams, ReturnRvalsTypes,
            TsccOutLocalVarDefns, CopyOutValThroughPtrStmts),
        !:MaybeEntryProcInfo = yes(EntryProcInfo)
    else
        !:NonEntryTsccInLocalVarDefns = !.NonEntryTsccInLocalVarDefns ++
            TsccInLocalVarDefns
    ),
    AllLocalVarDefns = OwnLocalVarDefns ++ GoalLocalVarDefns,
    AllStmts = CopyTsccInToOwnStmts ++ GoalStmts ++ CopyOwnToTsccOutStmts,
    ProcStmt = ml_stmt_block(AllLocalVarDefns, GoalFuncDefns, AllStmts,
        ProcContext),
    ProcStmtInfo = proc_stmt_info(IdInTscc, TsccInLocalVars, ProcStmt,
        ProcContext).

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

    % Take the codes that go under each "top_of_proc_i", and join them
    % together to yield the body of the MLDS function for EntryProc.
    % Use whiles and continues instead of labels and gotos if requested.
    %
:- pred make_container_proc(tail_rec_loop_kind::in, list(mlds_stmt)::in,
    list(mlds_rval)::in, proc_id_in_tscc::in, prog_context::in,
    list(proc_stmt_info)::in,
    list(mlds_local_var_defn)::out, list(mlds_stmt)::out) is det.

make_container_proc(LoopKind, CopyOutValThroughPtrStmts, ReturnRvals,
        EntryProc, EntryProcContext, ProcStmtInfos, ContainerVarDefns,
        Stmts) :-
    ReturnStmt = ml_stmt_return(ReturnRvals, EntryProcContext),
    (
        LoopKind = tail_rec_loop_label_goto,
        make_container_proc_with_label_goto(CopyOutValThroughPtrStmts,
            ReturnStmt, EntryProc, EntryProcContext, ProcStmtInfos, Stmts),
        ContainerVarDefns = []
    ;
        LoopKind = tail_rec_loop_while_continue,
        make_container_proc_with_while_continue(CopyOutValThroughPtrStmts,
            ReturnStmt, EntryProc, EntryProcContext, ProcStmtInfos,
            ContainerVarDefns, Stmts)
    ).

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

    % We wrap the statements we generate for each TSCC procedure like this:
    %
    % goto top_of_proc_<entry_proc>;
    %
    % top_of_proc_1:
    %   <copy tscc args 1 to own args 1>
    %   <body of TSCC proc 1>
    %   <copy own output args 1 to tscc output args>
    %   goto EndLabel;
    % ...
    % top_of_proc_N:
    %   <copy tscc args N to own args N>
    %   <body of TSCC proc N>
    %   <copy own output args N to tscc output args>
    %   goto EndLabel;
    % EndLabel:
    %   <for tscc byref output args, copy value to *ptr>
    %   return <tscc copied output args>;
    %
    % A tail call to TSCC proc i can just
    %
    % - assign the actual parameters to tscc args i, and
    % - goto `top_of_proc_i'.
    %
:- pred make_container_proc_with_label_goto(list(mlds_stmt)::in, mlds_stmt::in,
    proc_id_in_tscc::in, prog_context::in, list(proc_stmt_info)::in,
    list(mlds_stmt)::out) is det.

make_container_proc_with_label_goto(CopyOutValThroughPtrStmts, ReturnStmt,
        EntryProc, EntryProcContext, ProcStmtInfos, WrappedStmts) :-
    EndLabel = mlds_label("tscc_end"),
    EndLabelStmt = ml_stmt_label(EndLabel, EntryProcContext),
    GotoEndStmt = ml_stmt_goto(goto_label(EndLabel), EntryProcContext),
    list.map(make_wrapped_proc_with_label_goto(GotoEndStmt), ProcStmtInfos,
        ProcWrappedStmtLists),
    list.condense(ProcWrappedStmtLists, ProcWrappedStmts),
    EntryStartLabel =
        generate_tail_rec_start_label(tscc_self_and_mutual_rec, EntryProc),
    GotoEntryStmt =
        ml_stmt_goto(goto_label(EntryStartLabel), EntryProcContext),
    WrappedStmts = [GotoEntryStmt | ProcWrappedStmts] ++
        [EndLabelStmt | CopyOutValThroughPtrStmts] ++ [ReturnStmt].

:- pred make_wrapped_proc_with_label_goto(mlds_stmt::in, proc_stmt_info::in,
    list(mlds_stmt)::out) is det.

make_wrapped_proc_with_label_goto(GotoEndStmt, ProcStmtInfo, LabelProcStmts) :-
    ProcStmtInfo = proc_stmt_info(IdInTscc, _LoopLocalVars, ProcStmt,
        ProcContext),
    StartLabel =
        generate_tail_rec_start_label(tscc_self_and_mutual_rec, IdInTscc),
    StartLabelStmt = ml_stmt_label(StartLabel, ProcContext),
    LabelProcStmts =
        [StartLabelStmt | append_to_stmt(ProcStmt, [GotoEndStmt])].

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

    % We wrap the statements we generate for each TSCC procedure like this:
    %
    % proc_selector = <entry_proc>;
    % while (TRUE) {
    %   switch (proc_selector) {
    %       case 1:
    %           <copy tscc input args 1 to own input args 1>
    %           <body of TSCC proc 1>
    %           <copy own output args 1 to tscc output args>
    %           break;
    %       ...
    %       case N:
    %           <copy tscc args N to own args N>
    %           <body of TSCC proc N>
    %           <copy own output args N to tscc output args>
    %           break;
    %   }
    %   break;
    % }
    % <for tscc byref output args, copy value to *ptr>
    % return <tscc copied output args>;
    %
    % A tail call to TSCC proc i can just
    %
    % - assign the actual parameters to tscc args i,
    % - set proc_selector to i, and
    % - execute `continue'.
    %
:- pred make_container_proc_with_while_continue(list(mlds_stmt)::in,
    mlds_stmt::in, proc_id_in_tscc::in, prog_context::in,
    list(proc_stmt_info)::in,
    list(mlds_local_var_defn)::out, list(mlds_stmt)::out) is det.

make_container_proc_with_while_continue(CopyOutValThroughPtrStmts, ReturnStmt,
        EntryProc, EntryProcContext, ProcStmtInfos,
        ContainerVarDefns, WrappedStmts) :-
    GotoEndStmts = [ml_stmt_goto(goto_break_switch, EntryProcContext)],
    list.map_foldl2(make_wrapped_proc_with_while_continue(GotoEndStmts),
        ProcStmtInfos, SwitchCases,
        set.init, PossibleSwitchValues, [], AllTsccInLocalVars),

    SelectorVar = lvn_comp_var(lvnc_tscc_proc_selector),
    SelectorType = mlds_builtin_type_int(int_type_int),
    SelectorVarDefn = mlds_local_var_defn(SelectorVar, EntryProcContext,
        SelectorType, no_initializer, gc_no_stmt),
    ContainerVarDefns = [SelectorVarDefn],

    EntryProc = proc_id_in_tscc(EntryProcNum),
    SelectorVarLval = ml_local_var(SelectorVar, SelectorType),
    SetSelectorStmt = ml_stmt_atomic(
        assign(SelectorVarLval, ml_const(mlconst_int(EntryProcNum))),
        EntryProcContext),

    set.to_sorted_list(PossibleSwitchValues, PossibleSwitchValuesList),
    SwitchMin = list.det_head(PossibleSwitchValuesList),
    SwitchMax = list.det_last(PossibleSwitchValuesList),
    SwitchRange = mlds_switch_range(SwitchMin, SwitchMax),
    Default = default_is_unreachable,
    SwitchStmt = ml_stmt_switch(SelectorType, ml_lval(SelectorVarLval),
        SwitchRange, SwitchCases, Default, EntryProcContext),
    BreakStmt = ml_stmt_goto(goto_break_loop, EntryProcContext),
    SwitchBreakStmt = ml_stmt_block([], [], [SwitchStmt, BreakStmt],
        EntryProcContext),
    LoopLocalVars = [SelectorVar | AllTsccInLocalVars],
    LoopStmt = ml_stmt_while(may_loop_zero_times, ml_const(mlconst_true),
        SwitchBreakStmt, LoopLocalVars, EntryProcContext),
    WrappedStmts = [SetSelectorStmt, LoopStmt] ++
        CopyOutValThroughPtrStmts ++ [ReturnStmt].

:- pred make_wrapped_proc_with_while_continue(list(mlds_stmt)::in,
    proc_stmt_info::in, mlds_switch_case::out, set(int)::in, set(int)::out,
    list(mlds_local_var_name)::in, list(mlds_local_var_name)::out) is det.

make_wrapped_proc_with_while_continue(GotoEndStmts, ProcStmtInfo, SwitchCase,
        !PossibleSwitchValues, !AllLoopLocalVars) :-
    ProcStmtInfo = proc_stmt_info(IdInTscc, LoopLocalVars, ProcStmt,
        ProcContext),
    IdInTscc = proc_id_in_tscc(IdInTsccNum),
    MatchCond = match_value(ml_const(mlconst_int(IdInTsccNum))),
    SwitchStmt = ml_gen_block([], [], append_to_stmt(ProcStmt, GotoEndStmts),
        ProcContext),
    SwitchCase = mlds_switch_case(MatchCond, [], SwitchStmt),
    set.insert(IdInTsccNum, !PossibleSwitchValues),
    !:AllLoopLocalVars = LoopLocalVars ++ !.AllLoopLocalVars.

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

:- func append_to_stmt(mlds_stmt, list(mlds_stmt)) = list(mlds_stmt).

append_to_stmt(BaseStmt, EndStmts) = Stmts :-
    ( if
        BaseStmt = ml_stmt_block(LocalVarDefns, FuncDefns, BaseStmts, Context)
    then
        Stmts = [ml_stmt_block(LocalVarDefns, FuncDefns,
            BaseStmts ++ EndStmts, Context)]
    else
        Stmts = [BaseStmt | EndStmts]
    ).

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

    % Return the declaration flags appropriate for a procedure definition.
    %
:- func ml_gen_proc_decl_flags(module_info, pred_id, proc_id)
    = mlds_function_decl_flags.

ml_gen_proc_decl_flags(ModuleInfo, PredId, ProcId) = DeclFlags :-
    module_info_pred_info(ModuleInfo, PredId, PredInfo),
    ( if procedure_is_exported(ModuleInfo, PredInfo, ProcId) then
        Access = func_public
    else
        Access = func_private
    ),
    DeclFlags = mlds_function_decl_flags(Access, one_copy).

    % Generate the code for a procedure body.
    %
:- pred ml_gen_proc_body(code_model::in, list(var_mvar_type_mode)::in,
    list(prog_var)::in, hlds_goal::in, seen_at_label_map::in,
    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.

ml_gen_proc_body(CodeModel, ArgTuples, CopiedOutputVars, Goal, SeenAtLabelMap,
        LocalVarDefns, FuncDefns, Stmts, !Info) :-
    Goal = hlds_goal(_, GoalInfo),
    Context = goal_info_get_context(GoalInfo),

    % First just generate the code for the procedure's goal.

    % In certain cases -- for example existentially typed procedures,
    % or unification/compare procedures for equivalence types --
    % the parameters types may not match the types of the head variables.
    % In such cases, we need to box/unbox/cast them to the right type.
    % We also grab the original (uncast) lvals for the copied output
    % variables (if any) here, since for the return statement that
    % we append below, we want the original vars, not their cast versions.

    ml_gen_convert_headvars(ArgTuples, CopiedOutputVars, Context,
        ConvLocalVarDefns, ConvInputStmts, ConvOutputStmts, !Info),
    ( if
        ConvLocalVarDefns = [],
        ConvInputStmts = [],
        ConvOutputStmts = []
    then
        % No boxing/unboxing/casting required.
        ml_gen_goal(CodeModel, Goal, LocalVarDefns1, FuncDefns0, Stmts1, !Info)
    else
        DoGenGoal = ml_gen_goal(CodeModel, Goal),

        % Boxing/unboxing/casting required. We need to convert the input
        % arguments, generate the goal, convert the output arguments,
        % and then succeed.
        DoConvOutputs =
            ( pred(NewLocalVarDefns::out, NewFuncDefns::out,
                    NewStmts::out, Info0::in, Info::out) is det :-
                ml_gen_success(CodeModel, Context, SuccStmts, Info0, Info),
                NewLocalVarDefns = [],
                NewFuncDefns = [],
                NewStmts = ConvOutputStmts ++ SuccStmts
            ),
        ml_combine_conj(CodeModel, Context, DoGenGoal, DoConvOutputs,
            LocalVarDefns0, FuncDefns0, Stmts0, !Info),
        Stmts1 = ConvInputStmts ++ Stmts0,
        LocalVarDefns1 = ConvLocalVarDefns ++ LocalVarDefns0
    ),
    ml_gen_info_get_globals(!.Info, Globals),
    globals.get_opt_tuple(Globals, OptTuple),
    EliminateUnusedAssigns = OptTuple ^ ot_elim_unused_mlds_assigns,
    (
        EliminateUnusedAssigns = do_not_elim_unused_mlds_assigns,
        LocalVarDefns = LocalVarDefns1,
        FuncDefns = FuncDefns0,
        Stmts = Stmts1
    ;
        EliminateUnusedAssigns = elim_unused_mlds_assigns,
        list.map((func(var_mvar_type_mode(_, LocalVar, _, _)) = LocalVar),
            ArgTuples) = ArgLocalVars,
        (
            ( CodeModel = model_det
            ; CodeModel = model_non
            ),
            OutsideVars = ArgLocalVars
        ;
            CodeModel = model_semi,
            OutsideVars = [lvn_comp_var(lvnc_succeeded) | ArgLocalVars]
        ),
        optimize_away_unused_assigns_in_proc_body(OutsideVars,
            SeenAtLabelMap, LocalVarDefns1, LocalVarDefns,
            FuncDefns0, FuncDefns, Stmts1, Stmts)
    ).

    % In certain cases -- for example existentially typed procedures,
    % or unification/compare procedures for equivalence types --
    % the parameter types may not match the types of the head variables.
    % In such cases, we need to box/unbox/cast them to the right type.
    % This procedure handles that.
    %
:- pred ml_gen_convert_headvars(list(var_mvar_type_mode)::in,
    list(prog_var)::in, prog_context::in,
    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_convert_headvars([], _CopiedOutputVars, _Context, [], [], [], !Info).
ml_gen_convert_headvars([ArgTuple | ArgTuples], CopiedOutputVars, Context,
        LocalVarDefns, InputStmts, OutputStmts, !Info) :-
    ArgTuple = var_mvar_type_mode(Var, MLDSVarName, HeadType, TopFunctorMode),
    ml_variable_type_direct(!.Info, Var, BodyType),
    ( if
        % An argument doesn't need any conversion ...
        (
            % ... if its type is the same in the head as in the body
            % (modulo contexts), or ...
            map.init(Subst0),
            type_unify(HeadType, BodyType, [], Subst0, Subst),
            map.is_empty(Subst)
        ;
            % ... if it is unused.
            TopFunctorMode = top_unused
        )
    then
        ml_gen_convert_headvars(ArgTuples, CopiedOutputVars, Context,
            LocalVarDefns, InputStmts, OutputStmts, !Info)
    else
        % Generate the lval for the head variable.
        ml_gen_var_with_type(!.Info, Var, HeadType, HeadVarLval),

        % Generate code to box or unbox that head variable,
        % to convert its type from HeadType to BodyType.
        ml_gen_box_or_unbox_lval(HeadType, BodyType, bp_native_if_possible,
            HeadVarLval, MLDSVarName, Context, no, 0, BodyLval,
            ConvLocalVarDefns, ConvInputStmts, ConvOutputStmts, !Info),

        % Ensure that for any uses of this variable in the procedure body,
        % we use the BodyLval (which has type BodyType) rather than the
        % HeadVarLval (which has type HeadType).
        ml_gen_info_set_var_lval(Var, BodyLval, !Info),

        ml_gen_convert_headvars(ArgTuples, CopiedOutputVars, Context,
            LocalVarDefnsTail, InputStmtsTail, OutputStmtsTail, !Info),

        % Add the code to convert this input or output.
        ml_gen_info_get_byref_output_vars(!.Info, ByRefOutputVars),
        ( if
            ( set_of_var.member(ByRefOutputVars, Var)
            ; list.member(Var, CopiedOutputVars)
            )
        then
            InputStmts = InputStmtsTail,
            OutputStmts = OutputStmtsTail ++ ConvOutputStmts
        else
            InputStmts = ConvInputStmts ++ InputStmtsTail,
            OutputStmts = OutputStmtsTail
        ),
        LocalVarDefns = ConvLocalVarDefns ++ LocalVarDefnsTail
    ).

:- pred ml_gen_local_var_defns_for_copied_output_vars(ml_gen_info::in,
    prog_context::in, list(var_mvar_type_mode)::in, list(prog_var)::in,
    list(mlds_local_var_defn)::out, ml_gen_info::in, ml_gen_info::out) is det.

ml_gen_local_var_defns_for_copied_output_vars(Info, Context, ArgTuples,
        CopiedOutputVars, OutputVarLocalDefns, !Info) :-
    % We could generate all the local variables at the top of the function.
    % But instead, we now generate them locally for each goal.
    % We just declare the `succeeded' var here, plus locals
    % for any output arguments that are returned by value
    % (e.g. if --nondet-copy-out is enabled, or for det function
    % return values).
    (
        CopiedOutputVars = [],
        % Optimize common case.
        OutputVarLocalDefns = []
    ;
        CopiedOutputVars = [_ | _],
        ml_gen_info_get_var_table(Info, VarTable0),
        % Note that for headvars, we must use the types from
        % the procedure interface, not from the procedure body.
        OverrideHeadVarType =
            ( pred(AT::in, Table0::in, Table::out) is det :-
                AT = var_mvar_type_mode(HV, _, HT, _),
                lookup_var_entry(Table0, HV, Entry0),
                Entry = Entry0 ^ vte_type := HT,
                update_var_entry(HV, Entry, Table0, Table)
            ),
        list.foldl(OverrideHeadVarType, ArgTuples, VarTable0, VarTable1),
        ml_gen_local_var_decls(VarTable1, Context,
            CopiedOutputVars, OutputVarLocalDefns, !Info)
    ).

:- pred ml_gen_maybe_local_var_defn_for_succeeded(ml_gen_info::in,
    prog_context::in, list(mlds_local_var_defn)::out) is det.

ml_gen_maybe_local_var_defn_for_succeeded(Info, Context, SucceededVarDefns) :-
    ml_gen_info_get_used_succeeded_var(Info, UsedSucceededVar),
    (
        UsedSucceededVar = no,
        SucceededVarDefns = []
    ;
        UsedSucceededVar = yes,
        SucceededVarDefns = [ml_gen_succeeded_var_decl(Context)]
    ).

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

:- type maybe_contains_nested_funcs
    --->    does_not_contain_nested_funcs
    ;       contains_nested_funcs.

:- pred does_stmt_contain_nested_func_defn(mlds_stmt::in,
    maybe_contains_nested_funcs::in, maybe_contains_nested_funcs::out) is det.

does_stmt_contain_nested_func_defn(Stmt, !ContainsNestedFuncs) :-
    (
        Stmt = ml_stmt_block(_LocalVarDefns, FuncDefns, SubStmts, _Context),
        (
            FuncDefns = [],
            list.foldl(does_stmt_contain_nested_func_defn, SubStmts,
                !ContainsNestedFuncs)
        ;
            FuncDefns = [_ | _],
            !:ContainsNestedFuncs = contains_nested_funcs
        )
    ;
        Stmt = ml_stmt_while(_LoopKind, _CondRval, SubStmt, _LoopLocalVars,
            _Context),
        does_stmt_contain_nested_func_defn(SubStmt, !ContainsNestedFuncs)
    ;
        Stmt = ml_stmt_if_then_else(_CondRval, ThenStmt, MaybeElseStmt,
            _Context),
        does_stmt_contain_nested_func_defn(ThenStmt, !ContainsNestedFuncs),
        (
            MaybeElseStmt = no
        ;
            MaybeElseStmt = yes(ElseStmt),
            does_stmt_contain_nested_func_defn(ElseStmt, !ContainsNestedFuncs)
        )
    ;
        Stmt = ml_stmt_switch(_Type, _Rval, _Range, Cases, Default, _Context),
        list.foldl(does_case_contain_nested_func_defn, Cases,
            !ContainsNestedFuncs),
        (
            Default = default_is_unreachable
        ;
            Default = default_do_nothing
        ;
            Default = default_case(DefaultStmt),
            does_stmt_contain_nested_func_defn(DefaultStmt,
                !ContainsNestedFuncs)
        )
    ;
        Stmt = ml_stmt_try_commit(_Lval, GoalStmt, HandlerStmt, _Context),
        does_stmt_contain_nested_func_defn(GoalStmt, !ContainsNestedFuncs),
        does_stmt_contain_nested_func_defn(HandlerStmt, !ContainsNestedFuncs)
    ;
        ( Stmt = ml_stmt_label(_Label, _Context)
        ; Stmt = ml_stmt_goto(_Target, _Context)
        ; Stmt = ml_stmt_computed_goto(_Rval, _Targets, _Context)
        ; Stmt = ml_stmt_call(_Sig, _Callee, _Args, _Ret, _Kind, _Context)
        ; Stmt = ml_stmt_return(_RetVals, _Context)
        ; Stmt = ml_stmt_do_commit(_Rval, _Context)
        ; Stmt = ml_stmt_atomic(_Atomic, _Context)
        )
    ).

:- pred does_case_contain_nested_func_defn(mlds_switch_case::in,
    maybe_contains_nested_funcs::in, maybe_contains_nested_funcs::out) is det.

does_case_contain_nested_func_defn(Case, !ContainsNestedFuncs) :-
    Case = mlds_switch_case(_FirstCond, _LaterConds, Stmt),
    does_stmt_contain_nested_func_defn(Stmt, !ContainsNestedFuncs).

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

:- pred describe_pred_proc_ids(module_info::in, string::in,
    set(pred_proc_id)::in, list(mlds_stmt)::in, list(mlds_stmt)::out) is det.
:- pragma consider_used(pred(describe_pred_proc_ids/5)).

describe_pred_proc_ids(ModuleInfo, Msg, PredProcIds, !StartCommentStmts) :-
    MsgStmt = ml_stmt_atomic(comment(Msg), dummy_context),
    DescStmts = list.map(pred_proc_id_desc(ModuleInfo),
        set.to_sorted_list(PredProcIds)),
    !:StartCommentStmts = !.StartCommentStmts ++ [MsgStmt | DescStmts].

:- func pred_proc_id_desc(module_info, pred_proc_id) = mlds_stmt.

pred_proc_id_desc(ModuleInfo, PredProcId) = DescStmt :-
    Comment = "  " ++ describe_proc_from_id(include_module_name,
        ModuleInfo, PredProcId),
    DescStmt = ml_stmt_atomic(comment(Comment), dummy_context).

%---------------------------------------------------------------------------%
:- end_module ml_backend.ml_proc_gen.
%---------------------------------------------------------------------------%
