mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-15 05:44:58 +00:00
Code Issues Projects Releases Wiki Activity
Files
672f77c4ecd07daaf01217bc81c336dcf5d6aa02
mercury/compiler/trailing_analysis.m
Zoltan Somogyi 672f77c4ec Add a new compiler option. --inform-ite-instead-of-switch. 
Estimated hours taken: 20
Branches: main

Add a new compiler option. --inform-ite-instead-of-switch. If this is enabled,
the compiler will generate informational messages about if-then-elses that
it thinks should be converted to switches for the sake of program reliability.

Act on the output generated by this option.

compiler/simplify.m:
	Implement the new option.

	Fix an old bug that could cause us to generate warnings about code
	that was OK in one duplicated copy but not in another (where a switch
	arm's code is duplicated due to the case being selected for more than
	one cons_id).

compiler/options.m:
	Add the new option.

	Add a way to test for the bug fix in simplify.

doc/user_guide.texi:
	Document the new option.

NEWS:
	Mention the new option.

library/*.m:
mdbcomp/*.m:
browser/*.m:
compiler/*.m:
deep_profiler/*.m:
	Convert if-then-elses to switches at most of the sites suggested by the
	new option. At the remaining sites, switching to switches would have
	nontrivial downsides. This typically happens with the switched-on type
	has many functors, and we treat one or two specially (e.g. cons/2 in
	the cons_id type).

	Perform misc cleanups in the vicinity of the if-then-else to switch
	conversions.

	In a few cases, improve the error messages generated.

compiler/accumulator.m:
compiler/hlds_goal.m:
	(Rename and) move insts for particular kinds of goal from
	accumulator.m to hlds_goal.m, to allow them to be used in other
	modules. Using these insts allowed us to eliminate some if-then-elses
	entirely.

compiler/exprn_aux.m:
	Instead of fixing some if-then-elses, delete the predicates containing
	them, since they aren't used, and (as pointed out by the new option)
	would need considerable other fixing if they were ever needed again.

compiler/lp_rational.m:
	Add prefixes to the names of the function symbols on some types,
	since without those prefixes, it was hard to figure out what type
	the switch corresponding to an old if-then-else was switching on.

tests/invalid/reserve_tag.err_exp:
	Expect a new, improved error message.
2007-11-23 07:36:01 +00:00

1330 lines
51 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2007 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: trailing_analysis.m.
% Author: juliensf.
%
% This module implements trail usage analysis. It annotates the HLDS with
% information about which procedures will not modify the trail.
%
% The compiler can use this information to omit redundant trailing operations
% in trailing grades. After running the analysis the trailing status of each
% procedure is one of:
%
% (1) trail_will_not_modify
% (2) trail_may_modify
% (3) trail_conditional
%
% These have the following meaning:
%
% (1) for all inputs the procedure will not modify the trail.
% (2) for some inputs the procedure may modify the trail.
% (3) the procedure is polymorphic and whether it may modify the trail
% depends upon the instantiation of the type variables. We need
% this because we can define types with user-defined equality or
% comparison that modify the trail.
%
% NOTE: to be `trail_conditional' a procedure cannot modify the trail itself,
% any trail modifications that occur through the conditional procedure
% must result from a higher-order call or a call to a user-defined equality
% or comparison predicate.
%
% For procedures defined using the foreign language interface we rely upon
% the user annotations `will_not_modify_trail' and `may_not_modify_trail'.
%
% The predicates for determining if individual goals modify the trail
% are in goal_form.m.
%
% TODO:
%
% - Use the results of closure analysis to determine the trailing
% status of higher-order calls.
% - Improve the analysis in the presence of solver types.
% - Create specialised versions of higher-order procedures based on
% whether or not their arguments modify the trail.
%
%----------------------------------------------------------------------------%
:- module transform_hlds.trailing_analysis.
:- interface.
:- import_module analysis.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module io.
%----------------------------------------------------------------------------%
% Perform trail usage analysis on a module.
%
:- pred analyse_trail_usage(module_info::in, module_info::out,
io::di, io::uo) is det.
% Write out the trailing_info pragma for this module.
%
:- pred write_pragma_trailing_info(module_info::in, trailing_info::in,
pred_id::in, io::di, io::uo) is det.
% Types and instances for the intermodule analysis framework.
%
:- type trailing_analysis_answer.
:- instance analysis(any_call, trailing_analysis_answer).
:- instance partial_order(trailing_analysis_answer).
:- instance answer_pattern(trailing_analysis_answer).
:- instance to_string(trailing_analysis_answer).
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.type_util.
:- import_module hlds.code_model.
:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
:- import_module transform_hlds.dependency_graph.
:- import_module transform_hlds.mmc_analysis.
:- import_module bool.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module set.
:- import_module string.
:- import_module term.
%----------------------------------------------------------------------------%
%
% Perform trail usage analysis on a module
%
% The analysis is carried out in two passes. Both passes do a bottom-up
% traversal of the callgraph, one SCC at a time. For each SCC the first
% pass works out the trailing_status for each procedure in the SCC. The
% second pass then uses this information to annotate the goals in each
% procedure with trail usage information.
%
% The second pass is only run if we are going to use the information,
% that is if we are generating code as opposed to building the optimization
% interfaces.
analyse_trail_usage(!ModuleInfo, !IO) :-
globals.io_lookup_bool_option(use_trail, UseTrail, !IO),
(
% Only run the analysis in trailing grades.
UseTrail = yes,
globals.io_lookup_bool_option(make_optimization_interface,
MakeOptInt, !IO),
globals.io_lookup_bool_option(make_transitive_opt_interface,
MakeTransOptInt, !IO),
globals.io_lookup_bool_option(make_analysis_registry,
MakeAnalysisReg, !IO),
Pass1Only = MakeOptInt `bool.or` MakeTransOptInt
`bool.or` MakeAnalysisReg,
module_info_ensure_dependency_info(!ModuleInfo),
module_info_dependency_info(!.ModuleInfo, DepInfo),
hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
globals.io_lookup_bool_option(debug_trail_usage, Debug, !IO),
list.foldl2(process_scc(Debug, Pass1Only), SCCs, !ModuleInfo, !IO),
(
MakeOptInt = yes,
make_opt_int(!.ModuleInfo, !IO)
;
MakeOptInt = no
)
;
UseTrail = no
).
%----------------------------------------------------------------------------%
%
% Perform trail usage analysis on a SCC
%
:- type scc == list(pred_proc_id).
:- type proc_results == list(proc_result).
:- type proc_result
---> proc_result(
ppid :: pred_proc_id,
status :: trailing_status,
maybe_analysis_status :: maybe(analysis_status)
).
:- pred process_scc(bool::in, bool::in, scc::in,
module_info::in, module_info::out, io::di, io::uo) is det.
process_scc(Debug, Pass1Only, SCC, !ModuleInfo, !IO) :-
check_procs_for_trail_mods(SCC, ProcResults, !ModuleInfo, !IO),
%
% The `Results' above are the results of analysing each individual
% procedure in the SCC - we now have to combine them in a meaningful way.
%
combine_individual_proc_results(ProcResults,
TrailingStatus, MaybeAnalysisStatus),
%
% Print out debugging information.
%
(
Debug = yes,
dump_trail_usage_debug_info(!.ModuleInfo, SCC, TrailingStatus, !IO)
;
Debug = no
),
%
% Update the trailing_info with information about this SCC.
%
module_info_get_trailing_info(!.ModuleInfo, TrailingInfo0),
Update = (pred(PPId::in, Info0::in, Info::out) is det :-
Info = Info0 ^ elem(PPId) :=
proc_trailing_info(TrailingStatus, MaybeAnalysisStatus)
),
list.foldl(Update, SCC, TrailingInfo0, TrailingInfo),
module_info_set_trailing_info(TrailingInfo, !ModuleInfo),
%
% Record the analysis results for the intermodule analysis
%
globals.io_lookup_bool_option(make_analysis_registry,
MakeAnalysisRegistry, !IO),
(
MakeAnalysisRegistry = yes,
(
MaybeAnalysisStatus = yes(AnalysisStatus),
record_trailing_analysis_results(TrailingStatus, AnalysisStatus,
SCC, !ModuleInfo)
;
MaybeAnalysisStatus = no,
unexpected(this_file, "process_scc: no analysis status")
)
;
MakeAnalysisRegistry = no
),
(
Pass1Only = no,
list.foldl2(annotate_proc, SCC, !ModuleInfo, !IO)
;
Pass1Only = yes
).
% Check each procedure in the SCC individually.
%
:- pred check_procs_for_trail_mods(scc::in, proc_results::out,
module_info::in, module_info::out, io::di, io::uo) is det.
check_procs_for_trail_mods(SCC, Result, !ModuleInfo, !IO) :-
list.foldl3(check_proc_for_trail_mods(SCC), SCC, [], Result,
!ModuleInfo, !IO).
% Examine how the procedures interact with other procedures that
% are mutually-recursive to them.
%
:- pred combine_individual_proc_results(proc_results::in,
trailing_status::out, maybe(analysis_status)::out) is det.
combine_individual_proc_results([], _, _) :-
unexpected(this_file, "Empty SCC during trailing analysis.").
combine_individual_proc_results(ProcResults @ [_|_],
SCC_Result, MaybeAnalysisStatus) :-
(
% If none of the procedures modifies the trail or is conditional then
% the SCC cannot modify the trail.
all [ProcResult] list.member(ProcResult, ProcResults) =>
ProcResult ^ status = trail_will_not_modify
->
SCC_Result = trail_will_not_modify
;
all [EResult] list.member(EResult, ProcResults) =>
EResult ^ status \= trail_may_modify,
some [CResult] (
list.member(CResult, ProcResults),
CResult ^ status = trail_conditional
)
->
SCC_Result = trail_conditional
;
% Otherwise the SCC may modify the trail.
SCC_Result = trail_may_modify
),
combine_proc_result_maybe_analysis_statuses(ProcResults,
MaybeAnalysisStatus).
:- pred combine_proc_result_maybe_analysis_statuses(proc_results::in,
maybe(analysis_status)::out) is det.
combine_proc_result_maybe_analysis_statuses(ProcResults,
MaybeAnalysisStatus) :-
list.map(maybe_analysis_status, ProcResults, MaybeAnalysisStatuses),
list.foldl(combine_maybe_analysis_status, MaybeAnalysisStatuses,
yes(optimal), MaybeAnalysisStatus).
:- pred maybe_analysis_status(proc_result::in, maybe(analysis_status)::out)
is det.
maybe_analysis_status(ProcResult, ProcResult ^ maybe_analysis_status).
%----------------------------------------------------------------------------%
%
% Perform trail usage analysis on a procedure
%
:- pred check_proc_for_trail_mods(scc::in,
pred_proc_id::in, proc_results::in, proc_results::out,
module_info::in, module_info::out, io::di, io::uo) is det.
check_proc_for_trail_mods(SCC, PPId, !Results, !ModuleInfo, !IO) :-
module_info_pred_proc_info(!.ModuleInfo, PPId, _, ProcInfo),
proc_info_get_goal(ProcInfo, Body),
proc_info_get_vartypes(ProcInfo, VarTypes),
check_goal_for_trail_mods(SCC, VarTypes, Body,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO),
list.cons(proc_result(PPId, Result, MaybeAnalysisStatus), !Results).
%----------------------------------------------------------------------------%
%
% Perform trail usage analysis of a goal
%
:- pred check_goal_for_trail_mods(scc::in, vartypes::in, hlds_goal::in,
trailing_status::out, maybe(analysis_status)::out,
module_info::in, module_info::out, io::di, io::uo) is det.
check_goal_for_trail_mods(SCC, VarTypes, hlds_goal(GoalExpr, GoalInfo),
Result, MaybeStatus, !ModuleInfo, !IO) :-
check_goal_for_trail_mods_2(SCC, VarTypes, GoalExpr, GoalInfo,
Result, MaybeStatus, !ModuleInfo, !IO).
:- pred check_goal_for_trail_mods_2(scc::in,
vartypes::in, hlds_goal_expr::in, hlds_goal_info::in,
trailing_status::out, maybe(analysis_status)::out,
module_info::in, module_info::out, io::di, io::uo) is det.
check_goal_for_trail_mods_2(_, _, GoalExpr, _, trail_will_not_modify,
yes(optimal), !ModuleInfo, !IO) :-
GoalExpr = unify(_, _, _, Kind, _),
(
( Kind = construct(_, _, _, _, _, _, _)
; Kind = deconstruct(_, _, _, _, _, _)
; Kind = assign(_, _)
; Kind = simple_test(_, _)
)
;
Kind = complicated_unify(_, _, _),
unexpected(this_file, "complicated unify during trail usage analysis.")
).
check_goal_for_trail_mods_2(SCC, VarTypes, GoalExpr, _,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
GoalExpr = plain_call(CallPredId, CallProcId, CallArgs, _, _, _),
CallPPId = proc(CallPredId, CallProcId),
module_info_pred_info(!.ModuleInfo, CallPredId, CallPredInfo),
(
% Handle (mutually-)recursive calls.
list.member(CallPPId, SCC)
->
Types = list.map((func(Var) = VarTypes ^ det_elem(Var)), CallArgs),
TrailingStatus = check_types(!.ModuleInfo, Types),
Result = TrailingStatus,
MaybeAnalysisStatus = yes(optimal)
;
pred_info_is_builtin(CallPredInfo)
->
% There are no builtins that will modify the trail.
Result = trail_will_not_modify,
MaybeAnalysisStatus = yes(optimal)
;
% Handle builtin unify and compare.
% NOTE: the type specific unify and compare predicates are just
% treated as though they were normal predicates.
ModuleName = pred_info_module(CallPredInfo),
any_mercury_builtin_module(ModuleName),
Name = pred_info_name(CallPredInfo),
Arity = pred_info_orig_arity(CallPredInfo),
( SpecialPredId = spec_pred_compare
; SpecialPredId = spec_pred_unify
),
special_pred_name_arity(SpecialPredId, Name, _, Arity)
->
% XXX We should examine the argument types of calls to builtin.unify/2
% and builtin.compare/3 and then make a decision based on those.
Result = trail_may_modify,
MaybeAnalysisStatus = yes(optimal)
;
% Handle library predicates whose trailing status
% can be looked up in the known procedures table.
pred_info_has_known_status(CallPredInfo, Result0)
->
Result = Result0,
MaybeAnalysisStatus = yes(optimal)
;
globals.io_lookup_bool_option(intermodule_analysis, Intermod, !IO),
(
Intermod = yes,
pred_info_is_imported(CallPredInfo)
->
% With --intermodule-analysis use check_call_2 to look up results
% for locally defined procedures, otherwise we use the intermodule
% analysis framework.
search_analysis_status(CallPPId, Result0, AnalysisStatus, SCC,
!ModuleInfo, !IO),
(
Result0 = trail_conditional,
Result = check_vars(!.ModuleInfo, VarTypes, CallArgs)
;
( Result0 = trail_may_modify
; Result0 = trail_will_not_modify
),
Result = Result0
),
MaybeAnalysisStatus = yes(AnalysisStatus)
;
check_call_2(!.ModuleInfo, VarTypes, CallPPId, CallArgs,
MaybeResult),
(
MaybeResult = yes(proc_trailing_info(Result,
MaybeAnalysisStatus))
;
MaybeResult = no,
% If we do not have any information about the callee procedure
% then assume that it modifies the trail.
Result = trail_may_modify,
(
Intermod = yes,
MaybeAnalysisStatus = yes(suboptimal)
;
Intermod = no,
MaybeAnalysisStatus = no
)
)
)
).
check_goal_for_trail_mods_2(_, _VarTypes, GoalExpr, _GoalInfo,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
GoalExpr = generic_call(Details, _Args, _ArgModes, _),
(
% XXX Use results of closure analysis to handle this.
Details = higher_order(_Var, _, _, _),
Result = trail_may_modify,
MaybeAnalysisStatus = yes(optimal)
;
% XXX We could do better with class methods.
Details = class_method(_, _, _, _),
Result = trail_may_modify,
MaybeAnalysisStatus = yes(optimal)
;
( Details = cast(_)
; Details = event_call(_)
),
Result = trail_will_not_modify,
MaybeAnalysisStatus = yes(optimal)
).
check_goal_for_trail_mods_2(SCC, VarTypes, negation(Goal), _,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
check_goal_for_trail_mods(SCC, VarTypes, Goal, Result, MaybeAnalysisStatus,
!ModuleInfo, !IO).
check_goal_for_trail_mods_2(SCC, VarTypes, GoalExpr, OuterGoalInfo,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
GoalExpr = scope(_, InnerGoal),
check_goal_for_trail_mods(SCC, VarTypes, InnerGoal, Result0,
MaybeAnalysisStatus, !ModuleInfo, !IO),
InnerGoal = hlds_goal(_, InnerGoalInfo),
InnerCodeModel = goal_info_get_code_model(InnerGoalInfo),
OuterCodeModel = goal_info_get_code_model(OuterGoalInfo),
%
% `trail_conditional' scope goals (of the type that require extra trailing
% code) will have there status changed to `trail_may_modify'.
% See the comment in the clause that handles if-then-elses below
% for the reason why.
%
Result = scope_implies_trail_mod(InnerCodeModel, OuterCodeModel, Result0).
check_goal_for_trail_mods_2(_, _, GoalExpr, _, Result, MaybeAnalysisStatus,
!ModuleInfo, !IO) :-
GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _),
Result = attributes_imply_trail_mod(Attributes),
MaybeAnalysisStatus = yes(optimal).
check_goal_for_trail_mods_2(_, _, shorthand(_), _, _, _, !ModuleInfo, !IO) :-
unexpected(this_file,
"shorthand goal encountered during trail usage analysis.").
check_goal_for_trail_mods_2(SCC, VarTypes, GoalExpr, _,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
GoalExpr = switch(_, _, Cases),
CaseGoals = list.map((func(case(_, CaseGoal)) = CaseGoal), Cases),
check_goals_for_trail_mods(SCC, VarTypes, CaseGoals,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO).
check_goal_for_trail_mods_2(SCC, VarTypes, GoalExpr, _,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
GoalExpr = if_then_else(_, Cond, Then, Else),
check_goals_for_trail_mods(SCC, VarTypes, [Cond, Then, Else],
Result0, MaybeAnalysisStatus, !ModuleInfo, !IO),
(
% If the condition of an if-then-else does not modify the trail
% and is not model_non then we can omit the trailing ops around
% the condition.
%
% NOTE: any changes here may need to be relected in the clause
% of add_trail_ops.goal_expr_add_trail_ops that handles if_then_elses.
%
Result0 = trail_will_not_modify,
Cond = hlds_goal(_CondGoalExpr, CondGoalInfo),
goal_info_get_code_model(CondGoalInfo) \= model_non
->
Result = trail_will_not_modify
;
% If the condition modifies the trail, is model_non or both then
% we need to emit trailing ops around the conditoin. If the
% if-then-else has status `trail_conditional' then we also need
% to emit the trail ops because we cannot be sure that calls to
% builtin.{unify,compare} won't call user-defined equality or
% comparison predicates that modify the trail.
%
% NOTE: conditional procedures whose status is changed here are
% candidates for generating specialized versions that omit
% the trailing code.
%
Result = trail_may_modify
).
check_goal_for_trail_mods_2(SCC, VarTypes, conj(_, Goals), _,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
check_goals_for_trail_mods(SCC, VarTypes, Goals,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO).
check_goal_for_trail_mods_2(SCC, VarTypes, disj(Goals), _,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
check_goals_for_trail_mods(SCC, VarTypes, Goals,
_Result0, MaybeAnalysisStatus, !ModuleInfo, !IO),
% XXX Currently we have to put trailing code around disjunctions.
% If we introduce trail specialisation it may be possible to
% omit it.
Result = trail_may_modify.
:- pred check_goals_for_trail_mods(scc::in, vartypes::in,
hlds_goals::in, trailing_status::out, maybe(analysis_status)::out,
module_info::in, module_info::out, io::di, io::uo) is det.
check_goals_for_trail_mods(SCC, VarTypes, Goals,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
list.map2_foldl2(check_goal_for_trail_mods(SCC, VarTypes), Goals,
Results, MaybeAnalysisStatuses, !ModuleInfo, !IO),
list.foldl(combine_trailing_status, Results, trail_will_not_modify,
Result),
list.foldl(combine_maybe_analysis_status, MaybeAnalysisStatuses,
yes(optimal), MaybeAnalysisStatus).
%----------------------------------------------------------------------------%
%
% Utility procedure for processing goals
%
:- func attributes_imply_trail_mod(pragma_foreign_proc_attributes) =
trailing_status.
attributes_imply_trail_mod(Attributes) =
( get_may_modify_trail(Attributes) = proc_may_modify_trail ->
trail_may_modify
;
trail_will_not_modify
).
:- func scope_implies_trail_mod(code_model, code_model, trailing_status)
= trailing_status.
scope_implies_trail_mod(InnerCodeModel, OuterCodeModel, InnerStatus) =
(
% If we're at a commit for a goal that might modify the trail
% then we need to emit some trailing code around the scope goal.
InnerCodeModel = model_non,
OuterCodeModel \= model_non
->
trail_may_modify
;
InnerStatus
).
%----------------------------------------------------------------------------%
%
% "Known" library procedures
%
% Succeeds if the given pred_info is for a predicate or function
% whose trailing status can be looked up in the known procedures
% table. Returns the trailing status corresponding to that procedure.
% Fails if there was no corresponding entry in the table.
%
:- pred pred_info_has_known_status(pred_info::in, trailing_status::out)
is semidet.
pred_info_has_known_status(PredInfo, Status) :-
Name = pred_info_name(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
ModuleName = pred_info_module(PredInfo),
ModuleName = unqualified(ModuleNameStr),
Arity = pred_info_orig_arity(PredInfo),
known_procedure(PredOrFunc, ModuleNameStr, Name, Arity, Status).
% known_procedure/4 is a table of library predicates whose trailing
% status is hardcoded into the analyser. For a few predicates this
% information can make a big difference (particularly in the absence
% of any form of intermodule analysis).
%
:- pred known_procedure(pred_or_func::in, string::in, string::in, int::in,
trailing_status::out) is semidet.
known_procedure(pf_predicate, "require", "error", 1,
trail_will_not_modify).
known_procedure(pf_function, "require", "func_error", 1,
trail_will_not_modify).
known_procedure(_, "exception", "throw", 1, trail_will_not_modify).
known_procedure(_, "exception", "rethrow", 1, trail_will_not_modify).
%----------------------------------------------------------------------------%
%
% Further code to handle higher-order variables
%
% Extract those procedures whose trailing_status has been set to
% `conditional'. Fails if one of the procedures in the set
% is known to modify the trail or if the trailing status is not
% yet been set for one or more of the procedures.
%
% XXX The latter case probably shouldn't happen but may at the
% moment because the construction of the dependency graph doesn't
% take higher-order calls into account.
%
:- pred get_conditional_closures(module_info::in, set(pred_proc_id)::in,
list(pred_proc_id)::out) is semidet.
get_conditional_closures(ModuleInfo, Closures, Conditionals) :-
module_info_get_trailing_info(ModuleInfo, TrailingInfo),
set.fold(get_conditional_closure(TrailingInfo), Closures,
[], Conditionals).
:- pred get_conditional_closure(trailing_info::in, pred_proc_id::in,
list(pred_proc_id)::in, list(pred_proc_id)::out) is semidet.
get_conditional_closure(TrailingInfo, PPId, !Conditionals) :-
TrailingInfo ^ elem(PPId) = proc_trailing_info(Status, _),
(
Status = trail_conditional,
list.cons(PPId, !Conditionals)
;
Status = trail_will_not_modify
).
%----------------------------------------------------------------------------%
:- pred combine_trailing_status(trailing_status::in, trailing_status::in,
trailing_status::out) is det.
combine_trailing_status(trail_will_not_modify, Y, Y).
combine_trailing_status(trail_may_modify, _, trail_may_modify).
combine_trailing_status(trail_conditional, trail_will_not_modify,
trail_conditional).
combine_trailing_status(trail_conditional, trail_conditional,
trail_conditional).
combine_trailing_status(trail_conditional, trail_may_modify, trail_may_modify).
:- pred combine_maybe_analysis_status(maybe(analysis_status)::in,
maybe(analysis_status)::in, maybe(analysis_status)::out) is det.
combine_maybe_analysis_status(MaybeStatusA, MaybeStatusB, MaybeStatus) :-
(
MaybeStatusA = yes(StatusA),
MaybeStatusB = yes(StatusB)
->
MaybeStatus = yes(analysis.lub(StatusA, StatusB))
;
MaybeStatus = no
).
%----------------------------------------------------------------------------%
%
% Extra procedures for handling calls
%
% Check the trailing status of a call.
%
:- pred check_call(module_info::in, vartypes::in,
pred_proc_id::in, prog_vars::in, trailing_status::out) is det.
check_call(ModuleInfo, VarTypes, PPId, Args, Result) :-
check_call_2(ModuleInfo, VarTypes, PPId, Args, MaybeResult),
(
MaybeResult = yes(proc_trailing_info(Result, _))
;
MaybeResult = no,
% If we do not have any information about the callee procedure then
% assume that it modifies the trail.
Result = trail_may_modify
).
:- pred check_call_2(module_info::in, vartypes::in,
pred_proc_id::in, prog_vars::in, maybe(proc_trailing_info)::out) is det.
check_call_2(ModuleInfo, VarTypes, PPId, Args, MaybeResult) :-
module_info_get_trailing_info(ModuleInfo, TrailingInfo),
( map.search(TrailingInfo, PPId, CalleeTrailingInfo) ->
CalleeTrailingInfo = proc_trailing_info(CalleeTrailingStatus,
AnalysisStatus),
(
CalleeTrailingStatus = trail_will_not_modify,
MaybeResult = yes(CalleeTrailingInfo)
;
CalleeTrailingStatus = trail_may_modify,
MaybeResult = yes(CalleeTrailingInfo)
;
CalleeTrailingStatus = trail_conditional,
%
% This is a call to a polymorphic procedure. We need to make
% sure that none of the types involved has a user-defined
% equality or comparison predicate that modifies the trail.
% XXX Need to handle higher-order args here as well.
MaybeResult = yes(proc_trailing_info(TrailingStatus,
AnalysisStatus)),
TrailingStatus = check_vars(ModuleInfo, VarTypes, Args)
)
;
MaybeResult = no
).
:- func check_vars(module_info, vartypes, prog_vars) = trailing_status.
check_vars(ModuleInfo, VarTypes, Vars) = Result :-
Types = list.map((func(Var) = VarTypes ^ det_elem(Var)), Vars),
Result = check_types(ModuleInfo, Types).
%----------------------------------------------------------------------------%
%
% Stuff for processing types
%
% This is used in the analysis of calls to polymorphic procedures.
%
% By saying that a "type may modify the trail" we mean that tail modification
% may occur as a result of a unification or comparison involving the type
% because it has a user-defined equality/comparison predicate that modifies
% the trail.
%
% XXX We don't actually need to examine all the types, just those
% that are potentially going to be involved in unification/comparisons.
% (The exception and termination analyses have the same problem.)
%
% At the moment we don't keep track of that information so the current
% procedure is as follows:
%
% Examine the functor and then recursively examine the arguments.
%
% * If everything will not trail_will_not_modify then the type will not
% modify the trail.
%
% * If at least one of the types may modify the trail then the type will
% will modify the trail.
%
% * If at least one of the types is conditional and none of them modify
% the trail then the type is conditional.
% Return the collective trailing status of a list of types.
%
:- func check_types(module_info, list(mer_type)) = trailing_status.
check_types(ModuleInfo, Types) = Status :-
list.foldl(check_type(ModuleInfo), Types, trail_will_not_modify, Status).
:- pred check_type(module_info::in, mer_type::in, trailing_status::in,
trailing_status::out) is det.
check_type(ModuleInfo, Type, !Status) :-
combine_trailing_status(check_type(ModuleInfo, Type), !Status).
% Return the trailing status of an individual type.
%
:- func check_type(module_info, mer_type) = trailing_status.
check_type(ModuleInfo, Type) = Status :-
(
( is_solver_type(ModuleInfo, Type)
; is_existq_type(ModuleInfo, Type))
->
% XXX At the moment we just assume that existential
% types and solver types may modify the trail.
Status = trail_may_modify
;
TypeCategory = classify_type(ModuleInfo, Type),
Status = check_type_2(ModuleInfo, Type, TypeCategory)
).
:- func check_type_2(module_info, mer_type, type_category) = trailing_status.
check_type_2(_, _, type_cat_int) = trail_will_not_modify.
check_type_2(_, _, type_cat_char) = trail_will_not_modify.
check_type_2(_, _, type_cat_string) = trail_will_not_modify.
check_type_2(_, _, type_cat_float) = trail_will_not_modify.
check_type_2(_, _, type_cat_higher_order) = trail_will_not_modify.
check_type_2(_, _, type_cat_type_info) = trail_will_not_modify.
check_type_2(_, _, type_cat_type_ctor_info) = trail_will_not_modify.
check_type_2(_, _, type_cat_typeclass_info) = trail_will_not_modify.
check_type_2(_, _, type_cat_base_typeclass_info) = trail_will_not_modify.
check_type_2(_, _, type_cat_void) = trail_will_not_modify.
check_type_2(_, _, type_cat_dummy) = trail_will_not_modify.
check_type_2(_, _, type_cat_variable) = trail_conditional.
check_type_2(ModuleInfo, Type, type_cat_tuple) =
check_user_type(ModuleInfo, Type).
check_type_2(ModuleInfo, Type, type_cat_enum) =
check_user_type(ModuleInfo, Type).
check_type_2(ModuleInfo, Type, type_cat_foreign_enum) =
check_user_type(ModuleInfo, Type).
check_type_2(ModuleInfo, Type, type_cat_user_ctor) =
check_user_type(ModuleInfo, Type).
:- func check_user_type(module_info, mer_type) = trailing_status.
check_user_type(ModuleInfo, Type) = Status :-
( type_to_ctor_and_args(Type, _TypeCtor, Args) ->
(
type_has_user_defined_equality_pred(ModuleInfo, Type,
_UnifyCompare)
->
% XXX We can do better than this by examining
% what these preds actually do. Something
% similar needs to be sorted out for termination
% analysis as well, so we'll wait until that is
% done.
Status = trail_may_modify
;
Status = check_types(ModuleInfo, Args)
)
;
unexpected(this_file, "Unable to get ctor and args.")
).
%----------------------------------------------------------------------------%
%
% Code for attaching trail usage information to goals
%
% Traverse the body of the procedure and attach will_not_modify trail
% features to the goal_infos of those procedure that cannot modify the
% trail.
%
:- pred annotate_proc(pred_proc_id::in,
module_info::in, module_info::out, io::di, io::uo) is det.
annotate_proc(PPId, !ModuleInfo, !IO) :-
some [!ProcInfo, !Body] (
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, !:ProcInfo),
proc_info_get_goal(!.ProcInfo, !:Body),
proc_info_get_vartypes(!.ProcInfo, VarTypes),
annotate_goal(VarTypes, !Body, _Status, !ModuleInfo, !IO),
proc_info_set_goal(!.Body, !ProcInfo),
module_info_set_pred_proc_info(PPId, PredInfo, !.ProcInfo, !ModuleInfo)
).
:- pred annotate_goal(vartypes::in, hlds_goal::in, hlds_goal::out,
trailing_status::out, module_info::in, module_info::out,
io::di, io::uo) is det.
annotate_goal(VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
!.Goal = hlds_goal(GoalExpr0, GoalInfo0),
annotate_goal_2(VarTypes, GoalInfo0, GoalExpr0, GoalExpr, Status,
!ModuleInfo, !IO),
(
Status = trail_will_not_modify,
goal_info_add_feature(feature_will_not_modify_trail,
GoalInfo0, GoalInfo)
;
( Status = trail_may_modify
; Status = trail_conditional
),
GoalInfo = GoalInfo0
),
!:Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred annotate_goal_2(vartypes::in, hlds_goal_info::in,
hlds_goal_expr::in, hlds_goal_expr::out, trailing_status::out,
module_info::in, module_info::out, io::di, io::uo) is det.
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
!.Goal = conj(ConjType, Conjuncts0),
annotate_goal_list(VarTypes, Conjuncts0, Conjuncts, Status, !ModuleInfo,
!IO),
!:Goal = conj(ConjType, Conjuncts).
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
!.Goal = plain_call(CallPredId, CallProcId, CallArgs, _, _, _),
CallPPId = proc(CallPredId, CallProcId),
module_info_pred_info(!.ModuleInfo, CallPredId, CallPredInfo),
(
pred_info_is_builtin(CallPredInfo)
->
Status = trail_will_not_modify
;
% Handle builtin unify and compare.
ModuleName = pred_info_module(CallPredInfo),
any_mercury_builtin_module(ModuleName),
Name = pred_info_name(CallPredInfo),
Arity = pred_info_orig_arity(CallPredInfo),
( SpecialPredId = spec_pred_compare
; SpecialPredId = spec_pred_unify
),
special_pred_name_arity(SpecialPredId, Name, _, Arity)
->
Status = trail_may_modify
;
% Handle library predicates whose trailing status
% can be looked up in the known procedure table.
pred_info_has_known_status(CallPredInfo, Status0)
->
Status = Status0
;
globals.io_lookup_bool_option(intermodule_analysis, IntermodAnalysis,
!IO),
(
IntermodAnalysis = yes,
pred_info_is_imported(CallPredInfo)
->
% NOTE: we set the value of SCC to a dummy value here. This is OK
% because it only needs a meaningful value when building the
% analysis files; it won't be used when compiling to target code.
SCC = [],
search_analysis_status(CallPPId, Result, AnalysisStatus, SCC,
!ModuleInfo, !IO),
% XXX We shouldn't be getting invalid analysis results at this
% stage so maybe we should just call unexpected/2 here?
(
AnalysisStatus = invalid,
Status = trail_may_modify
;
( AnalysisStatus = suboptimal
; AnalysisStatus = optimal
),
(
Result = trail_conditional,
Status = check_vars(!.ModuleInfo, VarTypes, CallArgs)
;
( Result = trail_may_modify
; Result = trail_will_not_modify
),
Status = Result
)
)
;
% This time around we will be checking recursive calls as well.
check_call(!.ModuleInfo, VarTypes, CallPPId, CallArgs, Status)
)
).
annotate_goal_2(_VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
% XXX Use closure analysis results here.
!.Goal = generic_call(Details, _, _, _),
(
Details = higher_order(_, _, _, _),
Status = trail_may_modify
;
Details = class_method(_, _, _, _),
Status = trail_may_modify
;
Details = event_call(_),
Status = trail_will_not_modify
;
Details = cast(_),
Status = trail_will_not_modify
).
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
!.Goal = switch(Var, CanFail, Cases0),
annotate_cases(VarTypes, Cases0, Cases, Status, !ModuleInfo, !IO),
!:Goal = switch(Var, CanFail, Cases).
annotate_goal_2(_VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
!.Goal = unify(_, _, _, Kind, _),
(
( Kind = construct(_, _, _, _, _, _, _)
; Kind = deconstruct(_, _, _, _, _, _)
; Kind = assign(_, _)
; Kind = simple_test(_, _)
)
;
Kind = complicated_unify(_, _, _),
unexpected(this_file, "complicated unify during trail usage analysis.")
),
Status = trail_will_not_modify.
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
!.Goal = disj(Disjuncts0),
annotate_goal_list(VarTypes, Disjuncts0, Disjuncts, Status,
!ModuleInfo, !IO),
!:Goal = disj(Disjuncts).
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
!.Goal = negation(NegGoal0),
annotate_goal(VarTypes, NegGoal0, NegGoal, Status, !ModuleInfo, !IO),
!:Goal = negation(NegGoal).
annotate_goal_2(VarTypes, OuterGoalInfo, !Goal, Status, !ModuleInfo, !IO) :-
!.Goal = scope(Reason, InnerGoal0),
annotate_goal(VarTypes, InnerGoal0, InnerGoal, Status0, !ModuleInfo, !IO),
InnerGoal = hlds_goal(_, InnerGoalInfo),
InnerCodeModel = goal_info_get_code_model(InnerGoalInfo),
OuterCodeModel = goal_info_get_code_model(OuterGoalInfo),
Status = scope_implies_trail_mod(InnerCodeModel, OuterCodeModel, Status0),
!:Goal = scope(Reason, InnerGoal).
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
!.Goal = if_then_else(Vars, If0, Then0, Else0),
annotate_goal(VarTypes, If0, If, IfStatus, !ModuleInfo, !IO),
annotate_goal(VarTypes, Then0, Then, ThenStatus, !ModuleInfo, !IO),
annotate_goal(VarTypes, Else0, Else, ElseStatus, !ModuleInfo, !IO),
(
IfStatus = trail_will_not_modify,
ThenStatus = trail_will_not_modify,
ElseStatus = trail_will_not_modify
->
Status = trail_will_not_modify
;
Status = trail_may_modify
),
!:Goal = if_then_else(Vars, If, Then, Else).
annotate_goal_2(_, _, !Goal, Status, !ModuleInfo, !IO) :-
!.Goal = call_foreign_proc(Attributes, _, _, _, _, _, _),
Status = attributes_imply_trail_mod(Attributes).
annotate_goal_2(_, _, shorthand(_), _, _, _, _, _, _) :-
unexpected(this_file, "shorthand goal").
:- pred annotate_goal_list(vartypes::in, hlds_goals::in,
hlds_goals::out, trailing_status::out, module_info::in,
module_info::out, io::di, io::uo) is det.
annotate_goal_list(VarTypes, !Goals, Status, !ModuleInfo, !IO) :-
list.map2_foldl2(annotate_goal(VarTypes), !Goals, Statuses, !ModuleInfo,
!IO),
list.foldl(combine_trailing_status, Statuses, trail_will_not_modify,
Status).
:- pred annotate_cases(vartypes::in, list(case)::in, list(case)::out,
trailing_status::out, module_info::in, module_info::out,
io::di, io::uo) is det.
annotate_cases(VarTypes, !Cases, Status, !ModuleInfo, !IO) :-
list.map2_foldl2(annotate_case(VarTypes), !Cases, Statuses, !ModuleInfo,
!IO),
list.foldl(combine_trailing_status, Statuses, trail_will_not_modify,
Status).
:- pred annotate_case(vartypes::in, case::in, case::out,
trailing_status::out, module_info::in, module_info::out,
io::di, io::uo) is det.
annotate_case(VarTypes, !Case, Status, !ModuleInfo, !IO) :-
!.Case = case(ConsId, Goal0),
annotate_goal(VarTypes, Goal0, Goal, Status, !ModuleInfo, !IO),
!:Case = case(ConsId, Goal).
%----------------------------------------------------------------------------%
%
% Stuff for intermodule optimization
%
:- pred make_opt_int(module_info::in, io::di, io::uo) is det.
make_opt_int(ModuleInfo, !IO) :-
module_info_get_name(ModuleInfo, ModuleName),
module_name_to_file_name(ModuleName, ".opt.tmp", no, OptFileName, !IO),
globals.io_lookup_bool_option(verbose, Verbose, !IO),
maybe_write_string(Verbose, "% Appending trailing_info pragmas to `", !IO),
maybe_write_string(Verbose, OptFileName, !IO),
maybe_write_string(Verbose, "'...", !IO),
maybe_flush_output(Verbose, !IO),
io.open_append(OptFileName, OptFileRes, !IO),
(
OptFileRes = ok(OptFile),
io.set_output_stream(OptFile, OldStream, !IO),
module_info_get_trailing_info(ModuleInfo, TrailingInfo),
module_info_predids(PredIds, ModuleInfo, _ModuleInfo),
list.foldl(write_pragma_trailing_info(ModuleInfo, TrailingInfo),
PredIds, !IO),
io.set_output_stream(OldStream, _, !IO),
io.close_output(OptFile, !IO),
maybe_write_string(Verbose, " done.\n", !IO)
;
OptFileRes = error(IOError),
maybe_write_string(Verbose, " failed!\n", !IO),
io.error_message(IOError, IOErrorMessage),
io.write_strings(["Error opening file `",
OptFileName, "' for output: ", IOErrorMessage], !IO),
io.set_exit_status(1, !IO)
).
write_pragma_trailing_info(ModuleInfo, TrailingInfo, PredId, !IO) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
should_write_trailing_info(ModuleInfo, PredId, PredInfo, ShouldWrite),
(
ShouldWrite = yes,
ModuleName = pred_info_module(PredInfo),
Name = pred_info_name(PredInfo),
Arity = pred_info_orig_arity(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
ProcIds = pred_info_procids(PredInfo),
list.foldl((pred(ProcId::in, !.IO::di, !:IO::uo) is det :-
proc_id_to_int(ProcId, ModeNum),
(
map.search(TrailingInfo, proc(PredId, ProcId), ProcTrailInfo),
ProcTrailInfo = proc_trailing_info(Status, _)
->
mercury_output_pragma_trailing_info(PredOrFunc,
qualified(ModuleName, Name), Arity, ModeNum, Status, !IO)
;
true
)), ProcIds, !IO)
;
ShouldWrite = no
).
:- pred should_write_trailing_info(module_info::in, pred_id::in,
pred_info::in, bool::out) is det.
should_write_trailing_info(ModuleInfo, PredId, PredInfo, ShouldWrite) :-
pred_info_get_import_status(PredInfo, ImportStatus),
(
( ImportStatus = status_exported
; ImportStatus = status_opt_exported
),
not is_unify_or_compare_pred(PredInfo),
module_info_get_type_spec_info(ModuleInfo, TypeSpecInfo),
TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
not set.member(PredId, TypeSpecForcePreds),
%
% XXX Writing out pragmas for the automatically generated class
% instance methods causes the compiler to abort when it reads them
% back in.
%
pred_info_get_markers(PredInfo, Markers),
not check_marker(Markers, marker_class_instance_method),
not check_marker(Markers, marker_named_class_instance_method)
->
ShouldWrite = yes
;
ShouldWrite = no
).
%-----------------------------------------------------------------------------%
%
% Stuff for the intermodule analysis framework
%
:- type trailing_analysis_answer
---> trailing_analysis_answer(trailing_status).
:- func analysis_name = string.
analysis_name = "trail_usage".
:- instance analysis(any_call, trailing_analysis_answer) where [
analysis_name(_, _) = analysis_name,
analysis_version_number(_, _) = 1,
preferred_fixpoint_type(_, _) = least_fixpoint,
bottom(_) = trailing_analysis_answer(trail_will_not_modify),
top(_) = trailing_analysis_answer(trail_may_modify)
].
:- instance answer_pattern(trailing_analysis_answer) where [].
:- instance partial_order(trailing_analysis_answer) where [
(more_precise_than(
trailing_analysis_answer(Status1),
trailing_analysis_answer(Status2)) :-
trailing_status_more_precise_than(Status1, Status2)),
equivalent(Status, Status)
].
:- pred trailing_status_more_precise_than(trailing_status::in,
trailing_status::in) is semidet.
trailing_status_more_precise_than(trail_will_not_modify, trail_may_modify).
trailing_status_more_precise_than(trail_will_not_modify, trail_conditional).
trailing_status_more_precise_than(trail_conditional, trail_may_modify).
:- instance to_string(trailing_analysis_answer) where [
func(to_string/1) is trailing_analysis_answer_to_string,
func(from_string/1) is trailing_analysis_answer_from_string
].
:- func trailing_analysis_answer_to_string(trailing_analysis_answer) = string.
trailing_analysis_answer_to_string(trailing_analysis_answer(Status)) = Str :-
trailing_status_to_string(Status, Str).
:- func trailing_analysis_answer_from_string(string) =
trailing_analysis_answer is semidet.
trailing_analysis_answer_from_string(Str) = trailing_analysis_answer(Status) :-
trailing_status_to_string(Status, Str).
:- pred trailing_status_to_string(trailing_status, string).
:- mode trailing_status_to_string(in, out) is det.
:- mode trailing_status_to_string(out, in) is semidet.
trailing_status_to_string(trail_may_modify, "may_modify_trail").
trailing_status_to_string(trail_will_not_modify, "will_not_modify_trail").
trailing_status_to_string(trail_conditional, "conditional").
:- pred search_analysis_status(pred_proc_id::in,
trailing_status::out, analysis_status::out, scc::in,
module_info::in, module_info::out, io::di, io::uo) is det.
search_analysis_status(PPId, Result, AnalysisStatus, CallerSCC,
!ModuleInfo, !IO) :-
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
search_analysis_status_2(!.ModuleInfo, PPId, Result, AnalysisStatus,
CallerSCC, AnalysisInfo0, AnalysisInfo, !IO),
module_info_set_analysis_info(AnalysisInfo, !ModuleInfo).
:- pred search_analysis_status_2(module_info::in, pred_proc_id::in,
trailing_status::out, analysis_status::out, scc::in,
analysis_info::in, analysis_info::out, io::di, io::uo) is det.
search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus, CallerSCC,
!AnalysisInfo, !IO) :-
mmc_analysis.module_id_func_id(ModuleInfo, PPId, ModuleId, FuncId),
Call = any_call,
analysis.lookup_best_result(ModuleId, FuncId, Call,
MaybeBestStatus, !AnalysisInfo, !IO),
globals.io_lookup_bool_option(make_analysis_registry,
MakeAnalysisRegistry, !IO),
(
MaybeBestStatus = yes({BestCall, trailing_analysis_answer(Result),
AnalysisStatus}),
(
MakeAnalysisRegistry = yes,
record_dependencies(ModuleId, FuncId, BestCall,
ModuleInfo, CallerSCC, !AnalysisInfo)
;
MakeAnalysisRegistry = no
)
;
MaybeBestStatus = no,
% If we do not have any information about the callee procedure
% then assume that it modifies the trail.
top(Call) = Answer,
Answer = trailing_analysis_answer(Result),
module_is_local(mmc, ModuleId, IsLocal, !IO),
(
IsLocal = yes,
AnalysisStatus = suboptimal,
(
MakeAnalysisRegistry = yes,
PPId = proc(PredId, _),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
should_write_trailing_info(ModuleInfo, PredId, PredInfo,
ShouldWrite),
(
ShouldWrite = yes,
analysis.record_result(ModuleId, FuncId,
Call, Answer, AnalysisStatus, !AnalysisInfo),
analysis.record_request(analysis_name, ModuleId, FuncId,
Call, !AnalysisInfo),
record_dependencies(ModuleId, FuncId, Call,
ModuleInfo, CallerSCC, !AnalysisInfo)
;
ShouldWrite = no
)
;
MakeAnalysisRegistry = no
)
;
IsLocal = no,
% We can't do any better anyway.
AnalysisStatus = optimal
)
).
% XXX if the procedures in CallerSCC definitely come from the
% same module then we don't need to record the dependency so many
% times, at least while we only have module-level granularity.
%
:- pred record_dependencies(module_id::in, func_id::in, Call::in,
module_info::in, scc::in, analysis_info::in, analysis_info::out)
is det <= call_pattern(Call).
record_dependencies(ModuleId, FuncId, Call,
ModuleInfo, CallerSCC, !AnalysisInfo) :-
list.foldl((pred(CallerPPId::in, Info0::in, Info::out) is det :-
mmc_analysis.module_id_func_id(ModuleInfo, CallerPPId,
CallerModuleId, _),
analysis.record_dependency(CallerModuleId,
analysis_name, ModuleId, FuncId, Call, Info0, Info)
), CallerSCC, !AnalysisInfo).
:- pred record_trailing_analysis_results(trailing_status::in,
analysis_status::in, scc::in,
module_info::in, module_info::out) is det.
record_trailing_analysis_results(Status, ResultStatus, SCC, !ModuleInfo) :-
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
list.foldl(
record_trailing_analysis_result(!.ModuleInfo, Status, ResultStatus),
SCC, AnalysisInfo0, AnalysisInfo),
module_info_set_analysis_info(AnalysisInfo, !ModuleInfo).
:- pred record_trailing_analysis_result(module_info::in, trailing_status::in,
analysis_status::in, pred_proc_id::in,
analysis_info::in, analysis_info::out) is det.
record_trailing_analysis_result(ModuleInfo, Status, ResultStatus,
PPId @ proc(PredId, _ProcId), AnalysisInfo0, AnalysisInfo) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
should_write_trailing_info(ModuleInfo, PredId, PredInfo, ShouldWrite),
(
ShouldWrite = yes,
mmc_analysis.module_id_func_id(ModuleInfo, PPId, ModuleId, FuncId),
analysis.record_result(ModuleId, FuncId, any_call,
trailing_analysis_answer(Status), ResultStatus,
AnalysisInfo0, AnalysisInfo)
;
ShouldWrite = no,
AnalysisInfo = AnalysisInfo0
).
%----------------------------------------------------------------------------%
%
% Code for printing out debugging traces
%
:- pred dump_trail_usage_debug_info(module_info::in, scc::in,
trailing_status::in, io::di, io::uo) is det.
dump_trail_usage_debug_info(ModuleInfo, SCC, Status, !IO) :-
io.write_string("SCC: ", !IO),
io.write(Status, !IO),
io.nl(!IO),
output_proc_names(ModuleInfo, SCC, !IO),
io.nl(!IO).
:- pred output_proc_names(module_info::in, scc::in, io::di, io::uo) is det.
output_proc_names(ModuleInfo, SCC, !IO) :-
list.foldl(output_proc_name(ModuleInfo), SCC, !IO).
:- pred output_proc_name(module_info::in, pred_proc_id::in, io::di, io::uo)
is det.
output_proc_name(Moduleinfo, PPId, !IO) :-
Pieces = describe_one_proc_name(Moduleinfo, should_module_qualify, PPId),
Str = error_pieces_to_string(Pieces),
io.format("\t%s\n", [s(Str)], !IO).
%----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "trailing_analysis.m".
%----------------------------------------------------------------------------%
:- end_module trailing_analysis.
%----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink