mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-18 02:43:40 +00:00
Code Issues Projects Releases Wiki Activity
Files
dadf30718d6084962be37dae8b94de41aaee90e2
mercury/compiler/structure_sharing.analysis.m
Zoltan Somogyi 5f50259d16 Write to explicitly named streams in many modules. 
Right now, most parts of the compiler write to the "current output stream".
This was a pragmatic choice at the time, but has not aged well. The problem
is that the answer to the question "where is the current output stream going?"
is not obvious in *all* places in the compiler (although it is obvious in
most). When using such implicit streams, finding where the output is going
to in a given predicate requires inspecting not just the ancestors of that
predicate, but also all their older siblings (since any of them could have
changed the current stream), *including* their entire call trees. This is
usually an infeasible task. By constrast, if we explicitly pass streams
to all output operations, we need only follow the places where the variable
representing that stream is bound, which the mode system makes easy.

This diff switches large parts of the compiler over to doing output only
to explicitly passed streams, never to the implicit "current output stream".
The parts it switches over are the parts that rely to a significant degree
on the innermost change, which is to the "output" typeclass in
parse_tree_out_info.m. This is the part that has to be switched over to
explicit streams first, because (a) many modules such as mercury_to_mercury.m
rely on the output typeclass, and (b) most other modules that do output
call predicates in these modules. Starting anywhere else would be like
building a skyscraper starting at the top.

This typeclass, output(U), has two instances: output(io), and output(string),
so you could output either to the current output stream, or to a string.
To allow the specification of the destination stream in the first case,
this diff changes the typeclass to output(S, U) with a functional dependency
from U to S, with the two instances being output(io.text_output_stream, io)
and output(unit, string). (The unit arg is ignored in the second case.)

There is a complication with the output typeclass method, add_list, that
outputs a list of items. The complication is that each item is output
by a predicate supplied by the caller, but the separator between the items
(usually a comma) is output by add_list itself. We don't want to give
callers of this method the opportunity to screw up by specifying (possibly
implicitly) two different output streams for these two purposes, so we want
(a) the caller to tell add_list where to put the separators, and then
(b) for add_list, not its caller, tell the user-supplied predicate what
stream to write to. This works only if the stream argument is just before
the di,uo pair of I/O state arguments, which differs from our usual practice
of passing the stream at or near the left edge of the argument list,
not near the right. The result of this complication is that two categories
of predicates that are and are not used to print items in a list differ
in where they put the stream in their argument lists. This makes it easy
to pass the stream in the wrong argument position if you call a predicate
without looking up its signature, and may require *changing* the argument
order when a predicate is used to print an item in a list for the first time.
A complete switch over to always passing the stream just before !IO
would fix this inconsistency, but is far to big a change to make all at once.

compiler/parse_tree_out_info.m:
    Make the changes described above.

    Add write_out_list, which is a variant of io.write_list specifically
    designed to address the "complication" described above. It also has
    the arguments in an order that is better suited for higher-order use.

    Make the same change to argument order in the class method add_list
    as well.

Almost all of the following changes consist of passing an extra stream
argument to output predicates. In some places, where I thought this would
aid readability, I replaced sequences of calls to output predicates
with a single io.format.

compiler/prog_out.m:
    This module had many predicates that wrote things to the current output
    stream. This diff adds versions of these predicates that take an
    explicit stream argument.

    If the originals are still needed after the changes to the other modules,
    keep them, but add "_to_cur_stream" to the end of their names.
    Otherwise, delete them. (Many of the changes below replace
    write_xyz(..., !IO) with io.write_string(Stream, xyz_to_string(...), !IO),
    especially when write_xyz did nothing except call xyz_to_string
    and wrote out the result.)

compiler/c_util.m:
    Add either an explicit stream argument to the argument list, or a
    "_current_stream" suffix to the name, of every predicate defined
    in this module that does output.

    Add a new predicate to print out the block comment containing
    input for mkinit. This factors out common code in the LLDS and MLDS
    backends.

compiler/name_mangle.m:
    Delete all predicates that used to write to the current output stream,
    after replacing them if necessary with functions that return a string,
    which the caller can print to wherever it wants. (The "if necessary"
    part is there because some of the "replacement" functions already
    existed.)

    When converting a proc_label to a string, *always* require the caller
    to say whether the label prefix should be added to the string,
    instead of silently assuming "yes, add it", as calls to one of the old,
    now deleted predicates had it.

compiler/file_util.m:
    Add output_to_file_stream, a version of output_to_file which
    simply passes the output file stream it opens to the predicate
    that is intended to define the contents of the newly created or
    updated file. The existing output_to_file, which instead sets
    and resets the current output stream around the equivalent
    predicate call, is still needed e.g. by the MLDS backend,
    but hopefully for not too long.

compiler/mercury_to_mercury.m:
compiler/parse_tree_out.m:
compiler/parse_tree_out_clause.m:
compiler/parse_tree_out_inst.m:
compiler/parse_tree_out_pragma.m:
compiler/parse_tree_out_pred_decl.m:
compiler/parse_tree_out_term.m:
compiler/parse_tree_out_type_repn.m:
    Change the code writing out parse trees to explicitly pass a stream
    to every predicate that does output.

    In some places, this allows us to avoid changing the identity
    of the current output stream.

compiler/hlds_out.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_mode.m:
compiler/hlds_out_module.m:
compiler/hlds_out_pred.m:
compiler/hlds_out_util.m:
compiler/intermod.m:
    Change the code writing out HLDS code to explicitly pass a stream
    to every predicate that does output. (The changes to these modules
    belong in this diff because these modules call many of the output
    predicates in the parse tree package.)

    In hlds_out_util.m, delete some write_to_xyz(...) predicates that wrote
    the result of xyz_to_string(...) to the current output stream.
    Replace calls to the deleted predicates with calls to io.write_string
    with the string being written being computed by xyz_to_string.

    Add a predicate to hlds_out_util.m that outputs a comment containing
    the current context, if it is valid. This factors out code that used
    to be common to several of the other modules.

    In a few places in hlds_out_module.m, the new code generates a
    slighly different set of blank lines, but this should not be a problem.

compiler/layout_out.m:
compiler/llds_out_code_addr.m:
compiler/llds_out_data.m:
compiler/llds_out_file.m:
compiler/llds_out_global.m:
compiler/llds_out_instr.m:
compiler/llds_out_util.m:
compiler/opt_debug.m:
compiler/rtti_out.m:
    Change the code writing out the LLDS to explicitly pass a stream
    to every predicate that does output. (The changes to these modules
    belong in this diff because layout_out.m and rtti_out.m call
    many of the output predicates in the parse tree package,
    and through them, the rest of the LLDS backend is affected as well.)

compiler/make.module_dep_file.m:
compiler/mercury_compile_main.m:
compiler/mercury_compile_middle_passes.m:
    Replace code that sets and resets the current output stream
    with code that simply passes an explicit output stream to a
    predicate that now *takes* an explicit stream as an argument.

compiler/accumulator.m:
compiler/add_clause.m:
compiler/code_gen.m:
compiler/code_loc_dep.m:
compiler/cse_detection.m:
compiler/delay_partial_inst.m:
compiler/dep_par_conj.m:
compiler/det_analysis.m:
compiler/error_msg_inst.m:
compiler/export.m:
compiler/format_call.m:
compiler/goal_expr_to_goal.m:
compiler/ite_gen.m:
compiler/lco.m:
compiler/liveness.m:
compiler/lp_rational.m:
compiler/mercury_compile_front_end.m:
compiler/mercury_compile_llds_back_end.m:
compiler/mlds_to_c_file.m:
compiler/mlds_to_c_global.m:
compiler/mode_debug.m:
compiler/mode_errors.m:
compiler/modes.m:
compiler/optimize.m:
compiler/passes_aux.m:
compiler/pd_debug.m:
compiler/pragma_c_gen.m:
compiler/proc_gen.m:
compiler/prog_ctgc.m:
compiler/push_goals_together.m:
compiler/rat.m:
compiler/recompilation.m:
compiler/recompilation.usage.m:
compiler/recompilation.version.m:
compiler/rtti.m:
compiler/saved_vars.m:
compiler/simplify_goal_conj.m:
compiler/stack_opt.m:
compiler/structure_reuse.analysis.m:
compiler/structure_reuse.domain.m:
compiler/structure_reuse.indirect.m:
compiler/structure_sharing.analysis.m:
compiler/superhomogeneous.m:
compiler/term_constr_build.m:
compiler/term_constr_data.m:
compiler/term_constr_fixpoint.m:
compiler/term_constr_pass2.m:
compiler/term_constr_util.m:
compiler/tupling.m:
compiler/type_assign.m:
compiler/unneeded_code.m:
compiler/write_deps_file.m:
    Conform to the changes above, mostly by passing streams explicitly.

compiler/hlds_dependency_graph.m:
    Conform to the changes above, mostly by passing streams explicitly.
    Move a predicate's definition next it only use.

compiler/Mercury.options:
    Specify --warn-implicit-stream-calls for all the modules in which
    this diff has replaced all implicit streams with explicit streams.
    (Unfortunately, debugging this diff has shown that --warn-implicit-
    stream-calls detects only *some*, and not *all*, uses of implicit
    streams.)

library/term_io.m:
    Fix documentation.
2020-11-14 15:07:55 +11:00

1211 lines
46 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% 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 hlds.vartypes.
:- 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 transform_hlds.ctgc.fixpoint_table.
:- import_module transform_hlds.ctgc.structure_sharing.domain.
:- import_module transform_hlds.ctgc.util.
:- import_module transform_hlds.intermod.
:- 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_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) :-
some [!PredTable] (
module_info_get_preds(!.ModuleInfo, !:PredTable),
PredInfo0 = !.PredTable ^ det_elem(PredId),
process_imported_sharing_in_procs(PredInfo0, PredInfo),
map.det_update(PredId, PredInfo, !PredTable),
module_info_set_preds(!.PredTable, !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] (
!:ProcInfo = !.ProcTable ^ det_elem(ProcId),
( 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) :-
some [!PredTable] (
module_info_get_preds(!.ModuleInfo, !:PredTable),
map.lookup(!.PredTable, 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),
map.det_update(PredId, PredInfo, !PredTable),
module_info_set_preds(!.PredTable, !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] (
!:ProcInfo = !.ProcTable ^ det_elem(ProcId),
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.
SimplifyTasks = list_to_simplify_tasks([]),
PredProcId = proc(PredId, ProcId),
simplify_proc(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.
ProcsStrings = list.map(pred_proc_id_to_string(ModuleInfo), SCCProcs),
ProcsString = string.join_list(", ", ProcsStrings),
Msg = "SCC cannot be analysed: " ++ ProcsString,
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(!TIO)] (
write_proc_progress_message(
"% Sharing analysis (run " ++ string.int_to_string(Run) ++ ") ",
PPId, ModuleInfo, !TIO)
),
% 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(!TIO)] (
maybe_write_string(Verbose, "\t\t: bottom predicted", !TIO)
),
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),
domain.apply_widening(ModuleInfo, ProcInfo, WideningLimit,
WideningDone, !Sharing),
(
WideningDone = yes,
WidenAsDescr = sharing_as_short_description(!.Sharing)
;
WideningDone = no,
WidenAsDescr = "-"
),
trace [io(!TIO)] (
maybe_write_string(Verbose, "\n\t\t: " ++
TabledAsDescr ++ "->" ++
FullAsDescr ++ "/" ++
ProjAsDescr ++ "/" ++
WidenAsDescr, !TIO)
)
),
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(!TIO)] (
maybe_write_string(Verbose, "\t\t (ft = " ++ Desc ++ ")\n", !TIO)
).
%-----------------------------------------------------------------------------%
%
% 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_vartypes(ProcInfo, CallerVarTypes),
lookup_var_types(CallerVarTypes, 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(!TIO)] (
io.write_char('.', !TIO),
io.flush_output(!TIO)
)
;
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_vartypes(ProcInfo, CallerVarTypes),
lookup_var_types(CallerVarTypes, 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.
% 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.
% 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.
% 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.
% Give a string description of the state of the fixpoint table.
%
:- func ss_fixpoint_table_description(ss_fixpoint_table) = string.
% 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.
% 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.
:- func ss_fixpoint_table_get_short_description(pred_proc_id,
ss_fixpoint_table) = string.
% 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.
% 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.
%-----------------------------------------------------------------------------%
:- func wrapped_init(pred_proc_id) = sharing_as_and_status.
wrapped_init(_Id) = sharing_as_and_status(sharing_as_init, optimal).
ss_fixpoint_table_init(Keys) = init_fixpoint_table(wrapped_init, Keys).
ss_fixpoint_table_new_run(!Table) :-
fixpoint_table.new_run(!Table).
ss_fixpoint_table_which_run(Tin) = fixpoint_table.which_run(Tin).
ss_fixpoint_table_stable(Table) :-
fixpoint_table.fixpoint_reached(Table).
ss_fixpoint_table_description(Table) = fixpoint_table.description(Table).
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).
ss_fixpoint_table_get_as(PPId, SharingAs, !Table) :-
get_from_fixpoint_table(PPId, SharingAs, !Table).
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 = "-"
).
ss_fixpoint_table_get_final_as(PPId, T, SharingAs_Status) :-
SharingAs_Status = get_from_fixpoint_table_final(PPId, T).
ss_fixpoint_table_get_final_as_semidet(PPId, T, SharingAs_Status) :-
get_from_fixpoint_table_final_semidet(PPId, T, SharingAs_Status).
%-----------------------------------------------------------------------------%
%
% 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(
ssar_vars :: prog_vars,
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"), [], context_init)
),
( 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_vartypes(ProcInfo, VarTypes),
lookup_var_types(VarTypes, 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_vartypes(ProcInfo, VarTypes),
lookup_var_types(VarTypes, 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"), [], context_init)
;
Answer = structure_sharing_answer_top,
Term = term.functor(atom("t"), [], context_init)
;
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], context_init)
).
:- 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(!TIO),
compile_time(flag("structure_sharing")),
run_time(env("TOP_REASONS"))
] (
ReasonsList = set.to_sorted_list(Reasons),
io.write_string(":\n", !TIO),
io.write_list(ReasonsList, "\n",
write_top_feedback(ModuleInfo), !TIO),
io.nl(!TIO),
io.write_string("\t", !TIO),
io.write(Status, !TIO),
io.nl(!TIO)
)
;
Sharing = structure_sharing_real(SharingPairs),
proc_info_get_headvars(ProcInfo, HeadVars),
proc_info_get_vartypes(ProcInfo, VarTypes),
lookup_var_types(VarTypes, 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(module_info::in, top_feedback::in, io::di, io::uo)
is det.
write_top_feedback(ModuleInfo, Reason, !IO) :-
io.write_string("\t", !IO),
(
Reason = top_failed_lookup(ShroudedPPId),
PPId = unshroud_pred_proc_id(ShroudedPPId),
PPIdStr = pred_proc_id_to_string(ModuleInfo, PPId),
io.format("failed_lookup: %s", [s(PPIdStr)], !IO)
;
Reason = top_from_lookup(ShroudedPPId),
PPId = unshroud_pred_proc_id(ShroudedPPId),
PPIdStr = pred_proc_id_to_string(ModuleInfo, PPId),
io.format("from_lookup: %s", [s(PPIdStr)], !IO)
;
Reason = top_cannot_improve(String),
io.write_string("cannot_improve: ", !IO),
io.write_string(String, !IO)
).
%-----------------------------------------------------------------------------%
:- end_module transform_hlds.ctgc.structure_sharing.analysis.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink