mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-16 06:14:59 +00:00
Code Issues Projects Releases Wiki Activity
Files
01087b8ed1a9abeedc2863708ea19094f69c7f76
mercury/compiler/trailing_analysis.m
Zoltan Somogyi 15aa457e12 Delete $module arg from calls to unexpected.
2018-04-07 18:25:43 +10:00

1218 lines
47 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2012 The University of Melbourne.
% Copyright (C) 2017 The Mercury Team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: 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.
:- import_module hlds.hlds_module.
%----------------------------------------------------------------------------%
% Perform trail usage analysis on a module.
%
:- pred analyse_trail_usage(module_info::in, module_info::out) 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.
:- import_module check_hlds.type_util.
:- import_module hlds.code_model.
:- import_module hlds.hlds_dependency_graph.
:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module hlds.vartypes.
:- import_module libs.
:- import_module libs.dependency_graph.
:- import_module libs.globals.
:- import_module libs.op_mode.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.prog_type.
:- import_module transform_hlds.intermod.
:- import_module transform_hlds.mmc_analysis.
:- import_module bool.
:- import_module io.
:- import_module list.
:- import_module maybe.
:- import_module require.
:- 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) :-
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, use_trail, UseTrail),
(
% Only run the analysis in trailing grades.
UseTrail = yes,
globals.get_op_mode(Globals, OpMode),
( if
OpMode = opm_top_args(opma_augment(OpModeAugment)),
( OpModeAugment = opmau_make_opt_int
; OpModeAugment = opmau_make_trans_opt_int
; OpModeAugment = opmau_make_analysis_registry
)
then
Pass1Only = yes
else
Pass1Only = no
),
module_info_ensure_dependency_info(!ModuleInfo, DepInfo),
SCCs = dependency_info_get_bottom_up_sccs(DepInfo),
globals.lookup_bool_option(Globals, debug_trail_usage, Debug),
list.foldl(trail_analyse_scc(Debug, Pass1Only), SCCs, !ModuleInfo),
module_info_get_proc_analysis_kinds(!.ModuleInfo, ProcAnalysisKinds0),
set.insert(pak_trailing, ProcAnalysisKinds0, ProcAnalysisKinds),
module_info_set_proc_analysis_kinds(ProcAnalysisKinds, !ModuleInfo),
% Record results if making the analysis registry. We do this in
% a separate pass so that we record results for exported procedures
% which have a `:- pragma external_{pred/func}', which don't analyse
% because we don't have clauses for them.
( if
OpMode = opm_top_args(opma_augment(opmau_make_analysis_registry))
then
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
module_info_get_valid_pred_ids(!.ModuleInfo, PredIds),
list.foldl(maybe_record_trailing_result(!.ModuleInfo),
PredIds, AnalysisInfo0, AnalysisInfo),
module_info_set_analysis_info(AnalysisInfo, !ModuleInfo)
else
true
)
;
UseTrail = no
).
%----------------------------------------------------------------------------%
%
% Perform trail usage analysis on a SCC.
%
:- type trail_proc_result
---> trail_proc_result(
tpr_ppid :: pred_proc_id,
tpr_status :: trailing_status,
tpr_maybe_analysis_status :: maybe(analysis_status)
).
:- pred trail_analyse_scc(bool::in, bool::in, scc::in,
module_info::in, module_info::out) is det.
trail_analyse_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.
trail_combine_individual_proc_results(ProcResults,
TrailingStatus, MaybeAnalysisStatus),
(
Debug = yes,
trace [io(!IO)] (
dump_trail_usage_debug_info(!.ModuleInfo, SCC, TrailingStatus, !IO)
)
;
Debug = no
),
ProcTrailingInfo = proc_trailing_info(TrailingStatus, MaybeAnalysisStatus),
set.foldl(set_trailing_info(ProcTrailingInfo), SCC, !ModuleInfo),
(
Pass1Only = no,
set.foldl(trail_annotate_proc, SCC, !ModuleInfo)
;
Pass1Only = yes
).
:- pred set_trailing_info(proc_trailing_info::in, pred_proc_id::in,
module_info::in, module_info::out) is det.
set_trailing_info(ProcTrailingInfo, PPId, !ModuleInfo) :-
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo0, ProcInfo0),
proc_info_set_trailing_info(yes(ProcTrailingInfo), ProcInfo0, ProcInfo),
module_info_set_pred_proc_info(PPId, PredInfo0, ProcInfo, !ModuleInfo).
% Check each procedure in the SCC individually.
%
:- pred check_procs_for_trail_mods(scc::in, list(trail_proc_result)::out,
module_info::in, module_info::out) is det.
check_procs_for_trail_mods(SCC, Result, !ModuleInfo) :-
set.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 trail_combine_individual_proc_results(list(trail_proc_result)::in,
trailing_status::out, maybe(analysis_status)::out) is det.
trail_combine_individual_proc_results([], _, _) :-
unexpected($pred, "empty SCC").
trail_combine_individual_proc_results(ProcResults @ [_ | _], SCC_Result,
MaybeAnalysisStatus) :-
( if
% 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 ^ tpr_status = trail_will_not_modify
)
then
SCC_Result = trail_will_not_modify
else if
all [EResult] (
list.member(EResult, ProcResults)
=>
EResult ^ tpr_status \= trail_may_modify
),
some [CResult] (
list.member(CResult, ProcResults),
CResult ^ tpr_status = trail_conditional
)
then
SCC_Result = trail_conditional
else
% Otherwise the SCC may modify the trail.
SCC_Result = trail_may_modify
),
trail_combine_proc_result_maybe_analysis_statuses(ProcResults,
MaybeAnalysisStatus).
:- pred trail_combine_proc_result_maybe_analysis_statuses(
list(trail_proc_result)::in, maybe(analysis_status)::out) is det.
trail_combine_proc_result_maybe_analysis_statuses(ProcResults,
MaybeAnalysisStatus) :-
list.map(trail_maybe_analysis_status, ProcResults, MaybeAnalysisStatuses),
list.foldl(combine_maybe_trail_analysis_status, MaybeAnalysisStatuses,
yes(optimal), MaybeAnalysisStatus).
:- pred trail_maybe_analysis_status(trail_proc_result::in,
maybe(analysis_status)::out) is det.
trail_maybe_analysis_status(ProcResult, AnalysisStatus) :-
AnalysisStatus = ProcResult ^ tpr_maybe_analysis_status.
%----------------------------------------------------------------------------%
%
% Perform trail usage analysis on a procedure.
%
:- pred check_proc_for_trail_mods(scc::in, pred_proc_id::in,
list(trail_proc_result)::in, list(trail_proc_result)::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(trail_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($pred, "complicated unify")
)
;
GoalExpr = plain_call(CallPredId, CallProcId, CallArgs, _, _, _),
CallPPId = proc(CallPredId, CallProcId),
module_info_pred_info(!.ModuleInfo, CallPredId, CallPredInfo),
( if
% Handle (mutually-)recursive calls.
set.member(CallPPId, SCC)
then
lookup_var_types(VarTypes, CallArgs, Types),
TrailingStatus = trail_check_types(!.ModuleInfo, Types),
Result = TrailingStatus,
MaybeAnalysisStatus = yes(optimal)
else if
pred_info_is_builtin(CallPredInfo)
then
% There are no builtins that will modify the trail.
Result = trail_will_not_modify,
MaybeAnalysisStatus = yes(optimal)
else if
% 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)
then
% 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)
else if
% Handle library predicates whose trailing status
% can be looked up in the known procedures table.
pred_info_has_known_trail_status(CallPredInfo, Result0)
then
Result = Result0,
MaybeAnalysisStatus = yes(optimal)
else
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, intermodule_analysis,
Intermod),
( if
Intermod = yes,
pred_info_is_imported_not_external(CallPredInfo)
then
% With --intermodule-analysis use trail_check_call_2 to look up
% results for locally defined procedures, otherwise we use
% the intermodule analysis framework.
search_trail_analysis_status(CallPPId, Result0, AnalysisStatus,
!ModuleInfo),
(
Result0 = trail_conditional,
Result = trail_check_vars(!.ModuleInfo, VarTypes, CallArgs)
;
( Result0 = trail_may_modify
; Result0 = trail_will_not_modify
),
Result = Result0
),
MaybeAnalysisStatus = yes(AnalysisStatus)
else
trail_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
% 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
then
Result = trail_will_not_modify
else
% 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),
( if Reason = from_ground_term(_, from_ground_term_construct) then
% The construction of ground terms will not modify the trail.
Result = trail_will_not_modify,
MaybeAnalysisStatus = yes(optimal)
else
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($pred, "shorthand")
).
:- 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_trail_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) =
( if get_may_modify_trail(Attributes) = proc_may_modify_trail then
trail_may_modify
else
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
% 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
then
trail_may_modify
else
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_trail_status(pred_info::in, trailing_status::out)
is semidet.
pred_info_has_known_trail_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),
trail_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 trail_known_procedure(pred_or_func::in, string::in,
string::in, int::in, trailing_status::out) is semidet.
trail_known_procedure(pf_predicate, "require", "error", 1,
trail_will_not_modify).
trail_known_procedure(pf_function, "require", "func_error", 1,
trail_will_not_modify).
trail_known_procedure(_, "exception", "throw", 1, trail_will_not_modify).
trail_known_procedure(_, "exception", "rethrow", 1, trail_will_not_modify).
%----------------------------------------------------------------------------%
%
% 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 trail_get_conditional_closures(module_info::in, set(pred_proc_id)::in,
list(pred_proc_id)::out) is semidet.
:- pragma consider_used(trail_get_conditional_closures/3).
trail_get_conditional_closures(ModuleInfo, Closures, Conditionals) :-
set.fold(trail_get_conditional_closure(ModuleInfo), Closures,
[], Conditionals).
:- pred trail_get_conditional_closure(module_info::in, pred_proc_id::in,
list(pred_proc_id)::in, list(pred_proc_id)::out) is semidet.
trail_get_conditional_closure(ModuleInfo, PPId, !Conditionals) :-
module_info_pred_proc_info(ModuleInfo, PPId, _PredInfo, ProcInfo),
proc_info_get_trailing_info(ProcInfo, MaybeProcTrailingInfo),
MaybeProcTrailingInfo = yes(ProcTrailingInfo),
ProcTrailingInfo = 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_trail_analysis_status(maybe(analysis_status)::in,
maybe(analysis_status)::in, maybe(analysis_status)::out) is det.
combine_maybe_trail_analysis_status(MaybeStatusA, MaybeStatusB, MaybeStatus) :-
( if
MaybeStatusA = yes(StatusA),
MaybeStatusB = yes(StatusB)
then
MaybeStatus = yes(analysis.lub(StatusA, StatusB))
else
MaybeStatus = no
).
%----------------------------------------------------------------------------%
%
% Extra procedures for handling calls.
%
% Check the trailing status of a call.
%
:- pred trail_check_call(module_info::in, vartypes::in,
pred_proc_id::in, prog_vars::in, trailing_status::out) is det.
trail_check_call(ModuleInfo, VarTypes, PPId, Args, Result) :-
trail_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 we have to assume that it may modify the trail.
Result = trail_may_modify
).
:- pred trail_check_call_2(module_info::in, vartypes::in,
pred_proc_id::in, prog_vars::in, maybe(proc_trailing_info)::out) is det.
trail_check_call_2(ModuleInfo, VarTypes, PPId, Args, MaybeResult) :-
module_info_pred_proc_info(ModuleInfo, PPId, _PredInfo, ProcInfo),
proc_info_get_trailing_info(ProcInfo, MaybeCalleeTrailingInfo),
(
MaybeCalleeTrailingInfo = yes(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 = trail_check_vars(ModuleInfo, VarTypes, Args)
)
;
MaybeCalleeTrailingInfo = no,
MaybeResult = no
).
:- func trail_check_vars(module_info, vartypes, prog_vars) = trailing_status.
trail_check_vars(ModuleInfo, VarTypes, Vars) = Result :-
lookup_var_types(VarTypes, Vars, Types),
Result = trail_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 trail_check_types(module_info, list(mer_type)) = trailing_status.
trail_check_types(ModuleInfo, Types) = Status :-
list.foldl(trail_check_type(ModuleInfo), Types,
trail_will_not_modify, Status).
:- pred trail_check_type(module_info::in, mer_type::in, trailing_status::in,
trailing_status::out) is det.
trail_check_type(ModuleInfo, Type, !Status) :-
combine_trailing_status(trail_check_type(ModuleInfo, Type), !Status).
% Return the trailing status of an individual type.
%
:- func trail_check_type(module_info, mer_type) = trailing_status.
trail_check_type(ModuleInfo, Type) = Status :-
( if
( type_is_solver_type(ModuleInfo, Type)
; type_is_existq_type(ModuleInfo, Type)
)
then
% XXX At the moment we just assume that existential
% types and solver types may modify the trail.
Status = trail_may_modify
else
TypeCtorCategory = classify_type(ModuleInfo, Type),
Status = trail_check_type_2(ModuleInfo, Type, TypeCtorCategory)
).
:- func trail_check_type_2(module_info, mer_type, type_ctor_category)
= trailing_status.
trail_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)
; TypeCtorCat = ctor_cat_user(cat_user_abstract_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_abstract_notag)
; TypeCtorCat = ctor_cat_user(cat_user_general)
),
type_to_ctor_and_args_det(Type, _TypeCtor, Args),
( if
type_has_user_defined_equality_pred(ModuleInfo, Type,
_UnifyCompare)
then
% 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
else
Status = trail_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 trail_annotate_proc(pred_proc_id::in,
module_info::in, module_info::out) is det.
trail_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),
trail_annotate_goal(VarTypes, !Body, _Status, !ModuleInfo),
proc_info_set_goal(!.Body, !ProcInfo),
module_info_set_pred_proc_info(PPId, PredInfo, !.ProcInfo, !ModuleInfo)
).
:- pred trail_annotate_goal(vartypes::in, hlds_goal::in, hlds_goal::out,
trailing_status::out, module_info::in, module_info::out) is det.
trail_annotate_goal(VarTypes, !Goal, Status, !ModuleInfo) :-
!.Goal = hlds_goal(GoalExpr0, GoalInfo0),
trail_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 trail_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.
trail_annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
(
!.GoalExpr = unify(_, _, _, Kind, _),
(
( Kind = construct(_, _, _, _, _, _, _)
; Kind = deconstruct(_, _, _, _, _, _)
; Kind = assign(_, _)
; Kind = simple_test(_, _)
)
;
Kind = complicated_unify(_, _, _),
unexpected($pred, "complicated unify")
),
Status = trail_will_not_modify
;
!.GoalExpr = plain_call(CallPredId, CallProcId, CallArgs, _, _, _),
CallPPId = proc(CallPredId, CallProcId),
module_info_pred_info(!.ModuleInfo, CallPredId, CallPredInfo),
( if
pred_info_is_builtin(CallPredInfo)
then
Status = trail_will_not_modify
else if
% 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)
then
Status = trail_may_modify
else if
% Handle library predicates whose trailing status
% can be looked up in the known procedure table.
pred_info_has_known_trail_status(CallPredInfo, Status0)
then
Status = Status0
else
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, intermodule_analysis,
IntermodAnalysis),
( if
IntermodAnalysis = yes,
pred_info_is_imported(CallPredInfo)
then
search_trail_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 = trail_check_vars(!.ModuleInfo, VarTypes,
CallArgs)
;
( Result = trail_may_modify
; Result = trail_will_not_modify
),
Status = Result
)
)
else
% This time around we will be checking recursive calls as well.
trail_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),
trail_annotate_goal_list(VarTypes, Conjuncts0, Conjuncts, Status,
!ModuleInfo),
!:GoalExpr = conj(ConjType, Conjuncts)
;
!.GoalExpr = disj(Disjuncts0),
trail_annotate_goal_list(VarTypes, Disjuncts0, Disjuncts, Status,
!ModuleInfo),
!:GoalExpr = disj(Disjuncts)
;
!.GoalExpr = switch(Var, CanFail, Cases0),
trail_annotate_cases(VarTypes, Cases0, Cases, Status, !ModuleInfo),
!:GoalExpr = switch(Var, CanFail, Cases)
;
!.GoalExpr = if_then_else(Vars, If0, Then0, Else0),
trail_annotate_goal(VarTypes, If0, If, IfStatus, !ModuleInfo),
trail_annotate_goal(VarTypes, Then0, Then, ThenStatus, !ModuleInfo),
trail_annotate_goal(VarTypes, Else0, Else, ElseStatus, !ModuleInfo),
( if
IfStatus = trail_will_not_modify,
ThenStatus = trail_will_not_modify,
ElseStatus = trail_will_not_modify
then
Status = trail_will_not_modify
else
Status = trail_may_modify
),
!:GoalExpr = if_then_else(Vars, If, Then, Else)
;
!.GoalExpr = negation(SubGoal0),
trail_annotate_goal(VarTypes, SubGoal0, SubGoal, Status, !ModuleInfo),
!:GoalExpr = negation(SubGoal)
;
!.GoalExpr = scope(Reason, InnerGoal0),
( if Reason = from_ground_term(_, from_ground_term_construct) then
Status = trail_will_not_modify
else
OuterGoalInfo = GoalInfo,
trail_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($pred, "shorthand")
).
:- pred trail_annotate_goal_list(vartypes::in,
list(hlds_goal)::in, list(hlds_goal)::out, trailing_status::out,
module_info::in, module_info::out) is det.
trail_annotate_goal_list(VarTypes, !Goals, Status, !ModuleInfo) :-
list.map2_foldl(trail_annotate_goal(VarTypes), !Goals, Statuses,
!ModuleInfo),
list.foldl(combine_trailing_status, Statuses, trail_will_not_modify,
Status).
:- pred trail_annotate_cases(vartypes::in, list(case)::in, list(case)::out,
trailing_status::out, module_info::in, module_info::out) is det.
trail_annotate_cases(VarTypes, !Cases, Status, !ModuleInfo) :-
list.map2_foldl(trail_annotate_case(VarTypes), !Cases, Statuses,
!ModuleInfo),
list.foldl(combine_trailing_status, Statuses, trail_will_not_modify,
Status).
:- pred trail_annotate_case(vartypes::in, case::in, case::out,
trailing_status::out, module_info::in, module_info::out) is det.
trail_annotate_case(VarTypes, !Case, Status, !ModuleInfo) :-
!.Case = case(MainConsId, OtherConsIds, Goal0),
trail_annotate_goal(VarTypes, Goal0, Goal, Status, !ModuleInfo),
!:Case = case(MainConsId, OtherConsIds, Goal).
%-----------------------------------------------------------------------------%
%
% Stuff for the intermodule analysis framework.
%
:- type trailing_analysis_answer
---> trailing_analysis_answer(trailing_status).
:- func trail_analysis_name = string.
trail_analysis_name = "trail_usage".
:- instance analysis(no_func_info, any_call, trailing_analysis_answer) where [
analysis_name(_, _) = trail_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_trail_analysis_status(pred_proc_id::in, trailing_status::out,
analysis_status::out, module_info::in, module_info::out) is det.
search_trail_analysis_status(PPId, Result, AnalysisStatus, !ModuleInfo) :-
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
search_trail_analysis_status_2(!.ModuleInfo, PPId, Result, AnalysisStatus,
AnalysisInfo0, AnalysisInfo),
module_info_set_analysis_info(AnalysisInfo, !ModuleInfo).
:- pred search_trail_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_trail_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(trail_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 = should_write,
PPId = proc(PredId, ProcId),
lookup_proc_trailing_info(ModuleInfo, PPId, Status, ResultStatus),
module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
record_result(ModuleName, FuncId, any_call,
trailing_analysis_answer(Status), ResultStatus, !AnalysisInfo)
;
ShouldWrite = should_not_write
).
:- pred lookup_proc_trailing_info(module_info::in, pred_proc_id::in,
trailing_status::out, analysis_status::out) is det.
lookup_proc_trailing_info(ModuleInfo, PPId, Status, ResultStatus) :-
module_info_pred_proc_info(ModuleInfo, PPId, _PredInfo, ProcInfo),
proc_info_get_trailing_info(ProcInfo, MaybeProcTrailingInfo),
(
MaybeProcTrailingInfo = yes(ProcTrailingInfo),
ProcTrailingInfo = proc_trailing_info(Status, MaybeResultStatus),
(
MaybeResultStatus = yes(ResultStatus)
;
MaybeResultStatus = no,
unexpected($pred, "no result status")
)
;
MaybeProcTrailingInfo = no,
% Probably an exported `:- pragma external_{pred/func}' procedure,
% which 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) :-
set.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).
%----------------------------------------------------------------------------%
:- end_module transform_hlds.trailing_analysis.
%----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink