mercury/compiler/structure_sharing.analysis.m

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2005-2012 The University of Melbourne.
% Copyright (C) 2017 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: structure_sharing.analysis.m.
% Main authors: nancy.
%
% Implementation of the structure sharing analysis needed for compile-time
% garbage collection (CTGC).
%
%---------------------------------------------------------------------------%

:- module transform_hlds.ctgc.structure_sharing.analysis.
:- interface.

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

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

    % Perform structure sharing analysis on the procedures defined in the
    % current module.
    %
:- pred perform_structure_sharing_analysis(module_info::in, module_info::out)
    is det.

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

:- type structure_sharing_call.
:- type structure_sharing_answer.
:- type structure_sharing_func_info.

    % Only answer patterns actually require structure_sharing_func_info for
    % comparisons.
    %
:- instance analysis(structure_sharing_func_info,
    structure_sharing_call, structure_sharing_answer).

:- instance call_pattern(structure_sharing_func_info, structure_sharing_call).
:- instance partial_order(structure_sharing_func_info,
    structure_sharing_call).
:- instance to_term(structure_sharing_call).

:- instance answer_pattern(structure_sharing_func_info,
    structure_sharing_answer).
:- instance partial_order(structure_sharing_func_info,
    structure_sharing_answer).
:- instance to_term(structure_sharing_answer).

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

:- implementation.

:- import_module check_hlds.
:- import_module check_hlds.simplify.
:- import_module check_hlds.simplify.simplify_proc.
:- import_module check_hlds.simplify.simplify_tasks.
:- import_module hlds.arg_info.
:- import_module hlds.hlds_dependency_graph.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_util.
:- import_module hlds.hlds_pred.
:- import_module hlds.passes_aux.
:- import_module hlds.status.
:- import_module libs.
:- import_module libs.dependency_graph.
:- import_module libs.file_util.
:- import_module libs.globals.
:- import_module libs.op_mode.
:- import_module libs.options.
:- import_module ll_backend.
:- import_module ll_backend.liveness.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.prog_ctgc.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_pragma.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.var_table.
:- import_module transform_hlds.ctgc.fixpoint_table.
:- import_module transform_hlds.ctgc.structure_sharing.domain.
:- import_module transform_hlds.ctgc.util.
:- import_module transform_hlds.intermod_analysis.
:- import_module transform_hlds.mmc_analysis.

:- import_module bool.
:- import_module int.
:- import_module io.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module term.
:- import_module term_context.
:- import_module term_conversion.

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

    % During analysis we accumulate a list of imported procedures whose
    % answers this module depends on. This doesn't include `opt_imported'
    % procedures nor procedures that we can just predict the results for.
    %
:- type dep_procs == list(pred_proc_id).

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

perform_structure_sharing_analysis(!ModuleInfo) :-
    % Process all the imported sharing information.
    module_info_get_globals(!.ModuleInfo, Globals),
    globals.lookup_bool_option(Globals, intermodule_analysis,
        IntermodAnalysis),
    (
        IntermodAnalysis = yes,
        process_intermod_analysis_imported_sharing(!ModuleInfo)
    ;
        IntermodAnalysis = no,
        process_imported_sharing(!ModuleInfo)
    ),

    % Annotate the HLDS with liveness information. The liveness analysis
    % requires argument passing information.
    generate_arg_info(!ModuleInfo),
    annotate_liveness(!ModuleInfo),

    % Load all structure sharing information present in the HLDS.
    LoadedSharingTable = load_structure_sharing_table(!.ModuleInfo),

    % Analyse structure sharing for the module.
    sharing_analysis(!ModuleInfo, LoadedSharingTable),

    module_info_get_proc_analysis_kinds(!.ModuleInfo, ProcAnalysisKinds0),
    set.insert(pak_structure_sharing, ProcAnalysisKinds0, ProcAnalysisKinds),
    module_info_set_proc_analysis_kinds(ProcAnalysisKinds, !ModuleInfo).

%---------------------------------------------------------------------------%
%
% Preliminary steps.
%

    % Process the imported sharing information from .opt files
    %
:- pred process_imported_sharing(module_info::in, module_info::out) is det.

process_imported_sharing(!ModuleInfo):-
    module_info_get_valid_pred_ids(!.ModuleInfo, PredIds),
    list.foldl(process_imported_sharing_in_pred, PredIds, !ModuleInfo).

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

process_imported_sharing_in_pred(PredId, !ModuleInfo) :-
    module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
    process_imported_sharing_in_procs(PredInfo0, PredInfo),
    module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).

:- pred process_imported_sharing_in_procs(pred_info::in,
    pred_info::out) is det.

process_imported_sharing_in_procs(!PredInfo) :-
    some [!ProcTable] (
        pred_info_get_proc_table(!.PredInfo, !:ProcTable),
        ProcIds = pred_info_valid_procids(!.PredInfo),
        list.foldl(process_imported_sharing_in_proc(!.PredInfo),
            ProcIds, !ProcTable),
        pred_info_set_proc_table(!.ProcTable, !PredInfo)
    ).

:- pred process_imported_sharing_in_proc(pred_info::in, proc_id::in,
    proc_table::in, proc_table::out) is det.

process_imported_sharing_in_proc(PredInfo, ProcId, !ProcTable) :-
    some [!ProcInfo] (
        map.lookup(!.ProcTable, ProcId, !:ProcInfo),
        ( if
            proc_info_get_imported_structure_sharing(!.ProcInfo,
                ImpHeadVars, ImpTypes, ImpSharing)
        then
            proc_info_get_headvars(!.ProcInfo, HeadVars),
            pred_info_get_arg_types(PredInfo, HeadVarTypes),
            map.from_corresponding_lists(ImpHeadVars, HeadVars, VarRenaming),
            some [!TypeSubst] (
                !:TypeSubst = map.init,
                ( if
                    type_unify_list(ImpTypes, HeadVarTypes, [], !.TypeSubst,
                        TypeSubstNew)
                then
                    !:TypeSubst = TypeSubstNew
                else
                    true
                ),
                rename_structure_sharing_domain(VarRenaming, !.TypeSubst,
                    ImpSharing, Sharing)
            ),
            % Optimality does not apply to `--intermodule-optimisation'
            % system, only `--intermodule-analysis'.
            proc_info_set_structure_sharing(
                structure_sharing_domain_and_status(Sharing, optimal),
                !ProcInfo),
            proc_info_reset_imported_structure_sharing(!ProcInfo),
            map.det_update(ProcId, !.ProcInfo, !ProcTable)
        else
            true
        )
    ).

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

    % Process the intermodule imported sharing information from the analysis
    % framework
    %
:- pred process_intermod_analysis_imported_sharing(module_info::in,
    module_info::out) is det.

process_intermod_analysis_imported_sharing(!ModuleInfo):-
    module_info_get_valid_pred_ids(!.ModuleInfo, PredIds),
    list.foldl(process_intermod_analysis_imported_sharing_in_pred, PredIds,
        !ModuleInfo).

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

process_intermod_analysis_imported_sharing_in_pred(PredId, !ModuleInfo) :-
    module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
    ( if pred_info_is_imported_not_external(PredInfo0) then
        module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo),
        process_intermod_analysis_imported_sharing_in_procs(!.ModuleInfo,
            AnalysisInfo, PredId, PredInfo0, PredInfo),
        module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
    else
        true
    ).

:- pred process_intermod_analysis_imported_sharing_in_procs(module_info::in,
    analysis_info::in, pred_id::in, pred_info::in, pred_info::out) is det.

process_intermod_analysis_imported_sharing_in_procs(ModuleInfo, AnalysisInfo,
        PredId, !PredInfo) :-
    some [!ProcTable] (
        pred_info_get_proc_table(!.PredInfo, !:ProcTable),
        ProcIds = pred_info_valid_procids(!.PredInfo),
        list.foldl(
            process_intermod_analysis_imported_sharing_in_proc(ModuleInfo,
                AnalysisInfo, PredId, !.PredInfo),
            ProcIds, !ProcTable),
        pred_info_set_proc_table(!.ProcTable, !PredInfo)
    ).

:- pred process_intermod_analysis_imported_sharing_in_proc(module_info::in,
    analysis_info::in, pred_id::in, pred_info::in, proc_id::in,
    proc_table::in, proc_table::out) is det.

process_intermod_analysis_imported_sharing_in_proc(ModuleInfo, AnalysisInfo,
        PredId, PredInfo, ProcId, !ProcTable) :-
    PPId = proc(PredId, ProcId),
    some [!ProcInfo] (
        map.lookup(!.ProcTable, ProcId, !:ProcInfo),
        module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
        FuncInfo = structure_sharing_func_info(ModuleInfo, !.ProcInfo),
        lookup_best_result(AnalysisInfo, ModuleName, FuncId, FuncInfo,
            structure_sharing_call, MaybeBestResult),
        (
            MaybeBestResult = yes(analysis_result(_Call, Answer,
                ResultStatus)),
            pred_info_get_arg_types(PredInfo, HeadVarTypes),
            structure_sharing_answer_to_domain(yes(PPId), HeadVarTypes,
                !.ProcInfo, Answer, Sharing),
            proc_info_set_structure_sharing(
                structure_sharing_domain_and_status(Sharing, ResultStatus),
                !ProcInfo),
            map.det_update(ProcId, !.ProcInfo, !ProcTable)
        ;
            MaybeBestResult = no
        )
    ).

:- pred structure_sharing_answer_to_domain(maybe(pred_proc_id)::in,
    list(mer_type)::in, proc_info::in, structure_sharing_answer::in,
    structure_sharing_domain::out) is det.

structure_sharing_answer_to_domain(MaybePPId, HeadVarTypes, ProcInfo, Answer,
        Sharing) :-
    (
        Answer = structure_sharing_answer_bottom,
        Sharing = structure_sharing_bottom
    ;
        Answer = structure_sharing_answer_top,
        (
            MaybePPId = yes(PPId),
            TopReason = set.make_singleton_set(
                top_from_lookup(shroud_pred_proc_id(PPId)))
        ;
            MaybePPId = no,
            TopReason = set.init
        ),
        Sharing = structure_sharing_top(TopReason)
    ;
        Answer = structure_sharing_answer_real(ImpHeadVars, ImpTypes,
            ImpSharingPairs),
        proc_info_get_headvars(ProcInfo, HeadVars),
        map.from_corresponding_lists(ImpHeadVars, HeadVars, VarRenaming),
        ( if
            type_unify_list(ImpTypes, HeadVarTypes, [], map.init, TypeSubst)
        then
            rename_structure_sharing(VarRenaming, TypeSubst, ImpSharingPairs,
                SharingPairs),
            Sharing = structure_sharing_real(SharingPairs)
        else
            unexpected($pred, "type_unify_list failed")
        )
    ).

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

    % Annotate the HLDS with pre-birth and post-death information, as
    % used by the liveness pass (liveness.m). This information is used to
    % eliminate useless sharing pairs during sharing analysis.
    %
:- pred annotate_liveness(module_info::in, module_info::out) is det.

annotate_liveness(!ModuleInfo) :-
    process_valid_nonimported_procs(
        update_module(simplify_and_detect_liveness_proc), !ModuleInfo).

:- pred simplify_and_detect_liveness_proc(pred_proc_id::in,
    proc_info::in, proc_info::out, module_info::in, module_info::out) is det.

simplify_and_detect_liveness_proc(PredProcId, !ProcInfo, !ModuleInfo) :-
    % Liveness annotation expects the procedure to have been simplified.
    % For example, an if-then-else with an `erroneous' condition will cause
    % an assertion failure if it is not simplified away.
    module_info_get_globals(!.ModuleInfo, Globals),
    SimplifyTasks = list_to_simplify_tasks(Globals, []),
    PredProcId = proc(PredId, ProcId),
    MaybeProgressStream = maybe.no,
    simplify_proc(MaybeProgressStream, SimplifyTasks, PredId, ProcId,
        !ModuleInfo, !ProcInfo),
    detect_liveness_proc(!.ModuleInfo, PredProcId, !ProcInfo).

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

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

sharing_analysis(!ModuleInfo, !.SharingTable) :-
    % Perform a bottom-up traversal of the SCCs in the program,
    % analysing structure sharing in each one as we go.
    module_info_ensure_dependency_info(!ModuleInfo, DepInfo),
    SCCs = dependency_info_get_bottom_up_sccs(DepInfo),
    list.foldl2(analyse_scc(!.ModuleInfo), SCCs, !SharingTable, [], DepProcs),

    % Record the sharing results in the HLDS.
    map.foldl(save_sharing_in_module_info, !.SharingTable, !ModuleInfo),

    % If making a `.analysis' file, record structure sharing results, analysis
    % dependencies, assumed answers and requests in the analysis framework.
    module_info_get_globals(!.ModuleInfo, Globals),
    globals.get_op_mode(Globals, OpMode),
    ( if OpMode = opm_top_args(opma_augment(opmau_make_analysis_registry)) then
        some [!AnalysisInfo] (
            module_info_get_analysis_info(!.ModuleInfo, !:AnalysisInfo),
            module_info_get_valid_pred_ids(!.ModuleInfo, PredIds),
            list.foldl(maybe_record_sharing_analysis_result(!.ModuleInfo,
                !.SharingTable), PredIds, !AnalysisInfo),
            list.foldl(handle_dep_procs(!.ModuleInfo), DepProcs,
                !AnalysisInfo),
            module_info_set_analysis_info(!.AnalysisInfo, !ModuleInfo)
        )
    else
        true
    ).

:- pred save_sharing_in_module_info(pred_proc_id::in,
    sharing_as_and_status::in, module_info::in, module_info::out) is det.

save_sharing_in_module_info(PPId, SharingAs_Status, !ModuleInfo) :-
    SharingAs_Status = sharing_as_and_status(SharingAs, Status),
    module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, ProcInfo0),
    SharingDomain = to_structure_sharing_domain(SharingAs),
    proc_info_set_structure_sharing(
        structure_sharing_domain_and_status(SharingDomain, Status),
        ProcInfo0, ProcInfo),
    module_info_set_pred_proc_info(PPId, PredInfo, ProcInfo, !ModuleInfo).

:- pred analyse_scc(module_info::in, scc::in,
    sharing_as_table::in, sharing_as_table::out,
    dep_procs::in, dep_procs::out) is det.

analyse_scc(ModuleInfo, SCC, !SharingTable, !DepProcs) :-
    set.to_sorted_list(SCC, SCCProcs),
    ( if some_preds_require_no_analysis(ModuleInfo, SCC) then
        % At least one procedure in the SCC requires that we don't analyse it.
        % We update the sharing table otherwise procedures which call it will
        % not be able to find a result, and therefore conclude that the
        % analysis is suboptimal.
        ProcsStrs = list.map(pred_proc_id_to_dev_string(ModuleInfo), SCCProcs),
        ProcsStr = string.join_list(", ", ProcsStrs),
        Msg = "SCC cannot be analysed: " ++ ProcsStr,
        SharingAs = sharing_as_top_sharing(top_cannot_improve(Msg)),
        SharingAndStatus = sharing_as_and_status(SharingAs, optimal),
        set.foldl(
            ( pred(PPId::in, ST0::in, ST::out) is det :-
                sharing_as_table_set(PPId, SharingAndStatus, ST0, ST)
            ),
            SCC, !SharingTable)
    else
        FixpointTable0 = ss_fixpoint_table_init(SCCProcs),
        analyse_scc_until_fixpoint(ModuleInfo, SCCProcs, !.SharingTable,
            FixpointTable0, FixpointTable, !DepProcs),
        set.foldl(update_sharing_in_table(FixpointTable), SCC, !SharingTable)
    ).

:- pred analyse_scc_until_fixpoint(module_info::in, list(pred_proc_id)::in,
    sharing_as_table::in, ss_fixpoint_table::in, ss_fixpoint_table::out,
    dep_procs::in, dep_procs::out) is det.

analyse_scc_until_fixpoint(ModuleInfo, SCC, SharingTable,
        !FixpointTable, !DepProcs) :-
    % Abort if the analysis is taking too long. It is probably a bug.
    Run = ss_fixpoint_table_which_run(!.FixpointTable),
    ( if Run > max_runs then
        unexpected($pred, "fixpoint not reached after "
            ++ string.from_int(max_runs) ++ " runs")
    else
        true
    ),

    list.foldl2(analyse_pred_proc(ModuleInfo, SharingTable), SCC,
        !FixpointTable, !DepProcs),
    ( if ss_fixpoint_table_stable(!.FixpointTable) then
        true
    else
        ss_fixpoint_table_new_run(!FixpointTable),
        analyse_scc_until_fixpoint(ModuleInfo, SCC, SharingTable,
            !FixpointTable, !DepProcs)
    ).

:- func max_runs = int.

max_runs = 100.

%---------------------------------------------------------------------------%
%
% Perform structure sharing analysis on a procedure.
%

:- pred analyse_pred_proc(module_info::in, sharing_as_table::in,
    pred_proc_id::in, ss_fixpoint_table::in, ss_fixpoint_table::out,
    dep_procs::in, dep_procs::out) is det.

analyse_pred_proc(ModuleInfo, SharingTable, PPId, !FixpointTable, !DepProcs) :-
    % Collect relevant compiler options.
    module_info_get_globals(ModuleInfo, Globals),
    globals.lookup_bool_option(Globals, very_verbose, Verbose),
    globals.lookup_int_option(Globals, structure_sharing_widening,
        WideningLimit),

    % Collect relevant procedure information.
    module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, ProcInfo),
    proc_info_get_headvars(ProcInfo, HeadVars),

    % Write progress message for the start of analysing current procedure.
    Run = ss_fixpoint_table_which_run(!.FixpointTable),
    TabledAsDescr = ss_fixpoint_table_get_short_description(PPId,
        !.FixpointTable),
    trace [io(!IO)] (
        maybe_write_proc_progress_message(ModuleInfo,
            "Sharing analysis (run " ++ string.int_to_string(Run) ++ ")",
            PPId, !IO)
    ),

    % In some cases the sharing can be predicted to be bottom, in which
    % case a full sharing analysis is not needed.
    %
    some [!Sharing] (
        !:Sharing = sharing_as_init,
        ( if
            bottom_sharing_is_safe_approximation(ModuleInfo, PredInfo,
                ProcInfo)
        then
            trace [io(!IO)] (
                get_debug_output_stream(ModuleInfo, DebugStream, !IO),
                maybe_write_string(DebugStream, Verbose,
                    "\t\t: bottom predicted", !IO)
            ),
            Status = optimal
        else
            % Start analysis.
            proc_info_get_goal(ProcInfo, Goal),
            analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable,
                Verbose, Goal, !FixpointTable, !DepProcs, !Sharing,
                optimal, Status),
            FullAsDescr = sharing_as_short_description(!.Sharing),

            sharing_as_project(HeadVars, !Sharing),
            ProjAsDescr = sharing_as_short_description(!.Sharing),

            proc_info_get_var_table(ProcInfo, VarTable),
            domain.apply_widening(ModuleInfo, VarTable, WideningLimit,
                WideningDone, !Sharing),
            (
                WideningDone = yes,
                WidenAsDescr = sharing_as_short_description(!.Sharing)
            ;
                WideningDone = no,
                WidenAsDescr = "-"
            ),

            trace [io(!IO)] (
                get_debug_output_stream(ModuleInfo, DebugStream, !IO),
                maybe_write_string(DebugStream, Verbose,
                    "\n\t\t: " ++ TabledAsDescr ++ "->" ++
                    FullAsDescr ++ "/" ++ ProjAsDescr ++ "/" ++ WidenAsDescr,
                    !IO)
            )
        ),
        SharingAs_Status = sharing_as_and_status(!.Sharing, Status),
        ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, PPId, SharingAs_Status,
            !FixpointTable)
    ),
    Desc = ss_fixpoint_table_description(!.FixpointTable),
    trace [io(!IO)] (
        get_debug_output_stream(ModuleInfo, DebugStream, !IO),
        maybe_write_string(DebugStream, Verbose,
            "\t\t (ft = " ++ Desc ++ ")\n", !IO)
    ).

%---------------------------------------------------------------------------%
%
% Structure sharing analysis of goals.
%

:- pred analyse_goal(module_info::in, pred_info::in, proc_info::in,
    sharing_as_table::in, bool::in, hlds_goal::in,
    ss_fixpoint_table::in, ss_fixpoint_table::out,
    dep_procs::in, dep_procs::out, sharing_as::in, sharing_as::out,
    analysis_status::in, analysis_status::out) is det.

analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose, Goal,
        !FixpointTable, !DepProcs, !SharingAs, !Status) :-
    Goal = hlds_goal(GoalExpr, GoalInfo),
    (
        GoalExpr = conj(ConjType, Goals),
        (
            ConjType = plain_conj,
            list.foldl4(analyse_goal_with_progress(ModuleInfo, PredInfo,
                ProcInfo, SharingTable, Verbose), Goals,
                !FixpointTable, !DepProcs, !SharingAs, !Status)
        ;
            ConjType = parallel_conj,
            Context = goal_info_get_context(GoalInfo),
            context_to_string(Context, ContextString),
            !:SharingAs = sharing_as_top_sharing_accumulate(
                top_cannot_improve("par_conj (" ++ ContextString ++ ")"),
                !.SharingAs)
        )
    ;
        GoalExpr = plain_call(CalleePredId, CalleeProcId, CallArgs,_, _, _),
        CalleePPId = proc(CalleePredId, CalleeProcId),
        lookup_sharing(ModuleInfo, SharingTable, CalleePPId,
            !FixpointTable, CalleeSharing, CalleeStatus, IsPredicted),

        % If the called procedure was imported (not opt_imported) and its
        % result is not predictable, then remember that this module depends on
        % the results for that procedure.
        ( if
            IsPredicted = no,
            pred_info_get_status(PredInfo, PredStatus),
            pred_status_defined_in_this_module(PredStatus) = yes,
            module_info_pred_info(ModuleInfo, CalleePredId, CalleePredInfo),
            pred_info_is_imported_not_external(CalleePredInfo),
            not is_unify_index_or_compare_pred(CalleePredInfo)
        then
            !:DepProcs = [CalleePPId | !.DepProcs]
        else
            true
        ),

        % Rename
        proc_info_get_var_table(ProcInfo, CallerVarTable),
        lookup_var_types(CallerVarTable, CallArgs, ActualTypes),
        pred_info_get_typevarset(PredInfo, CallerTypeVarSet),
        pred_info_get_univ_quant_tvars(PredInfo, CallerHeadParams),
        sharing_as_rename_using_module_info(ModuleInfo, CalleePPId, CallArgs,
            ActualTypes, CallerTypeVarSet, CallerHeadParams,
            CalleeSharing, RenamedSharing),

        % Combine
        !:SharingAs = sharing_as_comb(ModuleInfo, ProcInfo,
            RenamedSharing, !.SharingAs),
        !:Status = lub(CalleeStatus, !.Status)
    ;
        GoalExpr = generic_call(GenDetails, CallArgs, Modes, _MaybeArgRegs,
            _Detism),
        analyse_generic_call(ModuleInfo, ProcInfo, GenDetails, CallArgs,
            Modes, GoalInfo, !SharingAs)
    ;
        GoalExpr = unify(_, _, _, Unification, _),
        !:SharingAs = add_unify_sharing(ModuleInfo, ProcInfo, Unification,
            GoalInfo, !.SharingAs)
    ;
        GoalExpr = disj(Goals),
        list.foldl4(
            analyse_disj(ModuleInfo, PredInfo, ProcInfo,
                SharingTable, !.SharingAs, Verbose),
            Goals, !FixpointTable, !DepProcs,
            sharing_as_init, !:SharingAs, !Status)
    ;
        GoalExpr = switch(_, _, Cases),
        list.foldl4(
            analyse_case(ModuleInfo, PredInfo, ProcInfo,
                SharingTable, !.SharingAs, Verbose),
            Cases, !FixpointTable, !DepProcs,
            sharing_as_init, !:SharingAs, !Status)
    ;
        GoalExpr = negation(_Goal)
        % XXX Check theory, but a negated goal can not create bindings,
        % hence it also can not create additional sharing.
    ;
        GoalExpr = scope(Reason, SubGoal),
        ( if Reason = from_ground_term(_, from_ground_term_construct) then
            % Ground terms cannot introduce sharing.
            true
        else
            % XXX Check theory.
            analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose,
                SubGoal, !FixpointTable, !DepProcs, !SharingAs, !Status)
        )
    ;
        GoalExpr = if_then_else(_, IfGoal, ThenGoal, ElseGoal),
        analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose,
            IfGoal, !FixpointTable, !DepProcs,
            !.SharingAs, IfSharingAs, !Status),
        analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose,
            ThenGoal, !FixpointTable, !DepProcs,
            IfSharingAs, ThenSharingAs, !Status),
        analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose,
            ElseGoal, !FixpointTable, !DepProcs,
            !.SharingAs, ElseSharingAs, !Status),
        !:SharingAs = sharing_as_least_upper_bound(ModuleInfo, ProcInfo,
            ThenSharingAs, ElseSharingAs)
    ;
        GoalExpr = call_foreign_proc(Attributes, ForeignPredId, ForeignProcId,
            Args, _ExtraArgs, _MaybeTraceRuntimeCond, _Impl),
        Context = goal_info_get_context(GoalInfo),
        ForeignPPId = proc(ForeignPredId, ForeignProcId),
        add_foreign_proc_sharing(ModuleInfo, PredInfo, ProcInfo, ForeignPPId,
            Attributes, Args, Context, !SharingAs)
    ;
        GoalExpr = shorthand(_),
        % These should have been expanded out by now.
        unexpected($pred, "shorthand")
    ).

:- pred analyse_goal_with_progress(module_info::in, pred_info::in,
    proc_info::in, sharing_as_table::in, bool::in, hlds_goal::in,
    ss_fixpoint_table::in, ss_fixpoint_table::out,
    dep_procs::in, dep_procs::out, sharing_as::in, sharing_as::out,
    analysis_status::in, analysis_status::out) is det.

analyse_goal_with_progress(ModuleInfo, PredInfo, ProcInfo, SharingTable,
        Verbose, Goal, !FixpointTable, !DepProcs, !SharingAs, !Status) :-
    (
        Verbose = yes,
        trace [io(!IO)] (
            get_debug_output_stream(ModuleInfo, DebugStream, !IO),
            io.write_char(DebugStream, '.', !IO),
            io.flush_output(DebugStream, !IO)
        )
    ;
        Verbose = no
    ),
    analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose, Goal,
        !FixpointTable, !DepProcs, !SharingAs, !Status).

%---------------------------------------------------------------------------%
%
% Additional code for analysing disjuctions.
%

:- pred analyse_disj(module_info::in, pred_info::in, proc_info::in,
    sharing_as_table::in, sharing_as::in, bool::in, hlds_goal::in,
    ss_fixpoint_table::in, ss_fixpoint_table::out,
    dep_procs::in, dep_procs::out, sharing_as::in, sharing_as::out,
    analysis_status::in, analysis_status::out) is det.

analyse_disj(ModuleInfo, PredInfo, ProcInfo, SharingTable, SharingBeforeDisj,
        Verbose, Goal, !FixpointTable, !DepProcs, !Sharing, !Status) :-
    analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose, Goal,
        !FixpointTable, !DepProcs, SharingBeforeDisj, GoalSharing,
        !Status),
    !:Sharing = sharing_as_least_upper_bound(ModuleInfo, ProcInfo, !.Sharing,
        GoalSharing).

%---------------------------------------------------------------------------%
%
% Additional code for analysing switches.
%

:- pred analyse_case(module_info::in, pred_info::in, proc_info::in,
    sharing_as_table::in, sharing_as::in, bool::in, case::in,
    ss_fixpoint_table::in, ss_fixpoint_table::out,
    dep_procs::in, dep_procs::out, sharing_as::in, sharing_as::out,
    analysis_status::in, analysis_status::out) is det.

analyse_case(ModuleInfo, PredInfo, ProcInfo, SharingTable, Sharing0,
        Verbose, Case, !FixpointTable, !DepProcs, !Sharing, !Status) :-
    Case = case(_, _, Goal),
    analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose, Goal,
        !FixpointTable, !DepProcs, Sharing0, CaseSharing, !Status),
    !:Sharing = sharing_as_least_upper_bound(ModuleInfo, ProcInfo, !.Sharing,
        CaseSharing).

%---------------------------------------------------------------------------%
%
% Code for handling calls.
%

    % Lookup the sharing information of a procedure identified by its
    % pred_proc_id.
    %
:- pred lookup_sharing(module_info::in, sharing_as_table::in, pred_proc_id::in,
    ss_fixpoint_table::in, ss_fixpoint_table::out, sharing_as::out,
    analysis_status::out, bool::out) is det.

lookup_sharing(ModuleInfo, SharingTable, PPId, !FixpointTable, SharingAs,
        Status, IsPredicted) :-
    ( if
        % Check fixpoint table.
        ss_fixpoint_table_get_as(PPId, SharingAs_Status, !FixpointTable)
    then
        SharingAs_Status = sharing_as_and_status(SharingAs, Status),
        IsPredicted = no
    else
        lookup_sharing_or_predict(ModuleInfo, SharingTable, PPId, SharingAs,
            Status, IsPredicted)
    ).

:- pred analyse_generic_call(module_info::in, proc_info::in, generic_call::in,
    prog_vars::in, list(mer_mode)::in, hlds_goal_info::in, sharing_as::in,
    sharing_as::out) is det.

analyse_generic_call(ModuleInfo, ProcInfo, GenDetails, CallArgs, Modes,
        GoalInfo, !SharingAs) :-
    (
        ( GenDetails = higher_order(_, _, _, _)
        ; GenDetails = class_method(_, _, _, _)
        ),
        proc_info_get_var_table(ProcInfo, CallerVarTable),
        lookup_var_types(CallerVarTable, CallArgs, ActualTypes),
        ( if
            bottom_sharing_is_safe_approximation_by_args(ModuleInfo, Modes,
                ActualTypes)
        then
            SetToTop = no
        else
            SetToTop = yes
        )
    ;
        ( GenDetails = event_call(_) % XXX too conservative
        ; GenDetails = cast(_)
        ),
        SetToTop = yes
    ),
    (
        SetToTop = yes,
        Context = goal_info_get_context(GoalInfo),
        context_to_string(Context, ContextString),
        !:SharingAs = sharing_as_top_sharing_accumulate(
            top_cannot_improve("generic call (" ++ ContextString ++ ")"),
            !.SharingAs)
    ;
        SetToTop = no
    ).

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

:- pred update_sharing_in_table(ss_fixpoint_table::in, pred_proc_id::in,
    sharing_as_table::in, sharing_as_table::out) is det.

update_sharing_in_table(FixpointTable, PPId, !SharingTable) :-
    ss_fixpoint_table_get_final_as(PPId, FixpointTable, SharingAs_Status),
    sharing_as_table_set(PPId, SharingAs_Status, !SharingTable).

%---------------------------------------------------------------------------%
%
% Structure sharing fixpoint table.
%

:- type ss_fixpoint_table ==
    fixpoint_table(pred_proc_id, sharing_as_and_status).

    % Initialise the fixpoint table for the given set of pred_proc_id's.
    %
:- func ss_fixpoint_table_init(list(pred_proc_id)) = ss_fixpoint_table.

ss_fixpoint_table_init(Keys) = init_fixpoint_table(wrapped_init, Keys).

    % Add the results of a new analysis pass to the already existing
    % fixpoint table.
    %
:- pred ss_fixpoint_table_new_run(ss_fixpoint_table::in,
    ss_fixpoint_table::out) is det.

ss_fixpoint_table_new_run(!Table) :-
    fixpoint_table.new_run(!Table).

    % The fixpoint table keeps track of the number of analysis passes. This
    % predicate returns this number.
    %
:- func ss_fixpoint_table_which_run(ss_fixpoint_table) = int.

ss_fixpoint_table_which_run(Tin) = fixpoint_table.which_run(Tin).

    % A fixpoint is reached if all entries in the table are stable,
    % i.e. haven't been modified by the last analysis pass.
    %
:- pred ss_fixpoint_table_stable(ss_fixpoint_table::in) is semidet.

ss_fixpoint_table_stable(Table) :-
    fixpoint_table.fixpoint_reached(Table).

    % Give a string description of the state of the fixpoint table.
    %
:- func ss_fixpoint_table_description(ss_fixpoint_table) = string.

ss_fixpoint_table_description(Table) = fixpoint_table.description(Table).

    % Enter the newly computed structure sharing description for a given
    % procedure. If the description is different from the one that was
    % already stored for that procedure, the stability of the fixpoint
    % table is set to "unstable".
    % Software error if the procedure is not in the fixpoint table.
    %
:- pred ss_fixpoint_table_new_as(module_info::in, proc_info::in,
    pred_proc_id::in, sharing_as_and_status::in,
    ss_fixpoint_table::in, ss_fixpoint_table::out) is det.

ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, Id, SharingAs, !Table) :-
    add_to_fixpoint_table(
        sharing_as_and_status_is_subsumed_by(ModuleInfo, ProcInfo),
        Id, SharingAs, !Table).

    % Retrieve the structure sharing description for a given pred_proc_id.
    %
    % If the id is part of the fixpoint table, but does not yet record any
    % sharing information about that pred_proc_id, then this means that the
    % set of pred_proc_id's to which the fixpoint table relates is mutually
    % recursive, hence the table is characterised as recursive.
    %
    % If the id is not part of the fixpoint table: fail.
    %
:- pred ss_fixpoint_table_get_as(pred_proc_id::in, sharing_as_and_status::out,
    ss_fixpoint_table::in, ss_fixpoint_table::out) is semidet.

ss_fixpoint_table_get_as(PPId, SharingAs, !Table) :-
    get_from_fixpoint_table(PPId, SharingAs, !Table).

:- func ss_fixpoint_table_get_short_description(pred_proc_id,
    ss_fixpoint_table) = string.

ss_fixpoint_table_get_short_description(PPId, Table) = Descr :-
    ( if
        ss_fixpoint_table_get_final_as_semidet(PPId, Table, SharingAs_Status)
    then
        SharingAs_Status = sharing_as_and_status(As, _Status),
        Descr = sharing_as_short_description(As)
    else
        Descr = "-"
    ).

    % Retrieve the structure sharing information without changing the table.
    % To be used after fixpoint has been reached.
    % Software error if the procedure is not in the table.
    %
:- pred ss_fixpoint_table_get_final_as(pred_proc_id::in,
    ss_fixpoint_table::in, sharing_as_and_status::out) is det.

ss_fixpoint_table_get_final_as(PPId, T, SharingAs_Status) :-
    SharingAs_Status = get_from_fixpoint_table_final(PPId, T).

    % Same as ss_fixpoint_table_get_final_as, but fails instead of aborting
    % if the procedure is not in the table.
    %
:- pred ss_fixpoint_table_get_final_as_semidet(pred_proc_id::in,
    ss_fixpoint_table::in, sharing_as_and_status::out) is semidet.

ss_fixpoint_table_get_final_as_semidet(PPId, T, SharingAs_Status) :-
    get_from_fixpoint_table_final_semidet(PPId, T, SharingAs_Status).

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

:- func wrapped_init(pred_proc_id) = sharing_as_and_status.

wrapped_init(_Id) = sharing_as_and_status(sharing_as_init, optimal).

%---------------------------------------------------------------------------%
%
% Types and instances for the intermodule analysis framework.
%

:- type structure_sharing_call
    --->    structure_sharing_call.

:- type structure_sharing_answer
    --->    structure_sharing_answer_bottom
    ;       structure_sharing_answer_top
    ;       structure_sharing_answer_real(
                % XXX The next two fields should be a list of pairs,
                % not a pair of lists.
                ssar_vars       :: list(prog_var),
                ssar_types      :: list(mer_type),
                ssar_sharing    :: structure_sharing
                % We cannot keep this as a sharing_as. When the analysis
                % answers are loaded, we don't have enough information to
                % rename the variables in the .analysis answer to the correct
                % variables for the proc_info that the sharing_as will be used
                % with.
            ).

:- type structure_sharing_func_info
    --->    structure_sharing_func_info(
                ssfi_module     :: module_info,
                ssfi_proc       :: proc_info
            ).

:- func analysis_name = string.

analysis_name = "structure_sharing".

:- instance analysis(structure_sharing_func_info, structure_sharing_call,
    structure_sharing_answer) where
[
    analysis_name(_, _) = analysis_name,
    analysis_version_number(_, _) = 2,
    preferred_fixpoint_type(_, _) = greatest_fixpoint,
    bottom(_, _) = structure_sharing_answer_bottom,
    top(_, _) = structure_sharing_answer_top,

    ( get_func_info(ModuleInfo, ModuleName, FuncId, _, _, FuncInfo) :-
        func_id_to_ppid(ModuleInfo, ModuleName, FuncId, PPId),
        module_info_proc_info(ModuleInfo, PPId, ProcInfo),
        FuncInfo = structure_sharing_func_info(ModuleInfo, ProcInfo)
    )
].

:- instance call_pattern(structure_sharing_func_info,
    structure_sharing_call) where [].

:- instance partial_order(structure_sharing_func_info,
        structure_sharing_call) where [
    (more_precise_than(_, _, _) :-
        semidet_fail
    ),
    equivalent(_, Call, Call)
].

:- instance to_term(structure_sharing_call) where [
    ( to_term(structure_sharing_call) = Term :-
        Term = term.functor(atom("any"), [], dummy_context)
    ),
    ( from_term(Term, structure_sharing_call) :-
        Term = term.functor(atom("any"), [], _)
    )
].

:- instance answer_pattern(structure_sharing_func_info,
    structure_sharing_answer) where [].

:- instance partial_order(structure_sharing_func_info,
        structure_sharing_answer) where [
    (more_precise_than(FuncInfo, Answer1, Answer2) :-
        % Fast path (maybe).
        Answer1 \= Answer2,

        FuncInfo = structure_sharing_func_info(ModuleInfo, ProcInfo),
        proc_info_get_headvars(ProcInfo, HeadVars),
        proc_info_get_var_table(ProcInfo, VarTable),
        lookup_var_types(VarTable, HeadVars, HeadVarTypes),
        structure_sharing_answer_to_domain(no, HeadVarTypes, ProcInfo,
            Answer1, Sharing1),
        structure_sharing_answer_to_domain(no, HeadVarTypes, ProcInfo,
            Answer2, Sharing2),
        SharingAs1 = from_structure_sharing_domain(Sharing1),
        SharingAs2 = from_structure_sharing_domain(Sharing2),
        sharing_as_is_subsumed_by(ModuleInfo, ProcInfo,
            SharingAs1, SharingAs2),
        not sharing_as_is_subsumed_by(ModuleInfo, ProcInfo,
            SharingAs2, SharingAs1)
    ),

    (equivalent(FuncInfo, Answer1, Answer2) :-
        (
            % Fast path (maybe).
            Answer1 = Answer2
        ;
            FuncInfo = structure_sharing_func_info(ModuleInfo, ProcInfo),
            proc_info_get_headvars(ProcInfo, HeadVars),
            proc_info_get_var_table(ProcInfo, VarTable),
            lookup_var_types(VarTable, HeadVars, HeadVarTypes),
            structure_sharing_answer_to_domain(no, HeadVarTypes, ProcInfo,
                Answer1, Sharing1),
            structure_sharing_answer_to_domain(no, HeadVarTypes, ProcInfo,
                Answer2, Sharing2),
            SharingAs1 = from_structure_sharing_domain(Sharing1),
            SharingAs2 = from_structure_sharing_domain(Sharing2),
            sharing_as_is_subsumed_by(ModuleInfo, ProcInfo,
                SharingAs2, SharingAs1),
            sharing_as_is_subsumed_by(ModuleInfo, ProcInfo,
                SharingAs1, SharingAs2)
        )
    )
].

:- instance to_term(structure_sharing_answer) where [
    func(to_term/1) is sharing_answer_to_term,
    pred(from_term/2) is sharing_answer_from_term
].

:- func sharing_answer_to_term(structure_sharing_answer) = term.

sharing_answer_to_term(Answer) = Term :-
    (
        Answer = structure_sharing_answer_bottom,
        Term = term.functor(atom("b"), [], dummy_context)
    ;
        Answer = structure_sharing_answer_top,
        Term = term.functor(atom("t"), [], dummy_context)
    ;
        Answer = structure_sharing_answer_real(HeadVars, Types, SharingPairs),
        type_to_term(HeadVars, HeadVarsTerm),
        type_to_term(Types, TypesTerm),
        type_to_term(SharingPairs, SharingPairsTerm),
        Term = term.functor(atom("sharing"),
            [HeadVarsTerm, TypesTerm, SharingPairsTerm], dummy_context)
    ).

:- pred sharing_answer_from_term(term::in, structure_sharing_answer::out)
    is semidet.

sharing_answer_from_term(Term, Answer) :-
    (
        Term = term.functor(atom("b"), [], _),
        Answer = structure_sharing_answer_bottom
    ;
        Term = term.functor(atom("t"), [], _),
        Answer = structure_sharing_answer_top
    ;
        Term = term.functor(atom("sharing"),
            [HeadVarsTerm, TypesTerm, SharingPairsTerm], _),
        term_to_type(HeadVarsTerm, HeadVars),
        term_to_type(TypesTerm, Types),
        term_to_type(SharingPairsTerm, SharingPairs),
        Answer = structure_sharing_answer_real(HeadVars, Types, SharingPairs)
    ).

%---------------------------------------------------------------------------%
%
% Additional predicates used for intermodule analysis.
%

:- pred maybe_record_sharing_analysis_result(module_info::in,
    sharing_as_table::in, pred_id::in, analysis_info::in, analysis_info::out)
    is det.

maybe_record_sharing_analysis_result(ModuleInfo, SharingAsTable, PredId,
        !AnalysisInfo) :-
    module_info_pred_info(ModuleInfo, PredId, PredInfo),
    ProcIds = pred_info_valid_procids(PredInfo),
    list.foldl(
        maybe_record_sharing_analysis_result_2(ModuleInfo, SharingAsTable,
            PredId, PredInfo),
        ProcIds, !AnalysisInfo).

:- pred maybe_record_sharing_analysis_result_2(module_info::in,
    sharing_as_table::in, pred_id::in, pred_info::in, proc_id::in,
    analysis_info::in, analysis_info::out) is det.

maybe_record_sharing_analysis_result_2(ModuleInfo, SharingAsTable, PredId,
        PredInfo, ProcId, !AnalysisInfo) :-
    should_write_sharing_info(ModuleInfo, PredId, ProcId, PredInfo,
        for_analysis_framework, ShouldWrite),
    (
        ShouldWrite = should_write,
        pred_info_proc_info(PredInfo, ProcId, ProcInfo),
        PPId = proc(PredId, ProcId),
        ( if
            sharing_as_table_search(PPId, SharingAsTable,
                sharing_as_and_status(SharingAsPrime, StatusPrime))
        then
            Sharing = to_structure_sharing_domain(SharingAsPrime),
            Status0 = StatusPrime
        else if
            % Probably an exported `:- pragma external_{pred/func}' procedure.
            bottom_sharing_is_safe_approximation(ModuleInfo, PredInfo,
                ProcInfo)
        then
            Sharing = structure_sharing_bottom,
            Status0 = optimal
        else
            Sharing = structure_sharing_top(set.init),
            Status0 = optimal
        ),
        (
            Sharing = structure_sharing_bottom,
            Answer = structure_sharing_answer_bottom,
            Status = optimal
        ;
            Sharing = structure_sharing_top(Reasons),
            Answer = structure_sharing_answer_top,
            % If the procedure contains a generic or foreign foreign call, or
            % it calls a procedure in a non-local module for which we have no
            % results, we won't be able to do better upon reanalysis.
            ( if
                set.member(Reason, Reasons),
                reason_implies_optimal(ModuleInfo, !.AnalysisInfo, Reason)
            then
                Status = optimal
            else
                Status = Status0
            ),
            trace [io(!IO),
                compile_time(flag("structure_sharing")),
                run_time(env("TOP_REASONS"))
            ] (
                get_debug_output_stream(ModuleInfo, DebugStream, !IO),
                ReasonsList = set.to_sorted_list(Reasons),
                io.write_string(DebugStream, ":\n", !IO),
                list.foldl(write_top_feedback(DebugStream, ModuleInfo),
                    ReasonsList, !IO),
                io.write_string(DebugStream, "\t", !IO),
                io.write_line(DebugStream, Status, !IO)
            )
        ;
            Sharing = structure_sharing_real(SharingPairs),
            proc_info_get_headvars(ProcInfo, HeadVars),
            proc_info_get_var_table(ProcInfo, VarTable),
            lookup_var_types(VarTable, HeadVars, HeadVarTypes),
            Answer = structure_sharing_answer_real(HeadVars, HeadVarTypes,
                SharingPairs),
            Status = Status0
        ),
        module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
        record_result(ModuleName, FuncId, structure_sharing_call, Answer,
            Status, !AnalysisInfo)
    ;
        ShouldWrite = should_not_write
    ).

:- pred reason_implies_optimal(module_info::in, analysis_info::in,
    top_feedback::in) is semidet.

reason_implies_optimal(ModuleInfo, AnalysisInfo, Reason) :-
    (
        Reason = top_cannot_improve(_)
    ;
        Reason = top_failed_lookup(ShroudedPPId),
        proc(PredId, _) = unshroud_pred_proc_id(ShroudedPPId),
        module_info_pred_info(ModuleInfo, PredId, PredInfo),
        PredModule = pred_info_module(PredInfo),
        module_is_local(AnalysisInfo, PredModule, no)
    ).

:- pred handle_dep_procs(module_info::in, pred_proc_id::in,
    analysis_info::in, analysis_info::out) is det.

handle_dep_procs(ModuleInfo, DepPPId, !AnalysisInfo) :-
    % Record that we depend on the result for the called procedure.
    module_name_func_id(ModuleInfo, DepPPId, DepModuleName, DepFuncId),
    Call = structure_sharing_call,
    Answer = _ : structure_sharing_answer,
    get_func_info(ModuleInfo, DepModuleName, DepFuncId, Call, Answer,
        FuncInfo),
    record_dependency(DepModuleName, DepFuncId, FuncInfo, Call, Answer,
        !AnalysisInfo).

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

:- pred write_top_feedback(io.text_output_stream::in, module_info::in,
    top_feedback::in, io::di, io::uo) is det.

write_top_feedback(Stream, ModuleInfo, Reason, !IO) :-
    io.write_string(Stream, "\t", !IO),
    (
        Reason = top_failed_lookup(ShroudedPPId),
        PPId = unshroud_pred_proc_id(ShroudedPPId),
        PPIdStr = pred_proc_id_to_dev_string(ModuleInfo, PPId),
        io.format(Stream, "failed_lookup: %s\n", [s(PPIdStr)], !IO)
    ;
        Reason = top_from_lookup(ShroudedPPId),
        PPId = unshroud_pred_proc_id(ShroudedPPId),
        PPIdStr = pred_proc_id_to_dev_string(ModuleInfo, PPId),
        io.format(Stream, "from_lookup: %s\n", [s(PPIdStr)], !IO)
    ;
        Reason = top_cannot_improve(String),
        io.format(Stream, "cannot_improve: %s\n", [s(String)], !IO)
    ).

%---------------------------------------------------------------------------%
:- end_module transform_hlds.ctgc.structure_sharing.analysis.
%---------------------------------------------------------------------------%