mercury/compiler/pd_info.m

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1998-2001, 2003-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: pd_info.m.
% Main author: stayl.
%
% Types for deforestation.
%
%---------------------------------------------------------------------------%

:- module transform_hlds.pd_info.
:- interface.

:- import_module hlds.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module hlds.instmap.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module transform_hlds.pd_term.

:- import_module bool.
:- import_module counter.
:- import_module io.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module set.

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

:- type pd_info
    --->    pd_info(
                pdi_module_info         :: module_info,
                pdi_maybe_unfold_info   :: maybe(unfold_info),
                pdi_goal_version_index  :: goal_version_index,
                pdi_versions            :: version_index,
                pdi_proc_arg_info       :: pd_arg_info,
                pdi_counter             :: counter,
                pdi_global_term_info    :: global_term_info,
                pdi_parent_versions     :: set(pred_proc_id),
                pdi_depth               :: int,
                pdi_created_versions    :: set(pred_proc_id),
                pdi_useless_versions    :: useless_versions,
                pdi_progress_stream     :: io.text_output_stream
            ).

    % Map from list of called preds in the conjunctions
    % to the specialised versions.
    %
:- type goal_version_index == map(list(pred_proc_id), list(pred_proc_id)).

:- type useless_versions == set(pair(pred_proc_id)).

    % Map from version id to the info about the version.
    %
:- type version_index == map(pred_proc_id, version_info).

:- pred pd_info_init(io.text_output_stream::in, module_info::in,
    pd_arg_info::in, pd_info::out) is det.

:- pred pd_info_init_unfold_info(pred_proc_id::in, pred_info::in,
    proc_info::in, pd_info::in, pd_info::out) is det.

:- pred pd_info_get_module_info(pd_info::in, module_info::out) is det.
:- pred pd_info_get_unfold_info(pd_info::in, unfold_info::out) is det.
:- pred pd_info_get_goal_version_index(pd_info::in, goal_version_index::out)
    is det.
:- pred pd_info_get_versions(pd_info::in, version_index::out) is det.
:- pred pd_info_get_proc_arg_info(pd_info::in, pd_arg_info::out) is det.
:- pred pd_info_get_counter(pd_info::in, counter::out) is det.
:- pred pd_info_get_global_term_info(pd_info::in, global_term_info::out)
    is det.
:- pred pd_info_get_parent_versions(pd_info::in, set(pred_proc_id)::out)
    is det.
:- pred pd_info_get_depth(pd_info::in, int::out) is det.
:- pred pd_info_get_created_versions(pd_info::in, set(pred_proc_id)::out)
    is det.
:- pred pd_info_get_useless_versions(pd_info::in, useless_versions::out)
    is det.
:- pred pd_info_get_progress_stream(pd_info::in, io.text_output_stream::out)
    is det.

:- pred pd_info_set_module_info(module_info::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_unfold_info(unfold_info::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_unset_unfold_info(
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_goal_version_index(goal_version_index::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_versions(version_index::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_proc_arg_info(pd_arg_info::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_counter(counter::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_global_term_info(global_term_info::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_parent_versions(set(pred_proc_id)::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_depth(int::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_created_versions(set(pred_proc_id)::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_useless_versions(useless_versions::in,
    pd_info::in, pd_info::out) is det.

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

:- pred pd_info_bind_var_to_functors(prog_var::in,
    cons_id::in, list(cons_id)::in, pd_info::in, pd_info::out) is det.

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

:- implementation.

:- import_module check_hlds.
:- import_module check_hlds.inst_match.
:- import_module check_hlds.modecheck_util.
:- import_module hlds.pred_name.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.set_of_var.
:- import_module parse_tree.var_table.
:- import_module transform_hlds.pd_debug.
:- import_module transform_hlds.pd_util.

:- import_module int.
:- import_module require.
:- import_module term_context.

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

pd_info_init(ProgressStream, ModuleInfo, ProcArgInfos, PDInfo) :-
    map.init(GoalVersionIndex),
    map.init(Versions),
    set.init(ParentVersions),
    pd_term.global_term_info_init(GlobalInfo),
    set.init(CreatedVersions),
    set.init(UselessVersions),
    PDInfo = pd_info(ModuleInfo, no, GoalVersionIndex,
        Versions, ProcArgInfos, counter.init(0), GlobalInfo, ParentVersions,
        0, CreatedVersions, UselessVersions, ProgressStream).

pd_info_init_unfold_info(PredProcId, PredInfo, ProcInfo, !PDInfo) :-
    pd_info_get_module_info(!.PDInfo, ModuleInfo),
    proc_info_get_argmodes(ProcInfo, ArgModes),
    get_constrained_inst_vars(ModuleInfo, ArgModes, HeadInstVars),
    proc_info_get_initial_instmap(ModuleInfo, ProcInfo, InstMap),
    CostDelta = 0,
    pd_term.local_term_info_init(LocalTermInfo),
    Parents = set.make_singleton_set(PredProcId),
    UnfoldInfo = unfold_info(ProcInfo, HeadInstVars, InstMap, CostDelta,
        LocalTermInfo, PredInfo, Parents, PredProcId, 0, no, no),
    pd_info_set_unfold_info(UnfoldInfo, !PDInfo).

pd_info_get_module_info(PDInfo, PDInfo ^ pdi_module_info).
pd_info_get_unfold_info(PDInfo, UnfoldInfo) :-
    MaybeUnfoldInfo = PDInfo ^ pdi_maybe_unfold_info,
    (
        MaybeUnfoldInfo = yes(UnfoldInfo)
    ;
        MaybeUnfoldInfo = no,
        unexpected($pred, "unfold_info not set")
    ).
pd_info_get_goal_version_index(PDInfo, PDInfo ^ pdi_goal_version_index).
pd_info_get_versions(PDInfo, PDInfo ^ pdi_versions).
pd_info_get_proc_arg_info(PDInfo, PDInfo ^ pdi_proc_arg_info).
pd_info_get_counter(PDInfo, PDInfo ^ pdi_counter).
pd_info_get_global_term_info(PDInfo, PDInfo ^ pdi_global_term_info).
pd_info_get_parent_versions(PDInfo, PDInfo ^ pdi_parent_versions).
pd_info_get_depth(PDInfo, PDInfo ^ pdi_depth).
pd_info_get_created_versions(PDInfo, PDInfo ^ pdi_created_versions).
pd_info_get_useless_versions(PDInfo, PDInfo ^ pdi_useless_versions).
pd_info_get_progress_stream(PDInfo, PDInfo ^ pdi_progress_stream).

pd_info_set_module_info(ModuleInfo, !PDInfo) :-
    !PDInfo ^ pdi_module_info := ModuleInfo.
pd_info_set_unfold_info(UnfoldInfo, !PDInfo) :-
    !PDInfo ^ pdi_maybe_unfold_info := yes(UnfoldInfo).
pd_info_unset_unfold_info(!PDInfo) :-
    !PDInfo ^ pdi_maybe_unfold_info := no.
pd_info_set_goal_version_index(Index, !PDInfo) :-
    !PDInfo ^ pdi_goal_version_index := Index.
pd_info_set_versions(Versions, !PDInfo) :-
    !PDInfo ^ pdi_versions := Versions.
pd_info_set_proc_arg_info(ProcArgInfo, !PDInfo) :-
    !PDInfo ^ pdi_proc_arg_info := ProcArgInfo.
pd_info_set_counter(Counter, !PDInfo) :-
    !PDInfo ^ pdi_counter := Counter.
pd_info_set_global_term_info(TermInfo, !PDInfo) :-
    !PDInfo ^ pdi_global_term_info := TermInfo.
pd_info_set_parent_versions(Parents, !PDInfo) :-
    !PDInfo ^ pdi_parent_versions := Parents.
pd_info_set_depth(Depth, !PDInfo) :-
    !PDInfo ^ pdi_depth := Depth.
pd_info_set_created_versions(Versions, !PDInfo) :-
    !PDInfo ^ pdi_created_versions := Versions.
pd_info_set_useless_versions(Versions, !PDInfo) :-
    !PDInfo ^ pdi_useless_versions := Versions.

pd_info_update_goal(hlds_goal(_, GoalInfo), !PDInfo) :-
    pd_info_get_instmap(!.PDInfo, InstMap0),
    Delta = goal_info_get_instmap_delta(GoalInfo),
    apply_instmap_delta(Delta, InstMap0, InstMap),
    pd_info_set_instmap(InstMap, !PDInfo).

pd_info_bind_var_to_functors(Var, MainConsId, OtherConsIds, !PDInfo) :-
    pd_info_get_instmap(!.PDInfo, InstMap0),
    pd_info_get_module_info(!.PDInfo, ModuleInfo0),
    pd_info_get_proc_info(!.PDInfo, ProcInfo),
    proc_info_get_var_table(ProcInfo, VarTable),
    lookup_var_type(VarTable, Var, Type),
    bind_var_to_functors(Var, Type, MainConsId, OtherConsIds,
        InstMap0, InstMap, ModuleInfo0, ModuleInfo),
    pd_info_set_instmap(InstMap, !PDInfo),
    pd_info_set_module_info(ModuleInfo, !PDInfo).

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

:- interface.

    % unfold_info contains information used while searching a procedure
    % body for unfolding and deforestation opportunities.
:- type unfold_info
    --->    unfold_info(
                ufi_proc_info       :: proc_info,
                ufi_head_inst_vars  :: map(inst_var, mer_inst),
                ufi_instmap         :: instmap,

                % Improvement in cost measured while processing this procedure.
                ufi_cost_delta      :: int,

                % Information used to prevent infinite unfolding within the
                % current procedure..
                ufi_local_term_info :: local_term_info,

                ufi_pred_info       :: pred_info,
                ufi_parents         :: set(pred_proc_id),

                % Current pred_proc_id.
                ufi_pred_proc_id    :: pred_proc_id,

                % Increase in size measured while processing this procedure.
                ufi_size_delta      :: int,

                % Has anything changed?
                ufi_changed         :: bool,

                % Does determinism analysis need to be rerun.
                ufi_rerun_det       :: bool
            ).

    % pd_arg_info records which procedures have arguments for which
    % it might be worthwhile to attempt deforestation if there
    % is extra information about them, and the branches of the single
    % branched goal in the top level conjunction which produce that extra
    % information.
:- type pd_arg_info == map(pred_proc_id, pd_proc_arg_info).

:- type pd_proc_arg_info    ==  pd_branch_info(int).

:- type pd_branch_info(T)
    --->    pd_branch_info(
                branch_info_map(T),

                % variables for which we want extra left context
                set(T),

                % outputs for which we have no extra information
                set(T)
            ).

    % Vars for which there is extra information at the end
    % of some branches, and the branches which add the extra
    % information (numbered from 1).
:- type branch_info_map(T)  ==  map(T, set(int)).

:- pred pd_info_get_proc_info(pd_info::in, proc_info::out) is det.
:- pred pd_info_get_head_inst_vars(pd_info::in, map(inst_var, mer_inst)::out)
    is det.
:- pred pd_info_get_instmap(pd_info::in, instmap::out) is det.
:- pred pd_info_get_cost_delta(pd_info::in, int::out) is det.
:- pred pd_info_get_local_term_info(pd_info::in, local_term_info::out) is det.
:- pred pd_info_get_pred_info(pd_info::in, pred_info::out) is det.
:- pred pd_info_get_parents(pd_info::in, set(pred_proc_id)::out) is det.
:- pred pd_info_get_pred_proc_id(pd_info::in, pred_proc_id::out) is det.
:- pred pd_info_get_size_delta(pd_info::in, int::out) is det.
:- pred pd_info_get_changed(pd_info::in, bool::out) is det.
:- pred pd_info_get_rerun_det(pd_info::in, bool::out) is det.

:- pred pd_info_set_proc_info(proc_info::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_instmap(instmap::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_cost_delta(int::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_local_term_info(local_term_info::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_pred_info(pred_info::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_parents(set(pred_proc_id)::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_pred_proc_id(pred_proc_id::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_size_delta(int::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_changed(bool::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_set_rerun_det(bool::in,
    pd_info::in, pd_info::out) is det.

:- pred pd_info_incr_cost_delta(int::in,
    pd_info::in, pd_info::out) is det.
:- pred pd_info_incr_size_delta(int::in,
    pd_info::in, pd_info::out) is det.

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

:- implementation.

pd_info_get_proc_info(PDInfo, UnfoldInfo ^ ufi_proc_info) :-
    pd_info_get_unfold_info(PDInfo, UnfoldInfo).
pd_info_get_head_inst_vars(PDInfo, UnfoldInfo ^ ufi_head_inst_vars) :-
    pd_info_get_unfold_info(PDInfo, UnfoldInfo).
pd_info_get_instmap(PDInfo, UnfoldInfo ^ ufi_instmap) :-
    pd_info_get_unfold_info(PDInfo, UnfoldInfo).
pd_info_get_cost_delta(PDInfo, UnfoldInfo ^ ufi_cost_delta) :-
    pd_info_get_unfold_info(PDInfo, UnfoldInfo).
pd_info_get_local_term_info(PDInfo, UnfoldInfo ^ ufi_local_term_info) :-
    pd_info_get_unfold_info(PDInfo, UnfoldInfo).
pd_info_get_pred_info(PDInfo, UnfoldInfo ^ ufi_pred_info) :-
    pd_info_get_unfold_info(PDInfo, UnfoldInfo).
pd_info_get_parents(PDInfo, UnfoldInfo ^ ufi_parents) :-
    pd_info_get_unfold_info(PDInfo, UnfoldInfo).
pd_info_get_pred_proc_id(PDInfo, UnfoldInfo ^ ufi_pred_proc_id) :-
    pd_info_get_unfold_info(PDInfo, UnfoldInfo).
pd_info_get_size_delta(PDInfo, UnfoldInfo ^ ufi_size_delta) :-
    pd_info_get_unfold_info(PDInfo, UnfoldInfo).
pd_info_get_changed(PDInfo, UnfoldInfo ^ ufi_changed) :-
    pd_info_get_unfold_info(PDInfo, UnfoldInfo).
pd_info_get_rerun_det(PDInfo, UnfoldInfo ^ ufi_rerun_det) :-
    pd_info_get_unfold_info(PDInfo, UnfoldInfo).

pd_info_set_proc_info(ProcInfo, !PDInfo) :-
    pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
    UnfoldInfo = UnfoldInfo0 ^ ufi_proc_info := ProcInfo,
    pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_instmap(InstMap, !PDInfo) :-
    pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
    UnfoldInfo = UnfoldInfo0 ^ ufi_instmap := InstMap,
    pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_cost_delta(CostDelta, !PDInfo) :-
    pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
    UnfoldInfo = UnfoldInfo0 ^ ufi_cost_delta := CostDelta,
    pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_local_term_info(TermInfo, !PDInfo) :-
    pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
    UnfoldInfo = UnfoldInfo0 ^ ufi_local_term_info := TermInfo,
    pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_pred_info(PredInfo, !PDInfo) :-
    pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
    UnfoldInfo = UnfoldInfo0 ^ ufi_pred_info := PredInfo,
    pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_parents(Parents, !PDInfo) :-
    pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
    UnfoldInfo = UnfoldInfo0 ^ ufi_parents := Parents,
    pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_pred_proc_id(PredProcId, !PDInfo) :-
    pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
    UnfoldInfo = UnfoldInfo0 ^ ufi_pred_proc_id := PredProcId,
    pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_size_delta(SizeDelta, !PDInfo) :-
    pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
    UnfoldInfo = UnfoldInfo0 ^ ufi_size_delta := SizeDelta,
    pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_changed(Changed, !PDInfo) :-
    pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
    UnfoldInfo = UnfoldInfo0 ^ ufi_changed := Changed,
    pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_rerun_det(Rerun, !PDInfo) :-
    pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
    UnfoldInfo = UnfoldInfo0 ^ ufi_rerun_det := Rerun,
    pd_info_set_unfold_info(UnfoldInfo, !PDInfo).

pd_info_incr_cost_delta(Delta1, !PDInfo) :-
    pd_info_get_cost_delta(!.PDInfo, Delta0),
    Delta = Delta0 + Delta1,
    pd_info_set_cost_delta(Delta, !PDInfo).

pd_info_incr_size_delta(Delta1, !PDInfo) :-
    pd_info_get_size_delta(!.PDInfo, Delta0),
    Delta = Delta0 + Delta1,
    pd_info_set_size_delta(Delta, !PDInfo).

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

:- interface.

    % Find the deforestation procedure which most closely matches
    % the given goal.
    %
:- pred pd_info_search_version(pd_info::in, hlds_goal::in, maybe_version::out)
    is det.

    % Create a new predicate for the input goal, returning a goal
    % which calls the new predicate.
    %
:- pred pd_info_define_new_pred(hlds_goal::in,
    pred_proc_id::out, hlds_goal::out, pd_info::in, pd_info::out) is det.

    % Add a version to the table.
    %
:- pred pd_info_register_version(pred_proc_id::in, version_info::in,
    pd_info::in, pd_info::out) is det.

    % Remove a version and make sure it is never recreated.
    %
:- pred pd_info_invalidate_version(pred_proc_id::in,
    pd_info::in, pd_info::out) is det.

    % Remove a version, but allow it to be recreated if it
    % is used elsewhere.
    %
:- pred pd_info_remove_version(pred_proc_id::in,
    pd_info::in, pd_info::out) is det.

    % The result of looking up a specialised version of a pred.
:- type maybe_version
    --->    no_version
    ;       version(
                mv_is_exact         :: version_is_exact,
                mv_ppid             :: pred_proc_id,
                mv_version          :: version_info,

                % renaming of the version info
                mv_renaming         :: map(prog_var, prog_var),

                % var types substitution
                mv_tsubst           :: tsubst
            ).

:- type version_is_exact
    --->    exact
    ;       more_general.

:- type version_info
    --->    version_info(
                % goal before unfolding.
                version_orig_goal   :: hlds_goal,

                % calls being deforested.
                version_deforest_calls  :: list(pred_proc_id),

                % arguments.
                version_arg_vars    :: list(prog_var),

                % argument types.
                version_arg_types   :: list(mer_type),

                % initial insts of the nonlocals.
                version_init_insts  :: instmap,

                % cost of the original goal.
                version_orig_cost   :: int,

                % improvement in cost.
                version_cost_improv :: int,

                % parent versions.
                version_parents     :: set(pred_proc_id),

                % the version which was generalised to produce this version.
                version_source      :: maybe(pred_proc_id)
            ).

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

:- implementation.

pd_info_search_version(PDInfo, Goal, MaybeVersion) :-
    trace [io(!IO)] (
        pd_debug_output_goal(PDInfo, "Searching for version:\n", Goal, !IO)
    ),
    pd_util.goal_get_calls(Goal, CalledPreds),
    pd_info_get_versions(PDInfo, Versions),
    pd_info_get_goal_version_index(PDInfo, GoalVersionIndex),
    pd_info_get_module_info(PDInfo, ModuleInfo),
    pd_info_get_proc_info(PDInfo, ProcInfo),
    pd_info_get_instmap(PDInfo, InstMap),
    proc_info_get_var_table(ProcInfo, VarTable),
    ( if
        map.search(GoalVersionIndex, CalledPreds, VersionIds),
        pd_info_get_matching_version(ModuleInfo, Goal, InstMap,
            VarTable, VersionIds, Versions, MaybeVersion0)
    then
        MaybeVersion = MaybeVersion0
    else
        MaybeVersion = no_version
    ),
    trace [io(!IO)] (
        pd_debug_search_version_result(PDInfo, MaybeVersion, !IO)
    ).

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

:- pred pd_info_get_matching_version(module_info::in, hlds_goal::in,
    instmap::in, var_table::in, list(pred_proc_id)::in,
    version_index::in, maybe_version::out) is semidet.

pd_info_get_matching_version(_, _, _, _, [], _, no_version).
pd_info_get_matching_version(ModuleInfo, ThisGoal, ThisInstMap, VarTable,
        [VersionId | VersionIds], Versions, MaybeVersion) :-
    map.lookup(Versions, VersionId, Version),
    Version = version_info(OldGoal, _, OldArgs, OldArgTypes,
        OldInstMap, _, _, _, _),
    ( if
        pd_info_goal_is_more_general(ModuleInfo, OldGoal, OldInstMap, OldArgs,
            OldArgTypes, ThisGoal, ThisInstMap, VarTable, VersionId, Version,
            MaybeVersion1)
    then
        (
            MaybeVersion1 = no_version,
            pd_info_get_matching_version(ModuleInfo, ThisGoal, ThisInstMap,
                VarTable, VersionIds, Versions, MaybeVersion)
        ;
            MaybeVersion1 = version(exact, _, _, _, _),
            MaybeVersion = MaybeVersion1
        ;
            MaybeVersion1 = version(more_general, PredProcId,
                MoreGeneralVersion, Renaming, TypeSubn),
            pd_info_get_matching_version(ModuleInfo, ThisGoal,
                ThisInstMap, VarTable, VersionIds,
                Versions, MaybeVersion2),
            pd_info_pick_version(ModuleInfo, PredProcId, Renaming,
                TypeSubn, MoreGeneralVersion, MaybeVersion2, MaybeVersion)
        )
    else
        pd_info_get_matching_version(ModuleInfo, ThisGoal, ThisInstMap,
            VarTable, VersionIds, Versions, MaybeVersion)
    ).

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

    % Choose between two versions.
    %
:- pred pd_info_pick_version(module_info::in, pred_proc_id::in,
    map(prog_var, prog_var)::in, tsubst::in, version_info::in,
    maybe_version::in, maybe_version::out) is det.

pd_info_pick_version(_, PredProcId, Renaming, TSubn, VersionInfo, no_version,
    version(more_general, PredProcId, VersionInfo, Renaming, TSubn)).
pd_info_pick_version(_, _, _, _, _,
        version(exact, PredProcId, Version2, Renaming2, TSubn2),
        version(exact, PredProcId, Version2, Renaming2, TSubn2)).
pd_info_pick_version(_ModuleInfo, PredProcId1, Renaming1, TSubn1, Version1,
        version(more_general, PredProcId2, Version2, Renaming2, TSubn2),
        MaybeVersion) :-
    Version1 = version_info(_, _, _, _, _, _, CostDelta1, _, _),
    Version2 = version_info(_, _, _, _, _, _, CostDelta2, _, _),
    % Select the version with the biggest decrease in cost.
    ( if CostDelta1 > CostDelta2 then
        MaybeVersion = version(more_general, PredProcId1,
            Version1, Renaming1, TSubn1)
    else
        MaybeVersion = version(more_general, PredProcId2,
            Version2, Renaming2, TSubn2)
    ).

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

    % The aim of this is to check whether the first goal can be used
    % instead of the second if specialisation on the second goal does
    % not produce any more improvement.
    %
    % An old version is more general than a new one if:
    % - the goals have the same "shape" (see pd_util.goals_match).
    % - each variable in the old goal maps to exactly one
    %   variable in the new (multiple vars in the new goal can
    %   map to one var in the old).
    % - each nonlocal in the new goal maps to a non-local in the
    %   old (i.e. the old version produces all the variables
    %   that the new one does).
    % - for each pair of corresponding insts in the above mapping,
    %   the old inst must be at least as general as the
    %   new one, i.e inst_matches_initial(FirstInst, SecondInst) (?)
    %
:- pred pd_info_goal_is_more_general(module_info::in, hlds_goal::in,
    instmap::in, list(prog_var)::in, list(mer_type)::in, hlds_goal::in,
    instmap::in, var_table::in, pred_proc_id::in,
    version_info::in, maybe_version::out) is semidet.

pd_info_goal_is_more_general(ModuleInfo, OldGoal, OldInstMap, OldArgs,
        OldArgTypes, NewGoal, NewInstMap, NewVarTable, PredProcId,
        Version, MaybeVersion) :-
    pd_util.goals_match(ModuleInfo, OldGoal, OldArgs, OldArgTypes,
        NewGoal, NewVarTable, OldNewRenaming, TypeRenaming),
    OldGoal = hlds_goal(_, OldGoalInfo),
    OldNonLocals0 = goal_info_get_nonlocals(OldGoalInfo),
    set_of_var.to_sorted_list(OldNonLocals0, OldNonLocalsList),
    pd_info_check_insts(ModuleInfo, OldNonLocalsList, OldNewRenaming,
        OldInstMap, NewInstMap, NewVarTable, exact, Exact),

    MaybeVersion = version(Exact, PredProcId, Version,
        OldNewRenaming, TypeRenaming).

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

    % Check that all the insts in the old version are at least as
    % general as the insts in the new version.
    %
:- pred pd_info_check_insts(module_info::in, list(prog_var)::in,
    map(prog_var, prog_var)::in, instmap::in, instmap::in, var_table::in,
    version_is_exact::in, version_is_exact::out) is semidet.

pd_info_check_insts(_, [], _, _, _, _, !ExactSoFar).
pd_info_check_insts(ModuleInfo, [OldVar | Vars], VarRenaming, OldInstMap,
        NewInstMap, VarTable, !ExactSoFar) :-
    instmap_lookup_var(OldInstMap, OldVar, OldVarInst),
    map.lookup(VarRenaming, OldVar, NewVar),
    instmap_lookup_var(NewInstMap, NewVar, NewVarInst),
    lookup_var_type(VarTable, NewVar, Type),
    inst_matches_initial(ModuleInfo, Type, NewVarInst, OldVarInst),
    (
        !.ExactSoFar = exact,
        % Does inst_matches_initial(Inst1, Inst2, M) and
        % inst_matches_initial(Inst2, Inst1, M) imply that Inst1
        % and Inst2 are interchangable?
        ( if
            inst_matches_initial(ModuleInfo, Type, OldVarInst, NewVarInst)
        then
            !:ExactSoFar = exact
        else
            !:ExactSoFar = more_general
        )
    ;
        !.ExactSoFar = more_general
    ),
    pd_info_check_insts(ModuleInfo, Vars, VarRenaming, OldInstMap,
        NewInstMap, VarTable, !ExactSoFar).

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

pd_info_define_new_pred(Goal, PredProcId, CallGoal, !PDInfo) :-
    pd_info_get_instmap(!.PDInfo, InstMap),
    Goal = hlds_goal(_, GoalInfo),
    NonLocals = goal_info_get_nonlocals(GoalInfo),
    set_of_var.to_sorted_list(NonLocals, Args),
    pd_info_get_counter(!.PDInfo, Counter0),
    counter.allocate(SeqNum, Counter0, Counter),
    pd_info_set_counter(Counter, !PDInfo),
    pd_info_get_pred_info(!.PDInfo, PredInfo),
    PredModule = pred_info_module(PredInfo),
    PredName = pred_info_name(PredInfo),
    Context = goal_info_get_context(GoalInfo),
    LineNum = term_context.context_line(Context),
    pd_info_get_module_info(!.PDInfo, ModuleInfo0),
    Origin = origin_compiler(made_for_deforestation(LineNum, SeqNum)),
    Transform = tn_deforestation(pf_predicate, lnc(LineNum, SeqNum)),
    make_transformed_pred_sym_name(PredModule, PredName, Transform,
        NewPredSymName),

    pd_info_get_proc_info(!.PDInfo, ProcInfo),
    pred_info_get_typevarset(PredInfo, TVarSet),
    pred_info_get_markers(PredInfo, Markers),
    pred_info_get_class_context(PredInfo, ClassContext),
    proc_info_get_var_table(ProcInfo, VarTable),
    proc_info_get_rtti_varmaps(ProcInfo, RttiVarMaps),
    proc_info_get_inst_varset(ProcInfo, InstVarSet),
    proc_info_get_has_parallel_conj(ProcInfo, HasParallelConj),
    proc_info_get_var_name_remap(ProcInfo, VarNameRemap),
    % XXX handle the extra typeinfo arguments for
    % --typeinfo-liveness properly.
    hlds_pred.define_new_pred(NewPredSymName, Origin, TVarSet, InstVarSet,
        VarTable, RttiVarMaps, ClassContext, InstMap, VarNameRemap, Markers,
        address_is_not_taken, HasParallelConj, PredProcId, Args, _ExtraArgs,
        Goal, CallGoal, ModuleInfo0, ModuleInfo),
    pd_info_set_module_info(ModuleInfo, !PDInfo).

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

pd_info_register_version(PredProcId, Version, !PDInfo) :-
    trace [io(!IO)] (
        pd_debug_register_version(!.PDInfo, PredProcId, Version, !IO)
    ),
    pd_info_get_goal_version_index(!.PDInfo, GoalVersionIndex0),
    Goal = Version ^ version_orig_goal,
    pd_util.goal_get_calls(Goal, Calls),
    ( if map.search(GoalVersionIndex0, Calls, VersionList0) then
        VersionList = [PredProcId | VersionList0],
        map.det_update(Calls, VersionList, GoalVersionIndex0, GoalVersionIndex)
    else
        VersionList = [PredProcId],
        map.det_insert(Calls, VersionList, GoalVersionIndex0, GoalVersionIndex)
    ),
    pd_info_set_goal_version_index(GoalVersionIndex, !PDInfo),
    pd_info_get_versions(!.PDInfo, Versions0),
    map.det_insert(PredProcId, Version, Versions0, Versions),
    pd_info_set_versions(Versions, !PDInfo),
    pd_info_get_created_versions(!.PDInfo, CreatedVersions0),
    set.insert(PredProcId, CreatedVersions0, CreatedVersions),
    pd_info_set_created_versions(CreatedVersions, !PDInfo).

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

pd_info_invalidate_version(PredProcId, !PDInfo) :-
    pd_info_get_versions(!.PDInfo, Versions0),
    map.lookup(Versions0, PredProcId, Version),
    Goal = Version ^ version_orig_goal,
    pd_util.goal_get_calls(Goal, Calls),
    ( if
        Calls = [FirstCall | _],
        list.last(Calls, LastCall)
    then
        % Make sure we never create another version to deforest
        % this pair of calls.
        pd_info_get_useless_versions(!.PDInfo, Useless0),
        set.insert(FirstCall - LastCall, Useless0, Useless),
        pd_info_set_useless_versions(Useless, !PDInfo)
    else
        true
    ),
    pd_info_remove_version(PredProcId, !PDInfo).

pd_info_remove_version(PredProcId, !PDInfo) :-
    pd_info_get_versions(!.PDInfo, Versions0),
    map.lookup(Versions0, PredProcId, Version),
    Goal = Version ^ version_orig_goal,
    pd_util.goal_get_calls(Goal, Calls),
    map.delete(PredProcId, Versions0, Versions),
    pd_info_set_versions(Versions, !PDInfo),

    pd_info_get_goal_version_index(!.PDInfo, GoalIndex0),
    ( if map.search(GoalIndex0, Calls, GoalVersions0) then
        list.delete_all(GoalVersions0, PredProcId, GoalVersions),
        map.det_update(Calls, GoalVersions, GoalIndex0, GoalIndex),
        pd_info_set_goal_version_index(GoalIndex, !PDInfo)
    else
        true
    ),

    pd_info_get_created_versions(!.PDInfo, CreatedVersions0),
    set.delete(PredProcId, CreatedVersions0, CreatedVersions),
    pd_info_set_created_versions(CreatedVersions, !PDInfo),

    pd_info_get_module_info(!.PDInfo, ModuleInfo0),
    PredProcId = proc(PredId, _),
    module_info_remove_predicate(PredId, ModuleInfo0, ModuleInfo),
    pd_info_set_module_info(ModuleInfo, !PDInfo).

%---------------------------------------------------------------------------%
:- end_module transform_hlds.pd_info.
%---------------------------------------------------------------------------%