mercury/compiler/term_constr_build.m

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%------------------------------------------------------------------------------%
% Copyright (C) 2003, 2005-2012 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% File: term_constr_build.m.
% Main author: juliensf.
% (partially based on code written by vjteag)
%
% This module is responsible for building the abstract representation (AR)
% used by the constraint termination analyser.
% (The AR is defined in term_constr_data.m).
%
% TODO:
% Make the abstract representations more independent of the HLDS.
%
%------------------------------------------------------------------------------%

:- module transform_hlds.term_constr_build.
:- interface.

:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module transform_hlds.term_constr_errors.
:- import_module transform_hlds.term_norm.

:- import_module bool.
:- import_module io.
:- import_module list.

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

    % This structure holds the values of options used to control the build
    % pass.
    %
:- type term_build_options.

    % term_build_options_init(Norm, PropFailure, ArgSizeOnly):
    %
    % Initialise the `build_options' structure.
    % `Norm' is the norm we are using.
    % `PropFailure' is `yes' if we are propagating failure constraints
    % and no otherwise.
    % `ArgSizeOnly' is `yes' if the `--arg-size-analysis-only' option
    % is enabled and `no' otherwise.
    %
:- func term_build_options_init(functor_info, bool, bool) = term_build_options.

    % Builds the abstract representation of an SCC.
    %
:- pred term_constr_build_abstract_scc(dependency_ordering::in,
    list(pred_proc_id)::in, term_build_options::in, term2_errors::out,
    module_info::in, module_info::out, io::di, io::uo) is det.

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

:- implementation.

:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_util.
:- import_module hlds.quantification.
:- import_module libs.lp_rational.
:- import_module libs.polyhedron.
:- import_module libs.rat.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.set_of_var.
:- import_module transform_hlds.dependency_graph.
:- import_module transform_hlds.term_constr_data.
:- import_module transform_hlds.term_constr_errors.
:- import_module transform_hlds.term_constr_main.
:- import_module transform_hlds.term_constr_util.

:- import_module int.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module std_util.
:- import_module term.
:- import_module varset.

%-----------------------------------------------------------------------------%
%
% Build pass options.
%

:- type term_build_options
    --->    term_build_options(
                % Which norm we are using.
                tbo_functor_info    :: functor_info,

                % Whether propagating failure constraints is enabled.
                tbo_failure_constrs :: bool,

                % Whether `--term2-arg-size-only' is enabled.
                tbo_arg_size_only   :: bool
            ).

term_build_options_init(Norm, Failure, ArgSizeOnly) =
    term_build_options(Norm, Failure, ArgSizeOnly).

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

% This information is accumulated while building the abstract
% representation of a SCC. After we have finished we write it to the
% module_info. We cannot do this while we are building each individual
% procedure because we will not have all the information we need until
% we have finished processing the entire SCC.

:- type term_scc_info
    --->    term_scc_info(
                tsi_scc_ppid        :: pred_proc_id,
                tsi_proc            :: abstract_proc,
                tsi_size_var_map    :: size_var_map,
                tsi_intermod        :: intermod_status,
                tsi_accum_errors    :: term2_errors,
                tsi_non_zero_heads  :: list(size_var)
            ).

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

term_constr_build_abstract_scc(DepOrder, SCC, Options, Errors,
        !ModuleInfo, !IO) :-
    dependency_graph.get_scc_entry_points(SCC, DepOrder, !.ModuleInfo,
        EntryProcs),
    list.foldl3(
        term_constr_build_abstract_proc(EntryProcs, Options, SCC,
            !.ModuleInfo),
        SCC, varset.init, SizeVarset, [], AbstractSCC, !IO),
    module_info_get_preds(!.ModuleInfo, PredTable0),
    RecordInfo = (pred(Info::in, !.Errors::in, !:Errors::out,
            !.PredTable::in, !:PredTable::out) is det :-
        Info = term_scc_info(proc(PredId, ProcId), AR0, VarMap, Status,
            ProcErrors, HeadSizeVars),

        % Record the proper size_varset. Each procedure has a copy.
        % XXX It would be nicer to store one copy per SCC.
        %
        % NOTE: although each procedure in the a SCC shares the same
        % size_varset, they should all have separate size_var_maps.

        AR = AR0 ^ ap_size_varset := SizeVarset,
        map.lookup(!.PredTable, PredId, PredInfo0),
        pred_info_get_procedures(PredInfo0, ProcTable0),
        map.lookup(ProcTable0, ProcId, ProcInfo0),
        some [!TermInfo] (
            proc_info_get_termination2_info(ProcInfo0, !:TermInfo),
            !TermInfo ^ intermod_status := yes(Status),
            !TermInfo ^ abstract_rep    := yes(AR),
            !TermInfo ^ size_var_map    := VarMap,
            !TermInfo ^ head_vars       := HeadSizeVars,

            % If the remainder of the analysis is going to depend upon
            % higher order constructs, then set up the information accordingly.
            ( analysis_depends_on_ho(AR) ->
                !TermInfo ^ success_constrs := yes(polyhedron.universe),
                HorderErrors = list.map((func(ho_call(Context))
                    = Context - horder_call), AR ^ ap_ho_calls),
                list.append(HorderErrors, !Errors)
            ;
                true
            ),
            proc_info_set_termination2_info(!.TermInfo, ProcInfo0, ProcInfo)
        ),
        map.det_update(ProcId, ProcInfo, ProcTable0, ProcTable),
        pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
        map.det_update(PredId, PredInfo, !PredTable),
        list.append(ProcErrors, !Errors)
    ),
    list.foldl2(RecordInfo, AbstractSCC, [], Errors, PredTable0, PredTable),
    module_info_set_preds(PredTable, !ModuleInfo).

:- pred term_constr_build_abstract_proc(list(pred_proc_id)::in,
    term_build_options::in, list(pred_proc_id)::in, module_info::in,
    pred_proc_id::in, size_varset::in, size_varset::out,
    list(term_scc_info)::in, list(term_scc_info)::out, io::di, io::uo) is det.

term_constr_build_abstract_proc(EntryProcs, Options, SCC, ModuleInfo, PPId,
        !SizeVarset, !AbstractInfo, !IO) :-
    trace [io(!DebugIO), compiletime(flag("term_constr_build"))] (
        io.write_string("Building procedure: ", !DebugIO),
        write_pred_proc_id(ModuleInfo, PPId, !DebugIO),
        io.nl(!DebugIO),
        io.flush_output(!DebugIO)
    ),

    module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, ProcInfo),
    pred_info_get_context(PredInfo, Context),
    proc_info_get_vartypes(ProcInfo, VarTypes),
    proc_info_get_headvars(ProcInfo, HeadProgVars),
    proc_info_get_argmodes(ProcInfo, ArgModes0),
    proc_info_get_goal(ProcInfo, Goal0),
    % The pretest code we add for compiler-generated unification and comparison
    % predicates uses type casts. It uses them in a way that is guaranteed
    % to terminate, but our analysis is not (yet) able to find this out for
    % itself. We therefore analyse only the non-pretest parts of such goals.
    Goal = maybe_strip_equality_pretest(Goal0),

    % Allocate one size_var for each real var. in the procedure.
    % Work out which variables have zero size.
    allocate_sizevars(HeadProgVars, Goal, SizeVarMap, !SizeVarset),
    Zeros = find_zero_size_vars(ModuleInfo, SizeVarMap, VarTypes),
    Info0 = init_traversal_info(ModuleInfo, Options ^ tbo_functor_info, PPId,
        Context, VarTypes, Zeros, SizeVarMap, SCC,
        Options ^ tbo_failure_constrs, Options ^ tbo_arg_size_only),

    % Traverse the HLDS and construct the abstract version of this procedure.
    build_abstract_goal(Goal, AbstractBody0, Info0, Info),
    IntermodStatus = Info ^ tti_intermod_status,
    HeadSizeVars   = prog_vars_to_size_vars(SizeVarMap, HeadProgVars),
    AbstractBody   = simplify_abstract_rep(AbstractBody0),

    % Work out which arguments can be used in termination proofs.
    % An argument may be used if (a) it is input and (b) it has non-zero size.
    ChooseArg = (func(Var, Mode) = UseArg :-
        lookup_var_type(VarTypes, Var, Type),
        (
            not zero_size_type(ModuleInfo, Type),
            mode_util.mode_is_input(ModuleInfo, Mode)
        ->
            UseArg = yes
        ;
            UseArg = no
        )
    ),
    Inputs = list.map_corresponding(ChooseArg, HeadProgVars, ArgModes0),

    % The size_varset for this procedure is set to rubbish here.
    % When we complete building this SCC we will set it to the correct value.
    IsEntryPoint = (list.member(PPId, EntryProcs) -> yes ; no),
    AbstractProc = abstract_proc(real(PPId), IsEntryPoint, Context,
        HeadSizeVars, Inputs, AbstractBody, SizeVarMap, !.SizeVarset, Zeros,
        Info ^ tti_recursion, Info ^ tti_maxcalls, Info ^ tti_ho_info),

    ThisProcInfo = term_scc_info(PPId, AbstractProc, SizeVarMap,
        IntermodStatus, Info ^ tti_errors, HeadSizeVars),

    list.cons(ThisProcInfo, !AbstractInfo),

    trace [io(!DebugIO), compiletime(flag("term_constr_build"))] (
        io.write_string("Abstract proc is:\n", !DebugIO),
        dump_abstract_proc(ModuleInfo, 0, AbstractProc, !DebugIO),
        io.nl(!DebugIO)
    ).

%------------------------------------------------------------------------------%
%
% Predicates for traversing HLDS goals and collecting constraints from them.
%

% While traversing the HLDS we accumulate the following information:
%
% * The type of recursion present in each procedure.
%
% * If the procedure may be involved in intermodule mutual recursion.
%
% * The number of calls in each procedure (We can use this information
%   to short-circuit edge labelling in pass 2).
%
% * Any calls that are made from the SCC being processed to lower SCCs
%   that do not terminate.

:- type tti_traversal_info
    --->    tti_traversal_info(
                % What type of recursion is present in the procedure,
                % i.e. `none', `direct', `mutual'.
                tti_recursion                   :: recursion_type,

                % Record whether this procedure is potentially involved
                % in mutual recursion across module boundaries.
                tti_intermod_status             :: intermod_status,

                % Errors encountered while building the AR.
                tti_errors                      :: term2_errors,

                % The HLDS.
                tti_module_info                 :: module_info,

                % The norm we are using.
                tti_norm                        :: functor_info,

                % The procedure we are currently processing.
                tti_ppid                        :: pred_proc_id,

                % The context of the current procedure.
                tti_context                     :: term.context,

                % Types for all prog_vars in the current procedure.
                tti_vartypes                    :: vartypes,

                % size_vars in the current procedure that are known
                % to have zero size.
                tti_zeros                       :: set(size_var),

                % Map from prog_vars to size_vars.
                tti_size_var_map                :: size_var_map,

                % The procedures in the SCC of the call graph
                % we are current traversing.
                tti_scc                         :: list(pred_proc_id),

                % The number of calls in the procedure.
                tti_maxcalls                    :: int,

                % If no then do not bother looking for failure constraints.
                % The `--no-term2-propagate-failure-constraints' options.
                tti_find_fail_constrs           :: bool,

                % Information about any higher-order calls a procedure makes.
                % XXX Currently unused.
                tti_ho_info                     :: list(abstract_ho_call),

                % Do we only want to run IR analysis?
                % The `--term2-arg-size-analysis-only' option.
                tti_arg_analysis_only           :: bool
        ).

:- func init_traversal_info(module_info, functor_info, pred_proc_id,
    term.context, vartypes, zero_vars, size_var_map, list(pred_proc_id),
    bool, bool) = tti_traversal_info.

init_traversal_info(ModuleInfo, Norm, PPId, Context, Types, Zeros,
        VarMap, SCC, FailConstrs, ArgSizeOnly)
    = tti_traversal_info(none, not_mutually_recursive, [], ModuleInfo, Norm,
        PPId, Context, Types, Zeros, VarMap, SCC, 0, FailConstrs, [],
        ArgSizeOnly).

:- pred info_increment_maxcalls(tti_traversal_info::in,
    tti_traversal_info::out) is det.

info_increment_maxcalls(!Info) :-
    !Info ^ tti_maxcalls := !.Info ^ tti_maxcalls + 1.

:- pred info_update_errors(term_constr_errors.error::in,
    tti_traversal_info::in, tti_traversal_info::out) is det.

info_update_errors(Error, !Info) :-
    !Info ^ tti_errors := [Error | !.Info ^ tti_errors].

:- pred info_update_recursion(recursion_type::in,
    tti_traversal_info::in, tti_traversal_info::out) is det.

info_update_recursion(RecType, !Info) :-
    UpdatedRecType = combine_recursion_types(!.Info ^ tti_recursion, RecType),
    !Info ^ tti_recursion := UpdatedRecType.

:- pred info_update_ho_info(context::in,
    tti_traversal_info::in, tti_traversal_info::out) is det.

info_update_ho_info(Context, !Info) :-
    !Info ^ tti_ho_info := [ho_call(Context) | !.Info ^ tti_ho_info].

:- pred set_intermod_status(intermod_status::in,
    tti_traversal_info::in, tti_traversal_info::out) is det.

set_intermod_status(Status, !TraversalInfo) :-
    !TraversalInfo ^ tti_intermod_status := Status.

%------------------------------------------------------------------------------%
%
% Predicates for abstracting goals.
%

% When constructing the abstract representation of the program
% this attaches the local variables to the abstract goal.
% (See comments about local variables in term_constr_data.m for more details.)

:- pred build_abstract_goal(hlds_goal::in, abstract_goal::out,
    tti_traversal_info::in, tti_traversal_info::out) is det.

build_abstract_goal(Goal, AbstractGoal, !Info) :-
    Goal = hlds_goal(GoalExpr, GoalInfo),
    build_abstract_goal_2(GoalExpr, GoalInfo, AbstractGoal0, !Info),
    partition_vars(Goal, Locals0, NonLocals0),
    SizeVarMap = !.Info ^ tti_size_var_map,
    Locals = prog_vars_to_size_vars(SizeVarMap, Locals0),
    NonLocals = prog_vars_to_size_vars(SizeVarMap, NonLocals0),
    AbstractGoal = update_local_and_nonlocal_vars(AbstractGoal0,
        Locals, NonLocals).

:- pred build_abstract_goal_2(hlds_goal_expr::in, hlds_goal_info::in,
    abstract_goal::out, tti_traversal_info::in, tti_traversal_info::out) is det.

build_abstract_goal_2(GoalExpr, GoalInfo, AbstractGoal, !Info) :-
    (
        GoalExpr = conj(_, Goals),
        % For the purposes of termination analysis there is no
        % distinction between parallel conjunctions and normal ones.
        build_abstract_conj(Goals, AbstractGoal, !Info)
    ;
        GoalExpr = disj(Goals),
        build_abstract_disj(non_switch(Goals), AbstractGoal, !Info)
    ;
        GoalExpr = switch(SwitchVar, _, Cases),
        build_abstract_disj(switch(SwitchVar, Cases), AbstractGoal, !Info)
    ;
        GoalExpr = if_then_else(_, Cond, Then, Else),

        % Reduce the if-then goals to an abstract conjunction.
        build_abstract_conj([Cond, Then], AbstractSuccessGoal, !Info),

        % Work out a failure constraint for the Cond and then abstract the else
        % branch. We won't bother do any other simplifications here as the AR
        % simplification pass will sort all of this out.
        CondFail = find_failure_constraint_for_goal(!.Info, Cond),

        % XXX FIXME - the local/non-local variable sets end up
        % being incorrect here.
        build_abstract_goal(Else, AbstractElse, !Info),
        AbstractFailureGoal = term_conj([CondFail, AbstractElse], [], []),
        AbstractDisjuncts = [AbstractSuccessGoal, AbstractFailureGoal],
        AbstractGoal = term_disj(AbstractDisjuncts, 2, [], [])
    ;
        GoalExpr = scope(Reason, SubGoal),
        ( Reason = from_ground_term(TermVar, from_ground_term_construct) ->
            build_abstract_from_ground_term_goal(TermVar, SubGoal,
                AbstractGoal, !Info)
        ;
            build_abstract_goal(SubGoal, AbstractGoal, !Info)
        )
    ;
        GoalExpr = plain_call(CallPredId, CallProcId, CallArgs, _, _, _),
        CallSizeArgs = prog_vars_to_size_vars(!.Info ^ tti_size_var_map,
            CallArgs),
        build_abstract_call(proc(CallPredId, CallProcId), CallSizeArgs,
            GoalInfo, AbstractGoal, !Info)
    ;
        GoalExpr = unify(_, _, _, Unification, _),
        build_abstract_unification(Unification, AbstractGoal, !Info)
    ;
        GoalExpr = negation(SubGoal),
        % Event though a negated goal cannot have any output we still need
        % to check it for calls to non-terminating procedures.
        build_abstract_goal(SubGoal, _, !Info),

        % Find a failure constraint for the goal if
        % `--term2-propagate-failure-constraints' is enabled,
        % otherwise just use the constraint that all non-zero input vars
        % should be non-negative.
        AbstractGoal = find_failure_constraint_for_goal(!.Info, SubGoal)
    ;
        GoalExpr = call_foreign_proc(Attrs, PredId, ProcId, Args, ExtraArgs,
            _, _),
        % XXX Eventually we should provide some facility for specifying the
        % arg_size constraints for foreign_procs.

        % Create non-negativity constraints for each non-zero argument
        % in the foreign proc.
        ForeignArgToVar = (func(ForeignArg) = ForeignArg ^ arg_var),
        ProgVars = list.map(ForeignArgToVar, Args ++ ExtraArgs),
        SizeVars = prog_vars_to_size_vars(!.Info ^ tti_size_var_map, ProgVars),
        Constraints = make_arg_constraints(SizeVars, !.Info ^ tti_zeros),
        (
            (
                get_terminates(Attrs) = proc_terminates
            ;
                get_terminates(Attrs) = depends_on_mercury_calls,
                get_may_call_mercury(Attrs) = proc_will_not_call_mercury
            )
        ->
            true
        ;
            Context = goal_info_get_context(GoalInfo),
            Error = Context - foreign_proc_called(proc(PredId, ProcId)),
            info_update_errors(Error, !Info)
        ),
        Polyhedron = polyhedron.from_constraints(Constraints),
        AbstractGoal = term_primitive(Polyhedron, [], [])
    ;
        GoalExpr = generic_call(_, _, _, _, _),
        % XXX At the moment all higher-order calls are eventually treated
        % as an error. We do not record them as a normal type of error
        % because this is going to change. To approximate their effect here
        % just assume that any non-zero output variables from the HO call
        % are unbounded in size.
        %
        Context = goal_info_get_context(GoalInfo),
        AbstractGoal = term_primitive(polyhedron.universe, [], []),
        info_update_ho_info(Context, !Info)
    ;
        GoalExpr = shorthand(_),
        % These should have been expanded out by now.
        unexpected($module, $pred, "shorthand")
    ).

%------------------------------------------------------------------------------%
%
% Additional predicates for abstracting (parallel) conjunctions.
%

:- pred build_abstract_conj(hlds_goals::in, abstract_goal::out,
    tti_traversal_info::in, tti_traversal_info::out) is det.

build_abstract_conj(Conjuncts, AbstractGoal, !Info) :-
    list.map_foldl(build_abstract_goal,Conjuncts, AbstractGoals0, !Info),
    AbstractGoals = simplify_conjuncts(AbstractGoals0),
    AbstractGoal = term_conj(AbstractGoals, [], []).

%------------------------------------------------------------------------------%
%
% Additional predicates for abstracting calls.
%

:- pred build_abstract_call(pred_proc_id::in, size_vars::in,
    hlds_goal_info::in, abstract_goal::out,
    tti_traversal_info::in, tti_traversal_info::out) is det.

build_abstract_call(CalleePPId, CallerArgs, GoalInfo, AbstractGoal, !Info) :-
    Context = goal_info_get_context(GoalInfo),
    ( list.member(CalleePPId, !.Info ^ tti_scc) ->
        build_recursive_call(CalleePPId, CallerArgs, Context, AbstractGoal,
            !Info)
    ;
        build_non_recursive_call(CalleePPId, CallerArgs, Context, AbstractGoal,
            !Info)
    ).

    % If the call is potentially recursive, we construct an abstract call
    % to represent it - see term_constr_data.m for details.
    %
:- pred build_recursive_call(pred_proc_id::in, size_vars::in, prog_context::in,
    abstract_goal::out,
    tti_traversal_info::in, tti_traversal_info::out) is det.

build_recursive_call(CalleePPId, CallerArgs, Context, AbstractGoal, !Info) :-
    CallerPPId = !.Info ^ tti_ppid,
    CallerZeros = !.Info ^ tti_zeros,
    ( CallerPPId = CalleePPId ->
        info_update_recursion(direct_only, !Info)
    ;
        info_update_recursion(mutual_only, !Info)
    ),
    CallerArgConstrs = make_arg_constraints(CallerArgs, CallerZeros),
    CallerArgPoly = polyhedron.from_constraints(CallerArgConstrs),
    info_increment_maxcalls(!Info),
    AbstractGoal = term_call(real(CalleePPId), Context, CallerArgs,
        CallerZeros, [], [], CallerArgPoly).

    % For non-recursive calls look up the argument size constraints for the
    % callee procedure and build an abstract primitive goal to store them.
    %
    % If we are running termination analysis, as opposed to just the IR
    % analysis then we also need to check that the termination status of the
    % callee procedure.
    %
:- pred build_non_recursive_call(pred_proc_id::in, size_vars::in,
    prog_context::in, abstract_goal::out,
    tti_traversal_info::in, tti_traversal_info::out) is det.

build_non_recursive_call(CalleePPId, CallerArgs, Context, AbstractGoal,
        !Info) :-
    ModuleInfo = !.Info ^ tti_module_info,
    CallerPPId = !.Info ^ tti_ppid,
    ZeroVars = !.Info ^ tti_zeros,
    module_info_pred_proc_info(ModuleInfo, CalleePPId, _, CalleeProcInfo),

    % Check the termination status of the callee procedure if we are running a
    % full analysis - ignore it if we are only running the IR analysis.
    proc_info_get_termination2_info(CalleeProcInfo, CalleeTerm2Info),
    ArgAnalysisOnly = !.Info ^ tti_arg_analysis_only,
    (
        ArgAnalysisOnly = no,
        MaybeTermStatus = CalleeTerm2Info ^ term_status,
        (
            MaybeTermStatus = yes(TermStatus),
            (
                TermStatus = can_loop(_),
                Error = Context - can_loop_proc_called(CallerPPId, CalleePPId),
                info_update_errors(Error, !Info)
            ;
                TermStatus = cannot_loop(_)
            )
        ;
            MaybeTermStatus = no,
            unexpected($module, $pred,
                "callee procedure has no termination status.")
        )
    ;
        ArgAnalysisOnly = yes
    ),

    % Check the arg_size_info for the procedure being called.
    ArgSizeInfo = CalleeTerm2Info ^ success_constrs,
    (
        ArgSizeInfo = no,
        unexpected($module, $pred, "no argument size info for callee proc")
    ;
        ArgSizeInfo = yes(SizeInfo),
        ArgSizeConstrs0 = polyhedron.non_false_constraints(SizeInfo),
        (
            ArgSizeConstrs0 = [],
            Constraints = []
        ;
            ArgSizeConstrs0 = [_ | _],
            CalleeHeadVars = CalleeTerm2Info ^ head_vars,
            SubstMap = create_var_substitution(CallerArgs, CalleeHeadVars),
            Constraints0 = lp_rational.substitute_vars(SubstMap,
                ArgSizeConstrs0),
            Constraints = lp_rational.set_vars_to_zero(ZeroVars, Constraints0)
        )
    ),
    Polyhedron = polyhedron.from_constraints(Constraints),
    AbstractGoal = term_primitive(Polyhedron, [], []).

%------------------------------------------------------------------------------%
%
% Additional predicates for abstracting switches and disjunctions.
%

% NOTE: for switches and disjunctions we add the variables that
% are local to the entire switch/disjunction to the list of variables
% that are local to each case/disjunct. The reason for this is that
% the projection operation distributes over the convex hull operation
% and it is more efficient to eliminate the variables from each branch
% *before* taking the convex hull. This is because the transformation
% matrix used by the convex hull operation (see polyhedron.m) will
% usually be much larger for the entire disjunction than the matrix used
% for each case/disjunct.

:- type disj_info
    --->    switch(prog_var, list(case))
    ;       non_switch(hlds_goals).

:- pred build_abstract_disj(disj_info::in, abstract_goal::out,
    tti_traversal_info::in, tti_traversal_info::out) is det.

build_abstract_disj(Type, AbstractGoal, !Info) :-
    (
        Type = non_switch(Goals),
        build_abstract_disj_acc(Goals, [], AbstractGoals, !Info)
    ;
        Type = switch(SwitchVar, Cases),
        build_abstract_switch_acc(SwitchVar, Cases, [], AbstractGoals, !Info)
    ),
    (
        AbstractGoals = [],
        AbstractGoal = term_primitive(polyhedron.universe, [], [])
    ;
        AbstractGoals = [Goal],
        AbstractGoal = Goal
    ;
        AbstractGoals = [_, _ | _],
        DisjSize = list.length(AbstractGoals),
        AbstractGoal = term_disj(AbstractGoals, DisjSize, [], [])
    ).

:- pred build_abstract_disj_acc(hlds_goals::in, abstract_goals::in,
    abstract_goals::out,
    tti_traversal_info::in, tti_traversal_info::out) is det.

build_abstract_disj_acc([], !AbstractGoals, !Info).
build_abstract_disj_acc([Goal | Goals], !AbstractGoals, !Info) :-
    build_abstract_goal(Goal, AbstractGoal, !Info),
    list.cons(AbstractGoal, !AbstractGoals),
    build_abstract_disj_acc(Goals, !AbstractGoals, !Info).

    % With switches we need to consider the constraints on the variable
    % being switched on as well as those from the body of each case.
    %
    % For each case, we check if there is a deconstruction unification
    % involving the switch variable. If there is no such unification then
    % the constraint for the case will not include a constraint on the size
    % of the switched-on var. In that case we add an appropriate constraint.
    %
    % We add the extra constraint by creating a new primitive abstract
    % goal and conjoining that to the rest.
    %
:- pred build_abstract_switch_acc(prog_var::in, list(case)::in,
    abstract_goals::in, abstract_goals::out,
    tti_traversal_info::in, tti_traversal_info::out) is det.

build_abstract_switch_acc(_, [], !AbstractGoals, !Info).
build_abstract_switch_acc(SwitchProgVar, [Case | Cases], !AbstractGoals,
        !Info) :-
    Case = case(MainConsId, OtherConsIds, Goal),
    build_abstract_goal(Goal, AbstractGoal0, !Info),

    % We now need to check that constraints on the switch var are included.
    % They will *not* have been included if the case did not contain a
    % unification deconstructing that variable (which it can't contain if the
    % switch arm is for several cons_ids). They are of course in the HLDS,
    % just not stored in a way we can derive them from the goal in the normal
    % fashion unless there is actually a deconstruction unification present.
    %
    % XXX Why do we ignore OtherConsIds when it is not []?

    (
        OtherConsIds = [],
        detect_switch_var(Goal, SwitchProgVar, MainConsId)
    ->
        AbstractGoal = AbstractGoal0
    ;
        TypeMap = !.Info ^ tti_vartypes,
        SizeVarMap = !.Info ^ tti_size_var_map,
        lookup_var_type(TypeMap, SwitchProgVar, SwitchVarType),
        SwitchSizeVar = prog_var_to_size_var(SizeVarMap, SwitchProgVar),
        type_to_ctor_det(SwitchVarType, TypeCtor),
        ModuleInfo = !.Info ^ tti_module_info,
        Norm = !.Info ^ tti_norm,
        Zeros = !.Info ^ tti_zeros,
        Size = functor_lower_bound(ModuleInfo, Norm, TypeCtor, MainConsId),
        ( set.member(SwitchSizeVar, Zeros) ->
            ExtraConstr = []
        ;
            SwitchVarConst = rat(Size),
            ( Size = 0 ->
                SwitchVarConstr =
                    make_var_const_eq_constraint(SwitchSizeVar,
                        SwitchVarConst)
            ;
                SwitchVarConstr =
                    make_var_const_gte_constraint(SwitchSizeVar,
                        SwitchVarConst)
            ),
            ExtraConstr = [SwitchVarConstr]
        ),
        ExtraPoly = polyhedron.from_constraints(ExtraConstr),
        ExtraGoal = term_primitive(ExtraPoly, [], []),
        AbstractGoal = term_conj([ExtraGoal, AbstractGoal0], [], [])
    ),
    list.cons(AbstractGoal, !AbstractGoals),
    build_abstract_switch_acc(SwitchProgVar, Cases, !AbstractGoals, !Info).

:- pred detect_switch_var(hlds_goal::in, prog_var::in, cons_id::in) is semidet.

detect_switch_var(hlds_goal(unify(_, _, _, Kind, _), _), SwitchVar, ConsId) :-
    (
        Kind = deconstruct(SwitchVar, ConsId, _, _, _, _)
    ;
        Kind = complicated_unify(_, _, _),
        unexpected($module, $pred, "complicated_unify")
    ;
        ( Kind = construct(_, _, _, _, _, _, _)
        ; Kind = assign(_, _)
        ; Kind = simple_test(_, _)
        ),
        fail
    ).
detect_switch_var(hlds_goal(shorthand(_), _), _, _) :-
    unexpected($module, $pred, "shorthand").

%------------------------------------------------------------------------------%
%
% Additional predicates for abstracting from_ground_term scopes,
% which act like giant construction unifications.
%

:- pred build_abstract_from_ground_term_goal(prog_var::in, hlds_goal::in,
    abstract_goal::out, tti_traversal_info::in, tti_traversal_info::out)
    is det.

build_abstract_from_ground_term_goal(TermVar, SubGoal, AbstractGoal, !Info) :-
    SubGoal = hlds_goal(SubGoalExpr, _SubGoalInfo),
    ( SubGoalExpr = conj(plain_conj, Conjuncts) ->
        SizeVarMap = !.Info ^ tti_size_var_map,
        Zeros = !.Info ^ tti_zeros,
        TermSizeVar = prog_var_to_size_var(SizeVarMap, TermVar),
        ( set.member(TermSizeVar, Zeros) ->
            Constraints = []
        ;
            ModuleInfo = !.Info ^ tti_module_info,
            Norm = !.Info ^ tti_norm,
            VarTypes = !.Info ^ tti_vartypes,
            abstract_from_ground_term_conjuncts(ModuleInfo, Norm, VarTypes,
                Conjuncts, map.init, SizeMap),
            map.lookup(SizeMap, TermVar, KnownTermVarSize),
            Terms = [TermSizeVar - one],
            Constraint =
                construct_constraint(Terms, lp_eq, rat(KnownTermVarSize)),
            Constraints = [Constraint]
        ),
        AbstractGoal = build_goal_from_unify(Constraints)
    ;
        unexpected($module, $pred, "not conj")
    ).

:- pred abstract_from_ground_term_conjuncts(module_info::in, functor_info::in,
    vartypes::in, list(hlds_goal)::in,
    map(prog_var, int)::in, map(prog_var, int)::out) is det.

abstract_from_ground_term_conjuncts(_ModuleInfo, _Norm, _VarTypes, [],
        !SizeMap).
abstract_from_ground_term_conjuncts(ModuleInfo, Norm, VarTypes, [Goal | Goals],
        !SizeMap) :-
    abstract_from_ground_term_conjunct(ModuleInfo, Norm, VarTypes, Goal,
        !SizeMap),
    abstract_from_ground_term_conjuncts(ModuleInfo, Norm, VarTypes, Goals,
        !SizeMap).

:- pred abstract_from_ground_term_conjunct(module_info::in, functor_info::in,
    vartypes::in, hlds_goal::in,
    map(prog_var, int)::in, map(prog_var, int)::out) is det.

abstract_from_ground_term_conjunct(ModuleInfo, Norm, VarTypes, Goal,
        !SizeMap) :-
    Goal = hlds_goal(GoalExpr, _GoalInfo),
    (
        GoalExpr = unify(_, _, _, Unify, _),
        Unify = construct(Var, ConsId, ArgVars, Modes, _, _, _)
    ->
        strip_typeinfos_from_args_and_modes(VarTypes, ArgVars, FixedArgVars,
            Modes, FixedModes),
        lookup_var_type(VarTypes, Var, Type),
        type_to_ctor_det(Type, TypeCtor),
        functor_norm(ModuleInfo, Norm, TypeCtor, ConsId, ConsIdSize,
            FixedArgVars, CountedVars, FixedModes, _),

        % Note that any vars that are in ArgVars but not in CountedVars
        % will be left in !:SizeMap, which is a performance problem (but not
        % correctness problem) for the later goals in the conjunction.
        list.map_foldl(map.det_remove, CountedVars, ArgSizes, !SizeMap),
        accumulate_sum(ArgSizes, 0, TotalArgSize),
        Size = ConsIdSize + TotalArgSize,
        map.det_insert(Var, Size, !SizeMap)
    ;
        unexpected($module, $pred, "malformed conjunct")
    ).

:- pred accumulate_sum(list(int)::in, int::in, int::out) is det.

accumulate_sum([], !TotalSize).
accumulate_sum([Size | Sizes], !TotalSize) :-
    !:TotalSize = !.TotalSize + Size,
    accumulate_sum(Sizes, !TotalSize).

%------------------------------------------------------------------------------%
%
% Additional predicates for abstracting unifications.
%

:- pred build_abstract_unification(unification::in, abstract_goal::out,
    tti_traversal_info::in, tti_traversal_info::out) is det.

build_abstract_unification(Unification, AbstractGoal, !Info) :-
    (
        Unification = construct(Var, ConsId, ArgVars, Modes, _, _, _),
        build_abstract_decon_or_con_unify(Var, ConsId, ArgVars, Modes,
            Constraints, !Info),
        AbstractGoal = build_goal_from_unify(Constraints)
    ;
        Unification = deconstruct(Var, ConsId, ArgVars, Modes, _, _),
        build_abstract_decon_or_con_unify(Var, ConsId, ArgVars, Modes,
            Constraints, !Info),
        AbstractGoal = build_goal_from_unify(Constraints)
    ;
        Unification = assign(LVar, RVar),
        build_abstract_simple_or_assign_unify(LVar, RVar, Constraints, !Info),
        AbstractGoal = build_goal_from_unify(Constraints)
    ;
        Unification = simple_test(LVar, RVar),
        build_abstract_simple_or_assign_unify(LVar, RVar, Constraints, !Info),
        AbstractGoal = build_goal_from_unify(Constraints)
    ;
        Unification = complicated_unify(_, _, _),
        unexpected($module, $pred, "complicated_unify")
    ).

    % Used for deconstruction and construction unifications, i.e. for
    % unifications of the form: X = f(U, V, W). If the norm counts the
    % first and second arguments, then the constraint returned is |X| -
    % |U| - |V| = |f|. (|X| is the size_var corresponding to X).
    %
:- pred build_abstract_decon_or_con_unify(prog_var::in, cons_id::in,
    prog_vars::in, list(uni_mode)::in, constraints::out,
    tti_traversal_info::in, tti_traversal_info::out) is det.

build_abstract_decon_or_con_unify(Var, ConsId, ArgVars, Modes, Constraints,
        !Info) :-
    VarTypes = !.Info ^ tti_vartypes,
    lookup_var_type(VarTypes, Var, Type),
    (
        % The only valid higher-order unifications are assignments.
        % For the purposes of the IR analysis, we can ignore them.
        % We can also ignore unifications that build constant terms.
        % XXX Should we process constant terms that are NOT typeinfos
        % or typeclass infos? We have no test cases (yet) that need that.
        ( type_is_higher_order(Type)
        ; cons_id_is_const_struct(ConsId, _)
        )
    ->
        Constraints = []
    ;
        % We need to strip out any typeinfo related variables before
        % measuring the size of the term; otherwise functor_norm will
        % raise a software error if we are using the `num-data-elems'
        % norm and the term has existential typeclass constraints.

        strip_typeinfos_from_args_and_modes(VarTypes, ArgVars, FixedArgVars,
            Modes, FixedModes),
        ModuleInfo = !.Info ^ tti_module_info,
        Norm = !.Info ^ tti_norm,
        type_to_ctor_det(Type, TypeCtor),
        functor_norm(ModuleInfo, Norm, TypeCtor, ConsId, Constant,
            FixedArgVars, CountedVars, FixedModes, _),

        % The constraint from this unification is:
        %
        %      |Var| = Constant + sum(CountedVars)
        %
        % |Var| is just the size_var corresponding to Var. The value of
        % `Constant' will depend upon the norm being used.

        SizeVarMap = !.Info ^ tti_size_var_map,
        Zeros = !.Info ^ tti_zeros,

        SizeVar = prog_var_to_size_var(SizeVarMap, Var),
        ( set.member(SizeVar, Zeros) ->
            FirstTerms = []
        ;
            FirstTerms = [SizeVar - one]
        ),
        list.foldl(accumulate_nonzero_arg_coeffs(SizeVarMap, Zeros, -one),
            CountedVars, FirstTerms, Terms),
        Constraint = construct_constraint(Terms, lp_eq, rat(Constant)),
        ( is_false(Constraint) ->
            unexpected($module, $pred, "false constraint from unification")
        ;
            SizeVars0 = prog_vars_to_size_vars(SizeVarMap, ArgVars),
            SizeVars1 = [SizeVar | SizeVars0],
            SizeVars  = list.filter(isnt(is_zero_size_var(Zeros)), SizeVars1)
        ),
        NonNegConstraints = list.map(make_nonneg_constr, SizeVars),
        Constraints = [Constraint | NonNegConstraints]
    ).

:- pred accumulate_nonzero_arg_coeffs(size_var_map::in, set(size_var)::in,
    coefficient::in, prog_var::in, lp_terms::in, lp_terms::out) is det.

accumulate_nonzero_arg_coeffs(SizeVarMap, Zeros, Coeff, Var, !Terms) :-
    SizeVar = prog_var_to_size_var(SizeVarMap, Var),
    ( set.member(SizeVar, Zeros) ->
        true
    ;
        !:Terms = [SizeVar - Coeff | !.Terms]
    ).

:- pred strip_typeinfos_from_args_and_modes(vartypes::in,
    list(prog_var)::in, list(prog_var)::out,
    list(uni_mode)::in, list(uni_mode)::out) is det.

strip_typeinfos_from_args_and_modes(VarTypes, !Args, !Modes) :-
    ( strip_typeinfos_from_args_and_modes_2(VarTypes, !Args, !Modes) ->
        true
    ;
        unexpected($module, $pred, "unequal length lists")
    ).

:- pred strip_typeinfos_from_args_and_modes_2(vartypes::in,
    list(prog_var)::in, list(prog_var)::out,
    list(uni_mode)::in, list(uni_mode)::out) is semidet.

strip_typeinfos_from_args_and_modes_2(_, [], [], [], []).
strip_typeinfos_from_args_and_modes_2(VarTypes, [Arg | !.Args], !:Args,
        [Mode | !.Modes], !:Modes) :-
    strip_typeinfos_from_args_and_modes_2(VarTypes, !Args, !Modes),
    lookup_var_type(VarTypes, Arg, Type),
    ( is_introduced_type_info_type(Type) ->
        true
    ;
        list.cons(Arg, !Args),
        list.cons(Mode, !Modes)
    ).

    % Assignment and simple_test unifications of the form X = Y
    % are abstracted as |X| - |Y| = 0.
    %
:- pred build_abstract_simple_or_assign_unify(prog_var::in, prog_var::in,
    constraints::out, tti_traversal_info::in, tti_traversal_info::out) is det.

build_abstract_simple_or_assign_unify(LeftProgVar, RightProgVar, Constraints,
        !Info) :-
    SizeVarMap = !.Info ^ tti_size_var_map,
    Zeros = !.Info ^ tti_zeros,
    LeftSizeVar = prog_var_to_size_var(SizeVarMap, LeftProgVar),
    RightSizeVar = prog_var_to_size_var(SizeVarMap, RightProgVar),
    (
        set.member(LeftSizeVar, Zeros),
        set.member(RightSizeVar, Zeros)
    ->
        Constraints = []    % `true' constraint.
    ;
        (set.member(LeftSizeVar, Zeros)
        ; set.member(RightSizeVar, Zeros)
        )
    ->
        unexpected($module, $pred, "zero unified with non-zero")
    ;
        % Create non-negativity constraints.
        NonNegConstrs = list.map(make_nonneg_constr,
            [LeftSizeVar, RightSizeVar]),
        Terms = [LeftSizeVar - one, RightSizeVar - (-one)],
        AssignConstr = construct_constraint(Terms, lp_eq, zero),
        % XXX I don't think this call to simplify helps anymore.
        Constraints = simplify_constraints([AssignConstr | NonNegConstrs])
    ).

    % Check that the abstraction of a unification has not resulted
    % in the false constraint.
    %
:- func build_goal_from_unify(constraints) = abstract_goal.

build_goal_from_unify(Constraints) = term_primitive(Polyhedron, [], []) :-
    Polyhedron = polyhedron.from_constraints(Constraints),
    ( polyhedron.is_empty(Polyhedron) ->
        unexpected($module, $pred, "empty polyhedron from unification")
    ;
        true
    ).

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

    % Because quantification returns a conservative estimate of nonlocal
    % vars, this returns a list of local vars that may omit some of the
    % real local vars. This shouldn't be a problem as everything but
    % the head_vars will be projected out at the end of each iteration anyway.
    %
:- func local_vars(hlds_goal) = prog_vars.

local_vars(hlds_goal(GoalExpr, GoalInfo)) = Locals :-
    NonLocals = goal_info_get_nonlocals(GoalInfo),
    QuantVars = free_goal_vars(hlds_goal(GoalExpr, GoalInfo)),
    LocalsSet = set_of_var.difference(QuantVars, NonLocals),
    Locals = set_of_var.to_sorted_list(LocalsSet).

    % Partition the variables of a goal into a set of local variables
    % and a set of non-local variables.
    %
:- pred partition_vars(hlds_goal::in, prog_vars::out, prog_vars::out) is det.

partition_vars(hlds_goal(GoalExpr, GoalInfo), Locals, NonLocals) :-
    NonLocals0 = goal_info_get_nonlocals(GoalInfo),
    QuantVars = free_goal_vars(hlds_goal(GoalExpr, GoalInfo)),
    Locals = set_of_var.to_sorted_list(
        set_of_var.difference(QuantVars, NonLocals0)),
    NonLocals = set_of_var.to_sorted_list(NonLocals0).

%-----------------------------------------------------------------------------%
%
% Procedures for manipulating sets of size_vars.
%

    % Create the size_vars corresponding to the given prog_vars.
    % Also create map from the prog_vars to the size_vars.
    %
    % As termination analysis is (currently) carried out before unused
    % argument analysis it is possible that some variables in the head
    % of a procedure may not occur in the body (this typically occurs
    % with typeinfos).
    %
:- pred allocate_sizevars(prog_vars::in, hlds_goal::in, size_var_map::out,
    size_varset::in, size_varset::out) is det.

allocate_sizevars(HeadProgVars, Goal, SizeVarMap, !SizeVarset) :-
    fill_var_to_sizevar_map(Goal, !SizeVarset, SizeVarMap0),
    possibly_fix_sizevar_map(HeadProgVars, !SizeVarset,
        SizeVarMap0, SizeVarMap).

:- pred fill_var_to_sizevar_map(hlds_goal::in,
    size_varset::in, size_varset::out, size_var_map::out) is det.

fill_var_to_sizevar_map(Goal, !SizeVarset, SizeVarMap) :-
    ProgVarsInGoal = free_goal_vars(Goal),
    ProgVars = set_of_var.to_sorted_list(ProgVarsInGoal),
    make_size_var_map(ProgVars, !SizeVarset, SizeVarMap).

    % Fix the map in case some variables that are present only
    % in the head of a procedure were missed.
    %
:- pred possibly_fix_sizevar_map(prog_vars::in, size_varset::in,
    size_varset::out, size_var_map::in, size_var_map::out) is det.

possibly_fix_sizevar_map([], !SizeVarset, !SizeVarMap).
possibly_fix_sizevar_map([ProgVar | ProgVars], !SizeVarset, !SizeVarMap) :-
    ( map.search(!.SizeVarMap, ProgVar, _) ->
        possibly_fix_sizevar_map(ProgVars, !SizeVarset, !SizeVarMap)
    ;
        varset.new_var(SizeVar, !SizeVarset),
        map.set(ProgVar, SizeVar, !SizeVarMap),
        possibly_fix_sizevar_map(ProgVars, !SizeVarset, !SizeVarMap)
    ).

%-----------------------------------------------------------------------------%
%
% Failure constraints.
%

% The idea here is that if a goal can fail, the fact that it fails
% may tell us information about the size of any input arguments.
%
% For unifications, both deconstructions and simple tests can fail but
% since the latter involves only zero size types it does not tell us
% anything useful. For a deconstruction unification that can fail we
% know that the variable must be bound to one of the other type
% constructors so we can use this to try and place a lower bound on the
% size of the variable.
%
% For calls we can associate a failure constraint with each procedure in
% the program. In contexts where the call fails we can just look up the
% failure constraint.
%
% In the worst case we just assume that the size of the (non-zero)
% inputs is unbounded.
%
% TODO Better failure constraints for goals other than unifications.

:-  func find_failure_constraint_for_goal(tti_traversal_info, hlds_goal)
    = abstract_goal.

find_failure_constraint_for_goal(Info, Goal) = AbstractGoal :-
    (
        Info ^ tti_find_fail_constrs = yes,
        find_failure_constraint_for_goal_2(Info, Goal, AbstractGoal0)
    ->
        AbstractGoal = AbstractGoal0
    ;
        NonLocalProgVars0 = goal_info_get_nonlocals(Goal ^ hlds_goal_info),
        NonLocalProgVars = set_of_var.to_sorted_list(NonLocalProgVars0),
        NonLocalSizeVars = prog_vars_to_size_vars(Info ^ tti_size_var_map,
            NonLocalProgVars),
        Constraints = make_arg_constraints(NonLocalSizeVars,
            Info ^ tti_zeros),
        FailPoly = polyhedron.from_constraints(Constraints),
        AbstractGoal = term_primitive(FailPoly, [], [])
    ).

:- pred find_failure_constraint_for_goal_2(tti_traversal_info::in,
    hlds_goal::in, abstract_goal::out) is semidet.

find_failure_constraint_for_goal_2(Info, Goal, AbstractGoal) :-
    % XXX We could factor out a lot of the code used for
    % substitutions below as the same code is used elsewhere.

    Goal = hlds_goal(GoalExpr, _),
    (
        GoalExpr = plain_call(PredId, ProcId, CallArgs, _, _, _),
        SizeVarMap = Info ^ tti_size_var_map,
        CallSizeArgs0 = prog_vars_to_size_vars(SizeVarMap, CallArgs),
        Zeros = Info ^ tti_zeros,
        CallSizeArgs = list.filter(isnt(is_zero_size_var(Zeros)),
            CallSizeArgs0),
        ModuleInfo = Info ^ tti_module_info,
        module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
        proc_info_get_termination2_info(ProcInfo, TermInfo),
        MaybeFailureConstrs = TermInfo ^ failure_constrs,
        (
            MaybeFailureConstrs = no,
            FailureConstraints = []
        ;
            MaybeFailureConstrs = yes(CalleeFailurePolyhedron),
            CalleeFailureConstraints =
                polyhedron.non_false_constraints(CalleeFailurePolyhedron),
            (
                CalleeFailureConstraints = [],
                FailureConstraints = []
            ;
                CalleeFailureConstraints = [_ | _],
                CalleeHeadVars = TermInfo ^ head_vars,
                SubstMap =
                    create_var_substitution(CallSizeArgs, CalleeHeadVars),
                FailureConstraints =
                    substitute_size_vars(CalleeFailureConstraints, SubstMap)
            )
        ),
        FailurePolyhedron = polyhedron.from_constraints(FailureConstraints),
        AbstractGoal = term_primitive(FailurePolyhedron, [], [])
    ;
        % Given a deconstruction unification and assuming that it has failed,
        % find a bound on the size of the variable being deconstructed.

        GoalExpr = unify(_, _, _, Unification, _),
        Unification = deconstruct(Var, ConsId, _, _, can_fail, _),
        lookup_var_type(Info ^ tti_vartypes, Var, Type),
        type_to_ctor_det(Type, TypeCtor),
        ModuleInfo = Info ^ tti_module_info,
        type_util.type_constructors(ModuleInfo, Type, Constructors0),
        ( ConsId = cons(ConsName, ConsArity, ConsTypeCtor) ->
            expect(unify(TypeCtor, ConsTypeCtor), $module, $pred,
                "mismatched type_ctors"),
            FindComplement = (pred(Ctor::in) is semidet :-
                Ctor = ctor(_, _, SymName, Args, _),
                list.length(Args, Arity),
                not (
                    SymName = ConsName,
                    Arity   = ConsArity
                )
            ),
            list.filter(FindComplement, Constructors0, Constructors)
        ;
            unexpected($module, $pred, "non cons cons_id.")
        ),
        SizeVarMap = Info ^ tti_size_var_map,
        SizeVar = prog_var_to_size_var(SizeVarMap, Var),
        Norm = Info ^ tti_norm,
        bounds_on_var(Norm, ModuleInfo, TypeCtor, SizeVar, Constructors,
            Polyhedron),
        AbstractGoal = term_primitive(Polyhedron, [], [])
    ).

    % Given a variable, its type and a list of constructors to which
    % it could be bound, return a polyhedron representing the bounds
    % on the size of that variable.
    %
:- pred bounds_on_var(functor_info::in, module_info::in, type_ctor::in,
    size_var::in, list(constructor)::in, polyhedron::out) is det.

bounds_on_var(Norm, ModuleInfo, TypeCtor, Var, Constructors, Polyhedron) :-
    CtorSizes = list.map(lower_bound(Norm, ModuleInfo, TypeCtor),
        Constructors),

    % Split constructors into those that have zero size and
    % those that have non-zero size.
    list.filter((pred(V::in) is semidet :- V = 0), CtorSizes,
        ZeroSizeCtors, NonZeroSizeCtors),
    (
        NonZeroSizeCtors = [],
        (
            ZeroSizeCtors = [],
            unexpected($module, $pred, "no other constructors for type")
        ;
            ZeroSizeCtors = [_ | _],
            Constraints = [construct_constraint([Var - one], lp_eq, zero)]
        )
    ;
        NonZeroSizeCtors = [C | Cs],
        upper_bound_constraints(Norm, ModuleInfo, Var, TypeCtor,
            Constructors, UpperBoundConstr),
        (
            ZeroSizeCtors = [],
            LowerBound = list.foldl(int.min, Cs, C),
            LowerBoundConstr =
                [construct_constraint([Var - one], lp_gt_eq, rat(LowerBound))]
        ;
            ZeroSizeCtors = [_ | _],
            LowerBoundConstr =
                [construct_constraint([Var - one], lp_gt_eq, zero)]
        ),
        Constraints = LowerBoundConstr ++ UpperBoundConstr
    ),
    Polyhedron = polyhedron.from_constraints(Constraints).

:- func lower_bound(functor_info, module_info, type_ctor, constructor) = int.

lower_bound(Norm, ModuleInfo, TypeCtor, Constructor) = LowerBound :-
    Constructor = ctor(_, _, SymName, Args, _),
    Arity = list.length(Args),
    ConsId = cons(SymName, Arity, TypeCtor),
    LowerBound = functor_lower_bound(ModuleInfo, Norm, TypeCtor, ConsId).

    % Given a variable, its type and a set of constructors to which it
    % could be bound, return a constraint that specifies an upper bound
    % on the size of the variable. An empty list means that there is no
    % upper bound.
    %
:- pred upper_bound_constraints(functor_info::in, module_info::in,
    size_var::in, type_ctor::in, list(constructor)::in, constraints::out)
    is det.

upper_bound_constraints(Norm, ModuleInfo, Var, TypeCtor, Ctors, Constraints) :-
    % If all the arguments of a functor are zero sized then we can give
    % an upper bound on its size. If we have a set of such functors
    % then the upper bound is the maximum of the individual upper bounds.
    %
    % XXX We could extend this to include functors can only have a
    % finite size but I'm not sure that it's worth it.

    FindUpperBound = (pred(Ctor::in, !.B::in, !:B::out) is semidet :-
        Ctor = ctor(_, _, SymName, Args, _),
        all [Arg] (
            list.member(Arg, Args)
        =>
            zero_size_type(ModuleInfo, Arg ^ arg_type)
        ),
        Arity = list.length(Args),
        ConsId = cons(SymName, Arity, TypeCtor),
        Bound = functor_lower_bound(ModuleInfo, Norm, TypeCtor, ConsId),
        ( if Bound > !.B then !:B = Bound else true )
    ),
    ( list.foldl(FindUpperBound, Ctors, 0, Bound0) ->
        ( Bound0 = 0 ->
            unexpected($module, $pred, "zero upper bound")
        ;
            Constraints =
                [construct_constraint([Var - one], lp_lt_eq, rat(Bound0))]
        )
    ;
        Constraints = []
    ).

%-----------------------------------------------------------------------------%
:- end_module transform_hlds.term_constr_build.
%-----------------------------------------------------------------------------%