Files
mercury/compiler/trailing_analysis.m
Zoltan Somogyi 5ad9a27793 Speed up the compiler's handling of code that constructs large ground terms
Estimated hours taken: 80
Branches: main

Speed up the compiler's handling of code that constructs large ground terms
by specializing the treatment of such code.

This diff reduces the compilation time for training_cars_full.m from 106.9
seconds to 30.3 seconds on alys, my laptop. The time on tools/speedtest
stays pretty much the same.

compiler/hlds_goal.m:
	Record the classification of from_ground_term scopes as purely
	constructing terms, purely deconstructing them or something other.

	Fix an old potential bug: variables inside the construct_how fields
	of unifications weren't being renamed along with other variables.
	This is a bug if any part of the compiler later looks at those
	variables. (I am not sure whether or not this happens.)

compiler/superhomogenous.m:
	Provisionally mark newly constructed static terms as being
	from_ground_term_construct. Mode checking will either confirm this
	or change the scope kind.

compiler/options.m:
compiler/handle_options.m:
	Add a new option, from_ground_term_threshold, that allows the user to
	set the boundary between ground terms that get scopes and ground terms
	do not. I plan to experiment with different settings later.

compiler/modes.m:
	Make this classification. For scopes that construct ground terms,
	use a specialized algorithm that avoids quadratic behavior.
	(It does not access the unify_inst_table, which is where the
	factor of N other than the length of the goal list came from.)
	The total size of the instmap_deltas, if printed out, still looks like
	O(N^2) in size, but due to structure sharing it needs only O(N) memory.

	For scopes that construct ground terms, set the determinism information
	so that det_analysis.m doesn't have to traverse such scopes.

	When handling disjunctions, check whether some nonlocals of the
	disjunctions are constructed by from_ground_term_construct scopes.
	For any such nonlocals, set their insts to just ground, throwing away
	the precise information we have about exactly what function symbols
	they and ALL their subterms are bound to. This is HUGE win, since
	it allows us avoid spending a lot of time building a huge merge_inst
	table, which later passes of the compiler (e.g. equiv_type_hlds) would
	then have to spend similarly huge times traversing.

	This approach does have a down side. If lots of arms of a disjunction
	bind a nonlocal to a large ground term, but a few bind it to a SMALL
	ground term, a term below the from_ground_term_threshold, this
	optimization won't kick in. That could be one purpose of the new
	option. It isn't documented yet; I will seek feedback about its
	usefulness first.

compiler/modecheck_unify.m:
	Handle the three different kinds of right hand sides separately.
	This yields a small speedup, because now we don't test rhs_vars and
	rhs_functors (the common right hand sides) for a special case
	(goals containing "any" insts) that is applicable only to
	rhs_lambda_goals.

compiler/unique_modes.m:
	Don't traverse scopes that construct ground terms, since modes.m has
	already done everything that needs to be done.

compiler/det_analysis.m:
	Don't traverse scopes that construct ground terms, since modes.m has
	already done the needed work.

compiler/instmap.m:
	Add a new predicate for use by modes.m.

	Many predicate names in this module were quite uninformative; give them
	informative names.

compiler/polymorphism.m:
	If this pass invalidates the from_ground_term_construct invariants,
	then mark the relevant scope as from_ground_term_other.

	Delete two unused access predicates.

compiler/equiv_type_hlds.m:
	Don't traverse scopes that construct ground terms, since modes.m
	ensures that their instmap deltas do not contain typed insts, and
	thus the scope cannot contain types that need to be expanded.

	Convert some predicates to single clauses.

compiler/goal_form.m:
compiler/goal_util.m:
	In predicates that test goals for various properties, don't traverse
	scopes that construct ground terms when the outcome of the test
	is the same for all such scopes.

	Convert some predicates to single clauses.

compiler/simplify.m:
	Do not look for common structs in from_ground_term_construct scopes,
	both because this speeds up the compiler, and because retaining
	references to ground terms is in fact a pessimization, not an
	optimization. This is because (a) those references need to be stored in
	stack slots across calls, and (b) the C code generators ensure that
	the cells representing ground terms will be shared as needed.

	If all arms of a switch are from_ground_term_construct scopes,
	do not merge the instmap_deltas from those arms, since this is
	both time-consuming (even after the other changes in this diff)
	and extremely unlikely to improve the instmap_delta.

	Disable common_struct in from_ground_term_construct scopes,
	since for these scopes, it is actually a pessimization.

	Do not delete from_ground_term_construct scopes, since many
	compiler passes can now use them.

	Do some manual deforestation, break up some large predicates,
	and give better names to some.

compiler/liveness.m
	Special-case the handling from_ground_term_construct scopes. This
	allows us to traverse them just once instead of three times, and this
	traversal is simpler and faster than any of the three.

	In some traversals, we were switching on the goal type twice; once
	in e.g. detect_liveness_in_goal_2, and once by calling
	goal_expr_has_subgoals. Eliminate the double switching by merging
	the relevant predicates. (The double-switching structure was easier
	to work with before we had multi-cons-id switches.)

compiler/typecheck.m:
	Move a lookup after a test, so we don't have to do it if the test
	fails.

	Provide a specialized mode for a predicate. This should allow the
	compiler to eliminate an argument and a test in the common case.

	Note a possible chance for a speedup.

compiler/typecheck_info.m:
	Don't apply empty substitutions to the types of a possibly very large
	set of variables.

compiler/quantification.m:
	Don't quantify from_ground_term_construct scopes. They are created
	correctly quantified, and any compiler pass that invalidates that
	quantification also removes the from_ground_term_construct mark.

	Don't apply empty renamings to a possibly very large set of variables.

	Move the code for handling scopes to its own predicate, to avoid
	overwhelming the code that handles other kinds of goals. Even from
	this, factor out the renaming code, since it is needed only for
	some kinds of scopes.

	Make some predicate names better reflect what the predicate does.

compiler/pd_cost.m:
	For from_ground_term_construct scopes, instead of computing their cost
	by adding up the costs of the goals inside, make their cost a constant,
	since binding a variable to a static term takes constant time.

compiler/pd_info.m:
	Add prefixes on field names to avoid ambiguities.

compiler/add_heap_ops.m:
compiler/add_trail_ops.m:
compiler/closure_analysis.m:
compiler/constraint.m:
compiler/cse_detection.m:
compiler/dead_proc_elim.m:
compiler/deep_profiling.m:
compiler/deforest.m:
compiler/delay_construct.m:
compiler/delay_partial_inst.m:
compiler/dep_par_conj.m:
compiler/distance_granularity.m:
compiler/exception_analysis.m:
compiler/follow_code.m:
compiler/follow_vars.m:
compiler/format_call.m:
compiler/granularity.m:
compiler/higher_order.m:
compiler/implicit_parallelism.m:
compiler/inlining.m:
compiler/interval.m:
compiler/lambda.m:
compiler/lco.m:
compiler/live_vars.m:
compiler/loop_inv.m:
compiler/middle_rec.m:
compiler/mode_util.m:
compiler/parallel_to_plain_conj.m:
compiler/saved_vars.m:
compiler/stm_expand.m:
compiler/store_alloc.m:
compiler/stratify.m:
compiler/structure_reuse.direct.detect_garbage.m:
compiler/structure_reuse.lbu.m:
compiler/structure_sharing.analysis.m:
compiler/switch_detection.analysis.m:
compiler/trail_analysis.m:
compiler/term_pass1.m:
compiler/tupling.m:
compiler/unneeded_code.m:
compiler/untupling.m:
compiler/unused_args.m:
	These passes have nothing to do in from_ground_term_construct scopes,
	so don't traverse them.

	In some modules (e.g. dead_proc_elim), some traversals had to be kept.

	In loop_inv.m, replace a code structure that updated accumulators
	with functions (which prevented the natural use of state variables),
	that in lots of places reconstructed the term it had just
	deconstructed, and obscured the identical handling of different kinds
	of goals, with a structure based on predicates, state variables and
	shared code for different goal types where possible.

	In store_alloc.m, avoid some double switching on the same value.

	In stratify.m, unneeded_code.m and unused_args.m, rename predicates
	to avoid ambiguities.

compiler/goal_path.m:
compiler/goal_util.m:
compiler/implementation_defined_literals.m:
compiler/intermode.m:
compiler/mark_static_terms.m:
compiler/ml_code_gen.m:
compiler/mode_ordering.m:
compiler/ordering_mode_constraints.m:
compiler/prop_mode_constraints.m:
compiler/purity.m:
compiler/rbmm.actual_region_arguments.m:
compiler/rbmm.add_rbmm_goal_infos.m:
compiler/rbmm.condition_renaming.m:
compiler/rbmm.execution_path.m:
compiler/rbmm.region_transformation.m:
compiler/structure_reuse.direct.choose_reuse.m:
compiler/structure_reuse.indirect.m:
compiler/structure_reuse.lfu.m:
compiler/structure_reuse.versions.m:
compiler/term_const_build.m:
compiler/term_traversal.m:
compiler/unused_imports.m:
	Mark places where we cannot (yet) special case
	from_ground_term_construct scopes.

	In structure_reuse.lfu.m, turn nested if-then-elses into a switch in.

compiler/size_prof.m:
	Turn from_ground_term_construct scopes into from_ground_term_other
	scopes, since in term size profiling grades, we need to attach sizes to
	terms.

	Give predicates better names.

compiler/*.m:
	Minor changes to conform to the changes above.

compiler/make_hlds_passes.m:
	With -S, print statistics after the third pass over items, since
	this is the time-consuming one.

compiler/mercury_compile.m:
	Conform to the new names of some predicates.

	When declining to output a HLDS dump because it would be identical to
	the previous dump, don't confuse the user either by being silent about
	the decision, or by leaving an old dump laying around that could be
	mistaken for a new one.

tools/binary:
tools/binary_step:
	Bring these tools up to date.

compiler/Mmakefile:
	Add an int3s target for use by the new code in the tools. The
	Mmakefiles in the other directories with Mercury code already have
	such a target.

compiler/notes/allocation.html:
	Fix an out-of-date reference.

tests/debugger/polymorphic_ground_term.{m,inp,exp}:
	New test case to check whether liveness.m handles typeinfo liveness
	of ground terms correctly.

tests/debugger/Mmakefile:
	Enable the new test case.

tests/debugger/polymorphic_output.{m,exp}:
	Fix tab/space mixup.
2008-12-23 01:38:03 +00:00

1320 lines
50 KiB
Mathematica

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2008 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(no_func_info, any_call, trailing_analysis_answer).
:- instance partial_order(no_func_info, trailing_analysis_answer).
:- instance answer_pattern(no_func_info, trailing_analysis_answer).
:- instance to_term(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.file_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_util.
:- import_module parse_tree.file_names.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_data.
:- 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(intermodule_analysis,
IntermodAnalysis, !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.foldl(process_scc(Debug, Pass1Only), SCCs, !ModuleInfo),
% Only write trailing analysis pragmas to `.opt' files for
% `--intermodule-optimization', not `--intermodule-analysis'.
(
MakeOptInt = yes,
IntermodAnalysis = no
->
make_opt_int(!.ModuleInfo, !IO)
;
true
),
% Record results if making the analysis registry. We do this in a
% separate pass so that we record results for exported `:- external'
% procedures, which don't get analysed because we don't have clauses
% for them.
(
MakeAnalysisReg = yes,
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
module_info_predids(PredIds, !ModuleInfo),
list.foldl(maybe_record_trailing_result(!.ModuleInfo),
PredIds, AnalysisInfo0, AnalysisInfo),
module_info_set_analysis_info(AnalysisInfo, !ModuleInfo)
;
MakeAnalysisReg = 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) is det.
process_scc(Debug, Pass1Only, SCC, !ModuleInfo) :-
check_procs_for_trail_mods(SCC, ProcResults, !ModuleInfo),
% 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),
(
Debug = yes,
trace [io(!IO)] (
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),
(
Pass1Only = no,
list.foldl(annotate_proc, SCC, !ModuleInfo)
;
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) is det.
check_procs_for_trail_mods(SCC, Result, !ModuleInfo) :-
list.foldl2(check_proc_for_trail_mods(SCC), SCC, [], Result, !ModuleInfo).
% 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) is det.
check_proc_for_trail_mods(SCC, PPId, !Results, !ModuleInfo) :-
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),
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) is det.
check_goal_for_trail_mods(SCC, VarTypes, Goal, Result, MaybeAnalysisStatus,
!ModuleInfo) :-
Goal = hlds_goal(GoalExpr, GoalInfo),
(
GoalExpr = unify(_, _, _, Kind, _),
Result = trail_will_not_modify,
MaybeAnalysisStatus = yes(optimal),
(
( Kind = construct(_, _, _, _, _, _, _)
; Kind = deconstruct(_, _, _, _, _, _)
; Kind = assign(_, _)
; Kind = simple_test(_, _)
)
;
Kind = complicated_unify(_, _, _),
unexpected(this_file,
"complicated unify during trail usage analysis.")
)
;
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)
;
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, intermodule_analysis,
Intermod),
(
Intermod = yes,
pred_info_is_imported_not_external(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,
!ModuleInfo),
(
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(optimal)
;
Intermod = no,
MaybeAnalysisStatus = no
)
)
)
)
;
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)
)
;
GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _),
Result = attributes_imply_trail_mod(Attributes),
MaybeAnalysisStatus = yes(optimal)
;
GoalExpr = conj(_ConjType, Goals),
check_goals_for_trail_mods(SCC, VarTypes, Goals,
Result, MaybeAnalysisStatus, !ModuleInfo)
;
GoalExpr = disj(Goals),
check_goals_for_trail_mods(SCC, VarTypes, Goals,
_Result0, MaybeAnalysisStatus, !ModuleInfo),
% 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
;
GoalExpr = switch(_, _, Cases),
CaseGoals = list.map((func(case(_, _, CaseGoal)) = CaseGoal), Cases),
check_goals_for_trail_mods(SCC, VarTypes, CaseGoals,
Result, MaybeAnalysisStatus, !ModuleInfo)
;
GoalExpr = if_then_else(_, Cond, Then, Else),
check_goals_for_trail_mods(SCC, VarTypes, [Cond, Then, Else],
Result0, MaybeAnalysisStatus, !ModuleInfo),
(
% 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 reflected in the handling
% of if_then-elses in add_trail_ops.m.
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
)
;
GoalExpr = negation(SubGoal),
check_goal_for_trail_mods(SCC, VarTypes, SubGoal, Result,
MaybeAnalysisStatus, !ModuleInfo)
;
GoalExpr = scope(Reason, InnerGoal),
( Reason = from_ground_term(_, from_ground_term_construct) ->
% The construction of ground terms will not modify the trail.
Result = trail_will_not_modify,
MaybeAnalysisStatus = yes(optimal)
;
OuterGoalInfo = GoalInfo,
check_goal_for_trail_mods(SCC, VarTypes, InnerGoal, Result0,
MaybeAnalysisStatus, !ModuleInfo),
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 their status changed to
% `trail_may_modify'. See the comment in the code handling
% if-then-elses above for the reason why.
Result = scope_implies_trail_mod(InnerCodeModel, OuterCodeModel,
Result0)
)
;
GoalExpr = shorthand(_),
unexpected(this_file,
"shorthand goal encountered during trail usage analysis.")
).
:- 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) is det.
check_goals_for_trail_mods(SCC, VarTypes, Goals,
Result, MaybeAnalysisStatus, !ModuleInfo) :-
list.map2_foldl(check_goal_for_trail_mods(SCC, VarTypes), Goals,
Results, MaybeAnalysisStatuses, !ModuleInfo),
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, Status, Status).
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
;
TypeCtorCategory = classify_type(ModuleInfo, Type),
Status = check_type_2(ModuleInfo, Type, TypeCtorCategory)
).
:- func check_type_2(module_info, mer_type, type_ctor_category)
= trailing_status.
check_type_2(ModuleInfo, Type, TypeCtorCat) = Status :-
(
( TypeCtorCat = ctor_cat_builtin(_)
; TypeCtorCat = ctor_cat_higher_order
; TypeCtorCat = ctor_cat_system(_)
; TypeCtorCat = ctor_cat_void
; TypeCtorCat = ctor_cat_builtin_dummy
; TypeCtorCat = ctor_cat_user(cat_user_direct_dummy)
),
Status = trail_will_not_modify
;
TypeCtorCat = ctor_cat_variable,
Status = trail_conditional
;
( TypeCtorCat = ctor_cat_tuple
; TypeCtorCat = ctor_cat_enum(_)
; TypeCtorCat = ctor_cat_user(cat_user_notag)
; TypeCtorCat = ctor_cat_user(cat_user_general)
),
type_to_ctor_and_args_det(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)
)
).
%----------------------------------------------------------------------------%
%
% 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)
is det.
annotate_proc(PPId, !ModuleInfo) :-
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),
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) is det.
annotate_goal(VarTypes, !Goal, Status, !ModuleInfo) :-
!.Goal = hlds_goal(GoalExpr0, GoalInfo0),
annotate_goal_2(VarTypes, GoalInfo0, GoalExpr0, GoalExpr, Status,
!ModuleInfo),
(
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) is det.
annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
(
!.GoalExpr = 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
;
!.GoalExpr = 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
;
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, intermodule_analysis,
IntermodAnalysis),
(
IntermodAnalysis = yes,
pred_info_is_imported(CallPredInfo)
->
search_analysis_status(CallPPId, Result, AnalysisStatus,
!ModuleInfo),
% 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)
)
)
;
!.GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _),
Status = attributes_imply_trail_mod(Attributes)
;
% XXX We should use any results from closure analysis here.
!.GoalExpr = generic_call(GenericCall, _, _, _),
(
GenericCall = higher_order(_, _, _, _),
Status = trail_may_modify
;
GenericCall = class_method(_, _, _, _),
Status = trail_may_modify
;
GenericCall = event_call(_),
Status = trail_will_not_modify
;
GenericCall = cast(_),
Status = trail_will_not_modify
)
;
!.GoalExpr = conj(ConjType, Conjuncts0),
annotate_goal_list(VarTypes, Conjuncts0, Conjuncts, Status,
!ModuleInfo),
!:GoalExpr = conj(ConjType, Conjuncts)
;
!.GoalExpr = disj(Disjuncts0),
annotate_goal_list(VarTypes, Disjuncts0, Disjuncts, Status,
!ModuleInfo),
!:GoalExpr = disj(Disjuncts)
;
!.GoalExpr = switch(Var, CanFail, Cases0),
annotate_cases(VarTypes, Cases0, Cases, Status, !ModuleInfo),
!:GoalExpr = switch(Var, CanFail, Cases)
;
!.GoalExpr = if_then_else(Vars, If0, Then0, Else0),
annotate_goal(VarTypes, If0, If, IfStatus, !ModuleInfo),
annotate_goal(VarTypes, Then0, Then, ThenStatus, !ModuleInfo),
annotate_goal(VarTypes, Else0, Else, ElseStatus, !ModuleInfo),
(
IfStatus = trail_will_not_modify,
ThenStatus = trail_will_not_modify,
ElseStatus = trail_will_not_modify
->
Status = trail_will_not_modify
;
Status = trail_may_modify
),
!:GoalExpr = if_then_else(Vars, If, Then, Else)
;
!.GoalExpr = negation(SubGoal0),
annotate_goal(VarTypes, SubGoal0, SubGoal, Status, !ModuleInfo),
!:GoalExpr = negation(SubGoal)
;
!.GoalExpr = scope(Reason, InnerGoal0),
( Reason = from_ground_term(_, from_ground_term_construct) ->
Status = trail_will_not_modify
;
OuterGoalInfo = GoalInfo,
annotate_goal(VarTypes, InnerGoal0, InnerGoal, Status0,
!ModuleInfo),
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),
!:GoalExpr = scope(Reason, InnerGoal)
)
;
!.GoalExpr = 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) is det.
annotate_goal_list(VarTypes, !Goals, Status, !ModuleInfo) :-
list.map2_foldl(annotate_goal(VarTypes), !Goals, Statuses, !ModuleInfo),
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) is det.
annotate_cases(VarTypes, !Cases, Status, !ModuleInfo) :-
list.map2_foldl(annotate_case(VarTypes), !Cases, Statuses, !ModuleInfo),
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) is det.
annotate_case(VarTypes, !Case, Status, !ModuleInfo) :-
!.Case = case(MainConsId, OtherConsIds, Goal0),
annotate_goal(VarTypes, Goal0, Goal, Status, !ModuleInfo),
!:Case = case(MainConsId, OtherConsIds, 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", do_not_create_dirs,
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),
ProcIds = pred_info_procids(PredInfo),
list.foldl(
write_pragma_trailing_info_2(ModuleInfo, TrailingInfo, PredId,
PredInfo),
ProcIds, !IO).
:- pred write_pragma_trailing_info_2(module_info::in, trailing_info::in,
pred_id::in, pred_info::in, proc_id::in, io::di, io::uo) is det.
write_pragma_trailing_info_2(ModuleInfo, TrailingInfo, PredId, PredInfo,
ProcId, !IO) :-
should_write_trailing_info(ModuleInfo, PredId, ProcId, PredInfo,
for_pragma, 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),
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
)
;
ShouldWrite = no
).
:- type should_write_for
---> for_analysis_framework
; for_pragma.
:- pred should_write_trailing_info(module_info::in, pred_id::in, proc_id::in,
pred_info::in, should_write_for::in, bool::out) is det.
should_write_trailing_info(ModuleInfo, PredId, ProcId, PredInfo, WhatFor,
ShouldWrite) :-
(
procedure_is_exported(ModuleInfo, PredInfo, ProcId),
not is_unify_or_compare_pred(PredInfo),
(
WhatFor = for_analysis_framework
;
WhatFor = for_pragma,
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(no_func_info, 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),
get_func_info(_, _, _, _, _, no_func_info)
].
:- instance answer_pattern(no_func_info, trailing_analysis_answer) where [].
:- instance partial_order(no_func_info, trailing_analysis_answer) where [
( more_precise_than(no_func_info, Answer1, Answer2) :-
Answer1 = trailing_analysis_answer(Status1),
Answer2 = trailing_analysis_answer(Status2),
trailing_status_more_precise_than(Status1, Status2)
),
equivalent(no_func_info, 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_term(trailing_analysis_answer) where [
func(to_term/1) is trailing_analysis_answer_to_term,
pred(from_term/2) is trailing_analysis_answer_from_term
].
:- func trailing_analysis_answer_to_term(trailing_analysis_answer) = term.
trailing_analysis_answer_to_term(trailing_analysis_answer(Status)) = Term :-
trailing_status_to_string(Status, String),
Term = term.functor(atom(String), [], context_init).
:- pred trailing_analysis_answer_from_term(term::in,
trailing_analysis_answer::out) is semidet.
trailing_analysis_answer_from_term(Term, trailing_analysis_answer(Status)) :-
Term = term.functor(atom(String), [], _),
trailing_status_to_string(Status, String).
:- 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, module_info::in, module_info::out) is det.
search_analysis_status(PPId, Result, AnalysisStatus, !ModuleInfo) :-
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
search_analysis_status_2(!.ModuleInfo, PPId, Result, AnalysisStatus,
AnalysisInfo0, AnalysisInfo),
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,
analysis_info::in, analysis_info::out) is det.
search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus,
!AnalysisInfo) :-
mmc_analysis.module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
Call = any_call,
analysis.lookup_best_result(!.AnalysisInfo, ModuleName, FuncId,
no_func_info, Call, MaybeBestStatus),
(
MaybeBestStatus = yes(analysis_result(BestCall,
trailing_analysis_answer(Result), AnalysisStatus)),
record_dependency(ModuleName, FuncId, no_func_info, BestCall,
_ : trailing_analysis_answer, !AnalysisInfo)
;
MaybeBestStatus = no,
% If we do not have any information about the callee procedure
% then assume that it modifies the trail.
top(no_func_info, Call) = Answer,
Answer = trailing_analysis_answer(Result),
AnalysisStatus = optimal,
record_request(analysis_name, ModuleName, FuncId, Call, !AnalysisInfo)
).
:- pred maybe_record_trailing_result(module_info::in, pred_id::in,
analysis_info::in, analysis_info::out) is det.
maybe_record_trailing_result(ModuleInfo, PredId, !AnalysisInfo) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
ProcIds = pred_info_procids(PredInfo),
list.foldl(maybe_record_trailing_result_2(ModuleInfo, PredId, PredInfo),
ProcIds, !AnalysisInfo).
:- pred maybe_record_trailing_result_2(module_info::in, pred_id::in,
pred_info::in, proc_id::in, analysis_info::in, analysis_info::out) is det.
maybe_record_trailing_result_2(ModuleInfo, PredId, PredInfo, ProcId,
!AnalysisInfo) :-
should_write_trailing_info(ModuleInfo, PredId, ProcId, PredInfo,
for_analysis_framework, ShouldWrite),
(
ShouldWrite = yes,
PPId = proc(PredId, ProcId),
module_info_get_trailing_info(ModuleInfo, TrailingInfo),
lookup_proc_trailing_info(TrailingInfo, PPId, Status, ResultStatus),
module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
record_result(ModuleName, FuncId, any_call,
trailing_analysis_answer(Status), ResultStatus, !AnalysisInfo)
;
ShouldWrite = no
).
:- pred lookup_proc_trailing_info(trailing_info::in, pred_proc_id::in,
trailing_status::out, analysis_status::out) is det.
lookup_proc_trailing_info(TrailingInfo, PPId, Status, ResultStatus) :-
( map.search(TrailingInfo, PPId, ProcTrailingInfo) ->
ProcTrailingInfo = proc_trailing_info(Status, MaybeResultStatus),
(
MaybeResultStatus = yes(ResultStatus)
;
MaybeResultStatus = no,
unexpected(this_file,
"lookup_proc_trailing_info: no result status")
)
;
% Probably an exported `:- external' procedure wouldn't have been
% analysed.
Status = trail_may_modify,
ResultStatus = optimal
).
%----------------------------------------------------------------------------%
%
% 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.
%----------------------------------------------------------------------------%