mercury/compiler/untupling.m

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2012 The University of Melbourne.
% Copyright (C) 2014-2016, 2018-2025 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: untupling.m.
% Author: wangp.
%
% This module takes the HLDS and transforms the locally-defined procedures as
% follows. If a formal parameter of a procedure has a type that has only
% a single function symbol (i.e. it is a kind of tuple), then it replaces
% the parameter holding the tuple with one parameter for each field of the
% tuple. If some of those fields also have types that have only one function
% symbol, it expand them as well. It recurses until it has expanded the
% argument list as deeply as possible, yielding a parameter list that has
% *no* arguments of such tuple-like types. We call such parameter lists "flat",
% because they have no expandable structure (at least no structure that is
% expandable by this module).
%
% For example, for the following predicate and types,
%
%   :- type t ---> t(u).
%   :- type u ---> u(v, w).
%   :- type v ---> v1 ; v2.
%   :- type w ---> w(int, string).
%
%   :- pred f(t::in) is det.
%   f(T) :- blah.
%
% we would generate this transformed version of f/1:
%
%   :- pred f_untupled(v::in, int::in, string::in) is det.
%   f_untupled(V, W1, W2) :- blah.
%
% The first pass creates transformed versions for all the procedures
% whose argument lists weren't already flat already.
% The second pass then replaces all the calls in the module which refer
% to the old procedures with calls to their transformed versions.
% It does this by adding deconstruction and construction unifications
% as needed, which can later be simplified by a simplification pass.
% (This module does not itself invoke simplification, because we expect that
% the HLDS it generates will be subject to further optimization passes;
% simplification *will* be called by the target backend before it starts
% code generation.)
%
% For example, we transform this code, which calls the predicate above,
%
%   :- pred g(T::in) is det.
%   g(_) :-
%       A = 1,
%       B = "foo",
%       C = w(A, B),
%       D = v1,
%       E = u(D, C),
%       F = t(E),
%       f(F).
%
% to this:
%
%   g(_) :-
%       A = 1,
%       B = "foo",
%       C = w(A, B),
%       D = v1,
%       E = u(D, C),
%       F = t(E),
%       F = t(G),   % added deconstructions
%       G = u(H, I),
%       I = w(J, K),
%       f_untupled(H, J, K).
%
% which, after simplification, should become:
%
%   g(_) :-
%       A = 1,
%       B = "foo",
%       D = v1,
%       f_untupled(D, A, B).
%
% Limitations:
%
% - When a formal parameter is expanded, both the parameter's type and mode
%   have to be expanded. Currently only arguments with in and out modes can
%   be expanded, as I don't know how to do it for the general case.
%   It should be enough for the majority of code.
%
% - Some predicates may or may not be expandable but won't be right now,
%   because I don't understand the features they use (see expand_args_in_pred
%   below).
%
% Julien says: "it should be possible for this transformation to work across
% module boundaries by exporting the goal templates [search for CallAux
% below] in the `.opt' files."
%
%-----------------------------------------------------------------------------%

:- module transform_hlds.untupling.
:- interface.

:- import_module hlds.
:- import_module hlds.hlds_module.

:- pred untuple_arguments(module_info::in, module_info::out) is det.

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

:- implementation.

:- import_module check_hlds.
:- import_module check_hlds.recompute_instmap_deltas.
:- import_module check_hlds.type_util.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_proc_util.
:- import_module hlds.make_goal.
:- import_module hlds.pred_name.
:- import_module hlds.quantification.
:- import_module hlds.status.
:- import_module hlds.var_table_hlds.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_type_test.
:- import_module parse_tree.var_table.

:- import_module bool.
:- import_module counter.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module one_or_more.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module term_context.
:- import_module varset.

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

    % The transform_map structure records which procedures were
    % transformed into what procedures during the first pass.
    %
:- type transform_map == map(pred_proc_id, transformed_proc).

:- type transformed_proc
    --->    transformed_proc(
                % A procedure that was generated by the untupling
                % transformation.
                pred_proc_id,

                % A call goal template that is used to update calls
                % referring to the old procedure to the new procedure.
                hlds_goal
            ).

untuple_arguments(!ModuleInfo) :-
    expand_args_in_module(!ModuleInfo, TransformMap),
    fix_calls_to_expanded_procs(TransformMap, !ModuleInfo).

%-----------------------------------------------------------------------------%
%
% Pass 1.
%

    % This is the top level of the first pass. It expands procedure arguments
    % where possible, adding new versions of the transformed procedures
    % into the module and recording the mapping between the old and new
    % procedures in the transform map.
    %
:- pred expand_args_in_module(module_info::in, module_info::out,
    transform_map::out) is det.

expand_args_in_module(!ModuleInfo, TransformMap) :-
    module_info_get_valid_pred_ids(!.ModuleInfo, PredIds),
    list.foldl3(expand_args_in_pred, PredIds,
        !ModuleInfo, map.init, TransformMap, counter.init(0), _).

:- pred expand_args_in_pred(pred_id::in, module_info::in, module_info::out,
    transform_map::in, transform_map::out, counter::in, counter::out) is det.

expand_args_in_pred(PredId, !ModuleInfo, !TransformMap, !Counter) :-
    module_info_get_type_table(!.ModuleInfo, TypeTable),
    module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
    ( if
        % Only perform the transformation on predicates which
        % satisfy the following criteria.
        pred_info_get_status(PredInfo, PredStatus),
        pred_status_defined_in_this_module(PredStatus) = yes,
        pred_info_get_goal_type(PredInfo,
            goal_not_for_promise(np_goal_type_clause)),
        % Some of these limitations may be able to be lifted later.
        % For now, take the safe option and don't touch them.
        pred_info_get_exist_quant_tvars(PredInfo, []),
        pred_info_get_external_type_params(PredInfo, []),
        pred_info_get_class_context(PredInfo, univ_exist_constraints([], [])),
        pred_info_get_origin(PredInfo, Origin),
        Origin = origin_user(user_made_pred(_, _, _)),
        pred_info_get_arg_types(PredInfo, TypeVarSet, ExistQVars, ArgTypes),
        varset.is_empty(TypeVarSet),
        ExistQVars = [],
        at_least_one_expandable_type(ArgTypes, TypeTable)
    then
        ProcIds = pred_info_all_non_imported_procids(PredInfo),
        list.foldl3(expand_args_in_proc(PredId), ProcIds,
            !ModuleInfo, !TransformMap, !Counter)
    else
        true
    ).

:- pred at_least_one_expandable_type(list(mer_type)::in, type_table::in)
    is semidet.

at_least_one_expandable_type([Type | Types], TypeTable) :-
    ( expand_type(Type, [], TypeTable, expansion(_, _))
    ; at_least_one_expandable_type(Types, TypeTable)
    ).

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

    % This structure records the mapping between a head variable of the
    % original procedure, and the list of variables that it was finally
    % expanded into. If the head variable expands into some intermediate
    % variables which are then expanded further, the intermediate
    % variables are not listed in the mapping.
    %
:- type untuple_map == map(prog_var, list(prog_var)).

:- pred expand_args_in_proc(pred_id::in, proc_id::in, module_info::in,
    module_info::out, transform_map::in, transform_map::out,
    counter::in, counter::out) is det.

expand_args_in_proc(PredId, ProcId, !ModuleInfo, !TransformMap, !Counter) :-
    some [!ProcInfo] (
        module_info_get_type_table(!.ModuleInfo, TypeTable),
        module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
            PredInfo0, !:ProcInfo),

        proc_info_get_headvars(!.ProcInfo, HeadVars0),
        proc_info_get_argmodes(!.ProcInfo, ArgModes0),
        proc_info_get_goal(!.ProcInfo, Goal0),
        proc_info_get_var_table(!.ProcInfo, VarTable0),

        expand_args_in_proc_2(!.ModuleInfo, TypeTable, HeadVars0, ArgModes0,
            HeadVars, ArgModes, Goal0, Goal, UntupleMap, VarTable0, VarTable),

        proc_info_set_headvars(HeadVars, !ProcInfo),
        proc_info_set_argmodes(ArgModes, !ProcInfo),
        proc_info_set_goal(Goal, !ProcInfo),
        proc_info_set_var_table(VarTable, !ProcInfo),
        requantify_proc_general(ord_nl_no_lambda, !ProcInfo),
        recompute_instmap_delta_proc(recomp_atomics, !ProcInfo, !ModuleInfo),

        counter.allocate(SeqNum, !Counter),
        create_untupling_aux_pred(PredId, ProcId, PredInfo0, !.ProcInfo,
            SeqNum, AuxPredId, AuxProcId, CallAux,
            AuxPredInfo, AuxProcInfo0, !ModuleInfo),
        proc_info_set_maybe_untuple_info(
            yes(untuple_proc_info(UntupleMap)),
            AuxProcInfo0, AuxProcInfo),
        module_info_set_pred_proc_info(AuxPredId, AuxProcId,
            AuxPredInfo, AuxProcInfo, !ModuleInfo),
        map.det_insert(proc(PredId, ProcId),
            transformed_proc(proc(AuxPredId, AuxProcId), CallAux),
            !TransformMap)
    ).

:- pred expand_args_in_proc_2(module_info::in, type_table::in,
    list(prog_var)::in, list(mer_mode)::in,
    list(prog_var)::out, list(mer_mode)::out, hlds_goal::in, hlds_goal::out,
    untuple_map::out, var_table::in, var_table::out) is det.

expand_args_in_proc_2(ModuleInfo, TypeTable, HeadVars0, ArgModes0,
        HeadVars, ArgModes, Goal0, Goal, UntupleMap, !VarTable) :-
    expand_args_in_proc_3(ModuleInfo, TypeTable, [],
        HeadVars0, ArgModes0, ListOfHeadVars, ListOfArgModes,
        Goal0, hlds_goal(GoalExpr, GoalInfo1), !VarTable),
    Context = goal_info_get_context(Goal0 ^ hg_info),
    goal_info_set_context(Context, GoalInfo1, GoalInfo),
    Goal = hlds_goal(GoalExpr, GoalInfo),
    list.condense(ListOfHeadVars, HeadVars),
    list.condense(ListOfArgModes, ArgModes),
    build_untuple_map(HeadVars0, ListOfHeadVars, map.init, UntupleMap).

:- pred expand_args_in_proc_3(module_info::in, type_table::in,
    list(mer_type)::in, list(prog_var)::in, list(mer_mode)::in,
    list(list(prog_var))::out, list(list(mer_mode))::out,
    hlds_goal::in, hlds_goal::out, var_table::in, var_table::out) is det.

expand_args_in_proc_3(_, _, _, [], [], [], [], !Goal, !VarTable).
expand_args_in_proc_3(_, _, _, [], [_ | _], _, _, !Goal, !VarTable) :-
    unexpected($pred, "length mismatch").
expand_args_in_proc_3(_, _, _, [_ | _], [], _, _, !Goal, !VarTable) :-
    unexpected($pred, "length mismatch").
expand_args_in_proc_3(ModuleInfo, TypeTable, ContainerTypes,
        [HeadVar0 | HeadVars0], [ArgMode0 | ArgModes0],
        [HeadVar | HeadVars], [ArgMode | ArgModes], !Goal, !VarTable) :-
    expand_one_arg_in_proc(ModuleInfo, TypeTable, ContainerTypes,
        HeadVar0, ArgMode0, HeadVar, ArgMode, !Goal, !VarTable),
    expand_args_in_proc_3(ModuleInfo, TypeTable, ContainerTypes,
        HeadVars0, ArgModes0, HeadVars, ArgModes, !Goal, !VarTable).

:- pred expand_one_arg_in_proc(module_info::in, type_table::in,
    list(mer_type)::in, prog_var::in, mer_mode::in, list(prog_var)::out,
    list(mer_mode)::out, hlds_goal::in, hlds_goal::out,
    var_table::in, var_table::out) is det.

expand_one_arg_in_proc(ModuleInfo, TypeTable, ContainerTypes0,
        HeadVar0, ArgMode0, HeadVars, ArgModes, !Goal, !VarTable) :-
    expand_one_arg_in_proc_2(ModuleInfo, TypeTable, HeadVar0, ArgMode0,
        MaybeHeadVarsAndArgModes, !Goal, !VarTable,
        ContainerTypes0, ContainerTypes),
    (
        MaybeHeadVarsAndArgModes = yes(HeadVars1 - ArgModes1),
        expand_args_in_proc_3(ModuleInfo, TypeTable, ContainerTypes,
            HeadVars1, ArgModes1, ListOfHeadVars, ListOfArgModes,
            !Goal, !VarTable),
        HeadVars = list.condense(ListOfHeadVars),
        ArgModes = list.condense(ListOfArgModes)
    ;
        MaybeHeadVarsAndArgModes = no,
        HeadVars = [HeadVar0],
        ArgModes = [ArgMode0]
    ).

:- pred expand_one_arg_in_proc_2(module_info::in, type_table::in,
    prog_var::in, mer_mode::in,
    maybe(pair(list(prog_var), list(mer_mode)))::out,
    hlds_goal::in, hlds_goal::out, var_table::in, var_table::out,
    list(mer_type)::in, list(mer_type)::out) is det.

expand_one_arg_in_proc_2(ModuleInfo, TypeTable, HeadVar0, ArgMode0,
        MaybeHeadVarsAndArgModes, !Goal, !VarTable,
        ContainerTypes0, ContainerTypes) :-
    lookup_var_type(!.VarTable, HeadVar0, Type),
    expand_argument(ArgMode0, Type, ContainerTypes0, TypeTable, Expansion),
    (
        Expansion = expansion(ConsId, NewTypes),
        ParentName = var_table_entry_name(!.VarTable, HeadVar0),
        create_untuple_vars(ModuleInfo, ParentName, 0, NewTypes, NewHeadVars,
            !VarTable),
        list.duplicate(list.length(NewHeadVars), ArgMode0, NewArgModes),
        MaybeHeadVarsAndArgModes = yes(NewHeadVars - NewArgModes),
        ( if ArgMode0 = in_mode then
            construct_functor(HeadVar0, ConsId, NewHeadVars, UnifGoal),
            conjoin_goals_keep_detism(UnifGoal, !Goal)
        else if ArgMode0 = out_mode then
            deconstruct_functor(HeadVar0, ConsId, NewHeadVars, UnifGoal),
            conjoin_goals_keep_detism(!.Goal, UnifGoal, !:Goal)
        else
            unexpected($pred, "unsupported mode")
        ),
        ContainerTypes = [Type | ContainerTypes0]
    ;
        Expansion = no_expansion,
        MaybeHeadVarsAndArgModes = no,
        ContainerTypes = ContainerTypes0
    ).

:- pred create_untuple_vars(module_info::in, string::in, int::in,
    list(mer_type)::in, list(prog_var)::out,
    var_table::in, var_table::out) is det.

create_untuple_vars(_, _, _, [], [], !VarTable).
create_untuple_vars(ModuleInfo, ParentName, Num,
        [Type | Types], [NewVar | NewVars], !VarTable) :-
    string.format("Untupled_%s_%d", [s(ParentName), i(Num)], Name),
    IsDummy = is_type_a_dummy(ModuleInfo, Type),
    Entry = vte(Name, Type, IsDummy),
    add_var_entry(Entry, NewVar, !VarTable),
    create_untuple_vars(ModuleInfo, ParentName, Num + 1,
        Types, NewVars, !VarTable).

:- pred conjoin_goals_keep_detism(hlds_goal::in, hlds_goal::in,
    hlds_goal::out) is det.

conjoin_goals_keep_detism(GoalA, GoalB, Goal) :-
    goal_to_conj_list(GoalA, GoalListA),
    goal_to_conj_list(GoalB, GoalListB),
    GoalList = GoalListA ++ GoalListB,
    goal_list_determinism(GoalList, Determinism),
    goal_info_init(GoalInfo0),
    goal_info_set_determinism(Determinism, GoalInfo0, GoalInfo),
    Goal = hlds_goal(conj(plain_conj, GoalList), GoalInfo).

:- pred build_untuple_map(list(prog_var)::in, list(list(prog_var))::in,
    untuple_map::in, untuple_map::out) is det.

build_untuple_map([], [], !UntupleMap).
build_untuple_map([], [_| _], !_) :-
    unexpected($pred, "length mismatch").
build_untuple_map([_| _], [], !_) :-
    unexpected($pred, "length mismatch").
build_untuple_map([OldVar | OldVars], [NewVars | NewVarss], !UntupleMap) :-
    ( if NewVars = [OldVar] then
        build_untuple_map(OldVars, NewVarss, !UntupleMap)
    else
        map.det_insert(OldVar, NewVars, !UntupleMap),
        build_untuple_map(OldVars, NewVarss, !UntupleMap)
    ).

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

    % This predicate makes a new version of the given procedure in a module.
    % Amongst other things the new procedure is given a new pred_id and
    % proc_id, a new name and a new goal.
    %
    % CallAux is an output variable, which is unified with a goal that
    % can be used as a template for constructing calls to the newly
    % created procedure.
    %
    % See also create_loop_inv_aux_pred in loop_inv.m.
    %
:- pred create_untupling_aux_pred(pred_id::in, proc_id::in, pred_info::in,
    proc_info::in, int::in, pred_id::out, proc_id::out, hlds_goal::out,
    pred_info::out, proc_info::out, module_info::in, module_info::out) is det.

create_untupling_aux_pred(PredId, ProcId, PredInfo, ProcInfo, SeqNum,
        AuxPredId, AuxProcId, CallAux, AuxPredInfo, AuxProcInfo,
        !ModuleInfo) :-
    proc_info_get_headvars(ProcInfo, AuxHeadVars),
    proc_info_get_goal(ProcInfo, Goal @ hlds_goal(_GoalExpr, GoalInfo)),
    proc_info_get_initial_instmap(!.ModuleInfo, ProcInfo, InitialAuxInstMap),
    pred_info_get_typevarset(PredInfo, TVarSet),
    proc_info_get_var_table(ProcInfo, VarTable),
    pred_info_get_class_context(PredInfo, ClassContext),
    proc_info_get_rtti_varmaps(ProcInfo, RttiVarMaps),
    proc_info_get_inst_varset(ProcInfo, InstVarSet),
    pred_info_get_markers(PredInfo, Markers),
    pred_info_get_origin(PredInfo, OrigOrigin),
    proc_info_get_has_parallel_conj(ProcInfo, HasParallelConj),
    pred_info_get_var_name_remap(PredInfo, VarNameRemap),

    PredModule = pred_info_module(PredInfo),
    PredName = pred_info_name(PredInfo),
    PredOrFunc = pred_info_is_pred_or_func(PredInfo),
    proc_id_to_int(ProcId, ProcNum),
    Context = goal_info_get_context(GoalInfo),
    LineNum = term_context.context_line(Context),
    Transform = tn_untupling(PredOrFunc, ProcNum, lnc(LineNum, SeqNum)),
    make_transformed_pred_sym_name(PredModule, PredName, Transform,
        AuxPredSymName),

    ProcTransform = proc_transform_untuple(LineNum, SeqNum),
    Origin = origin_proc_transform(ProcTransform, OrigOrigin, PredId, ProcId),
    hlds_pred.define_new_pred(AuxPredSymName, Origin, TVarSet, InstVarSet,
        VarTable, RttiVarMaps, ClassContext, InitialAuxInstMap, VarNameRemap,
        Markers, address_is_not_taken, HasParallelConj,
        AuxPredProcId, AuxHeadVars, _ExtraArgs, Goal, CallAux, !ModuleInfo),
    AuxPredProcId = proc(AuxPredId, AuxProcId),

    module_info_pred_proc_info(!.ModuleInfo, AuxPredId, AuxProcId,
        AuxPredInfo, AuxProcInfo).

%-----------------------------------------------------------------------------%
%
% Pass 2.
%

    % This is the top level of the second pass. It takes the transform map
    % built during the first pass as input. For every call to a procedure
    % in the transform map, it rewrites the call to use the new procedure
    % instead, inserting unifications before and after the call as necessary.
    %
:- pred fix_calls_to_expanded_procs(transform_map::in,
    module_info::in, module_info::out) is det.

fix_calls_to_expanded_procs(TransformMap, !ModuleInfo) :-
    module_info_get_valid_pred_ids(!.ModuleInfo, PredIds),
    list.foldl(fix_calls_in_pred(TransformMap), PredIds, !ModuleInfo).

:- pred fix_calls_in_pred(transform_map::in, pred_id::in,
    module_info::in, module_info::out) is det.

fix_calls_in_pred(TransformMap, PredId, !ModuleInfo) :-
    module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
    ProcIds = pred_info_all_non_imported_procids(PredInfo),
    list.foldl(fix_calls_in_proc(TransformMap, PredId), ProcIds, !ModuleInfo).

:- pred fix_calls_in_proc(transform_map::in, pred_id::in, proc_id::in,
    module_info::in, module_info::out) is det.

fix_calls_in_proc(TransformMap, PredId, ProcId, !ModuleInfo) :-
    some [!ProcInfo] (
        module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
            PredInfo, !:ProcInfo),
        proc_info_get_goal(!.ProcInfo, Goal0),
        proc_info_get_var_table(!.ProcInfo, VarTable0),
        fix_calls_in_goal(!.ModuleInfo, TransformMap,
            Goal0, Goal, VarTable0, VarTable),
        ( if Goal0 = Goal then
            true
        else
            proc_info_set_goal(Goal, !ProcInfo),
            proc_info_set_var_table(VarTable, !ProcInfo),
            requantify_proc_general(ord_nl_no_lambda, !ProcInfo),
            recompute_instmap_delta_proc(recomp_atomics,
                !ProcInfo, !ModuleInfo),
            module_info_set_pred_proc_info(PredId, ProcId,
                PredInfo, !.ProcInfo, !ModuleInfo)
        )
    ).

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

:- pred fix_calls_in_goal(module_info::in, transform_map::in,
    hlds_goal::in, hlds_goal::out, var_table::in, var_table::out) is det.

fix_calls_in_goal(ModuleInfo, TransformMap, Goal0, Goal, !VarTable) :-
    Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
    (
        ( GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
        ; GoalExpr0 = generic_call(_, _, _, _, _)
        ; GoalExpr0 = unify(_, _, _, _, _)
        ),
        Goal = Goal0
    ;
        GoalExpr0 = plain_call(CalleePredId, CalleeProcId, OrigArgs, _, _, _),
        ( if
            map.search(TransformMap, proc(CalleePredId, CalleeProcId),
                transformed_proc(_, hlds_goal(CallAux0, CallAuxInfo)))
        then
            module_info_get_type_table(ModuleInfo, TypeTable),
            module_info_pred_proc_info(ModuleInfo, CalleePredId,
                CalleeProcId, _CalleePredInfo, CalleeProcInfo),
            proc_info_get_argmodes(CalleeProcInfo, OrigArgModes),
            expand_call_args(ModuleInfo, TypeTable, OrigArgs, OrigArgModes,
                Args, EnterUnifs, ExitUnifs, !VarTable),
            ( if CallAux = CallAux0 ^ call_args := Args then
                Call = hlds_goal(CallAux, CallAuxInfo),
                ConjList = EnterUnifs ++ [Call] ++ ExitUnifs,
                conj_list_to_goal(ConjList, GoalInfo0, Goal)
            else
                unexpected($pred, "not a call template")
            )
        else
            Goal = hlds_goal(GoalExpr0, GoalInfo0)
        )
    ;
        GoalExpr0 = negation(SubGoal0),
        fix_calls_in_goal(ModuleInfo, TransformMap, SubGoal0, SubGoal,
            !VarTable),
        GoalExpr = negation(SubGoal),
        Goal = hlds_goal(GoalExpr, GoalInfo0)
    ;
        GoalExpr0 = scope(Reason, SubGoal0),
        ( if
            Reason = from_ground_term(_, FGT),
            ( FGT = from_ground_term_construct
            ; FGT = from_ground_term_deconstruct
            )
        then
            % There are no calls in these scopes.
            Goal = Goal0
        else
            fix_calls_in_goal(ModuleInfo, TransformMap, SubGoal0, SubGoal,
                !VarTable),
            GoalExpr = scope(Reason, SubGoal),
            Goal = hlds_goal(GoalExpr, GoalInfo0)
        )
    ;
        GoalExpr0 = conj(ConjType, Goals0),
        (
            ConjType = plain_conj,
            fix_calls_in_conj(ModuleInfo, TransformMap, Goals0, Goals,
                !VarTable)
        ;
            ConjType = parallel_conj,
            % I am not sure whether parallel conjunctions should be treated
            % with fix_calls_in_goal or fix_calls_in_goal_list. At any rate,
            % this is untested.
            fix_calls_in_goals(ModuleInfo, TransformMap, Goals0, Goals,
                !VarTable)
        ),
        GoalExpr = conj(ConjType, Goals),
        Goal = hlds_goal(GoalExpr, GoalInfo0)
    ;
        GoalExpr0 = disj(Goals0),
        fix_calls_in_goals(ModuleInfo, TransformMap, Goals0, Goals, !VarTable),
        GoalExpr = disj(Goals),
        Goal = hlds_goal(GoalExpr, GoalInfo0)
    ;
        GoalExpr0 = switch(Var, CanFail, Cases0),
        fix_calls_in_cases(ModuleInfo, TransformMap, Cases0, Cases, !VarTable),
        GoalExpr = switch(Var, CanFail, Cases),
        Goal = hlds_goal(GoalExpr, GoalInfo0)
    ;
        GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
        fix_calls_in_goal(ModuleInfo, TransformMap, Cond0, Cond, !VarTable),
        fix_calls_in_goal(ModuleInfo, TransformMap, Then0, Then, !VarTable),
        fix_calls_in_goal(ModuleInfo, TransformMap, Else0, Else, !VarTable),
        GoalExpr = if_then_else(Vars, Cond, Then, Else),
        Goal = hlds_goal(GoalExpr, GoalInfo0)
    ;
        GoalExpr0 = shorthand(_),
        % These should have been expanded out by now.
        unexpected($pred, "shorthand")
    ).

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

:- pred fix_calls_in_conj(module_info::in, transform_map::in,
    list(hlds_goal)::in, list(hlds_goal)::out,
    var_table::in, var_table::out) is det.

fix_calls_in_conj(_, _, [], [], !VarTable).
fix_calls_in_conj(ModuleInfo, TransformMap,
        [Goal0 | Goals0], Goals, !VarTable) :-
    fix_calls_in_goal(ModuleInfo, TransformMap, Goal0, Goal1, !VarTable),
    fix_calls_in_conj(ModuleInfo, TransformMap, Goals0, Goals1, !VarTable),
    ( if Goal1 = hlds_goal(conj(plain_conj, ConjGoals), _) then
        Goals = ConjGoals ++ Goals1
    else
        Goals = [Goal1 | Goals1]
    ).

:- pred fix_calls_in_goals(module_info::in, transform_map::in,
    list(hlds_goal)::in, list(hlds_goal)::out,
    var_table::in, var_table::out) is det.

fix_calls_in_goals(_, _, [], [], !VarTable).
fix_calls_in_goals(ModuleInfo, TransformMap,
        [Goal0 | Goals0], [Goal | Goals], !VarTable) :-
    fix_calls_in_goal(ModuleInfo, TransformMap, Goal0, Goal, !VarTable),
    fix_calls_in_goals(ModuleInfo, TransformMap, Goals0, Goals, !VarTable).

:- pred fix_calls_in_cases(module_info::in, transform_map::in,
    list(case)::in, list(case)::out, var_table::in, var_table::out) is det.

fix_calls_in_cases(_, _, [], [], !VarTable).
fix_calls_in_cases(ModuleInfo, TransformMap,
        [Case0 | Cases0], [Case | Cases], !VarTable) :-
    Case0 = case(MainConsId, OtherConsIds, Goal0),
    fix_calls_in_goal(ModuleInfo, TransformMap, Goal0, Goal, !VarTable),
    Case = case(MainConsId, OtherConsIds, Goal),
    fix_calls_in_cases(ModuleInfo, TransformMap, Cases0, Cases, !VarTable).

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

:- pred expand_call_args(module_info::in, type_table::in,
    list(prog_var)::in, list(mer_mode)::in,
    list(prog_var)::out, list(hlds_goal)::out, list(hlds_goal)::out,
    var_table::in, var_table::out) is det.

expand_call_args(ModuleInfo, TypeTable, ArgVars0, ArgModes0, ArgVars,
        EnterUnifs, ExitUnifs, !VarTable) :-
    expand_call_args_2(ModuleInfo, TypeTable, [], ArgVars0, ArgModes0, ArgVars,
        EnterUnifs, ExitUnifs, !VarTable).

:- pred expand_call_args_2(module_info::in, type_table::in, list(mer_type)::in,
    list(prog_var)::in, list(mer_mode)::in,
    list(prog_var)::out, list(hlds_goal)::out, list(hlds_goal)::out,
    var_table::in, var_table::out) is det.

expand_call_args_2(_, _, _, [], [], [], [], [], !VarTable).
expand_call_args_2(_, _, _, [], [_ | _], _, _, _, !VarTable) :-
    unexpected($pred, "length mismatch").
expand_call_args_2(_, _, _, [_ | _], [], _, _, _, !VarTable) :-
    unexpected($pred, "length mismatch").
expand_call_args_2(ModuleInfo, TypeTable, ContainerTypes0,
        [ArgVar0 | ArgVars0], [ArgMode | ArgModes], ArgVars,
        EnterUnifs, ExitUnifs, !VarTable) :-
    lookup_var_type(!.VarTable, ArgVar0, Arg0Type),
    expand_argument(ArgMode, Arg0Type, ContainerTypes0, TypeTable, Expansion),
    (
        Expansion = expansion(ConsId, Types),
        list.length(Types, NumVars),
        create_fresh_vars(ModuleInfo, Types, ReplacementArgVars, !VarTable),
        list.duplicate(NumVars, ArgMode, ReplacementModes),
        ContainerTypes = [Arg0Type | ContainerTypes0],
        ( if ArgMode = in_mode then
            deconstruct_functor(ArgVar0, ConsId, ReplacementArgVars, Unif),
            EnterUnifs = [Unif | EnterUnifs1],
            expand_call_args_2(ModuleInfo, TypeTable, ContainerTypes,
                ReplacementArgVars ++ ArgVars0, ReplacementModes ++ ArgModes,
                ArgVars, EnterUnifs1, ExitUnifs, !VarTable)
        else if ArgMode = out_mode then
            construct_functor(ArgVar0, ConsId, ReplacementArgVars, Unif),
            ExitUnifs = ExitUnifs1 ++ [Unif],
            expand_call_args_2(ModuleInfo, TypeTable, ContainerTypes,
                ReplacementArgVars ++ ArgVars0, ReplacementModes ++ ArgModes,
                ArgVars, EnterUnifs, ExitUnifs1, !VarTable)
        else
            unexpected($pred, "unsupported mode")
        )
    ;
        Expansion = no_expansion,
        expand_call_args(ModuleInfo, TypeTable, ArgVars0, ArgModes, ArgVars1,
            EnterUnifs, ExitUnifs, !VarTable),
        ArgVars = [ArgVar0 | ArgVars1]
    ).

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

:- type expansion_result
    --->    expansion(
                % The cons_id of the expanded constructor.
                cons_id,

                % The types of the arguments for the expanded constructor.
                list(mer_type)
            )
    ;       no_expansion.

    % This predicate tries to expand the argument of the given mode and type.
    % If this is possible then Expansion is unified with the `expansion'
    % functor, giving the details of the expansion. Otherwise, it is
    % unified with `no_expansion'.
    %
:- pred expand_argument(mer_mode::in, mer_type::in, list(mer_type)::in,
    type_table::in, expansion_result::out) is det.

expand_argument(ArgMode, ArgType, ContainerTypes, TypeTable, Expansion) :-
    ( if expandable_arg_mode(ArgMode) then
        expand_type(ArgType, ContainerTypes, TypeTable, Expansion)
    else
        Expansion = no_expansion
    ).

    % This module so far only knows how to expand arguments which have
    % the following modes.
    %
:- pred expandable_arg_mode(mer_mode::in) is semidet.

expandable_arg_mode(in_mode).
expandable_arg_mode(out_mode).

:- pred expand_type(mer_type::in, list(mer_type)::in, type_table::in,
    expansion_result::out) is det.

expand_type(Type, ContainerTypes, TypeTable, Expansion) :-
    ( if
        % Always expand tuple types.
        type_to_ctor_and_args(Type, TypeCtor, TypeArgs),
        type_ctor_is_tuple(TypeCtor)
    then
        Arity = list.length(TypeArgs),
        ConsId = tuple_cons(Arity),
        Expansion = expansion(ConsId, TypeArgs)
    else if
        % Expand a discriminated union type if it has only a
        % single functor and the type has no parameters.
        type_to_ctor_and_args(Type, TypeCtor, []),
        search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
        get_type_defn_tparams(TypeDefn, []),
        get_type_defn_body(TypeDefn, TypeBody),
        TypeBody = hlds_du_type(TypeBodyDu),
        TypeBodyDu ^ du_type_ctors = one_or_more(SingleCtor, []),
        SingleCtor ^ cons_maybe_exist = no_exist_constraints,
        SingleCtorName = SingleCtor ^ cons_name,
        SingleCtorArgs = SingleCtor ^ cons_args,
        SingleCtorArgs = [_ | _],
        % Prevent infinite loop with recursive types.
        not list.member(Type, ContainerTypes)
    then
        Arity = list.length(SingleCtorArgs),
        ConsId = du_data_ctor(du_ctor(SingleCtorName, Arity, TypeCtor)),
        ExpandedTypes = list.map(func(C) = C ^ arg_type, SingleCtorArgs),
        Expansion = expansion(ConsId, ExpandedTypes)
    else
        Expansion = no_expansion
    ).

%-----------------------------------------------------------------------------%
:- end_module transform_hlds.untupling.
%-----------------------------------------------------------------------------%