mercury/compiler/common.m

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1995-2012 The University of Melbourne.
% Copyright (C) 2014-2017, 2019-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: common.m.
% Original author: squirrel (Jane Anna Langley).
% Other authors: fjh, zs, stayl.
%
% The main task of this module is to look for conjoined goals that involve
% the same structure (the "common" structure the module is named after),
% and to optimize those goals. The reason why we created this module was
% code like this:
%
%   X => f(A, B, C),
%   ...
%   Y <= f(A, B, C)
%
% This module replaces this code with
%
%   X => f(A, B, C),
%   ...
%   Y := X
%
% since this allocates less memory on the heap.
%
% We want to perform this optimization even if the deconstruction of X and
% the construction of Y are not in the same conjunction, but are nevertheless
% conjoined (e.g. because the construction of Y is inside an if-then-else
% or a disjunction that is inside the conjunction containing the deconstruction
% of X). We also want to do it if the two argument lists are not equal
% syntactically, but instead look like this:
%
%   X => f(A, B, C1),
%   ...
%   C2 := C1
%   ...
%   Y <= f(A, B, C2)
%
% We therefore have to keep track of pretty much all unifications in the body
% of the procedure being optimized. Since we have this information laying
% around anyway, we also use to for two other purposes. The first is
% to eliminate unnecessary tests of function symbols, replacing
%
%   X => f(A1, B1, C1),
%   ...
%   X => f(A2, B2, C2)
%
% with
%
%   X => f(A1, B1, C1),
%   ...
%   A2 := A1,
%   B2 := B1,
%   C2 := C1
%
% provided that this does not increase the number of variables that
% have to be saved across calls and other stack flushes.
%
% The other is to detect and optimize duplicate calls, replacing
%
%   p(InA, InB, OutC1, OutD1),
%   ...
%   p(InA, InB, OutC2, OutD2)
%
% with
%
%   p(InA, InB, OutC1, OutD1),
%   ...
%   OutC2 := OutC1,
%   OutD2 := OutD1
%
% Since the author probably did not mean to write duplicate calls, we also
% generate a warning for such code, if the option asking for such warnings
% is set.
%
% IMPORTANT: This module does a small subset of the job of compile-time
% garbage collection, but it does so without paying attention to uniqueness
% information, since the compiler does not yet have such information.
% Once we implement ctgc, the assumptions made by this module
% will have to be revisited.
%
% NOTE: There is another compiler module, cse_detection.m, that looks for
% unifications involving common structures in *disjoined*, not *conjoined*
% goals. Its purpose is not optimization, but the generation of more precise
% determinism information.
%
%---------------------------------------------------------------------------%

:- module check_hlds.simplify.common.
:- interface.

:- import_module check_hlds.simplify.simplify_info.
:- import_module check_hlds.simplify.simplify_tasks.
:- import_module hlds.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.

:- import_module list.
:- import_module maybe.

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

    % Assorted stuff used here that the rest of the simplify package
    % does not need to know about.
    %
:- type common_info.
:- func common_info_init(simplify_tasks) = common_info.

    % Handle the effects of an operation that causes a stack flush.
    %
:- pred common_info_stack_flush(common_info::in, common_info::out) is det.

    % If we find a construction that constructs a cell identical to one we
    % have seen before, replace the construction with an assignment from the
    % variable that already holds that cell.
    %
    % If we find a deconstruction or a construction we cannot optimize, record
    % the details of the memory cell in the updated common_info.
    %
:- pred common_optimise_unification(unify_rhs::in, unify_mode::in,
    unification::in, unify_context::in,
    hlds_goal_expr::in, hlds_goal_expr::out,
    hlds_goal_info::in, hlds_goal_info::out,
    common_info::in, common_info::out,
    simplify_info::in, simplify_info::out) is det.

    % Check whether this call has been seen before and is replaceable.
    % If it is, generate assignment unifications for the nonlocal output
    % variables (to remove the redundant call), and a warning (since the
    % programmer probably did not mean to write a redundant call).
    %
    % A call is considered replaceable if it is pure, and it has neither
    % destructive inputs nor uniquely moded outputs.
    %
:- pred common_optimise_call(pred_id::in, proc_id::in, list(prog_var)::in,
    purity::in, hlds_goal_info::in,
    hlds_goal_expr::in, maybe(hlds_goal_expr)::out,
    common_info::in, common_info::out,
    simplify_info::in, simplify_info::out) is det.

:- pred common_optimise_higher_order_call(prog_var::in, list(prog_var)::in,
    list(mer_mode)::in, determinism::in, purity::in, hlds_goal_info::in,
    hlds_goal_expr::in, maybe(hlds_goal_expr)::out,
    common_info::in, common_info::out,
    simplify_info::in, simplify_info::out) is det.

    % Succeeds if the two variables are equivalent according to the
    % information in the specified common_info.
    %
:- pred common_vars_are_equivalent(common_info::in,
    prog_var::in, prog_var::in) is semidet.

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

:- implementation.

:- import_module hlds.const_struct.
:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_markers.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_rtti.
:- import_module hlds.inst_match.
:- import_module hlds.inst_test.
:- import_module hlds.instmap.
:- import_module hlds.mode_util.
:- import_module hlds.status.
:- import_module libs.
:- import_module libs.maybe_util.
:- import_module libs.optimization_options.
:- import_module libs.options.
:- import_module parse_tree.error_spec.
:- 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 transform_hlds.
:- import_module transform_hlds.pd_cost.

:- import_module bool.
:- import_module eqvclass.
:- import_module map.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module term.

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

    % This module can implement two related family of optimizations.
    %
    % The original family of optimizations that this module was created for
    % is described in the big comment at the top of this module.
    % This family of optimizations uses the information in the
    % common_struct_info, and is enabled if and only if the common_struct_info
    % is actually present.
    %
    % The second optimization is the replacement of code that constructs
    % ground constant structure dynamically (i.e. at runtime) with code
    % that constructs that same ground term statically (i.e. at compile time).
    % It uses the const_struct_info, and is enabled if and only if
    % the const_struct_info is present. The optimization is described
    % in more detail in the comment above the definition of that type.
    %
    % All four combinations of the two structures being absent vs present
    % are legal.
    %
:- type common_info
    --->    common_info(
                maybe(common_struct_info),
                maybe(const_struct_info)
            ).

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

    % The var_eqv field records information about which sets of variables are
    % known to be equivalent, usually because they have been unified. This is
    % useful when eliminating duplicate unifications and when eliminating
    % duplicate calls.
    %
    % The all_structs and since_call_structs fields record information about
    % the memory cells available for reuse. The all_structs field has info
    % about all the cells available at the current program point. The
    % since_call_structs field contains info about the subset of these cells
    % that have been seen since the last stack flush, which is usually a call.
    %
    % The reason why we make the distinction between structs seen before the
    % last call and structs seen after is best explained by these two program
    % fragments:
    %
    % fragment 1:
    %   X => f(A1, A2, A3, A4),
    %   X => f(B1, B2, B3, B4),
    %
    % fragment 2:
    %   X => f(A1, A2, A3, A4),
    %   p(...),
    %   X => f(B1, B2, B3, B4),
    %
    % In fragment 1, we want to replace the second deconstruction with
    % the assignments B1 = A1, ... B4 = A4, since this can avoid the
    % second check of X's function symbol. (If the inst of X at the start
    % of the second unification is `bound(f(...))', we can dispense with
    % this test anyway, but if the two unifications are brought together
    % by inlining, then X's inst then may simply be `ground'.)
    %
    % In fragment 2, we don't want make the same transformation, because
    % doing so would require storing A1 ... A4 across the call instead of
    % just X.
    %
    % If the second unification were a construction instead of a
    % deconstruction, we want to make the transformation in both cases,
    % because the heap allocation we thus avoid is quite expensive,
    % and because it actually reduces the number of stack slots we need
    % across the call (X instead of A1 .. A4). The exception is
    % constructions using function symbols of arity zero, which we
    % never need to eliminate. We process unifications with constants
    % only to update our information about variable equivalences: after
    % X = c and Y = c, X and Y are equivalent.
    %
    % The seen_calls field records which calls we have seen, which we use
    % to eliminate duplicate calls.
    %
    % XXX One struct_map should be enough. It should be handled as all_structs
    % if common_struct_task = common_task_extra, and as since_call_structs
    % if common_struct_task = common_task_std.

:- type common_struct_info
    --->    common_struct_info(
                common_struct_task      :: common_struct_task,
                var_eqv                 :: eqvclass(prog_var),
                all_structs             :: struct_map,
                since_call_structs      :: struct_map,
                since_call_vars         :: set_of_progvar,
                seen_calls              :: seen_calls
            ).

:- type common_struct_task
    --->    common_task_only_eqv
            % Only record var-to-var equivalences; do not optimise
            % constructions or deconstructions.
    ;       common_task_std
            % Do optimise construction unifications as described
            % in the comment above common_struct_info, but only if
            % it does not lead to storing more variables on the stack.
    ;       common_task_extra.
            % Do optimise construction unifications as described
            % in the comment above common_struct_info, even if
            % it leads to storing more variables on the stack.

    % A struct_map maps a principal type constructor and a cons_id of that
    % type to information about cells involving that cons_id.
    %
    % The reason why we need the principal type constructors is that
    % two syntactically identical structures are guaranteed to have
    % compatible representations if and ONLY if their principal type
    % constructors are the same. For example, if we have:
    %
    %   :- type maybe_err(T) ---> ok(T) ; err(string).
    %
    %   :- pred p(maybe_err(foo)::in, maybe_err(bar)::out) is semidet.
    %   p(err(X), err(X)).
    %
    % then we want to reuse the `err(X)' in the first arg rather than
    % constructing a new copy of it for the second arg.
    % The two occurrences of `err(X)' have types `maybe_err(int)' and
    % `maybe(float)', but we know that they have the same representation.
    %
    % Instead of a simple map whose keys are <type_ctor, cons_id> pairs,
    % we use a two-stage map, with the keys being type_ctors in the first stage
    % and cons_ids in the second. Having two stages makes the comparisons
    % cheaper, and we put the type_ctors first to avoid mixing together
    % cons_ids from different type constructors.

:- type struct_map == map(type_ctor, cons_id_map).
:- type cons_id_map == map(cons_id, list(structure)).

    % Given a unification X = f(Y1, ... Yn), we record its availability for
    % reuse by creating structure(X, [Y1, ... Yn]), and putting it at the
    % front of the list of structures for the entry for f and X's type_ctor.

:- type structure
    --->    structure(prog_var, list(prog_var)).

:- type seen_calls == map(seen_call_id, list(call_args)).

:- type seen_call_id
    --->    seen_call(pred_id, proc_id)
    ;       higher_order_call.

:- type call_args
    --->    call_args(
                % The context of the call, for use in warnings about
                % duplicate calls.
                prog_context,

                % The input arguments. For higher-order calls, the closure
                % is the first input argument.
                list(prog_var),

                % The output arguments.
                list(prog_var)
            ).

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

    % The const struct optimization, if enabled, looks for construction
    % unifications X = f(...) where all the RHS arguments are constant terms,
    % and replaces them with X = ground_term_const(N), where ground constant
    % term #N in the const_struct_db is f(...).
    %
    % The const_var_map, which maps each variable that contains a
    % known-to-be-ground term to its representation as an argument
    % in a const_struct, is stored in here, in the common_info.
    % Entries put into the common_info in one branch of a control structure
    % are used only in the rest of that branch; they are not used
    % either in other branches, or in code after the branched control
    % structure. (This means that we reset the common_info both when entering
    % a non-first branch of a branched control structure, and when leaving
    % a branched control structure.) However, we never reset the
    % const_struct_db, which is stored inside the module_info, which
    % in turn is inside the simplify_info. In other words, the common_info
    % is a program-point-specific data structure, but the simplify_info
    % is not.

:- type const_struct_info
    --->    const_struct_info(
                const_var_map           :: const_var_map
            ).

:- type const_var_map == map(prog_var, const_struct_arg).

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

common_info_init(SimplifyTasks) = Common :-
    OptCommonStructs = SimplifyTasks ^ do_opt_common_structs,
    (
        OptCommonStructs = opt_common_structs,
        OptExtraStructs = SimplifyTasks ^ do_opt_extra_structs,
        (
            OptExtraStructs = opt_extra_structs,
            MaybeCommonStructTask = yes(common_task_extra)
        ;
            OptExtraStructs = do_not_opt_extra_structs,
            MaybeCommonStructTask = yes(common_task_std)
        )
    ;
        OptCommonStructs = do_not_opt_common_structs,
        WarnDuplicateCalls = SimplifyTasks ^ do_warn_duplicate_calls,
        OptDuplicateCalls = SimplifyTasks ^ do_opt_duplicate_calls,
        ( if
            ( WarnDuplicateCalls = warn_duplicate_calls
            ; OptDuplicateCalls = opt_dup_calls
            )
        then
            MaybeCommonStructTask = yes(common_task_only_eqv)
        else
            MaybeCommonStructTask = no
        )
    ),
    (
        MaybeCommonStructTask = no,
        MaybeCommonStruct = no
    ;
        MaybeCommonStructTask = yes(CommonStructTask),
        eqvclass.init(VarEqv0),
        map.init(StructMap0),
        set_of_var.init(SinceCallVars0),
        map.init(SeenCalls0),
        CommonStruct = common_struct_info(CommonStructTask,
            VarEqv0, StructMap0, StructMap0, SinceCallVars0, SeenCalls0),
        MaybeCommonStruct = yes(CommonStruct)
    ),
    OptConstStruct = SimplifyTasks ^ do_opt_const_structs,
    (
        OptConstStruct = opt_const_structs,
        map.init(ConstVarMap0),
        ConstStruct = const_struct_info(ConstVarMap0),
        MaybeConstStruct = yes(ConstStruct)
    ;
        OptConstStruct = do_not_opt_const_structs,
        MaybeConstStruct = no
    ),
    Common = common_info(MaybeCommonStruct, MaybeConstStruct).

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

common_info_stack_flush(!Info) :-
    !.Info = common_info(MaybeCommonStruct0, ConstStruct),
    (
        MaybeCommonStruct0 = no
        % There is no information to flush.
    ;
        MaybeCommonStruct0 = yes(CommonStruct0),
        Task = CommonStruct0 ^ common_struct_task,
        (
            ( Task = common_task_only_eqv
            ; Task = common_task_std
            ),
            % Clear the common_info structs accumulated since the last goal
            % that could cause a stack flush. This is done to avoid replacing
            % a deconstruction with assignments to the arguments where this
            % would cause more variables to be live across the stack flush.
            % Calls and construction unifications are not treated in this way
            % since it is nearly always better to optimize them away.
            %
            % Clear the set of variables seen since the last stack flush,
            % for the same reason.
            CommonStruct = ((CommonStruct0
                ^ since_call_structs := map.init)
                ^ since_call_vars := set_of_var.init),
            !:Info = common_info(yes(CommonStruct), ConstStruct)
        ;
            Task = common_task_extra
            % When doing deforestation, which is the only compiler pass
            % that sets common_task_extra, we try to remove as many
            % common structures as possible, even when this causes
            % more variables to be stored on the stack.
        )
    ).

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

common_optimise_unification(RHS0, UnifyMode, Unification0, UnifyContext,
        !GoalExpr, !GoalInfo, !Common, !Info) :-
    (
        Unification0 = construct(LHSVar, _, _, _, _, _, SubInfo),
        ( if
            % The call to common_optimise_construct below will try to perform
            % one of two optimizations on this construction unification.
            %
            % - The first is replacing a dynamic unification with an
            %   assignment whose right hand side is a reference to
            %   a constant structure. We try to do this if !.Common
            %   contains a const_struct_info.
            %
            % - The second is to replace the construction with an assignment
            %   from a variable that already contains the term that the
            %   construction would build. We try to do this if !.Common
            %   contains a common_struct_info.
            %
            % There are two tests that must pass before we can attempt
            % either optimization, and we test those here. Each optimization
            % also has a test that only it requires; those tests are done
            % inside common_optimise_construct.
            %
            % All these tests usually pass, so the order in which we test
            % for them does not matter much.

            % The first common test is that none of the arguments should have
            % their addresses taken. This is because the address being taken
            % signifies that the value being put into the argument now
            % is only a dummy, with the real value being supplied later
            % (as can happen with code that has been optimized with
            % last-call-modulo-construction).
            (
                SubInfo = no_construct_sub_info
            ;
                SubInfo = construct_sub_info(MaybeTakeAddr, _),
                MaybeTakeAddr = no
            ),

            % The second common test checks that we don't optimise partially
            % instantiated construction unifications, because it would be
            % tricky to work out how to mode the replacement assignment
            % unifications. In the vast majority of cases, the variable
            % is ground.
            simplify_info_get_module_info(!.Info, ModuleInfo),
            simplify_info_get_var_table(!.Info, VarTable),
            lookup_var_type(VarTable, LHSVar, LHSVarType),
            UnifyMode = unify_modes_li_lf_ri_rf(_, LVarFinalInst, _, _),
            inst_is_ground(ModuleInfo, LHSVarType, LVarFinalInst)
        then
            common_optimise_construct(RHS0, UnifyMode, Unification0,
                UnifyContext, !GoalExpr, !GoalInfo, !Common, !Info)
        else
            true
        )
    ;
        Unification0 =
            deconstruct(LHSVar, ConsId, ArgVars, ArgModes, CanFail, _),
        !.Common = common_info(MaybeCommonStruct0, MaybeConstStruct0),
        some [!CommonStruct]
        (
            MaybeCommonStruct0 = no
        ;
            MaybeCommonStruct0 = yes(!:CommonStruct),
            GoalExpr0 = !.GoalExpr,
            GoalInfo0 = !.GoalInfo,
            UnifyMode = unify_modes_li_lf_ri_rf(LVarInitInst, _, _, _),
            simplify_info_get_module_info(!.Info, ModuleInfo),
            simplify_info_get_var_table(!.Info, VarTable),
            lookup_var_type(VarTable, LHSVar, LHSVarType),
            ( if
                % Don't optimise partially instantiated deconstruction
                % unifications, because it would be tricky to work out
                % how to mode the replacement assignment unifications.
                % In the vast majority of cases, the variable is ground.
                inst_is_ground(ModuleInfo, LHSVarType, LVarInitInst)
                % XXX See the comment on how_to_construct_is_acceptable.
            then
                common_optimise_deconstruct(LHSVar, ConsId, ArgVars, ArgModes,
                    CanFail, !GoalExpr, !GoalInfo, !CommonStruct, !Info),
                maybe_restore_original_goal(!.CommonStruct,
                    no_override_by_const_struct, GoalExpr0, GoalInfo0,
                    !GoalExpr, !GoalInfo)
            else
                true
            ),
            record_nonlocals_as_seen(!.GoalInfo, !CommonStruct),
            !:Common = common_info(yes(!.CommonStruct), MaybeConstStruct0)
        )
    ;
        ( Unification0 = assign(Var1, Var2)
        ; Unification0 = simple_test(Var1, Var2)
        ),
        !.Common = common_info(MaybeCommonStruct0, MaybeConstStruct0),
        some [!CommonStruct]
        (
            MaybeCommonStruct0 = no
        ;
            MaybeCommonStruct0 = yes(!:CommonStruct),
            record_equivalence(Var1, Var2, !CommonStruct),
            record_nonlocals_as_seen(!.GoalInfo, !CommonStruct),
            !:Common = common_info(yes(!.CommonStruct), MaybeConstStruct0)
        )
    ;
        Unification0 = complicated_unify(_, _, _),
        % The call in simplify_goal_unify.m to common_optimise_unification
        % is preceded by a test that prevents that call for complicated
        % unifications.
        unexpected($pred, "complicated_unify")
    ).

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

:- pred common_optimise_construct(unify_rhs::in, unify_mode::in,
    unification::in(unification_construct), unify_context::in,
    hlds_goal_expr::in, hlds_goal_expr::out,
    hlds_goal_info::in, hlds_goal_info::out,
    common_info::in, common_info::out,
    simplify_info::in, simplify_info::out) is det.

common_optimise_construct(RHS0, UnifyMode0, Unification0, UnifyContext0,
        !GoalExpr, !GoalInfo, !Common, !Info) :-
    Unification0 =
        construct(Var, ConsId, ArgVars, _ArgModes, How, _Uniq, _SubInfo),

    !.Common = common_info(MaybeCommonStruct0, MaybeConstStruct0),
    GoalExpr0 = !.GoalExpr,
    GoalInfo0 = !.GoalInfo,
    (
        MaybeConstStruct0 = no,
        MaybeConstStruct = no,
        Override = no_override_by_const_struct
    ;
        MaybeConstStruct0 = yes(ConstStruct0),
        ConstStruct0 = const_struct_info(VarMap0),
        (
            ArgVars = [],
            ( if ConsId = ground_term_const(ConstNum, _) then
                map.det_insert(Var, csa_const_struct(ConstNum),
                    VarMap0, VarMap)
            else
                simplify_info_get_var_table(!.Info, VarTable),
                lookup_var_type(VarTable, Var, Type),
                map.det_insert(Var, csa_constant(ConsId, Type),
                    VarMap0, VarMap)
            ),
            ConstStruct = const_struct_info(VarMap),
            MaybeConstStruct = yes(ConstStruct),
            Override = no_override_by_const_struct
        ;
            ArgVars = [_ | _],
            ( if
                all_vars_are_const_struct_args(VarMap0, ArgVars, CSAs),
                % In an is_exist_constr unification, the types of some
                % arguments are described by the values of other
                % (type_info and/or typeclass_info) arguments, and *not*
                % by the type recorded for a given const_struct.
                % We cannot apply this optimization to is_exist_constr
                % unifications unless we teach the backends about how
                % to handle this situation. That handling would be
                % highly nontrivial, and since the situation is very rare,
                % there is no point in expending the effort.
                RHS0 = rhs_functor(_, is_not_exist_constr, _)
            then
                generate_assign_from_const_struct(Unification0, UnifyMode0,
                    UnifyContext0, CSAs, GoalInfo0,
                    ConstGoalExpr, ConstGoalInfo, VarMap0, VarMap, !Info),
                ConstStruct = const_struct_info(VarMap),
                MaybeConstStruct = yes(ConstStruct),
                Override =
                    override_by_const_struct(ConstGoalExpr, ConstGoalInfo)
            else
                MaybeConstStruct = MaybeConstStruct0,
                Override = no_override_by_const_struct
            )
        )
    ),

    some [!CommonStruct]
    (
        MaybeCommonStruct0 = no,
        MaybeCommonStruct = no
    ;
        MaybeCommonStruct0 = yes(!:CommonStruct),
        ( if how_to_construct_is_acceptable(!.Info, How) then
            TypeCtor = lookup_var_type_ctor(!.Info, Var),
            VarEqv0 = !.CommonStruct ^ var_eqv,
            list.map_foldl(eqvclass.ensure_element_partition_id,
                ArgVars, ArgVarIds, VarEqv0, VarEqv1),
            AllStructMap0 = !.CommonStruct ^ all_structs,
            ( if
                map.search(AllStructMap0, TypeCtor, ConsIdMap0),
                map.search(ConsIdMap0, ConsId, Structs),
                find_matching_cell_construct(Structs, VarEqv1, ArgVarIds,
                    OldStruct),
                % generate_assign assumes that the output variable is in the
                % instmap_delta, which will not be true if the variable
                % is local to the unification. The optimization is pointless
                % in that case.
                %
                % This test is after find_matching_cell_construct, because
                % that call is *much* more likely to fail than this test,
                % even though it is also significantly more expensive.
                InstMapDelta = goal_info_get_instmap_delta(GoalInfo0),
                instmap_delta_search_var(InstMapDelta, Var, _)
            then
                OldStruct = structure(OldVar, _),
                eqvclass.ensure_equivalence(Var, OldVar, VarEqv1, VarEqv),
                !CommonStruct ^ var_eqv := VarEqv,
                (
                    ArgVars = []
                    % Constants don't use memory, so there is no point in
                    % optimizing away their construction; in fact, doing so
                    % could cause more stack usage.
                ;
                    ArgVars = [_ | _],
                    UnifyMode0 =
                        unify_modes_li_lf_ri_rf(_, LVarFinalInst, _, _),
                    VarFromToInsts =
                        from_to_insts(LVarFinalInst, LVarFinalInst),
                    generate_assign(Var, OldVar, VarFromToInsts, GoalInfo0,
                        !:GoalExpr, !:GoalInfo, !CommonStruct, !Info),
                    simplify_info_set_rerun_quant_instmap_delta(!Info),
                    goal_cost(hlds_goal(GoalExpr0, GoalInfo0), Cost),
                    simplify_info_incr_cost_delta(Cost, !Info)
                )
            else
                common_standardize_and_record_construct(Var, TypeCtor, ConsId,
                    ArgVars, VarEqv1, !GoalExpr, !GoalInfo,
                    !CommonStruct, !Info)
            ),
            maybe_restore_original_goal(!.CommonStruct, Override,
                GoalExpr0, GoalInfo0, !GoalExpr, !GoalInfo),
            record_nonlocals_as_seen(!.GoalInfo, !CommonStruct),
            MaybeCommonStruct = yes(!.CommonStruct)
        else
            MaybeCommonStruct = MaybeCommonStruct0
        )
    ),
    !:Common = common_info(MaybeCommonStruct, MaybeConstStruct).

:- pred all_vars_are_const_struct_args(const_var_map::in, list(prog_var)::in,
    list(const_struct_arg)::out) is semidet.

all_vars_are_const_struct_args(_VarMap, [], []).
all_vars_are_const_struct_args(VarMap, [ArgVar | ArgVars], [CSA | CSAs]) :-
    map.search(VarMap, ArgVar, CSA),
    all_vars_are_const_struct_args(VarMap, ArgVars, CSAs).

    % The third test, applied specifically to the MLDS backend,
    % is that mark_static_terms.m should not have already decided
    % that we construct Var statically. This is because if it has,
    % then it may have *also* decided that a term where Var occurs
    % on the right hand side should *also* be constructed statically.
    % If we replace the static construction of Var with an assign
    % to Var from a coincidentally-guaranteed-to-be-identical term
    % from somewhere else, as in tests/valid/bug493.m, then Var
    % won't be marked as a static term in the MLDS code generator
    % (the only backend that gets its info about what terms should be
    % static from mark_static_terms.m.), and we get a compiler abort
    % when we get to the occurrence of Var on the right hand side
    % of the later term.
    %
    % The LLDS backend decides what terms it can allocate statically
    % in var_locn.m, during code generation; it does not pay attention
    % to the construct_how field. When targeting this backend, the
    % compiler does not invoke the mark_static_terms pass at the
    % default optimization level, but it does invoke it when the
    % --loop-invariants option is set. To reflect the fact that
    % the LLDS code generator will treat construction unifications
    % marked static by mark_static_terms.m the same way it would treat
    % construction unifications with construct_dynamically, we set
    % the maybe_ignore_marked_static field of the simplify_info to
    % ignore_marked_static when targeting the LLDS backend.
    %
    % Note also that the problem we have described above for the
    % MLDS backend can happen *only* in procedure bodies that
    % have been modified after semantic analysis, e.g. by inlining.
    % This is because
    %
    % - we can see How = construct_statically only *after* the
    %   mark_static_terms pass has been run, which is way after
    %   the first simplification pass, which is run just after
    %   semantic analysis;
    %
    % - the common struct optimization we are implementing here
    %   is idempotent, so it can find new optimization opportunities
    %   on its second invocation only if the code has been modified
    %   after its first invocation.
    %
    % XXX This is only an instance of a more general problem.
    % We should replace X = f(...) with X = Y *only* if the location
    % of Y in terms of what memory area it is in (the heap, static
    % data, or a region) satisfies the constraints imposed by the code
    % that deals with X.
    %
    % Traditionally, except for the third test, the code we use here
    % has worked in the usual case where How says that Var should be
    % constructed either dynamically (on the heap) or statically.
    % However, I (zs) have grave doubts about whether it does
    % the right thing when either X or Y is supposed to be allocated
    % in a region. This is because (a) the optimization is valid
    % only if X and Y are supposed to be allocated from the *same*
    % region; and (b) common_optimise_deconstruct does not record
    % anything about Y, so we cannot possibly test for that here.
    %
:- pred how_to_construct_is_acceptable(simplify_info::in, how_to_construct::in)
    is semidet.

how_to_construct_is_acceptable(Info, How) :-
    (
        How = construct_dynamically
    ;
        How = construct_statically(_),
        simplify_info_get_ignore_marked_static(Info, ignore_marked_static)
    ).

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

    % The purpose of this predicate is to short-circuit variable-to-variable
    % equivalences in structure arguments.
    %
    % The kind of situation where this matters is a sequence of updates
    % to various fields of a structure. Consider the code
    %
    %   !S ^ f1 = F1,
    %   !S ^ f2 = F2
    %
    % where S has four fields. The compiler represents those two lines as
    %
    %   ( % removable barrier scope
    %       S0 = struct(_V11, V12, V13, V14),
    %       S1 = struct(  F1, V12, V13, V14)
    %   ),
    %   ( % removable barrier scope
    %       S1 = struct(V_21, _V22, V23, V24),
    %       S2 = struct(V_21,   F2, V13, V14)
    %   ),
    %
    % The compiler knows that V_21 is equivalent to F1, since both
    % occur in the same place, the first argument of S1. But as long as
    % the first argument of S2 is recorded as V_21, the compiler will
    % need to keep the goal that defines V_21, the deconstruction of S1,
    % which means that it also needs to keep the *construction* of S1.
    % This means that the compiler cannot optimize a sequence of field
    % assignments into the single construction of a new cell with all
    % the updated field values.
    %
    % We handle this by replacing each argument variable in a construction
    % unification with the lowest-numbered (and therefore earliest-introduced)
    % variable in its equivalence class (but see next paragraph). That means
    % that we would make the first argument of S2 be F1, not V_21. And since
    % we know that V23 and V24 are equivalent to V13 and V14 respectively
    % (due to their appearance in the third and fourth slots of S1), the args
    % from which we construct S2 would be F1, F2, V13 and V14.
    %
    % There is one qualification to the above. When we look for the lowest
    % numbered variable in the argument variable's equivalence class,
    % we confine our attention to the variables that we have seen since
    % the last call. This is because reading the value of a variable
    % that we last saw before a call will require the code generator
    % to save the value of that variable on the stack, which has costs
    % of its own. Between (a) saving the values of three fields in stack slots
    % and later loading those values from their stack slots, and (b) saving
    % just the cell variable on the stack, and later loading it from the stack
    % and then reading the fields from the heap, (b) is almost certainly
    % faster, since it does 1 store and 3 loads vs 3 stores and 3 loads.
    % When reusing just one or two fields, the difference is almost certainly
    % going to be minor, and its direction (which approach is better) will
    % probably depend on information we don't have right now. I (zs) think
    % that not requiring extra variables to be stored in stack slots is
    % probably the better approach overall.
    %
:- pred common_standardize_and_record_construct(prog_var::in, type_ctor::in,
    cons_id::in, list(prog_var)::in, eqvclass(prog_var)::in,
    hlds_goal_expr::in, hlds_goal_expr::out,
    hlds_goal_info::in, hlds_goal_info::out,
    common_struct_info::in, common_struct_info::out,
    simplify_info::in, simplify_info::out) is det.

common_standardize_and_record_construct(Var, TypeCtor, ConsId, ArgVars, VarEqv,
        GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !CommonStruct, !Info) :-
    SinceCallVars = !.CommonStruct ^ since_call_vars,
    find_representatives(SinceCallVars, VarEqv, ArgVars, ArgRepnVars,
        unchanged, Changed),
    (
        Changed = unchanged,
        GoalExpr = GoalExpr0,
        GoalInfo = GoalInfo0
    ;
        Changed = changed,
        ( if
            GoalExpr0 = unify(Var, RHS0, UnifyMode, Unification0, Ctxt),
            RHS0 = rhs_functor(ConsId, IsExistConstr, ArgVars),
            Unification0 = construct(Var, ConsId, ArgVars, ArgModes, How,
                Uniq, SubInfo)
        then
            Unification = construct(Var, ConsId, ArgRepnVars, ArgModes, How,
                Uniq, SubInfo),
            RHS = rhs_functor(ConsId, IsExistConstr, ArgRepnVars),
            GoalExpr = unify(Var, RHS, UnifyMode, Unification, Ctxt),
            set_of_var.list_to_set([Var | ArgRepnVars], NonLocals),
            goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
            !CommonStruct ^ var_eqv := VarEqv,
            simplify_info_set_rerun_quant_instmap_delta(!Info)
        else
            unexpected($pred, "GoalExpr0 has unexpected shape")
        )
    ),
    Struct = structure(Var, ArgRepnVars),
    record_cell_in_maps(TypeCtor, ConsId, Struct, VarEqv, !CommonStruct).

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

    % Given a variable, return the lowest numbered variable in its
    % equivalence class that we have seen since the last stack flush.
    % See the comment on common_standardize_and_record_construct
    % for the reason why we do this.
    %
:- pred find_representatives(set_of_progvar::in,
    eqvclass(prog_var)::in, list(prog_var)::in, list(prog_var)::out,
    maybe_changed::in, maybe_changed::out) is det.

find_representatives(_SinceCallVars, _VarEqv, [], [], !Changed).
find_representatives(SinceCallVars, VarEqv, [Var | Vars], [RepnVar | RepnVars],
        !Changed) :-
    EqvVarsSet = get_equivalent_elements(VarEqv, Var),
    set.to_sorted_list(EqvVarsSet, EqvVars),
    ( if find_representative_loop(SinceCallVars, EqvVars, RepnVarPrime) then
        RepnVar = RepnVarPrime,
        !:Changed = changed
    else
        RepnVar = Var
    ),
    find_representatives(SinceCallVars, VarEqv, Vars, RepnVars, !Changed).

:- pred find_representative_loop(set_of_progvar::in, list(prog_var)::in,
    prog_var::out) is semidet.

find_representative_loop(SinceCallVars, [Var | Vars], RepnVar) :-
    ( if set_of_var.contains(SinceCallVars, Var) then
        RepnVar = Var
    else
        find_representative_loop(SinceCallVars, Vars, RepnVar)
    ).

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

:- pred common_optimise_deconstruct(prog_var::in, cons_id::in,
    list(prog_var)::in, list(unify_mode)::in, can_fail::in,
    hlds_goal_expr::in, hlds_goal_expr::out,
    hlds_goal_info::in, hlds_goal_info::out,
    common_struct_info::in, common_struct_info::out,
    simplify_info::in, simplify_info::out) is det.

common_optimise_deconstruct(Var, ConsId, ArgVars, ArgModes, CanFail,
        GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !CommonStruct, !Info) :-
    TypeCtor = lookup_var_type_ctor(!.Info, Var),
    VarEqv0 = !.CommonStruct ^ var_eqv,
    eqvclass.ensure_element_partition_id(Var, VarId, VarEqv0, VarEqv1),
    SinceCallStructMap0 = !.CommonStruct ^ since_call_structs,
    ( if
        % Do not delete deconstruction unifications inserted by
        % stack_opt.m or tupling.m, which have done a more comprehensive
        % cost analysis than common.m can do.
        not goal_info_has_feature(GoalInfo, feature_stack_opt),
        not goal_info_has_feature(GoalInfo, feature_tuple_opt),

        map.search(SinceCallStructMap0, TypeCtor, ConsIdMap0),
        map.search(ConsIdMap0, ConsId, Structs),
        find_matching_cell_deconstruct(Structs, VarEqv1, VarId, OldStruct)
    then
        OldStruct = structure(_, OldArgVars),
        eqvclass.ensure_corresponding_equivalences(ArgVars,
            OldArgVars, VarEqv1, VarEqv),
        !CommonStruct ^ var_eqv := VarEqv,
        RHSFromToInsts = list.map(unify_mode_to_rhs_from_to_insts,
            ArgModes),
        create_output_unifications(GoalInfo0, ArgVars, OldArgVars,
            RHSFromToInsts, Goals, !CommonStruct, !Info),
        GoalExpr = conj(plain_conj, Goals),
        goal_cost(hlds_goal(GoalExpr0, GoalInfo0), Cost),
        simplify_info_incr_cost_delta(Cost, !Info),
        simplify_info_set_rerun_quant_instmap_delta(!Info),
        (
            CanFail = can_fail,
            simplify_info_set_rerun_det(!Info)
        ;
            CanFail = cannot_fail
        )
    else
        GoalExpr = GoalExpr0,
        Struct = structure(Var, ArgVars),
        record_cell_in_maps(TypeCtor, ConsId, Struct, VarEqv1, !CommonStruct)
    ),
    GoalInfo = GoalInfo0.

:- func lookup_var_type_ctor(simplify_info, prog_var) = type_ctor.

lookup_var_type_ctor(Info, Var) = TypeCtor :-
    simplify_info_get_var_table(Info, VarTable),
    lookup_var_type(VarTable, Var, Type),
    % If we unify a variable with a function symbol, we *must* know
    % what the principal type constructor of its type is.
    type_to_ctor_det(Type, TypeCtor).

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

:- pred find_matching_cell_construct(list(structure)::in,
    eqvclass(prog_var)::in, list(partition_id)::in, structure::out) is semidet.

find_matching_cell_construct([Struct | Structs], VarEqv, ArgVarIds, Match) :-
    Struct = structure(_Var, Vars),
    ( if ids_vars_match(ArgVarIds, Vars, VarEqv) then
        Match = Struct
    else
        find_matching_cell_construct(Structs, VarEqv, ArgVarIds, Match)
    ).

:- pred find_matching_cell_deconstruct(list(structure)::in,
    eqvclass(prog_var)::in, partition_id::in, structure::out) is semidet.

find_matching_cell_deconstruct([Struct | Structs], VarEqv, VarId, Match) :-
    Struct = structure(Var, _Vars),
    ( if id_var_match(VarId, Var, VarEqv) then
        Match = Struct
    else
        find_matching_cell_deconstruct(Structs, VarEqv, VarId, Match)
    ).

:- pred ids_vars_match(list(partition_id)::in, list(prog_var)::in,
    eqvclass(prog_var)::in) is semidet.

ids_vars_match([], [], _VarEqv).
ids_vars_match([Id | Ids], [Var | Vars], VarEqv) :-
    id_var_match(Id, Var, VarEqv),
    ids_vars_match(Ids, Vars, VarEqv).

:- pred id_var_match(partition_id::in, prog_var::in, eqvclass(prog_var)::in)
    is semidet.
:- pragma inline(pred(id_var_match/3)).

id_var_match(Id, Var, VarEqv) :-
    eqvclass.partition_id(VarEqv, Var, VarId),
    Id = VarId.

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

:- pred record_cell_in_maps(type_ctor::in, cons_id::in, structure::in,
    eqvclass(prog_var)::in,
    common_struct_info::in, common_struct_info::out) is det.

record_cell_in_maps(TypeCtor, ConsId, Struct, VarEqv, !CommonStruct) :-
    AllStructMap0 = !.CommonStruct ^ all_structs,
    SinceCallStructMap0 = !.CommonStruct ^ since_call_structs,
    do_record_cell_in_struct_map(TypeCtor, ConsId, Struct,
        AllStructMap0, AllStructMap),
    do_record_cell_in_struct_map(TypeCtor, ConsId, Struct,
        SinceCallStructMap0, SinceCallStructMap),
    !CommonStruct ^ var_eqv := VarEqv,
    !CommonStruct ^ all_structs := AllStructMap,
    !CommonStruct ^ since_call_structs := SinceCallStructMap.

:- pred do_record_cell_in_struct_map(type_ctor::in, cons_id::in,
    structure::in, struct_map::in, struct_map::out) is det.

do_record_cell_in_struct_map(TypeCtor, ConsId, Struct, !StructMap) :-
    ( if map.search(!.StructMap, TypeCtor, ConsIdMap0) then
        ( if map.search(ConsIdMap0, ConsId, Structs0) then
            Structs = [Struct | Structs0],
            map.det_update(ConsId, Structs, ConsIdMap0, ConsIdMap)
        else
            map.det_insert(ConsId, [Struct], ConsIdMap0, ConsIdMap)
        ),
        map.det_update(TypeCtor, ConsIdMap, !StructMap)
    else
        ConsIdMap = map.singleton(ConsId, [Struct]),
        map.det_insert(TypeCtor, ConsIdMap, !StructMap)
    ).

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

:- pred record_equivalence(prog_var::in, prog_var::in,
    common_struct_info::in, common_struct_info::out) is det.

record_equivalence(VarA, VarB, !CommonStruct) :-
    VarEqv0 = !.CommonStruct ^ var_eqv,
    eqvclass.ensure_equivalence(VarA, VarB, VarEqv0, VarEqv),
    !CommonStruct ^ var_eqv := VarEqv.

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

:- type maybe_override_by_const_struct
    --->    no_override_by_const_struct
    ;       override_by_const_struct(hlds_goal_expr, hlds_goal_info).

:- pred maybe_restore_original_goal(common_struct_info::in,
    maybe_override_by_const_struct::in,
    hlds_goal_expr::in, hlds_goal_info::in,
    hlds_goal_expr::in, hlds_goal_expr::out,
    hlds_goal_info::in, hlds_goal_info::out) is det.

maybe_restore_original_goal(CommonStruct, Override, GoalExpr0, GoalInfo0,
        !GoalExpr, !GoalInfo) :-
    CommonStructTask = CommonStruct ^ common_struct_task,
    (
        ( CommonStructTask = common_task_std
        ; CommonStructTask = common_task_extra
        )
    ;
        CommonStructTask = common_task_only_eqv,
        % We keep the update of !Common, but we throw away any update
        % of the goal.
        !:GoalExpr = GoalExpr0,
        !:GoalInfo = GoalInfo0
    ),
    (
        Override = no_override_by_const_struct
    ;
        Override = override_by_const_struct(!:GoalExpr, !:GoalInfo)
    ).

:- pred record_nonlocals_as_seen(hlds_goal_info::in,
    common_struct_info::in, common_struct_info::out) is det.

record_nonlocals_as_seen(GoalInfo, !CommonStruct) :-
    NonLocals = goal_info_get_nonlocals(GoalInfo),
    SinceCallVars0 = !.CommonStruct ^ since_call_vars,
    set_of_var.union(NonLocals, SinceCallVars0, SinceCallVars),
    !CommonStruct ^ since_call_vars := SinceCallVars.

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

common_optimise_call(PredId, ProcId, ArgVars, Purity, GoalInfo,
        GoalExpr0, MaybeAssignsGoalExpr, !Common, !Info) :-
    !.Common = common_info(MaybeCommonStruct0, ConstStruct),
    ( if
        MaybeCommonStruct0 = yes(CommonStruct0),
        Purity = purity_pure,
        Det = goal_info_get_determinism(GoalInfo),
        check_call_detism(Det),
        simplify_info_get_module_info(!.Info, ModuleInfo),
        module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
        simplify_info_get_var_table(!.Info, VarTable),
        proc_info_get_argmodes(ProcInfo, ArgModes),
        partition_call_args(ModuleInfo, VarTable, ArgModes, ArgVars,
            InputArgVars, OutputArgVars, OutputModes)
    then
        common_do_optimise_call(seen_call(PredId, ProcId), InputArgVars,
            OutputArgVars, OutputModes, GoalInfo, GoalExpr0,
            MaybeAssignsGoalExpr, CommonStruct0, CommonStruct, !Info),
        !:Common = common_info(yes(CommonStruct), ConstStruct)
    else
        MaybeAssignsGoalExpr = no
    ).

common_optimise_higher_order_call(ClosureVar, ArgVars, Modes, Det, Purity,
        GoalInfo, GoalExpr0, MaybeAssignsGoalExpr, !Common, !Info) :-
    !.Common = common_info(MaybeCommonStruct0, ConstStruct),
    ( if
        MaybeCommonStruct0 = yes(CommonStruct0),
        Purity = purity_pure,
        check_call_detism(Det),
        simplify_info_get_var_table(!.Info, VarTable),
        simplify_info_get_module_info(!.Info, ModuleInfo),
        partition_call_args(ModuleInfo, VarTable, Modes, ArgVars,
            InputArgVars, OutputArgVars, OutputModes)
    then
        common_do_optimise_call(higher_order_call, [ClosureVar | InputArgVars],
            OutputArgVars, OutputModes, GoalInfo, GoalExpr0,
            MaybeAssignsGoalExpr, CommonStruct0, CommonStruct, !Info),
        !:Common = common_info(yes(CommonStruct), ConstStruct)
    else
        MaybeAssignsGoalExpr = no
    ).

:- pred check_call_detism(determinism::in) is semidet.

check_call_detism(Det) :-
    determinism_components(Det, _, SolnCount),
    % Replacing nondet or multi calls would cause loss of solutions.
    ( SolnCount = at_most_one
    ; SolnCount = at_most_many_cc
    ).

:- pred common_do_optimise_call(seen_call_id::in, list(prog_var)::in,
    list(prog_var)::in, list(mer_mode)::in, hlds_goal_info::in,
    hlds_goal_expr::in, maybe(hlds_goal_expr)::out,
    common_struct_info::in, common_struct_info::out,
    simplify_info::in, simplify_info::out) is det.

common_do_optimise_call(SeenCall, InputArgs, OutputArgs, Modes, GoalInfo,
        GoalExpr0, MaybeAssignsGoalExpr, CommonStruct0, CommonStruct, !Info) :-
    Eqv0 = CommonStruct0 ^ var_eqv,
    SeenCalls0 = CommonStruct0 ^ seen_calls,
    ( if map.search(SeenCalls0, SeenCall, SeenCallsList0) then
        ( if
            find_previous_call(SeenCallsList0, InputArgs, Eqv0,
                OutputArgs2, PrevContext)
        then
            simplify_info_get_module_info(!.Info, ModuleInfo),
            list.map(mode_get_from_to_insts(ModuleInfo), Modes, FromToInsts),
            create_output_unifications(GoalInfo, OutputArgs, OutputArgs2,
                FromToInsts, AssignGoals, CommonStruct0, CommonStruct, !Info),
            ( if AssignGoals = [hlds_goal(OnlyGoalExpr, _OnlyGoalInfo)] then
                AssignsGoalExpr = OnlyGoalExpr
            else
                AssignsGoalExpr = conj(plain_conj, AssignGoals)
            ),
            MaybeAssignsGoalExpr = yes(AssignsGoalExpr),
            simplify_info_get_var_table(!.Info, VarTable),
            ( if
                simplify_do_warn_duplicate_calls(!.Info),
                % Don't warn for cases such as:
                % set.init(Set1 : set(int)),
                % set.init(Set2 : set(float)).
                lookup_var_types(VarTable, OutputArgs, OutputArgTypes1),
                lookup_var_types(VarTable, OutputArgs2, OutputArgTypes2),
                types_match_exactly_list(OutputArgTypes1, OutputArgTypes2)
            then
                Context = goal_info_get_context(GoalInfo),
                CallPieces = det_report_seen_call_id(ModuleInfo, SeenCall),
                CurPieces = [words("Warning: redundant") | CallPieces]
                    ++ [suffix(".")],
                PrevPieces = [words("Here is the previous") | CallPieces]
                    ++ [suffix(".")],
                Msg = msg(Context, CurPieces),
                PrevMsg = error_msg(yes(PrevContext), always_treat_as_first,
                    0u, [always(PrevPieces)]),
                Severity = severity_warning(warn_duplicate_calls),
                Spec = error_spec($pred, Severity,
                    phase_simplify(report_in_any_mode), [Msg, PrevMsg]),
                simplify_info_add_message(Spec, !Info)
            else
                true
            ),
            goal_cost(hlds_goal(GoalExpr0, GoalInfo), Cost),
            simplify_info_incr_cost_delta(Cost, !Info),
            simplify_info_set_rerun_quant_instmap_delta(!Info),
            Detism0 = goal_info_get_determinism(GoalInfo),
            (
                Detism0 = detism_det
            ;
                ( Detism0 = detism_semi
                ; Detism0 = detism_non
                ; Detism0 = detism_multi
                ; Detism0 = detism_failure
                ; Detism0 = detism_erroneous
                ; Detism0 = detism_cc_non
                ; Detism0 = detism_cc_multi
                ),
                simplify_info_set_rerun_det(!Info)
            )
        else
            Context = goal_info_get_context(GoalInfo),
            ThisCall = call_args(Context, InputArgs, OutputArgs),
            map.det_update(SeenCall, [ThisCall | SeenCallsList0],
                SeenCalls0, SeenCalls),
            CommonStruct = CommonStruct0 ^ seen_calls := SeenCalls,
            MaybeAssignsGoalExpr = no
        )
    else
        Context = goal_info_get_context(GoalInfo),
        ThisCall = call_args(Context, InputArgs, OutputArgs),
        map.det_insert(SeenCall, [ThisCall], SeenCalls0, SeenCalls),
        CommonStruct = CommonStruct0 ^ seen_calls := SeenCalls,
        MaybeAssignsGoalExpr = no
    ).

    % Describe a call we have seen.
    %
:- func det_report_seen_call_id(module_info, seen_call_id)
    = list(format_piece).

det_report_seen_call_id(ModuleInfo, SeenCall) = Pieces :-
    (
        SeenCall = seen_call(PredId, _),
        PredPieces = describe_one_pred_name(ModuleInfo, no,
            should_module_qualify, [], PredId),
        Pieces = [words("call to") | PredPieces]
    ;
        SeenCall = higher_order_call,
        Pieces = [words("higher-order call")]
    ).

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

    % Partition the arguments of a call into inputs and outputs,
    % failing if any of the outputs have a unique component
    % or if any of the outputs contain any `any' insts.
    %
:- pred partition_call_args(module_info::in, var_table::in,
    list(mer_mode)::in, list(prog_var)::in, list(prog_var)::out,
    list(prog_var)::out, list(mer_mode)::out) is semidet.

partition_call_args(_, _, [], [], [], [], []).
partition_call_args(_, _, [], [_ | _], _, _, _) :-
    unexpected($pred, "length mismatch (1)").
partition_call_args(_, _, [_ | _], [], _, _, _) :-
    unexpected($pred, "length mismatch (2)").
partition_call_args(ModuleInfo, VarTable, [ArgMode | ArgModes],
        [Arg | Args], InputArgs, OutputArgs, OutputModes) :-
    partition_call_args(ModuleInfo, VarTable, ArgModes, Args,
        InputArgs1, OutputArgs1, OutputModes1),
    mode_get_insts(ModuleInfo, ArgMode, InitialInst, FinalInst),
    lookup_var_type(VarTable, Arg, Type),
    ( if inst_matches_binding(ModuleInfo, Type, InitialInst, FinalInst) then
        InputArgs = [Arg | InputArgs1],
        OutputArgs = OutputArgs1,
        OutputModes = OutputModes1
    else
        % Calls with partly unique outputs cannot be replaced,
        % since a unique copy of the outputs must be produced.
        inst_is_not_partly_unique(ModuleInfo, FinalInst),

        % Don't optimize calls whose outputs include any `any' insts, since
        % that would create false aliasing between the different variables.
        % (inst_matches_binding applied to identical insts fails only for
        % `any' insts.)
        inst_matches_binding(ModuleInfo, Type, FinalInst, FinalInst),

        % Don't optimize calls where a partially instantiated variable is
        % further instantiated. That case is difficult to test properly
        % because mode analysis currently rejects most potential test cases.
        inst_is_free(ModuleInfo, InitialInst),

        InputArgs = InputArgs1,
        OutputArgs = [Arg | OutputArgs1],
        OutputModes = [ArgMode | OutputModes1]
    ).

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

:- pred find_previous_call(list(call_args)::in, list(prog_var)::in,
    eqvclass(prog_var)::in, list(prog_var)::out,
    prog_context::out) is semidet.

find_previous_call([SeenCall | SeenCalls], InputArgs, Eqv, OutputArgs,
        PrevContext) :-
    SeenCall = call_args(PrevContext, InputArgs1, OutputArgs1),
    ( if common_var_lists_are_equiv(Eqv, InputArgs, InputArgs1) then
        OutputArgs = OutputArgs1
    else
        find_previous_call(SeenCalls, InputArgs, Eqv, OutputArgs, PrevContext)
    ).

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

common_vars_are_equivalent(Common, Xs, Ys) :-
    Common = common_info(MaybeCommonStruct, _ConstStruct),
    (
        MaybeCommonStruct = no,
        Xs = Ys
    ;
        MaybeCommonStruct = yes(CommonStruct),
        EqvVars = CommonStruct ^ var_eqv,
        common_vars_are_equiv(EqvVars, Xs, Ys)
    ).

    % Succeeds if the two lists of variables are equivalent
    % according to the specified equivalence class.
    %
:- pred common_var_lists_are_equiv(eqvclass(prog_var)::in,
    list(prog_var)::in, list(prog_var)::in) is semidet.

common_var_lists_are_equiv(_VarEqv, [], []).
common_var_lists_are_equiv(VarEqv, [X | Xs], [Y | Ys]) :-
    common_vars_are_equiv(VarEqv, X, Y),
    common_var_lists_are_equiv(VarEqv, Xs, Ys).

    % Succeeds if the two variables are equivalent according to the
    % specified equivalence class.
    %
:- pred common_vars_are_equiv(eqvclass(prog_var)::in,
    prog_var::in, prog_var::in) is semidet.

common_vars_are_equiv(VarEqv, X, Y) :-
    (
        X = Y
    ;
        eqvclass.partition_id(VarEqv, X, Id),
        eqvclass.partition_id(VarEqv, Y, Id)
    ).

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

    % Create unifications to assign the vars in OutputArgs from the
    % corresponding var in OldOutputArgs. This needs to be done even if
    % OutputArg is not a nonlocal in the original goal, because later goals
    % in the conjunction may match against the cell and need all the output
    % arguments. Any unneeded assignments will be removed later.
    %
:- pred create_output_unifications(hlds_goal_info::in, list(prog_var)::in,
    list(prog_var)::in, list(from_to_insts)::in, list(hlds_goal)::out,
    common_struct_info::in, common_struct_info::out,
    simplify_info::in, simplify_info::out) is det.

create_output_unifications(OldGoalInfo, OutputArgs, OldOutputArgs, FromToInsts,
        AssignGoals, !CommonStruct, !Info) :-
    ( if
        OutputArgs = [HeadOutputArg | TailOutputArgs],
        OldOutputArgs = [HeadOldOutputArg | TailOldOutputArgs],
        FromToInsts = [HeadFromToInsts | TailFromToInsts]
    then
        ( if HeadOutputArg = HeadOldOutputArg then
            % This can happen if the first cell was created
            % with a partially instantiated deconstruction.
            create_output_unifications(OldGoalInfo,
                TailOutputArgs, TailOldOutputArgs, TailFromToInsts,
                AssignGoals, !CommonStruct, !Info)
        else
            generate_assign(HeadOutputArg, HeadOldOutputArg, HeadFromToInsts,
                OldGoalInfo, HeadAssignGoalExpr, HeadAssignGoalInfo,
                !CommonStruct, !Info),
            HeadAssignGoal = hlds_goal(HeadAssignGoalExpr, HeadAssignGoalInfo),
            create_output_unifications(OldGoalInfo,
                TailOutputArgs, TailOldOutputArgs, TailFromToInsts,
                TailAssignGoals, !CommonStruct, !Info),
            AssignGoals = [HeadAssignGoal | TailAssignGoals]
        )
    else if
        OutputArgs = [],
        OldOutputArgs = [],
        FromToInsts = []
    then
        AssignGoals = []
    else
        unexpected($pred, "mode mismatch")
    ).

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

:- pred generate_assign_from_const_struct(
    unification::in(unification_construct), unify_mode::in,
    unify_context::in,
    list(const_struct_arg)::in,
    hlds_goal_info::in, hlds_goal_expr::out, hlds_goal_info::out,
    const_var_map::in, const_var_map::out,
    simplify_info::in, simplify_info::out) is det.

generate_assign_from_const_struct(Unification0, UnifyMode0, UnifyContext0,
        CSAs, OldGoalInfo, ConstGoalExpr, ConstGoalInfo,
        VarMap0, VarMap, !Info) :-
    Unification0 =
        construct(Var, ConsId, _ArgVars, _ArgModes, _How, _Uniq, SubInfo),

    simplify_info_get_var_table(!.Info, VarTable),
    lookup_var_type(VarTable, Var, Type),
    UnifyMode0 = unify_modes_li_lf_ri_rf(ToVarInit, ToVarFinal,
        _FromTermInit, _FromTermFinal),
    simplify_info_get_module_info(!.Info, ModuleInfo0),
    simplify_info_get_pred_proc_id(!.Info, proc(PredId, _ProcId)),
    module_info_pred_info(ModuleInfo0, PredId, PredInfo),
    pred_info_get_status(PredInfo, PredStatus),
    DefnThisModule = pred_status_defined_in_this_module(PredStatus),
    ( DefnThisModule = no,  Where = defined_in_other_module
    ; DefnThisModule = yes, Where = defined_in_this_module
    ),
    Struct = const_struct(ConsId, CSAs, Type, ToVarFinal, Where),
    module_info_get_const_struct_db(ModuleInfo0, ConstStructDb0),
    lookup_insert_const_struct(Struct, ConstNum,
        ConstStructDb0, ConstStructDb),
    module_info_set_const_struct_db(ConstStructDb, ModuleInfo0, ModuleInfo),
    simplify_info_set_module_info(ModuleInfo, !Info),
    map.det_insert(Var, csa_const_struct(ConstNum), VarMap0, VarMap),

    ConstConsId = ground_term_const(ConstNum, ConsId),
    ConstRHS = rhs_functor(ConstConsId, is_not_exist_constr, []),
    ConstUnifyMode = unify_modes_li_lf_ri_rf(ToVarInit, ToVarFinal,
        ToVarFinal, ToVarFinal),
    % The how_to_construct field is not meaningful for construction
    % unifications without arguments, and the ConstUnification we are building
    % has no arguments.
    ConstHow = construct_dynamically,
    ConstUniq = cell_is_shared,
    ConstUnification =
        construct(Var, ConstConsId, [], [], ConstHow, ConstUniq, SubInfo),
    ConstGoalExpr = unify(Var, ConstRHS, ConstUnifyMode,
        ConstUnification, UnifyContext0),

    set_of_var.make_singleton(Var, NonLocals),
    InstMapDelta = instmap_delta_from_assoc_list([Var - ToVarFinal]),
    Context = goal_info_get_context(OldGoalInfo),
    goal_info_init(NonLocals, InstMapDelta, detism_det, purity_pure, Context,
        ConstGoalInfo).

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

:- pred generate_assign(prog_var::in, prog_var::in, from_to_insts::in,
    hlds_goal_info::in, hlds_goal_expr::out, hlds_goal_info::out,
    common_struct_info::in, common_struct_info::out,
    simplify_info::in, simplify_info::out) is det.

generate_assign(ToVar, FromVar, ToVarMode, OldGoalInfo, GoalExpr, GoalInfo,
        !CommonStruct, !Info) :-
    apply_induced_substitutions(ToVar, FromVar, !Info),
    simplify_info_get_var_table(!.Info, VarTable),
    lookup_var_type(VarTable, ToVar, ToVarType),
    lookup_var_type(VarTable, FromVar, FromVarType),

    set_of_var.list_to_set([ToVar, FromVar], NonLocals),
    ToVarMode = from_to_insts(ToVarInit, ToVarFinal),
    ( if types_match_exactly(ToVarType, FromVarType) then
        UnifyMode = unify_modes_li_lf_ri_rf(ToVarInit, ToVarFinal,
            ToVarFinal, ToVarFinal),
        UnifyContext = unify_context(umc_explicit, []),
        GoalExpr = unify(ToVar, rhs_var(FromVar), UnifyMode,
            assign(ToVar, FromVar), UnifyContext)
    else
        % If the cells we are optimizing don't have exactly the same type,
        % we insert explicit type casts to ensure type correctness.
        % This avoids problems with HLDS optimizations such as inlining
        % which expect the HLDS to be well-typed. Unfortunately, this loses
        % information for other optimizations, since the cast hides the
        % equivalence of the input and output.
        Modes =
            [from_to_mode(ToVarFinal, ToVarFinal),
            from_to_mode(free, ToVarFinal)],
        GoalExpr = generic_call(cast(unsafe_type_cast), [FromVar, ToVar],
            Modes, arg_reg_types_unset, detism_det)
    ),

    % `ToVar' may not appear in the original instmap_delta, so we can't just
    % use instmap_delta_restrict on the original instmap_delta here.
    InstMapDelta = instmap_delta_from_assoc_list([ToVar - ToVarFinal]),
    Context = goal_info_get_context(OldGoalInfo),
    goal_info_init(NonLocals, InstMapDelta, detism_det, purity_pure, Context,
        GoalInfo),

    record_equivalence(ToVar, FromVar, !CommonStruct).

:- pred types_match_exactly(mer_type::in, mer_type::in) is semidet.

types_match_exactly(TypeA, TypeB) :-
    require_complete_switch [TypeA]
    (
        TypeA = type_variable(TVar, _),
        TypeB = type_variable(TVar, _)
    ;
        TypeA = defined_type(Name, ArgTypesA, _),
        TypeB = defined_type(Name, ArgTypesB, _),
        types_match_exactly_list(ArgTypesA, ArgTypesB)
    ;
        TypeA = builtin_type(BuiltinType),
        TypeB = builtin_type(BuiltinType)
    ;
        TypeA = higher_order_type(PorF, ArgTypesA, H, P),
        TypeB = higher_order_type(PorF, ArgTypesB, H, P),
        types_match_exactly_list(ArgTypesA, ArgTypesB)
    ;
        TypeA = tuple_type(ArgTypesA, _),
        TypeB = tuple_type(ArgTypesB, _),
        types_match_exactly_list(ArgTypesA, ArgTypesB)
    ;
        TypeA = apply_n_type(TVar, ArgTypesA, _),
        TypeB = apply_n_type(TVar, ArgTypesB, _),
        types_match_exactly_list(ArgTypesA, ArgTypesB)
    ;
        TypeA = kinded_type(_, _),
        unexpected($pred, "kind annotation")
    ).

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

types_match_exactly_list([], []).
types_match_exactly_list([TypeA | TypesA], [TypeB | TypesB]) :-
    types_match_exactly(TypeA, TypeB),
    types_match_exactly_list(TypesA, TypesB).

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

    % Two existentially quantified type variables may become aliased if two
    % calls or two deconstructions are merged together. We detect this
    % situation here and apply the appropriate tsubst to the var_table and
    % rtti_varmaps. This allows us to avoid an unsafe cast, and also may
    % allow more opportunities for simplification.
    %
    % If we do need to apply a type substitution, then we also apply the
    % substitution ToVar -> FromVar to the RttiVarMaps, then duplicate
    % FromVar's information for ToVar. This ensures we always refer to the
    % "original" variables, not the copies created by generate_assign.
    %
    % Note that this relies on the assignments for type_infos and
    % typeclass_infos to be generated before other arguments with these
    % existential types are processed. In other words, the arguments of
    % calls and deconstructions must be processed in left to right order.
    %
:- pred apply_induced_substitutions(prog_var::in, prog_var::in,
    simplify_info::in, simplify_info::out) is det.

apply_induced_substitutions(ToVar, FromVar, !Info) :-
    simplify_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
    rtti_varmaps_var_info(RttiVarMaps0, FromVar, FromVarRttiInfo),
    rtti_varmaps_var_info(RttiVarMaps0, ToVar, ToVarRttiInfo),
    ( if calculate_induced_tsubst(ToVarRttiInfo, FromVarRttiInfo, TSubst) then
        ( if map.is_empty(TSubst) then
            true
        else
            simplify_info_apply_substitutions_and_duplicate(ToVar, FromVar,
                TSubst, !Info)
        )
    else
        % Update the rtti_varmaps with new information if only one of the
        % variables has rtti_var_info recorded. This can happen if a new
        % variable has been introduced, eg in quantification, without
        % being recorded in the rtti_varmaps.
        (
            FromVarRttiInfo = non_rtti_var,
            rtti_var_info_duplicate(ToVar, FromVar,
                RttiVarMaps0, RttiVarMaps),
            simplify_info_set_rtti_varmaps(RttiVarMaps, !Info)
        ;
            ( FromVarRttiInfo = type_info_var(_)
            ; FromVarRttiInfo = typeclass_info_var(_)
            ),
            (
                ToVarRttiInfo = non_rtti_var,
                rtti_var_info_duplicate(FromVar, ToVar,
                    RttiVarMaps0, RttiVarMaps),
                simplify_info_set_rtti_varmaps(RttiVarMaps, !Info)
            ;
                ( ToVarRttiInfo = type_info_var(_)
                ; ToVarRttiInfo = typeclass_info_var(_)
                ),
                % Calculate_induced_tsubst failed for a different reason,
                % either because unification failed or because one variable
                % was a type_info and the other was a typeclass_info.
                unexpected($pred, "inconsistent info")
            )
        )
    ).

    % Calculate the induced substitution by unifying the types or constraints,
    % if they exist. Fail if given non-matching rtti_var_infos.
    %
:- pred calculate_induced_tsubst(rtti_var_info::in, rtti_var_info::in,
    tsubst::out) is semidet.

calculate_induced_tsubst(ToVarRttiInfo, FromVarRttiInfo, TSubst) :-
    (
        FromVarRttiInfo = type_info_var(FromVarTypeInfoType),
        ToVarRttiInfo = type_info_var(ToVarTypeInfoType),
        type_subsumes(ToVarTypeInfoType, FromVarTypeInfoType, TSubst)
    ;
        FromVarRttiInfo = typeclass_info_var(FromVarConstraint),
        ToVarRttiInfo = typeclass_info_var(ToVarConstraint),
        FromVarConstraint = constraint(Name, FromArgs),
        ToVarConstraint = constraint(Name, ToArgs),
        type_list_subsumes(ToArgs, FromArgs, TSubst)
    ;
        FromVarRttiInfo = non_rtti_var,
        ToVarRttiInfo = non_rtti_var,
        map.init(TSubst)
    ).

%---------------------------------------------------------------------------%
:- end_module check_hlds.simplify.common.
%---------------------------------------------------------------------------%