mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-16 06:14:59 +00:00
Code Issues Projects Releases Wiki Activity
Files
7c8eeadabf91a648051a16ff2234f2067c97a32b
mercury/compiler/structure_sharing.analysis.m
Zoltan Somogyi cc9912faa8 Don't import anything in packages. 
Packages are modules whose only job is to serve as a container for submodules.
Modules like top_level.m, hlds.m, parse_tree.m and ll_backend.m are packages
in this (informal) sense.

Besides the include_module declarations for their submodules, most of the
packages in the compiler used to import some modules, mostly other packages
whose component modules their submodules may need. For example, ll_backend.m
used to import parse_tree.m. This meant that modules in the ll_backend package
did not have to import parse_tree.m before importing modules in the parse_tree
package.

However, this had a price. When we add a new module to the parse_tree package,
parse_tree.int would change, and this would require the recompilation of ALL
the modules in the ll_backend package, even the ones that did NOT import ANY
of the modules in the parse_tree package.

This happened even at one remove. Pretty much all modules in every one
of the backend have to import one or more modules in the hlds package,
and they therefore have import hlds.m. Since hlds.m imported transform_hlds.m,
any addition of a new middle pass to the transform_hlds package required
the recompilation of all backend modules, even in the usual case of the two
having nothing to do with each other.

This diff removes all import_module declarations from the packages,
and replaces them with import_module declarations in the modules that need
them. This includes only a SUBSET of their child modules and of the non-child
modules that import them.
2015-11-13 15:03:20 +11:00

1214 lines
47 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2012 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: 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.
:- import_module io.
%-----------------------------------------------------------------------------%
% Perform structure sharing analysis on the procedures defined in the
% current module.
%
:- pred structure_sharing_analysis(module_info::in, module_info::out,
io::di, io::uo) 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_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.file_util.
:- import_module libs.globals.
:- 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_out.
:- import_module parse_tree.prog_type.
:- import_module transform_hlds.ctgc.fixpoint_table.
:- import_module transform_hlds.ctgc.selector.
:- import_module transform_hlds.ctgc.structure_sharing.domain.
:- import_module transform_hlds.ctgc.util.
:- import_module transform_hlds.dependency_graph.
:- import_module transform_hlds.intermod.
:- import_module transform_hlds.mmc_analysis.
:- import_module bool.
:- import_module int.
:- 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).
%-----------------------------------------------------------------------------%
structure_sharing_analysis(!ModuleInfo, !IO) :-
% 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, !IO),
% 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, !IO),
module_info_get_proc_analysis_kinds(!.ModuleInfo, ProcAnalysisKinds0),
set.insert(pak_structure_sharing, ProcAnalysisKinds0, ProcAnalysisKinds),
module_info_set_proc_analysis_kinds(ProcAnalysisKinds, !ModuleInfo),
selector.reset_tables(!IO).
%-----------------------------------------------------------------------------%
%
% 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_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_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($module, $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,
io::di, io::uo) is det.
annotate_liveness(!ModuleInfo, !IO) :-
process_all_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, io::di, io::uo) is det.
sharing_analysis(!ModuleInfo, !.SharingTable, !IO) :-
% 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),
module_info_get_maybe_dependency_info(!.ModuleInfo, MaybeDepInfo),
(
MaybeDepInfo = yes(DepInfo),
hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
list.foldl3(analyse_scc(!.ModuleInfo), SCCs,
!SharingTable, [], DepProcs, !IO)
;
MaybeDepInfo = no,
unexpected($module, $pred, "No dependency information")
),
% 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.lookup_bool_option(Globals, make_analysis_registry,
MakeAnalysisRegistry),
(
MakeAnalysisRegistry = yes,
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)
)
;
MakeAnalysisRegistry = no
).
:- 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, list(pred_proc_id)::in,
sharing_as_table::in, sharing_as_table::out,
dep_procs::in, dep_procs::out, io::di, io::uo) is det.
analyse_scc(ModuleInfo, SCC, !SharingTable, !DepProcs, !IO) :-
( if some_preds_requiring_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), SCC),
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),
list.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(SCC),
analyse_scc_until_fixpoint(ModuleInfo, SCC, !.SharingTable,
FixpointTable0, FixpointTable, !DepProcs, !IO),
list.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, io::di, io::uo) is det.
analyse_scc_until_fixpoint(ModuleInfo, SCC, SharingTable,
!FixpointTable, !DepProcs, !IO) :-
% 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($module, $pred, "fixpoint not reached after "
++ string.from_int(max_runs) ++ " runs")
else
true
),
list.foldl3(analyse_pred_proc(ModuleInfo, SharingTable), SCC,
!FixpointTable, !DepProcs, !IO),
( if ss_fixpoint_table_stable(!.FixpointTable) then
true
else
ss_fixpoint_table_new_run(!FixpointTable),
analyse_scc_until_fixpoint(ModuleInfo, SCC, SharingTable,
!FixpointTable, !DepProcs, !IO)
).
:- 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, io::di, io::uo) is det.
analyse_pred_proc(ModuleInfo, SharingTable, PPId, !FixpointTable, !DepProcs,
!IO) :-
% 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),
write_proc_progress_message(
"% Sharing analysis (run " ++ string.int_to_string(Run) ++ ") ",
PPId, ModuleInfo, !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
maybe_write_string(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),
domain.apply_widening(ModuleInfo, ProcInfo, WideningLimit,
WideningDone, !Sharing),
(
WideningDone = yes,
WidenAsDescr = sharing_as_short_description(!.Sharing)
;
WideningDone = no,
WidenAsDescr = "-"
),
maybe_write_string(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),
maybe_write_string(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_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($module, $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)] (
io.write_char('.', !IO),
io.flush_output(!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_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_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 `:- external' 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"))
] (
ReasonsList = set.to_sorted_list(Reasons),
io.write_string(":\n", !IO),
io.write_list(ReasonsList, "\n",
write_top_feedback(ModuleInfo), !IO),
io.nl(!IO),
io.write_string("\t", !IO),
io.write(Status, !IO),
io.nl(!IO)
)
;
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),
io.write_string("failed_lookup: ", !IO),
write_pred_proc_id(ModuleInfo, PPId, !IO)
;
Reason = top_from_lookup(ShroudedPPId),
PPId = unshroud_pred_proc_id(ShroudedPPId),
io.write_string("from_lookup: ", !IO),
write_pred_proc_id(ModuleInfo, PPId, !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