%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2003-2012 The University of Melbourne.
% Copyright (C) 2015 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: size_prof.m
% Author: zs.
%
% This module performs a source-to-source program transformation that
% implements term size profiling. The objective of the transformation is to
% make it possible to find out the size of every term in constant time, i.e.
% *without* traversing the term. (If finding out the size of a term required
% traversing the term, the cost of this traversal would dominate the cost of
% most procedures that took that term as input, and thus the traversal
% overhead would introduce a "noise" that would overwhelm the "signal" that
% profiling is trying to measure.) We can thus match the time taken by a
% procedure against the size of its inputs, and use curve-fitting to find out
% its actual complexity. (The theoretical minimum and maxiumum complexities of
% most real algorithms are so different that they are of no use.)
%
% The obvious way to avoid the traversal overhead on size lookup is to
% calculate the size when the term is being constructed, which requires
% traversing it anyway. In term profiling grades, we reserve an extra word at
% the start of every memory cell (with a few exceptions explained below) that
% stores the size of the whole term the memory cell is the top of. The size
% is defined as the memory words in the term or the number of memory cells in
% the term, depending on the grade.
%
% The main job of this module is to annotate every construction unification
% with the information that the code generator needs to fill in the term size
% slot. In order to do this, it must be able to find out the sizes of the
% arguments, which in turn requires knowing the arguments' types. (Without
% type information, we cannot distinguish a pointer from an integer.) Most of
% the code in this module is concerned with adding code to the procedure being
% transformed to find or construct the typeinfos we need in order to find out
% the sizes of subterms, mainly because we want to minimize the number of
% goals that construct typeinfos that we add to the procedure body.
%
% A minor job of this transformation is to look for places where the procedure
% fills in a previously undefined field in a cell, and to add code at those
% places to destructively increment the size slot of the cell by the size of
% the newly added subterm.
%
% In theory, when this happens, we should also increase the sizes of all the
% terms containing the term that had one or more of its fields instantiated.
% We do not do so, because doing that would require a lot more machinery.
% However, given our lack of support for partially instantiated data
% structures, and the fact that the correctness of the program does not in
% fact require term sizes to be computed accurately, the problem this poses
% can be safely ignored.
%
% The transformation we perform is not optimal: for example, if two branches
% of a switch bind a variable to terms of the same size, we don't exploit this
% fact. The transformation tries to get all the "low-hanging fruit"; we will
% go after higher hanging fruit if and when a performance evaluation says we
% need to.
%
% We do not associate sizes with the memory cells of a small set of types,
% including type_infos, type_class_infos, closures and boxed floats. The two
% reasons for this are that (1) the sizes of values of these types practically
% never control the complexity of a procedure, so there is no need for their
% sizes, and (2) this allows us to create e.g. static type_info structures
% without worrying about term size slots. The set of type categories whose
% values are always considered zero sized is defined by the predicate
% zero_size_type in term_norm.m.
%
% We currently do not associate sizes with data types which are handled mostly
% by hand-written C code in the runtime system or in the standard library:
% strings, arrays, higher-order values and foreign types. Keeping their sizes
% would require a lot of extra work and (in the case of foreign types)
% cooperation from the programmer. In the case of arrays, their destructive
% updates also pose the same problems with respect to the propagation of size
% changes as the instantiation of free variables in cells. Maintaining sizes
% for strings and arrays would be desirable, since real programs do contain
% predicates whose complexity is governed by the length of an array or a
% string, but this remains future work.
%
%-----------------------------------------------------------------------------%

:- module transform_hlds.size_prof.
:- interface.

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

:- import_module io.

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

    % Specifies how term sizes are to be measured.
    %
:- type construct_transform
    --->    term_words
    ;       term_cells.

    % Perform the transformation on the specified predicate.
    %
:- pred size_prof_process_proc_msg(io.text_output_stream::in,
    construct_transform::in, pred_proc_id::in, proc_info::in, proc_info::out,
    module_info::in, module_info::out) is det.

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

:- implementation.

:- import_module check_hlds.
:- import_module check_hlds.inst_test.
:- import_module check_hlds.polymorphism_type_info.
:- import_module check_hlds.recompute_instmap_deltas.
:- import_module check_hlds.simplify.
:- import_module check_hlds.simplify.simplify_proc.
:- import_module check_hlds.simplify.simplify_tasks.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_proc_util.
:- import_module hlds.hlds_rtti.
:- import_module hlds.instmap.
:- import_module hlds.make_goal.
:- import_module hlds.passes_aux.
:- import_module hlds.pred_table.
:- import_module hlds.quantification.
:- import_module mdbcomp.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_type_construct.
:- import_module parse_tree.prog_type_test.
:- import_module parse_tree.set_of_var.
:- import_module parse_tree.var_table.
:- import_module transform_hlds.term_norm.

:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module term.
:- import_module varset.

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

% The transformation maintains several maps that allows it to minimize
% the number of constructions of typeinfos it needs to add to the procedure
% body.
%
% If there is a variable live at the current program point that already
% contains a type_info for a given type, then the type_info_map will record
% its identity. The type_ctor_map does likewise for variables that contain the
% type_ctor_infos of type constructors. However, we treat type_ctor_map
% differently from type_info_maps, because the tradeoff are different.
% Creating a new type_ctor_info reference is cheap: just return a pointer to a
% static compiler-generated data structure. Creating a new type_info isn't
% cheap: it requires memory allocation. This is why in some places (calls,
% ends of branched control structures) we simply clean out the type_ctor_map:
% it is cheaper to recreate a type_ctor_info than to store it or move it
% around.
%
% The rev_type_info_map and rev_type_ctor_map contain the same information
% as type_info_map and type_ctor_map respectively, only indexed by the
% program variable, not by the type or type constructor.
%
% If each arm of a branched control structure creates a type_info for a given
% type but make different variables hold this type_info, then the code after
% the branched control structure, not knowing which branch was taken, cannot
% look up the type_info in any one of these variables, and is instead forced
% to allocate that same type_info anew. The purpose of the target_type_info_map
% is to minimize the number of places where we have to do this. If an earlier
% branch has put the typeinfo for a given type into a given variable, then we
% record this fact in the target_type_info_map, so that when a later branch
% needs a type_info for the same type, it will put it into the same variable.
% Of course, this pays off only if all branches allocate a type_info for the
% type, but this does happen reasonably often. When it doesn't, the variable
% that two or more branches use to store the type_into may need to be named
% apart, which is why we invoke quantification after our transformation is
% finished.
%
% It is of course better to find out the sizes of terms at compile time
% than at runtime. The known_size_map maps each variable whose size is known
% to its size.
%
% The varset and vartypes fields come from the proc_info of the procedure being
% transformed, and their modified versions (updated when the transformation
% creates new variables) are put back into the procedure's new proc_info.
%
% The construct_transform field specifies how term sizes are to be measured.
%
% The rtti_varmaps specifies which program variables hold the type_infos
% of which type variables.
%
% The module_info is needed by some utility predicates called by the
% transformation.

:- type type_info_map       == map(mer_type, prog_var).
:- type type_ctor_map       == map(type_ctor, prog_var).
:- type rev_type_info_map   == map(prog_var, mer_type).
:- type rev_type_ctor_map   == map(prog_var, type_ctor).
:- type known_size_map      == map(prog_var, int).

:- type size_prof_info
    --->    size_prof_info(
                spi_module_info             :: module_info,
                spi_type_ctor_map           :: type_ctor_map,
                spi_type_info_map           :: type_info_map,
                spi_rev_type_ctor_map       :: rev_type_ctor_map,
                spi_rev_type_info_map       :: rev_type_info_map,
                spi_target_type_info_map    :: type_info_map,
                spi_known_size_map          :: known_size_map,
                spi_var_table               :: var_table,
                spi_transform_op            :: construct_transform,
                spi_rtti_varmaps            :: rtti_varmaps
            ).

size_prof_process_proc_msg(ProgressStream, Transform, PredProcId,
        !ProcInfo, !ModuleInfo) :-
    trace [io(!IO)] (
        maybe_write_proc_progress_message(ProgressStream, !.ModuleInfo,
            "Size profiling", PredProcId, !IO)
    ),
    size_prof_process_proc(ProgressStream, Transform, PredProcId,
        !ProcInfo, !ModuleInfo).

:- pred size_prof_process_proc(io.text_output_stream::in,
    construct_transform::in, pred_proc_id::in, proc_info::in, proc_info::out,
    module_info::in, module_info::out) is det.

size_prof_process_proc(ProgressStream, Transform, proc(PredId, ProcId),
        !ProcInfo, !ModuleInfo) :-
    module_info_get_globals(!.ModuleInfo, Globals),
    SimplifyTasks = list_to_simplify_tasks(Globals, []),
    simplify_proc(maybe.no, ProgressStream, SimplifyTasks, PredId, ProcId,
        !ProcInfo, !ModuleInfo),

    proc_info_get_goal(!.ProcInfo, Goal0),
    proc_info_get_var_table(!.ProcInfo, VarTable0),
    proc_info_get_initial_instmap(!.ModuleInfo, !.ProcInfo, InstMap0),
    proc_info_get_rtti_varmaps(!.ProcInfo, RttiVarMaps0),
    % The with_types are needed to avoid a combinatorial explosion
    % of ambiguity in the type checker.
    TypeCtorMap0 = map.init : type_ctor_map,
    TypeInfoMap0 = map.init : type_info_map,
    RevTypeCtorMap0 = map.init : rev_type_ctor_map,
    RevTypeInfoMap0 = map.init : rev_type_info_map,
    TargetTypeInfoMap0 = map.init : type_info_map,
    KnownSizeMap0 = map.init : known_size_map,
    Info0 = size_prof_info(!.ModuleInfo, TypeCtorMap0, TypeInfoMap0,
        RevTypeCtorMap0, RevTypeInfoMap0, TargetTypeInfoMap0,
        KnownSizeMap0, VarTable0, Transform, RttiVarMaps0),
    rtti_varmaps_tvars(RttiVarMaps0, TVars),
    list.foldl(record_typeinfo_in_type_info_varmap(RttiVarMaps0), TVars,
        Info0, Info1),
    size_prof_process_goal(Goal0, Goal1, Info1, Info),

    % We need to fix up goal_infos by recalculating
    % the nonlocal vars and the non-atomic instmap deltas.
    proc_info_get_headvars(!.ProcInfo, HeadVars),
    proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
    implicitly_quantify_clause_body_general(ord_nl_no_lambda,
        HeadVars, _Warnings, Goal1, Goal2,
        Info ^ spi_var_table, VarTable,
        Info ^ spi_rtti_varmaps, RttiVarMaps),
    recompute_instmap_delta(no_recomp_atomics,
        VarTable, InstVarSet, InstMap0, Goal2, Goal, !ModuleInfo),
    proc_info_set_goal(Goal, !ProcInfo),
    proc_info_set_var_table(VarTable, !ProcInfo),
    proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo).

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

size_prof_process_goal(Goal0, Goal, !Info) :-
    Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
    (
        GoalExpr0 = unify(LHS, RHS, UniMode, Unify0, UnifyContext),
        (
            Unify0 = construct(Var, ConsId, Args, ArgModes, How, Unique, _),
            size_prof_process_construct(LHS, RHS, UniMode, UnifyContext,
                Var, ConsId, Args, ArgModes, How, Unique, GoalInfo0, GoalExpr,
                !Info)
        ;
            Unify0 = deconstruct(Var, ConsId, Args, ArgModes,
                _CanFail, _CanCGC),
            ( if
                % The following test is an optimization. If
                % BindingArgModes = [], which is almost 100% likely,
                % then size_prof_process_deconstruct would return GoalExpr0 as
                % GoalExpr anyway, but would take longer.
                list.filter(binds_arg_in_cell(!.Info), ArgModes,
                    BindingArgModes),
                BindingArgModes = [_ | _]
            then
                size_prof_process_deconstruct(Var, ConsId, Args, ArgModes,
                    Goal0, GoalExpr, !Info)
            else
                GoalExpr = GoalExpr0
            )
        ;
            ( Unify0 = assign(_, _)
            ; Unify0 = simple_test(_, _)
            ),
            GoalExpr = GoalExpr0
        ;
            Unify0 = complicated_unify(_, _, _),
            % These should have been expanded out by now.
            unexpected($pred, "complicated_unify")
        )
    ;
        GoalExpr0 = plain_call(_, _, _, _, _, _),
        % We don't want to save type_ctor_info variables across calls,
        % because saving/restoring them is more expensive than defining
        % them again.
        !Info ^ spi_type_ctor_map := map.init,
        !Info ^ spi_rev_type_ctor_map := map.init,
        GoalExpr = GoalExpr0
    ;
        GoalExpr0 = generic_call(_, _, _, _, _),
        % We don't want to save type_ctor_info variables across calls,
        % because saving/restoring them is more expensive than defining
        % them again.
        !Info ^ spi_type_ctor_map := map.init,
        !Info ^ spi_rev_type_ctor_map := map.init,
        GoalExpr = GoalExpr0
    ;
        GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
        GoalExpr = GoalExpr0
    ;
        GoalExpr0 = conj(ConjType, Goals0),
        (
            ConjType = plain_conj,
            size_prof_process_conj(Goals0, Goals, !Info)
        ;
            ConjType = parallel_conj,
            % This transformation produces code that is much less than
            % optimal. However, it ought to be more robust than any better
            % transformation, and there is no point in spending time on a
            % better transformation while parallel conjunctions are rare.
            TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
            TypeInfoMap0 = !.Info ^ spi_type_info_map,
            RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
            TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
            KnownSizeMap0 = !.Info ^ spi_known_size_map,
            size_prof_process_par_conj(Goals0, Goals, !Info,
                TargetTypeInfoMap0, TypeInfoMap0, TypeCtorMap0, KnownSizeMap0),
            !Info ^ spi_target_type_info_map := TargetTypeInfoMap0,
            !Info ^ spi_type_info_map := TypeInfoMap0,
            !Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
            !Info ^ spi_type_ctor_map := map.init,
            !Info ^ spi_rev_type_ctor_map := map.init,
            !Info ^ spi_known_size_map := KnownSizeMap0
        ),
        GoalExpr = conj(ConjType, Goals)
    ;
        GoalExpr0 = switch(SwitchVar, CanFail, Cases0),
        (
            Cases0 = [First0 | Later0],
            TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
            TypeInfoMap0 = !.Info ^ spi_type_info_map,
            RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
            TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
            RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
            KnownSizeMap0 = !.Info ^ spi_known_size_map,
            size_prof_process_switch(First0, First, Later0, Later, !Info,
                TargetTypeInfoMap0,
                TypeInfoMap0, RevTypeInfoMap0,
                TypeCtorMap0, RevTypeCtorMap0,
                TypeInfoMap, KnownSizeMap0, KnownSizeMap),
            !Info ^ spi_type_info_map := TypeInfoMap,
            % The rev_type_info_map field is updated by
            % the call to update_rev_maps below.
            !Info ^ spi_type_ctor_map := map.init,
            !Info ^ spi_rev_type_ctor_map := map.init,
            !Info ^ spi_known_size_map := KnownSizeMap,
            Cases = [First | Later]
        ;
            Cases0 = [],
            unexpected($pred, "empty switch")
        ),
        update_rev_maps(!Info),
        update_target_map(!Info),
        GoalExpr = switch(SwitchVar, CanFail, Cases)
    ;
        GoalExpr0 = disj(Disjuncts0),
        (
            Disjuncts0 = [First0 | Later0],
            TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
            TypeInfoMap0 = !.Info ^ spi_type_info_map,
            RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
            TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
            RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
            KnownSizeMap0 = !.Info ^ spi_known_size_map,
            size_prof_process_disj(First0, First, Later0, Later, !Info,
                TargetTypeInfoMap0,
                TypeInfoMap0, RevTypeInfoMap0,
                TypeCtorMap0, RevTypeCtorMap0,
                TypeInfoMap, KnownSizeMap0, KnownSizeMap),
            !Info ^ spi_type_info_map := TypeInfoMap,
            % The rev_type_info_map field is updated by
            % the call to update_rev_maps below.
            !Info ^ spi_type_ctor_map := map.init,
            !Info ^ spi_rev_type_ctor_map := map.init,
            !Info ^ spi_known_size_map := KnownSizeMap,
            Disjuncts = [First | Later]
        ;
            Disjuncts0 = [],
            % An empty disj represents `fail'.
            !Info ^ spi_type_info_map := map.init,
            !Info ^ spi_rev_type_ctor_map := map.init,
            !Info ^ spi_type_info_map := map.init,
            !Info ^ spi_rev_type_ctor_map := map.init,
            Disjuncts = []
        ),
        update_rev_maps(!Info),
        update_target_map(!Info),
        GoalExpr = disj(Disjuncts)
    ;
        GoalExpr0 = if_then_else(Quant, Cond0, Then0, Else0),
        TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
        TypeInfoMap0 = !.Info ^ spi_type_info_map,
        RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
        TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
        RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
        KnownSizeMap0 = !.Info ^ spi_known_size_map,

        !Info ^ spi_target_type_info_map := map.init,
        size_prof_process_goal(Cond0, Cond, !Info),
        !Info ^ spi_target_type_info_map := TargetTypeInfoMap0,
        size_prof_process_goal(Then0, Then, !Info),
        TargetTypeInfoMapThen = !.Info ^ spi_target_type_info_map,
        TypeInfoMapThen = !.Info ^ spi_type_info_map,
        KnownSizeMapThen = !.Info ^ spi_known_size_map,

        map.union(select_first, TargetTypeInfoMapThen,
            TargetTypeInfoMap0, ElseTargetTypeInfoMap),
        !Info ^ spi_target_type_info_map := ElseTargetTypeInfoMap,
        !Info ^ spi_type_info_map := TypeInfoMap0,
        !Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
        !Info ^ spi_type_ctor_map := TypeCtorMap0,
        !Info ^ spi_rev_type_ctor_map := RevTypeCtorMap0,
        !Info ^ spi_known_size_map := KnownSizeMap0,
        size_prof_process_goal(Else0, Else, !Info),
        TypeInfoMapElse = !.Info ^ spi_type_info_map,
        KnownSizeMapElse = !.Info ^ spi_known_size_map,

        TypeInfoMap = map.common_subset(TypeInfoMapThen, TypeInfoMapElse),
        KnownSizeMap = map.common_subset(KnownSizeMapThen, KnownSizeMapElse),
        !Info ^ spi_type_info_map := TypeInfoMap,
        !Info ^ spi_type_ctor_map := map.init,
        !Info ^ spi_known_size_map := KnownSizeMap,
        update_rev_maps(!Info),
        update_target_map(!Info),
        GoalExpr = if_then_else(Quant, Cond, Then, Else)
    ;
        GoalExpr0 = negation(NegGoal0),
        TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
        TypeInfoMap0 = !.Info ^ spi_type_info_map,
        RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
        TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
        RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
        KnownSizeMap0 = !.Info ^ spi_known_size_map,
        size_prof_process_goal(NegGoal0, NegGoal, !Info),
        % Variables constructed in negated goals are not available after the
        % negated goal fails and the negation succeeds. The sizes we learn
        % in NegGoal0 don't apply after NegGoal0 fails.
        !Info ^ spi_target_type_info_map := TargetTypeInfoMap0,
        !Info ^ spi_type_info_map := TypeInfoMap0,
        !Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
        !Info ^ spi_type_ctor_map := TypeCtorMap0,
        !Info ^ spi_rev_type_ctor_map := RevTypeCtorMap0,
        !Info ^ spi_known_size_map := KnownSizeMap0,
        GoalExpr = negation(NegGoal)
    ;
        GoalExpr0 = scope(Reason0, SubGoal0),
        % The code inside from_ground_term_construct scopes wants to construct
        % terms statically, but for term size profiling, we need to construct
        % terms dynamically,
        ( if
            Reason0 = from_ground_term(TermVar, from_ground_term_construct)
        then
            Reason = from_ground_term(TermVar, from_ground_term_other)
        else
            Reason = Reason0
        ),
        size_prof_process_goal(SubGoal0, SubGoal, !Info),
        GoalExpr = scope(Reason, SubGoal)
    ;
        GoalExpr0 = shorthand(_),
        unexpected($pred, "shorthand")
    ),
    Goal = hlds_goal(GoalExpr, GoalInfo0).

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

:- pred size_prof_process_conj(list(hlds_goal)::in, list(hlds_goal)::out,
    size_prof_info::in, size_prof_info::out) is det.

size_prof_process_conj([], [], !Info).
size_prof_process_conj([Goal0 | Goals0], Conj, !Info) :-
    size_prof_process_goal(Goal0, Goal, !Info),
    size_prof_process_conj(Goals0, Goals, !Info),
    ( if Goal = hlds_goal(conj(plain_conj, SubConj), _) then
        % Flatten out any conjunction introduced by size_prof_process_goal.
        % We never create conjunctions more than one level deep,
        % so this single test is sufficient to ensure that we never
        % leave conjunctions nested more deeply than the input goal.
        Conj = list.append(SubConj, Goals)
    else
        Conj = [Goal | Goals]
    ).

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

:- pred size_prof_process_par_conj(list(hlds_goal)::in, list(hlds_goal)::out,
    size_prof_info::in, size_prof_info::out,
    type_info_map::in, type_info_map::in,
    type_ctor_map::in, known_size_map::in) is det.

size_prof_process_par_conj([], [], !Info, _, _, _, _).
size_prof_process_par_conj([Goal0 | Goals0], [Goal | Goals], !Info,
        TargetTypeInfoMap0, TypeInfoMap0, TypeCtorMap0, KnownSizeMap0) :-
    !Info ^ spi_target_type_info_map := TargetTypeInfoMap0,
    !Info ^ spi_type_info_map := TypeInfoMap0,
    !Info ^ spi_type_ctor_map := TypeCtorMap0,
    !Info ^ spi_known_size_map := KnownSizeMap0,
    size_prof_process_goal(Goal0, Goal, !Info),
    size_prof_process_par_conj(Goals0, Goals, !Info,
        TargetTypeInfoMap0, TypeInfoMap0, TypeCtorMap0, KnownSizeMap0).

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

:- pred size_prof_process_disj(hlds_goal::in, hlds_goal::out,
    list(hlds_goal)::in, list(hlds_goal)::out,
    size_prof_info::in, size_prof_info::out,
    type_info_map::in, type_info_map::in, rev_type_info_map::in,
    type_ctor_map::in, rev_type_ctor_map::in,
    type_info_map::out, known_size_map::in, known_size_map::out) is det.

size_prof_process_disj(First0, First, Later0, Later, !Info, TargetTypeInfoMap,
        TypeInfoMap0, RevTypeInfoMap0, TypeCtorMap0, RevTypeCtorMap0,
        TypeInfoMap, KnownSizeMap0, KnownSizeMap) :-
    !Info ^ spi_type_info_map := TypeInfoMap0,
    !Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
    !Info ^ spi_type_ctor_map := TypeCtorMap0,
    !Info ^ spi_rev_type_ctor_map := RevTypeCtorMap0,
    !Info ^ spi_known_size_map := KnownSizeMap0,
    size_prof_process_goal(First0, First, !Info),
    TypeInfoMapFirst = !.Info ^ spi_type_info_map,
    KnownSizeMapFirst = !.Info ^ spi_known_size_map,
    (
        Later0 = [Head0 | Tail0],
        map.union(select_first, TypeInfoMapFirst,
            TargetTypeInfoMap, LaterTargetTypeInfoMap),
        !Info ^ spi_target_type_info_map := LaterTargetTypeInfoMap,
        size_prof_process_disj(Head0, Head, Tail0, Tail, !Info,
            TargetTypeInfoMap,
            TypeInfoMap0, RevTypeInfoMap0, TypeCtorMap0, RevTypeCtorMap0,
            TypeInfoMapLater, KnownSizeMap0, KnownSizeMapLater),
        TypeInfoMap = map.common_subset(TypeInfoMapFirst, TypeInfoMapLater),
        KnownSizeMap = map.common_subset(KnownSizeMapFirst, KnownSizeMapLater),
        Later = [Head | Tail]
    ;
        Later0 = [],
        Later = [],
        TypeInfoMap = TypeInfoMapFirst,
        KnownSizeMap = KnownSizeMapFirst
    ).

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

:- pred size_prof_process_switch(case::in, case::out,
    list(case)::in, list(case)::out, size_prof_info::in, size_prof_info::out,
    type_info_map::in, type_info_map::in, rev_type_info_map::in,
    type_ctor_map::in, rev_type_ctor_map::in,
    type_info_map::out, known_size_map::in, known_size_map::out) is det.

size_prof_process_switch(First0, First, Later0, Later, !Info,
        TargetTypeInfoMap, TypeInfoMap0, RevTypeInfoMap0,
        TypeCtorMap0, RevTypeCtorMap0,
        TypeInfoMap, KnownSizeMap0, KnownSizeMap) :-
    !Info ^ spi_type_info_map := TypeInfoMap0,
    !Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
    !Info ^ spi_type_ctor_map := TypeCtorMap0,
    !Info ^ spi_rev_type_ctor_map := RevTypeCtorMap0,
    !Info ^ spi_known_size_map := KnownSizeMap0,
    First0 = case(FirstMainConsId, FirstOtherConsIds, FirstGoal0),
    size_prof_process_goal(FirstGoal0, FirstGoal, !Info),
    TypeInfoMapFirst = !.Info ^ spi_type_info_map,
    KnownSizeMapFirst = !.Info ^ spi_known_size_map,
    First = case(FirstMainConsId, FirstOtherConsIds, FirstGoal),
    (
        Later0 = [Head0 | Tail0],
        map.union(select_first, TargetTypeInfoMap,
            TypeInfoMapFirst, LaterTargetTypeInfoMap),
        !Info ^ spi_target_type_info_map := LaterTargetTypeInfoMap,
        size_prof_process_switch(Head0, Head, Tail0, Tail, !Info,
            TargetTypeInfoMap, TypeInfoMap0, RevTypeInfoMap0,
            TypeCtorMap0, RevTypeCtorMap0,
            TypeInfoMapLater, KnownSizeMap0, KnownSizeMapLater),
        TypeInfoMap = map.common_subset(TypeInfoMapFirst, TypeInfoMapLater),
        KnownSizeMap = map.common_subset(KnownSizeMapFirst, KnownSizeMapLater),
        Later = [Head | Tail]
    ;
        Later0 = [],
        Later = [],
        TypeInfoMap = TypeInfoMapFirst,
        KnownSizeMap = KnownSizeMapFirst
    ).

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

:- pred size_prof_process_construct(prog_var::in, unify_rhs::in,
    unify_mode::in, unify_context::in, prog_var::in, cons_id::in,
    list(prog_var)::in, list(unify_mode)::in, how_to_construct::in,
    cell_is_unique::in, hlds_goal_info::in, hlds_goal_expr::out,
    size_prof_info::in, size_prof_info::out) is det.

size_prof_process_construct(LHS, RHS, UniMode, UnifyContext, Var, ConsId,
        Args, ArgModes, How, Unique, GoalInfo, GoalExpr, !Info) :-
    lookup_var_type(!.Info ^ spi_var_table, Var, VarType),
    type_to_ctor_det(VarType, VarTypeCtor),
    type_ctor_module_name_arity(VarTypeCtor,
        VarTypeCtorModule, VarTypeCtorName, _),
    ( if
        ctor_is_type_info_related(VarTypeCtorModule, VarTypeCtorName)
    then
        ( if VarTypeCtorName = "type_info" then
            ( if
                ConsId = type_info_cell_constructor(_),
                Args = [TypeCtorInfoVar | ArgTypeInfoVars]
            then
                record_known_type_info(Var, TypeCtorInfoVar, ArgTypeInfoVars,
                    !Info)
            else if
                ConsId = type_ctor_info_const(M, N, A)
            then
                % When type specialization creates a procedure with a type
                % substitution such as K=int, it leaves the type of
                % TypeInfo_for_K as type_info, not type_ctor_info.
                record_known_type_ctor_info(Var, M, N, A, !Info)
            else
                unexpected($pred, "bad type_info")
            )
        else if VarTypeCtorName = "type_ctor_info" then
            ( if ConsId = type_ctor_info_const(M, N, A) then
                record_known_type_ctor_info(Var, M, N, A, !Info)
            else
                unexpected($pred, "bad type_ctor_info")
            )
        else
            !:Info = !.Info
        ),
        Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
            no_construct_sub_info),
        GoalExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext)
    else if
        ConsId = du_data_ctor(DuCtor),
        Args = [_ | _]
    then
        size_prof_process_cons_construct(LHS, RHS, UniMode, UnifyContext,
            Var, VarType, DuCtor, Args, ArgModes, How, Unique,
            GoalInfo, GoalExpr, !Info)
    else
        % All ConsIds other than cons/2 with at least one argument
        % construct terms that we consider zero-sized.
        record_known_size(Var, 0, !Info),
        Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
            no_construct_sub_info),
        GoalExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext)
    ).

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

:- pred size_prof_process_deconstruct(prog_var::in, cons_id::in,
    list(prog_var)::in, list(unify_mode)::in, hlds_goal::in,
    hlds_goal_expr::out, size_prof_info::in, size_prof_info::out) is det.

size_prof_process_deconstruct(Var, ConsId, Args, ArgModes, Goal0, GoalExpr,
        !Info) :-
    lookup_var_type(!.Info ^ spi_var_table, Var, VarType),
    type_to_ctor_det(VarType, VarTypeCtor),
    type_ctor_module_name_arity(VarTypeCtor, VarTypeCtorModule,
        VarTypeCtorName, _),
    ( if
        ctor_is_type_info_related(VarTypeCtorModule, VarTypeCtorName)
    then
        Goal0 = hlds_goal(GoalExpr, _)
    else if
        ( ConsId = du_data_ctor(_)
        ; ConsId = tuple_cons(_Arity)
        ),
        Args = [_ | _]
    then
        size_prof_process_cons_deconstruct(Var, Args, ArgModes, Goal0,
            GoalExpr, !Info)
    else
        % All ConsIds other than cons/2 deconstruct terms that we
        % consider zero-sized.
        record_known_size(Var, 0, !Info),
        Goal0 = hlds_goal(GoalExpr, _)
    ).

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

:- pred size_prof_process_cons_construct(prog_var::in, unify_rhs::in,
    unify_mode::in, unify_context::in, prog_var::in, mer_type::in,
    du_ctor::in, list(prog_var)::in, list(unify_mode)::in,
    how_to_construct::in, cell_is_unique::in, hlds_goal_info::in,
    hlds_goal_expr::out, size_prof_info::in, size_prof_info::out) is det.

size_prof_process_cons_construct(LHS, RHS, UniMode, UnifyContext, Var, _Type,
        DuCtor, Args, ArgModes, How, Unique, GoalInfo0, GoalExpr, !Info) :-
    FunctorSize = compute_functor_size(Args, !.Info),
    find_defined_args(Args, ArgModes, DefinedArgs, NonDefinedArgs, !.Info),
    Context = goal_info_get_context(GoalInfo0),
    size_prof_process_args(DefinedArgs, FunctorSize, KnownSize,
        no, MaybeDynamicSizeVar, Context, ArgGoals, !Info),
    ConsId = du_data_ctor(DuCtor),
    (
        MaybeDynamicSizeVar = no,
        expect(unify(ArgGoals, []), $pred, "nonempty ArgGoals"),
        (
            NonDefinedArgs = [],
            record_known_size(Var, KnownSize, !Info)
        ;
            NonDefinedArgs = [_ | _],
            % The size of the term may change as some of its
            % currently free arguments become bound.
            true
        ),
        Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
            construct_sub_info(no, yes(known_size(KnownSize)))),
        GoalExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext)
    ;
        MaybeDynamicSizeVar = yes(SizeVar0),
        generate_size_var(SizeVar0, KnownSize, Context, SizeVar, SizeGoals,
            !Info),
        Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
            construct_sub_info(no, yes(dynamic_size(SizeVar)))),
        UnifyExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext),
        NonLocals0 = goal_info_get_nonlocals(GoalInfo0),
        set_of_var.insert(SizeVar, NonLocals0, NonLocals),
        goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
        UnifyGoal = hlds_goal(UnifyExpr, GoalInfo),
        Goals = list.condense([ArgGoals, SizeGoals, [UnifyGoal]]),
        GoalExpr = conj(plain_conj, Goals)
    ).

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

:- pred size_prof_process_cons_deconstruct(prog_var::in, list(prog_var)::in,
    list(unify_mode)::in, hlds_goal::in, hlds_goal_expr::out,
    size_prof_info::in, size_prof_info::out) is det.

size_prof_process_cons_deconstruct(Var, Args, ArgModes, UnifyGoal, GoalExpr,
        !Info) :-
    find_defined_args(Args, ArgModes, DefinedArgs, _NonDefArgs, !.Info),
    UnifyGoal = hlds_goal(GoalExpr0, GoalInfo0),
    Context = goal_info_get_context(GoalInfo0),
    size_prof_process_args(DefinedArgs, 0, KnownSize,
        no, MaybeDynamicSizeVar, Context, ArgGoals, !Info),
    (
        MaybeDynamicSizeVar = no,
        expect(unify(ArgGoals, []), $pred, "nonempty ArgGoals"),
        GoalExpr = GoalExpr0
    ;
        MaybeDynamicSizeVar = yes(SizeVar0),
        generate_size_var(SizeVar0, KnownSize, Context, SizeVar, SizeGoals,
            !Info),
        % The increment_size primitive doesn't need Var's type_info,
        % so we make it a no_type_info_builtin.
        TermSizeProfBuiltin = mercury_term_size_prof_builtin_module,
        generate_plain_call(!.Info ^ spi_module_info, pf_predicate,
            TermSizeProfBuiltin, "increment_size",
            [], [Var, SizeVar], instmap_delta_bind_no_var, only_mode,
            detism_det, purity_impure, [], Context, UpdateGoal),
        % Put UnifyGoal first in case it fails.
        Goals = [UnifyGoal] ++ ArgGoals ++ SizeGoals ++ [UpdateGoal],
        GoalExpr = conj(plain_conj, Goals)
    ).

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

    % Process the variables representing the fields being bound in a memory
    % cell, computing the contribution they make to the increase in size of
    % that cell. The increase is in two parts: the statically known part,
    % and the part that can be known only at runtime. We record the former
    % in the KnownSize accumulator and the latter in the MaybeSizeVar
    % accumulator. We allocate a variable to hold the dynamically-computed part
    % of the size only if the sum of the arguments' sizes is not static.
    % In that case, the Goals we return will be nonempty.
    %
:- pred size_prof_process_args(list(prog_var)::in, int::in, int::out,
    maybe(prog_var)::in, maybe(prog_var)::out, prog_context::in,
    list(hlds_goal)::out, size_prof_info::in, size_prof_info::out) is det.

size_prof_process_args([], !KnownSize, !MaybeSizeVar, _, [], !Info).
size_prof_process_args([Arg | Args], !KnownSize, !MaybeSizeVar, Context, Goals,
        !Info) :-
    lookup_var_type(!.Info ^ spi_var_table, Arg, Type),
    ( if map.search(!.Info ^ spi_known_size_map, Arg, ArgSize) then
        !:KnownSize = !.KnownSize + ArgSize,
        ArgGoals = []
    else if zero_size_type(!.Info ^ spi_module_info, Type) then
        ArgGoals = []
    else
        make_type_info(Context, Type, TypeInfoVar, TypeInfoGoals, !Info),
        make_size_goal(TypeInfoVar, Arg, Context, SizeGoal, !MaybeSizeVar,
            !Info),
        list.append(TypeInfoGoals, [SizeGoal], ArgGoals)
    ),
    size_prof_process_args(Args, !KnownSize, !MaybeSizeVar, Context,
        LaterGoals, !Info),
    Goals = ArgGoals ++ LaterGoals.

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

    % Given that KnownSize is the static part of the sum of sizes of the fields
    % being defined and SizeVar0 is a variable containing the dynamic part,
    % return a variable SizeVar that contains their sum and the Goals needed to
    % compute it.
    %
:- pred generate_size_var(prog_var::in, int::in, prog_context::in,
    prog_var::out, list(hlds_goal)::out,
    size_prof_info::in, size_prof_info::out) is det.

generate_size_var(SizeVar0, KnownSize, Context, SizeVar, Goals, !Info) :-
    ( if KnownSize = 0 then
        SizeVar = SizeVar0,
        Goals = []
    else
        VarTable0 = !.Info ^ spi_var_table,
        make_int_const_construction_alloc(KnownSize, "KnownSize",
            KnownSizeGoal, KnownSizeVar, VarTable0, VarTable1),
        !Info ^ spi_var_table := VarTable1,
        get_new_var("FinalSizeVar", int_type, is_not_dummy_type, SizeVar,
            !Info),
        TermSizeProfModule = mercury_term_size_prof_builtin_module,
        generate_plain_call(!.Info ^ spi_module_info, pf_function,
            TermSizeProfModule, "term_size_plus",
            [], [SizeVar0, KnownSizeVar, SizeVar],
            instmap_delta_bind_var(SizeVar), mode_no(0),
            detism_det, purity_pure, [], Context, AddGoal),
        Goals = [KnownSizeGoal, AddGoal]
    ).

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

    % Create a type_info for a given type as cheaply as possible, with the
    % cheapest methods involving the reuse of existing type_infos and/or
    % type_ctor_infos. Return the variable holding the type_info in
    % TypeInfoVar, and the goals needed to create it in TypeInfoGoals.

:- pred make_type_info(prog_context::in, mer_type::in, prog_var::out,
    list(hlds_goal)::out, size_prof_info::in, size_prof_info::out) is det.

make_type_info(Context, Type, TypeInfoVar, TypeInfoGoals, !Info) :-
    ( if map.search(!.Info ^ spi_type_info_map, Type, TypeInfoVarPrime) then
        TypeInfoVar = TypeInfoVarPrime,
        TypeInfoGoals = []
    else if type_has_variable_arity_ctor(Type, TypeCtor, ArgTypes) then
        construct_type_info(Context, Type, TypeCtor, ArgTypes, yes,
            TypeInfoVar, TypeInfoGoals, !Info)
    else if type_to_ctor_and_args(Type, TypeCtor, ArgTypes) then
        (
            ArgTypes = [],
            make_type_ctor_info(TypeCtor, [], TypeCtorVar, TypeCtorGoals,
                !Info),
            TypeInfoVar = TypeCtorVar,
            TypeInfoGoals = TypeCtorGoals
        ;
            ArgTypes = [_ | _],
            construct_type_info(Context, Type, TypeCtor, ArgTypes,
                no, TypeInfoVar, TypeInfoGoals, !Info)
        )
    else if Type = type_variable(TVar, _) then
        rtti_lookup_type_info_locn(!.Info ^ spi_rtti_varmaps, TVar, TVarLocn),
        (
            TVarLocn = type_info(TypeInfoVar),
            TypeInfoGoals = []
        ;
            TVarLocn = typeclass_info(TypeClassInfoVar, Slot),
            TargetTypeInfoMap = !.Info ^ spi_target_type_info_map,
            VarTable0 = !.Info ^ spi_var_table,
            ( if map.search(TargetTypeInfoMap, Type, TargetVar) then
                TypeInfoVar = TargetVar,
                VarTable1 = VarTable0
            else
                RttiVarMaps0 = !.Info ^ spi_rtti_varmaps,
                new_type_info_var_vt(Type, type_info, TypeInfoVar,
                    VarTable0, VarTable1, RttiVarMaps0, RttiVarMaps),
                !Info ^ spi_rtti_varmaps := RttiVarMaps
            ),
            make_int_const_construction_alloc(Slot, "TypeClassInfoSlot",
                SlotGoal, SlotVar, VarTable1, VarTable),
            !Info ^ spi_var_table := VarTable,
            PrivateBuiltin = mercury_private_builtin_module,
            generate_plain_call(!.Info ^ spi_module_info, pf_predicate,
                PrivateBuiltin, "type_info_from_typeclass_info",
                [], [TypeClassInfoVar, SlotVar, TypeInfoVar],
                instmap_delta_bind_var(TypeInfoVar), only_mode,
                detism_det, purity_pure, [], Context, ExtractGoal),
            record_type_info_var(Type, TypeInfoVar, !Info),
            TypeInfoGoals = [SlotGoal, ExtractGoal]
        )
    else
        % Type_to_ctor_and_args can fail only if Type is a type variable,
        % or acts like one. The tests in our callers should have filtered
        % out both cases.
        unexpected($pred, "cannot happen")
    ).

    % Construct a type_info for Type = TypeCtor(ArgTypes), given that we know
    % there is no variable that currently holds a type_info for Type. Return
    % the variable holding the type_info in TypeInfoVar, and the goals needed
    % to create it in TypeInfoGoals.
    %
:- pred construct_type_info(prog_context::in, mer_type::in, type_ctor::in,
    list(mer_type)::in, bool::in, prog_var::out, list(hlds_goal)::out,
    size_prof_info::in, size_prof_info::out) is det.

construct_type_info(Context, Type, TypeCtor, ArgTypes, CtorIsVarArity,
        TypeInfoVar, TypeInfoGoals, !Info) :-
    list.map2_foldl(make_type_info(Context), ArgTypes,
        ArgTypeInfoVars, ArgTypeInfoGoalLists, !Info),
    ArgTypeInfoGoals = list.condense(ArgTypeInfoGoalLists),
    make_type_ctor_info(TypeCtor, ArgTypes, TypeCtorVar, TypeCtorGoals, !Info),
    (
        CtorIsVarArity = yes,
        list.length(ArgTypes, Arity),
        VarTable0 = !.Info ^ spi_var_table,
        make_int_const_construction_alloc(Arity, "TupleArity", ArityGoal,
            ArityVar, VarTable0, VarTable1),
        !Info ^ spi_var_table := VarTable1,
        FrontGoals = list.append(TypeCtorGoals, [ArityGoal]),
        ArgVars = [TypeCtorVar, ArityVar | ArgTypeInfoVars]
    ;
        CtorIsVarArity = no,
        FrontGoals = TypeCtorGoals,
        ArgVars = [TypeCtorVar | ArgTypeInfoVars]
    ),
    VarTable2 = !.Info ^ spi_var_table,
    RttiVarMaps2 = !.Info ^ spi_rtti_varmaps,
    TargetTypeInfoMap = !.Info ^ spi_target_type_info_map,
    ( if map.search(TargetTypeInfoMap, Type, TypeInfoVarPrime) then
        TypeInfoVar = TypeInfoVarPrime,
        VarTable = VarTable2,
        RttiVarMaps3 = RttiVarMaps2
    else
        new_type_info_var_vt(Type, type_info, TypeInfoVar,
            VarTable2, VarTable, RttiVarMaps2, RttiVarMaps3)
    ),
    init_type_info_var(Type, ArgVars, TypeInfoVar, TypeInfoGoal,
        RttiVarMaps3, RttiVarMaps),

    !Info ^ spi_var_table := VarTable,
    !Info ^ spi_rtti_varmaps := RttiVarMaps,
    TypeInfoGoals = ArgTypeInfoGoals ++ FrontGoals ++ [TypeInfoGoal].

    % Create a type_ctor_info for a given type constructor as cheaply as
    % possible, with the cheapest method being the reuse of an existing
    % type_ctor_info. Return the variable holding the type_ctor_info in
    % TypeCtorVar, and the goals needed to create it in TypeCtorGoals.
    %
:- pred make_type_ctor_info(type_ctor::in, list(mer_type)::in, prog_var::out,
    list(hlds_goal)::out, size_prof_info::in, size_prof_info::out) is det.

make_type_ctor_info(TypeCtor, TypeArgs, TypeCtorVar, TypeCtorGoals, !Info) :-
    ( if
        map.search(!.Info ^ spi_type_ctor_map, TypeCtor, TypeCtorVarPrime)
    then
        TypeCtorVar = TypeCtorVarPrime,
        TypeCtorGoals = []
    else
        ( if type_ctor_is_higher_order(TypeCtor, Purity, PredOrFunc) then
            construct_higher_order_type(Purity, PredOrFunc, TypeArgs, Type)
        else
            construct_type(TypeCtor, [], Type)
        ),
        VarTable0 = !.Info ^ spi_var_table,
        RttiVarMaps0 = !.Info ^ spi_rtti_varmaps,
        init_const_type_ctor_info_var(Type, TypeCtor, TypeCtorVar, _ConsId,
            TypeCtorGoal, VarTable0, VarTable, RttiVarMaps0, RttiVarMaps),
        TypeCtorGoals = [TypeCtorGoal],
        !Info ^ spi_var_table := VarTable,
        !Info ^ spi_rtti_varmaps := RttiVarMaps
    ).

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

    % Generate a goal that looks up the size of Arg at runtime, given that the
    % type_info of Arg's type is in TypeInfoVar.
    %
    % We ultimately always want to compute the sum of the sizes of the fields
    % being defined, so if we have previously looked up the sizes of other
    % fields, then combine the operation of looking up Arg's size with adding
    % that size to the sum of the (dynamic) sizes so far: measure_size_acc
    % does both these operations.
    %
:- pred make_size_goal(prog_var::in, prog_var::in, prog_context::in,
    hlds_goal::out, maybe(prog_var)::in, maybe(prog_var)::out,
    size_prof_info::in, size_prof_info::out) is det.

make_size_goal(TypeInfoVar, Arg, Context, SizeGoal,
        MaybeSizeVar0, MaybeSizeVar, !Info) :-
    get_new_var("SizeVar", int_type, is_not_dummy_type, SizeVar, !Info),
    (
        MaybeSizeVar0 = yes(SizeVar0),
        Pred = "measure_size_acc",
        ArgVars = [Arg, SizeVar0, SizeVar]
    ;
        MaybeSizeVar0 = no,
        Pred = "measure_size",
        ArgVars = [Arg, SizeVar]
    ),
    TermSizeProfBuiltin = mercury_term_size_prof_builtin_module,
    generate_plain_call(!.Info ^ spi_module_info, pf_predicate,
        TermSizeProfBuiltin, Pred,
        [TypeInfoVar], ArgVars, instmap_delta_bind_var(SizeVar), only_mode,
        detism_det, purity_pure, [], Context, SizeGoal),
    MaybeSizeVar = yes(SizeVar).

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

    % Create a new variable with a name constructed from Prefix and the
    % variable number.
    %
:- pred get_new_var(string::in, mer_type::in, is_dummy_type::in, prog_var::out,
    size_prof_info::in, size_prof_info::out) is det.

get_new_var(Prefix, Type, IsDummy, Var, !Info) :-
    VarTable0 = !.Info ^ spi_var_table,
    add_prefix_number_var_entry(Prefix, Type, IsDummy, Var,
        VarTable0, VarTable),
    !Info ^ spi_var_table := VarTable.

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

    % These predicates record information about the procedure body (that was
    % either there originally or was made true by our transformation) for later
    % use in optimizating the transformation of the rest of the procedure body.
    %
    % The reason why the implementation uses map.set instead of
    % map.det_insert is that it is possible for Var to already exist in the
    % maps. This can happen e.g. when each branch of a branched structure
    % generates a value of an existential type, and thus also generates
    % the type_info describing that type. The first branch will insert the
    % variable holding that type_info into the maps, and the later branches
    % will be given the resulting map as guidance.
    %
    % We override any old settings here, for use in the rest of the current
    % branch. Other branches will do likewise. The correct handling of the code
    % after the branched structure is ensured by size_prof_process_goal
    % returning only the common subsets of the maps constructed by the
    % various branches to be used when processing the following code.
    %
:- pred record_known_type_ctor_info(prog_var::in, module_name::in, string::in,
    int::in, size_prof_info::in, size_prof_info::out) is det.

record_known_type_ctor_info(Var, TypeCtorModule, TypeCtorName, TypeCtorArity,
        !Info) :-
    TypeCtor = type_ctor(qualified(TypeCtorModule, TypeCtorName),
        TypeCtorArity),
    TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
    RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
    map.set(TypeCtor, Var, TypeCtorMap0, TypeCtorMap),
    map.set(Var, TypeCtor, RevTypeCtorMap0, RevTypeCtorMap),
    !Info ^ spi_type_ctor_map := TypeCtorMap,
    !Info ^ spi_rev_type_ctor_map := RevTypeCtorMap.

:- pred record_known_type_info(prog_var::in, prog_var::in, list(prog_var)::in,
    size_prof_info::in, size_prof_info::out) is det.

record_known_type_info(Var, TypeCtorInfoVar, ArgTypeInfoVars, !Info) :-
    RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
    ( if map.search(RevTypeCtorMap0, TypeCtorInfoVar, TypeCtor0) then
        RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
        ( if
            list.map(map.search(RevTypeInfoMap0), ArgTypeInfoVars, ArgTypes)
        then
            list.length(ArgTypes, Arity),
            % Just in case TypeCtorInfo0 has fake arity, e.g. if it is a tuple.
            TypeCtor0 = type_ctor(SymName, _DeclArity),
            TypeCtor1 = type_ctor(SymName, Arity),
            construct_type(TypeCtor1, ArgTypes, Type),
            record_type_info_var(Type, Var, !Info)
        else
            true
        )
    else
        % We don't know what type is being constructed, because we have
        % forgotten what type constructor the type constructor variable
        % stands for due to an intervening call. This cannot happen
        % for HLDS code constructed directly by polymorphism.m, but
        % can happen after that code has been rearranged by other
        % compiler passes.
        true
    ).

:- pred record_type_info_var(mer_type::in, prog_var::in,
    size_prof_info::in, size_prof_info::out) is det.

record_type_info_var(Type, Var, !Info) :-
    RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
    TypeInfoMap0 = !.Info ^ spi_type_info_map,
    map.set(Type, Var, TypeInfoMap0, TypeInfoMap),
    ( if map.insert(Var, Type, RevTypeInfoMap0, RevTypeInfoMap1) then
        RevTypeInfoMap = RevTypeInfoMap1
    else
        % This can happen because inlining XXX can leave a type_info_varmap
        % saying that one type_info variable holds the typeinfo for
        % more than one type.
        RevTypeInfoMap = RevTypeInfoMap0
    ),
    !Info ^ spi_type_info_map := TypeInfoMap,
    !Info ^ spi_rev_type_info_map := RevTypeInfoMap.

:- pred record_known_size(prog_var::in, int::in,
    size_prof_info::in, size_prof_info::out) is det.

record_known_size(Var, KnownSize, !Info) :-
    KnownSizeMap0 = !.Info ^ spi_known_size_map,
    map.det_insert(Var, KnownSize, KnownSizeMap0, KnownSizeMap),
    !Info ^ spi_known_size_map := KnownSizeMap.

:- pred record_typeinfo_in_type_info_varmap(rtti_varmaps::in, tvar::in,
    size_prof_info::in, size_prof_info::out) is det.

record_typeinfo_in_type_info_varmap(RttiVarMaps, TVar, !Info) :-
    rtti_lookup_type_info_locn(RttiVarMaps, TVar, TypeInfoLocn),
    % XXX kind inference:
    % we assume the kind is `star'.
    Type = type_variable(TVar, kind_star),
    (
        TypeInfoLocn = type_info(TypeInfoVar),
        record_type_info_var(Type, TypeInfoVar, !Info)
    ;
        TypeInfoLocn = typeclass_info(_TypeClassInfoVar, _Offset)
        % We could record this information and then look for calls that
        % extract typeinfos from typeclass_infos, but code that does
        % that is rare enough that it is not worth optimizing.
        % TypeClassInfoMap0 = !.Info ^ spi_type_class_info_map,
        % map.det_insert(TypeClassInfoMap0,
        %   TypeClassInfoVar - Offset, Type, TypeClassInfoMap),
        % !Info ^ spi_type_class_info_map := TypeClassInfoMap
    ).

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

    % We must ensure that we record that a branched control structure is
    % considered to generate a type_ctor_info or type_info variable only
    % if all the branches generate it. The code above takes the intersections
    % of the forward maps (type to type_info or type_ctor_info var maps)
    % produced by different branches directly, but calls update_rev_maps
    % to ensure that the reverse maps
    %
    % (a) contain only entries that are also in the forward maps, i.e. do not
    %     contain entries that the intersection process removed, and
    % (b) do not contain entries derived from inconsistent forward map entries
    %     (since a forward map can say that e.g. both the type int and the type
    %     constructor int/0 have their typeinfo in the same variable).
    %
:- pred update_rev_maps(size_prof_info::in, size_prof_info::out) is det.

update_rev_maps(!Info) :-
    map.to_sorted_assoc_list(!.Info ^ spi_type_info_map, TypeInfoList),
    map.to_sorted_assoc_list(!.Info ^ spi_type_ctor_map, TypeCtorList),
    map.init(VarCounts0),
    count_appearances(TypeInfoList, VarCounts0, VarCounts1),
    count_appearances(TypeCtorList, VarCounts1, VarCounts),
    construct_rev_map(TypeInfoList, VarCounts, map.init, RevTypeInfoMap),
    construct_rev_map(TypeCtorList, VarCounts, map.init, RevTypeCtorMap),
    !Info ^ spi_rev_type_info_map := RevTypeInfoMap,
    !Info ^ spi_rev_type_ctor_map := RevTypeCtorMap.

:- pred count_appearances(assoc_list(T, prog_var)::in,
    map(prog_var, int)::in, map(prog_var, int)::out) is det.

count_appearances([], !VarCounts).
count_appearances([_ - Var | AssocList], !VarCounts) :-
    ( if map.search(!.VarCounts, Var, Count) then
        map.det_update(Var, Count + 1, !VarCounts)
    else
        map.det_insert(Var, 1, !VarCounts)
    ),
    count_appearances(AssocList, !VarCounts).

:- pred construct_rev_map(assoc_list(T, prog_var)::in,
    map(prog_var, int)::in,
    map(prog_var, T)::in, map(prog_var, T)::out) is det.

construct_rev_map([], _, !RevMap).
construct_rev_map([T - Var | AssocList], VarCounts, !RevMap) :-
    map.lookup(VarCounts, Var, Count),
    ( if Count = 1 then
        map.det_insert(Var, T, !RevMap)
    else
        true
    ),
    construct_rev_map(AssocList, VarCounts, !RevMap).

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

    % During the processing of a branched control structure, we add entries
    % to the target type_info map in an effort to encourage different branches
    % to use the same variable to store the type_info for the same type,
    % since this increases the probability that all branches define a type_info
    % for the type and that thus we will be able to use the variable holding
    % that type_info after the branched control structure without recreating
    % it. However, if some branches define the target variable but others
    % don't, then the branched control structure cannot define the variable
    % for later code. We must therefore remove the variable from the target
    % type_info map used by later code.
    %
:- pred update_target_map(size_prof_info::in, size_prof_info::out) is det.

update_target_map(!Info) :-
    TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
    TypeInfoMap = !.Info ^ spi_type_info_map,
    map.to_sorted_assoc_list(TargetTypeInfoMap0, TargetTypeInfoList),
    list.foldl(include_in_target_map(TypeInfoMap), TargetTypeInfoList,
        map.init, TargetTypeInfoMap),
    !Info ^ spi_target_type_info_map := TargetTypeInfoMap.

:- pred include_in_target_map(type_info_map::in, pair(mer_type, prog_var)::in,
    type_info_map::in, type_info_map::out) is det.

include_in_target_map(TypeInfoMap, Type - TypeInfoVar, !TargetTypeInfoMap) :-
    ( if map.search(TypeInfoMap, Type, TypeInfoVar) then
        map.det_insert(Type, TypeInfoVar, !TargetTypeInfoMap)
    else
        true
    ).

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

:- func compute_functor_size(list(prog_var), size_prof_info) = int.

compute_functor_size(Args, Info) = FunctorSize :-
    TransformOp = Info ^ spi_transform_op,
    (
        TransformOp = term_cells,
        FunctorSize = 1
    ;
        TransformOp = term_words,
        FunctorSize = list.length(Args)
    ).

:- pred find_defined_args(list(prog_var)::in, list(unify_mode)::in,
    list(prog_var)::out, list(prog_var)::out, size_prof_info::in) is det.

find_defined_args(Args, Modes, DefinedArgs, NonDefinedArgs, Info) :-
    (
        Args = [],
        Modes = [],
        DefinedArgs = [],
        NonDefinedArgs = []
    ;
        Args = [],
        Modes = [_ | _],
        unexpected($pred, "length mismatch")
    ;
        Args = [_ | _],
        Modes = [],
        unexpected($pred, "length mismatch")
    ;
        Args = [FirstArg | LaterArgs],
        Modes = [FirstMode | LaterModes],
        find_defined_args(LaterArgs, LaterModes, LaterDefinedArgs,
            LaterNonDefinedArgs, Info),
        ( if binds_arg_in_cell(Info, FirstMode) then
            DefinedArgs = [FirstArg | LaterDefinedArgs],
            NonDefinedArgs = LaterNonDefinedArgs
        else
            DefinedArgs = LaterDefinedArgs,
            NonDefinedArgs = [FirstArg | LaterNonDefinedArgs]
        )
    ).

:- pred binds_arg_in_cell(size_prof_info::in, unify_mode::in) is semidet.

binds_arg_in_cell(Info, UnifyMode) :-
    ModuleInfo = Info ^ spi_module_info,
    UnifyMode = unify_modes_li_lf_ri_rf(CellInitInst, CellFinalInst, _, _),
    inst_is_free(ModuleInfo, CellInitInst),
    inst_is_bound(ModuleInfo, CellFinalInst).

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

:- pred select_first(T::in, T::in, T::out) is det.

select_first(X, _, X).

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

:- pred ctor_is_type_info_related(module_name::in, string::in) is semidet.

ctor_is_type_info_related(VarTypeCtorModule, VarTypeCtorName) :-
    VarTypeCtorModule = mercury_private_builtin_module,
    ( VarTypeCtorName = "type_info"
    ; VarTypeCtorName = "type_ctor_info"
    ; VarTypeCtorName = "typeclass_info"
    ; VarTypeCtorName = "base_typeclass_info"
    ).

%---------------------------------------------------------------------------%
:- end_module transform_hlds.size_prof.
%---------------------------------------------------------------------------%
