mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-18 15:26:31 +00:00
459847a064
Estimated hours taken: 18 Branches: main Move the univ, maybe, pair and unit types from std_util into their own modules. std_util still contains the general purpose higher-order programming constructs. library/std_util.m: Move univ, maybe, pair and unit (plus any other related types and procedures) into their own modules. library/maybe.m: New module. This contains the maybe and maybe_error types and the associated procedures. library/pair.m: New module. This contains the pair type and associated procedures. library/unit.m: New module. This contains the types unit/0 and unit/1. library/univ.m: New module. This contains the univ type and associated procedures. library/library.m: Add the new modules. library/private_builtin.m: Update the declaration of the type_ctor_info struct for univ. runtime/mercury.h: Update the declaration for the type_ctor_info struct for univ. runtime/mercury_mcpp.h: runtime/mercury_hlc_types.h: Update the definition of MR_Univ. runtime/mercury_init.h: Fix a comment: ML_type_name is now exported from type_desc.m. compiler/mlds_to_il.m: Update the the name of the module that defines univs (which are handled specially by the il code generator.) library/*.m: compiler/*.m: browser/*.m: mdbcomp/*.m: profiler/*.m: deep_profiler/*.m: Conform to the above changes. Import the new modules where they are needed; don't import std_util where it isn't needed. Fix formatting in lots of modules. Delete duplicate module imports. tests/*: Update the test suite to confrom to the above changes.
1262 lines
48 KiB
Mathematica
1262 lines
48 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2005-2006 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
|
|
% procedue is one of:
|
|
%
|
|
% (1) will_not_modify_trail
|
|
% (2) may_modify_trail
|
|
% (3) 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 `conditional' a procedure cannot modify the trail itself,
|
|
% any trail modifications that occur through the conditional procedure
|
|
% must result from a higher-order call or a call to a user-defined equality
|
|
% or comparison predicate.
|
|
%
|
|
% For procedures defined using the foreign language interface we rely upon
|
|
% the user annotations `will_not_modify_trail' and `may_not_modify_trail'.
|
|
%
|
|
% The predicates for determining if individual goals modify the trail
|
|
% are in goal_form.m.
|
|
|
|
% TODO:
|
|
%
|
|
% - Use the results of closure analysis to determine the trailing
|
|
% status of higher-order calls.
|
|
% - Improve the analysis in the presence of solver types.
|
|
% - Create specialised versions of higher-order procedures based on
|
|
% whether or not their arguments modify the trail.
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- module transform_hlds.trailing_analysis.
|
|
:- interface.
|
|
|
|
:- import_module analysis.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
|
|
:- import_module io.
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
% Perform trail usage analysis on a module.
|
|
%
|
|
:- pred analyse_trail_usage(module_info::in, module_info::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Write out the trailing_info pragma for this module.
|
|
%
|
|
:- pred write_pragma_trailing_info(module_info::in, trailing_info::in,
|
|
pred_id::in, io::di, io::uo) is det.
|
|
|
|
% Types and instances for the intermodule analysis framework.
|
|
%
|
|
:- type trailing_analysis_answer.
|
|
:- instance analysis(any_call, trailing_analysis_answer).
|
|
:- instance partial_order(trailing_analysis_answer).
|
|
:- instance answer_pattern(trailing_analysis_answer).
|
|
:- instance to_string(trailing_analysis_answer).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.mode_util.
|
|
:- 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 hlds.make_hlds.
|
|
:- import_module hlds.passes_aux.
|
|
:- import_module hlds.special_pred.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.mercury_to_mercury.
|
|
:- import_module parse_tree.modules.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module parse_tree.prog_util.
|
|
:- 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),
|
|
Pass1Only = MakeOptInt `bool.or` MakeTransOptInt,
|
|
module_info_ensure_dependency_info(!ModuleInfo),
|
|
module_info_dependency_info(!.ModuleInfo, DepInfo),
|
|
hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
|
|
globals.io_lookup_bool_option(debug_trail_usage, Debug, !IO),
|
|
list.foldl2(process_scc(Debug, Pass1Only), SCCs, !ModuleInfo, !IO),
|
|
(
|
|
MakeOptInt = yes,
|
|
make_opt_int(!.ModuleInfo, !IO)
|
|
;
|
|
MakeOptInt = no
|
|
)
|
|
;
|
|
UseTrail = no
|
|
).
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Perform trail usage analysis on a SCC
|
|
%
|
|
|
|
:- type scc == list(pred_proc_id).
|
|
|
|
:- type proc_results == list(proc_result).
|
|
|
|
:- type proc_result
|
|
---> proc_result(
|
|
ppid :: pred_proc_id,
|
|
status :: trailing_status,
|
|
maybe_analysis_status :: maybe(analysis_status)
|
|
).
|
|
|
|
:- pred process_scc(bool::in, bool::in, scc::in,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
process_scc(Debug, Pass1Only, SCC, !ModuleInfo, !IO) :-
|
|
check_procs_for_trail_mods(SCC, ProcResults, !ModuleInfo, !IO),
|
|
%
|
|
% The `Results' above are the results of analysing each individual
|
|
% procedure in the SCC - we now have to combine them in a meaningful way.
|
|
%
|
|
combine_individual_proc_results(ProcResults,
|
|
TrailingStatus, MaybeAnalysisStatus),
|
|
%
|
|
% Print out debugging information.
|
|
%
|
|
(
|
|
Debug = yes,
|
|
dump_trail_usage_debug_info(!.ModuleInfo, SCC, TrailingStatus, !IO)
|
|
;
|
|
Debug = no
|
|
),
|
|
%
|
|
% Update the trailing_info with information about this SCC.
|
|
%
|
|
module_info_get_trailing_info(!.ModuleInfo, TrailingInfo0),
|
|
Update = (pred(PPId::in, Info0::in, Info::out) is det :-
|
|
Info = Info0 ^ elem(PPId) :=
|
|
proc_trailing_info(TrailingStatus, MaybeAnalysisStatus)
|
|
),
|
|
list.foldl(Update, SCC, TrailingInfo0, TrailingInfo),
|
|
module_info_set_trailing_info(TrailingInfo, !ModuleInfo),
|
|
%
|
|
% Record the analysis results for the intermodule analysis
|
|
%
|
|
globals__io_lookup_bool_option(make_analysis_registry,
|
|
MakeAnalysisRegistry, !IO),
|
|
(
|
|
MakeAnalysisRegistry = yes,
|
|
(
|
|
MaybeAnalysisStatus = yes(AnalysisStatus),
|
|
record_trailing_analysis_results(TrailingStatus, AnalysisStatus,
|
|
SCC, !ModuleInfo)
|
|
;
|
|
MaybeAnalysisStatus = no,
|
|
unexpected(this_file, "process_scc: no analysis status")
|
|
)
|
|
;
|
|
MakeAnalysisRegistry = no
|
|
),
|
|
(
|
|
Pass1Only = no,
|
|
list.foldl2(annotate_proc, SCC, !ModuleInfo, !IO)
|
|
;
|
|
Pass1Only = yes
|
|
).
|
|
|
|
% Check each procedure in the SCC individually.
|
|
%
|
|
:- pred check_procs_for_trail_mods(scc::in, proc_results::out,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
check_procs_for_trail_mods(SCC, Result, !ModuleInfo, !IO) :-
|
|
list.foldl3(check_proc_for_trail_mods(SCC), SCC, [], Result,
|
|
!ModuleInfo, !IO).
|
|
|
|
% Examine how the procedures interact with other procedures that
|
|
% are mutually-recursive to them.
|
|
%
|
|
:- pred combine_individual_proc_results(proc_results::in,
|
|
trailing_status::out, maybe(analysis_status)::out) is det.
|
|
|
|
combine_individual_proc_results([], _, _) :-
|
|
unexpected(this_file, "Empty SCC during trailing analysis.").
|
|
combine_individual_proc_results(ProcResults @ [_|_],
|
|
SCC_Result, MaybeAnalysisStatus) :-
|
|
(
|
|
% If none of the procedures modifies the trail or is conditional then
|
|
% the SCC cannot modify the trail.
|
|
all [ProcResult] list.member(ProcResult, ProcResults) =>
|
|
ProcResult ^ status = will_not_modify_trail
|
|
->
|
|
SCC_Result = will_not_modify_trail
|
|
;
|
|
all [EResult] list.member(EResult, ProcResults) =>
|
|
EResult ^ status \= may_modify_trail,
|
|
some [CResult] (
|
|
list.member(CResult, ProcResults),
|
|
CResult ^ status = conditional
|
|
)
|
|
->
|
|
SCC_Result = conditional
|
|
;
|
|
% Otherwise the SCC may modify the trail.
|
|
SCC_Result = may_modify_trail
|
|
),
|
|
combine_proc_result_maybe_analysis_statuses(ProcResults,
|
|
MaybeAnalysisStatus).
|
|
|
|
:- pred combine_proc_result_maybe_analysis_statuses(proc_results::in,
|
|
maybe(analysis_status)::out) is det.
|
|
|
|
combine_proc_result_maybe_analysis_statuses(ProcResults,
|
|
MaybeAnalysisStatus) :-
|
|
list.map(maybe_analysis_status, ProcResults, MaybeAnalysisStatuses),
|
|
list.foldl(combine_maybe_analysis_status, MaybeAnalysisStatuses,
|
|
yes(optimal), MaybeAnalysisStatus).
|
|
|
|
:- pred maybe_analysis_status(proc_result::in, maybe(analysis_status)::out)
|
|
is det.
|
|
|
|
maybe_analysis_status(ProcResult, ProcResult ^ maybe_analysis_status).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Perform trail usage analysis on a procedure
|
|
%
|
|
|
|
:- pred check_proc_for_trail_mods(scc::in,
|
|
pred_proc_id::in, proc_results::in, proc_results::out,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
check_proc_for_trail_mods(SCC, PPId, !Results, !ModuleInfo, !IO) :-
|
|
module_info_pred_proc_info(!.ModuleInfo, PPId, _, ProcInfo),
|
|
proc_info_get_goal(ProcInfo, Body),
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
check_goal_for_trail_mods(SCC, VarTypes, Body,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO),
|
|
list.cons(proc_result(PPId, Result, MaybeAnalysisStatus), !Results).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Perform trail usage analysis of a goal
|
|
%
|
|
|
|
:- pred check_goal_for_trail_mods(scc::in, vartypes::in, hlds_goal::in,
|
|
trailing_status::out, maybe(analysis_status)::out,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
check_goal_for_trail_mods(SCC, VarTypes, Goal - GoalInfo,
|
|
Result, MaybeStatus, !ModuleInfo, !IO) :-
|
|
check_goal_for_trail_mods_2(SCC, VarTypes, Goal, GoalInfo,
|
|
Result, MaybeStatus, !ModuleInfo, !IO).
|
|
|
|
:- pred check_goal_for_trail_mods_2(scc::in,
|
|
vartypes::in, hlds_goal_expr::in, hlds_goal_info::in,
|
|
trailing_status::out, maybe(analysis_status)::out,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
check_goal_for_trail_mods_2(_, _, Goal, _, will_not_modify_trail, yes(optimal),
|
|
!ModuleInfo, !IO) :-
|
|
Goal = unify(_, _, _, Kind, _),
|
|
( Kind = complicated_unify(_, _, _) ->
|
|
unexpected(this_file, "complicated unify during trail usage analysis.")
|
|
;
|
|
true
|
|
).
|
|
check_goal_for_trail_mods_2(SCC, VarTypes, Goal, _,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
|
|
Goal = 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 = will_not_modify_trail,
|
|
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 = may_modify_trail,
|
|
MaybeAnalysisStatus = yes(optimal)
|
|
;
|
|
% Handle library predicates whose trailing status
|
|
% can be looked up in the known procedures table.
|
|
pred_info_has_known_status(CallPredInfo, Result0)
|
|
->
|
|
Result = Result0,
|
|
MaybeAnalysisStatus = yes(optimal)
|
|
;
|
|
globals__io_lookup_bool_option(intermodule_analysis, Intermod, !IO),
|
|
(
|
|
Intermod = yes,
|
|
pred_info_is_imported(CallPredInfo)
|
|
->
|
|
% With --intermodule-analysis use check_call_2 to look up results
|
|
% for locally defined procedures, otherwise we use the intermodule
|
|
% analysis framework.
|
|
search_analysis_status(CallPPId, Result0, AnalysisStatus, SCC,
|
|
!ModuleInfo, !IO),
|
|
( Result0 = conditional ->
|
|
Result = check_vars(!.ModuleInfo, VarTypes, CallArgs)
|
|
;
|
|
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 = may_modify_trail,
|
|
(
|
|
Intermod = yes,
|
|
MaybeAnalysisStatus = yes(suboptimal)
|
|
;
|
|
Intermod = no,
|
|
MaybeAnalysisStatus = no
|
|
)
|
|
)
|
|
)
|
|
).
|
|
|
|
check_goal_for_trail_mods_2(_, _VarTypes, Goal, _GoalInfo,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
|
|
Goal = generic_call(Details, _Args, _ArgModes, _),
|
|
(
|
|
% XXX Use results of closure analysis to handle this.
|
|
Details = higher_order(_Var, _, _, _),
|
|
Result = may_modify_trail,
|
|
MaybeAnalysisStatus = yes(optimal)
|
|
;
|
|
% XXX We could do better with class methods.
|
|
Details = class_method(_, _, _, _),
|
|
Result = may_modify_trail,
|
|
MaybeAnalysisStatus = yes(optimal)
|
|
;
|
|
Details = cast(_),
|
|
Result = will_not_modify_trail,
|
|
MaybeAnalysisStatus = yes(optimal)
|
|
).
|
|
check_goal_for_trail_mods_2(SCC, VarTypes, not(Goal), _,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
|
|
check_goal_for_trail_mods(SCC, VarTypes, Goal, Result, MaybeAnalysisStatus,
|
|
!ModuleInfo, !IO).
|
|
check_goal_for_trail_mods_2(SCC, VarTypes, Goal, OuterGoalInfo,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
|
|
Goal = scope(_, InnerGoal),
|
|
check_goal_for_trail_mods(SCC, VarTypes, InnerGoal, Result0,
|
|
MaybeAnalysisStatus, !ModuleInfo, !IO),
|
|
InnerGoal = _ - InnerGoalInfo,
|
|
goal_info_get_code_model(InnerGoalInfo, InnerCodeModel),
|
|
goal_info_get_code_model(OuterGoalInfo, OuterCodeModel),
|
|
Result = scope_implies_trail_mod(InnerCodeModel, OuterCodeModel, Result0).
|
|
check_goal_for_trail_mods_2(_, _, Goal, _, Result, MaybeAnalysisStatus,
|
|
!ModuleInfo, !IO) :-
|
|
Goal = foreign_proc(Attributes, _, _, _, _, _),
|
|
Result = attributes_imply_trail_mod(Attributes),
|
|
MaybeAnalysisStatus = yes(optimal).
|
|
check_goal_for_trail_mods_2(_, _, shorthand(_), _, _, _, !ModuleInfo, !IO) :-
|
|
unexpected(this_file,
|
|
"shorthand goal encountered during trail usage analysis.").
|
|
check_goal_for_trail_mods_2(SCC, VarTypes, Goal, _,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
|
|
Goal = switch(_, _, Cases),
|
|
CaseGoals = list.map((func(case(_, CaseGoal)) = CaseGoal), Cases),
|
|
check_goals_for_trail_mods(SCC, VarTypes, CaseGoals,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO).
|
|
check_goal_for_trail_mods_2(SCC, VarTypes, Goal, _,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
|
|
Goal = if_then_else(_, If, Then, Else),
|
|
check_goals_for_trail_mods(SCC, VarTypes, [If, Then, Else],
|
|
Result0, MaybeAnalysisStatus, !ModuleInfo, !IO),
|
|
(
|
|
% If none of the disjuncts can modify the trail then we don't need
|
|
% to emit trailing code around this disjunction.
|
|
Result0 = will_not_modify_trail,
|
|
Result = will_not_modify_trail
|
|
;
|
|
( Result0 = conditional ; Result0 = may_modify_trail),
|
|
Result = may_modify_trail
|
|
).
|
|
check_goal_for_trail_mods_2(SCC, VarTypes, conj(_, Goals), _,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
|
|
check_goals_for_trail_mods(SCC, VarTypes, Goals,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO).
|
|
check_goal_for_trail_mods_2(SCC, VarTypes, disj(Goals), _,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
|
|
check_goals_for_trail_mods(SCC, VarTypes, Goals,
|
|
Result0, MaybeAnalysisStatus, !ModuleInfo, !IO),
|
|
(
|
|
% If none of the disjuncts can modify the trail then we don't need
|
|
% to emit trailing code around this disjunction.
|
|
Result0 = will_not_modify_trail,
|
|
Result = will_not_modify_trail
|
|
;
|
|
% One or or more of the disjuncts may modify the trail, so
|
|
% we need to emit the trailing code - XXX could do better by
|
|
% specialising conditional code.
|
|
( Result0 = conditional ; Result0 = may_modify_trail),
|
|
Result = may_modify_trail
|
|
).
|
|
|
|
:- pred check_goals_for_trail_mods(scc::in, vartypes::in,
|
|
hlds_goals::in, trailing_status::out, maybe(analysis_status)::out,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
check_goals_for_trail_mods(SCC, VarTypes, Goals,
|
|
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
|
|
list.map2_foldl2(check_goal_for_trail_mods(SCC, VarTypes), Goals,
|
|
Results, MaybeAnalysisStatuses, !ModuleInfo, !IO),
|
|
list.foldl(combine_trailing_status, Results, will_not_modify_trail,
|
|
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) =
|
|
( may_modify_trail(Attributes) = may_modify_trail ->
|
|
may_modify_trail
|
|
;
|
|
will_not_modify_trail
|
|
).
|
|
|
|
:- 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,
|
|
InnerStatus \= will_not_modify_trail
|
|
->
|
|
may_modify_trail
|
|
;
|
|
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(predicate, "require", "error", 1, will_not_modify_trail).
|
|
known_procedure(function, "require", "func_error", 1, will_not_modify_trail).
|
|
known_procedure(_, "exception", "throw", 1, will_not_modify_trail).
|
|
known_procedure(_, "exception", "rethrow", 1, will_not_modify_trail).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% 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 = conditional,
|
|
list.cons(PPId, !Conditionals)
|
|
;
|
|
Status = will_not_modify_trail
|
|
).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- pred combine_trailing_status(trailing_status::in, trailing_status::in,
|
|
trailing_status::out) is det.
|
|
|
|
combine_trailing_status(will_not_modify_trail, Y, Y).
|
|
combine_trailing_status(may_modify_trail, _, may_modify_trail).
|
|
combine_trailing_status(conditional, will_not_modify_trail, conditional).
|
|
combine_trailing_status(conditional, conditional, conditional).
|
|
combine_trailing_status(conditional, may_modify_trail, may_modify_trail).
|
|
|
|
:- 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 = may_modify_trail
|
|
).
|
|
|
|
:- 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 = will_not_modify_trail,
|
|
MaybeResult = yes(CalleeTrailingInfo)
|
|
;
|
|
CalleeTrailingStatus = may_modify_trail,
|
|
MaybeResult = yes(CalleeTrailingInfo)
|
|
;
|
|
CalleeTrailingStatus = 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 will_not_modify_trail 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, will_not_modify_trail, 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 = may_modify_trail
|
|
;
|
|
TypeCategory = classify_type(ModuleInfo, Type),
|
|
Status = check_type_2(ModuleInfo, Type, TypeCategory)
|
|
).
|
|
|
|
:- func check_type_2(module_info, mer_type, type_category) = trailing_status.
|
|
|
|
check_type_2(_, _, type_cat_int) = will_not_modify_trail.
|
|
check_type_2(_, _, type_cat_char) = will_not_modify_trail.
|
|
check_type_2(_, _, type_cat_string) = will_not_modify_trail.
|
|
check_type_2(_, _, type_cat_float) = will_not_modify_trail.
|
|
check_type_2(_, _, type_cat_higher_order) = will_not_modify_trail.
|
|
check_type_2(_, _, type_cat_type_info) = will_not_modify_trail.
|
|
check_type_2(_, _, type_cat_type_ctor_info) = will_not_modify_trail.
|
|
check_type_2(_, _, type_cat_typeclass_info) = will_not_modify_trail.
|
|
check_type_2(_, _, type_cat_base_typeclass_info) = will_not_modify_trail.
|
|
check_type_2(_, _, type_cat_void) = will_not_modify_trail.
|
|
check_type_2(_, _, type_cat_dummy) = will_not_modify_trail.
|
|
|
|
check_type_2(_, _, type_cat_variable) = conditional.
|
|
|
|
check_type_2(ModuleInfo, Type, type_cat_tuple) =
|
|
check_user_type(ModuleInfo, Type).
|
|
check_type_2(ModuleInfo, Type, type_cat_enum) =
|
|
check_user_type(ModuleInfo, Type).
|
|
check_type_2(ModuleInfo, Type, type_cat_user_ctor) =
|
|
check_user_type(ModuleInfo, Type).
|
|
|
|
:- func check_user_type(module_info, mer_type) = trailing_status.
|
|
|
|
check_user_type(ModuleInfo, Type) = Status :-
|
|
( type_to_ctor_and_args(Type, _TypeCtor, Args) ->
|
|
(
|
|
type_has_user_defined_equality_pred(ModuleInfo, Type,
|
|
_UnifyCompare)
|
|
->
|
|
% XXX We can do better than this by examining
|
|
% what these preds actually do. Something
|
|
% similar needs to be sorted out for termination
|
|
% analysis as well, so we'll wait until that is
|
|
% done.
|
|
Status = may_modify_trail
|
|
;
|
|
Status = check_types(ModuleInfo, Args)
|
|
)
|
|
;
|
|
unexpected(this_file, "Unable to get ctor and args.")
|
|
).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Code for attaching trail usage information to goals
|
|
%
|
|
|
|
% Traverse the body of the procedure and attach will_not_modify trail
|
|
% features to the goal_infos of those procedure that cannot modify the
|
|
% trail.
|
|
%
|
|
:- pred annotate_proc(pred_proc_id::in,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
annotate_proc(PPId, !ModuleInfo, !IO) :-
|
|
some [!ProcInfo, !Body] (
|
|
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, !:ProcInfo),
|
|
proc_info_get_goal(!.ProcInfo, !:Body),
|
|
proc_info_get_vartypes(!.ProcInfo, VarTypes),
|
|
annotate_goal(VarTypes, !Body, _Status, !ModuleInfo, !IO),
|
|
proc_info_set_goal(!.Body, !ProcInfo),
|
|
module_info_set_pred_proc_info(PPId, PredInfo, !.ProcInfo, !ModuleInfo)
|
|
).
|
|
|
|
:- pred annotate_goal(vartypes::in, hlds_goal::in, hlds_goal::out,
|
|
trailing_status::out, module_info::in, module_info::out,
|
|
io::di, io::uo) is det.
|
|
|
|
annotate_goal(VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
|
|
!.Goal = GoalExpr0 - GoalInfo0,
|
|
annotate_goal_2(VarTypes, GoalInfo0, GoalExpr0, GoalExpr, Status,
|
|
!ModuleInfo, !IO),
|
|
( Status = will_not_modify_trail ->
|
|
goal_info_add_feature(will_not_modify_trail, GoalInfo0, GoalInfo)
|
|
;
|
|
GoalInfo = GoalInfo0
|
|
),
|
|
!:Goal = GoalExpr - GoalInfo.
|
|
|
|
:- pred annotate_goal_2(vartypes::in, hlds_goal_info::in,
|
|
hlds_goal_expr::in, hlds_goal_expr::out, trailing_status::out,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
|
|
!.Goal = conj(ConjType, Conjuncts0),
|
|
annotate_goal_list(VarTypes, Conjuncts0, Conjuncts, Status, !ModuleInfo,
|
|
!IO),
|
|
!:Goal = conj(ConjType, Conjuncts).
|
|
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
|
|
!.Goal = call(CallPredId, CallProcId, CallArgs, _, _, _),
|
|
CallPPId = proc(CallPredId, CallProcId),
|
|
module_info_pred_info(!.ModuleInfo, CallPredId, CallPredInfo),
|
|
(
|
|
pred_info_is_builtin(CallPredInfo)
|
|
->
|
|
Status = will_not_modify_trail
|
|
;
|
|
% 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 = may_modify_trail
|
|
;
|
|
% Handle library predicates whose trailing status
|
|
% can be looked up in the known procedure table.
|
|
pred_info_has_known_status(CallPredInfo, Status0)
|
|
->
|
|
Status = Status0
|
|
;
|
|
globals.io_lookup_bool_option(intermodule_analysis, IntermodAnalysis,
|
|
!IO),
|
|
(
|
|
IntermodAnalysis = yes,
|
|
pred_info_is_imported(CallPredInfo)
|
|
->
|
|
% NOTE: we set the value of SCC to a dummy value here. This is OK
|
|
% because it only needs a meaningful value when building the
|
|
% analysis files; it won't be used when compiling to target code.
|
|
SCC = [],
|
|
search_analysis_status(CallPPId, Result, AnalysisStatus, SCC,
|
|
!ModuleInfo, !IO),
|
|
|
|
% XXX We shouldn't be getting invalid analysis results at this
|
|
% stage so maybe we should just call unexpected/2 here?
|
|
( AnalysisStatus = invalid ->
|
|
Status = may_modify_trail
|
|
;
|
|
( Result = conditional ->
|
|
Status = check_vars(!.ModuleInfo, VarTypes, CallArgs)
|
|
;
|
|
Status = Result
|
|
)
|
|
)
|
|
;
|
|
% This time around we will be checking recursive calls as well.
|
|
check_call(!.ModuleInfo, VarTypes, CallPPId, CallArgs, Status)
|
|
)
|
|
).
|
|
annotate_goal_2(_VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
|
|
% XXX Use closure analysis results here.
|
|
!.Goal = generic_call(_, _, _, _),
|
|
Status = may_modify_trail.
|
|
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
|
|
!.Goal = switch(Var, CanFail, Cases0),
|
|
annotate_cases(VarTypes, Cases0, Cases, Status, !ModuleInfo, !IO),
|
|
!:Goal = switch(Var, CanFail, Cases).
|
|
annotate_goal_2(_VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
|
|
!.Goal = unify(_, _, _, Kind, _),
|
|
( Kind = complicated_unify(_, _, _) ->
|
|
unexpected(this_file, "complicated unify during trail usage analysis.")
|
|
;
|
|
true
|
|
),
|
|
Status = will_not_modify_trail.
|
|
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
|
|
!.Goal = disj(Disjuncts0),
|
|
annotate_goal_list(VarTypes, Disjuncts0, Disjuncts, Status,
|
|
!ModuleInfo, !IO),
|
|
!:Goal = disj(Disjuncts).
|
|
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
|
|
!.Goal = not(NegGoal0),
|
|
annotate_goal(VarTypes, NegGoal0, NegGoal, Status, !ModuleInfo, !IO),
|
|
!:Goal = not(NegGoal).
|
|
annotate_goal_2(VarTypes, OuterGoalInfo, !Goal, Status, !ModuleInfo, !IO) :-
|
|
!.Goal = scope(Reason, InnerGoal0),
|
|
annotate_goal(VarTypes, InnerGoal0, InnerGoal, Status0, !ModuleInfo, !IO),
|
|
InnerGoal = _ - InnerGoalInfo,
|
|
goal_info_get_code_model(InnerGoalInfo, InnerCodeModel),
|
|
goal_info_get_code_model(OuterGoalInfo, OuterCodeModel),
|
|
Status = scope_implies_trail_mod(InnerCodeModel, OuterCodeModel, Status0),
|
|
!:Goal = scope(Reason, InnerGoal).
|
|
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
|
|
!.Goal = if_then_else(Vars, If0, Then0, Else0),
|
|
annotate_goal(VarTypes, If0, If, IfStatus, !ModuleInfo, !IO),
|
|
annotate_goal(VarTypes, Then0, Then, ThenStatus, !ModuleInfo, !IO),
|
|
annotate_goal(VarTypes, Else0, Else, ElseStatus, !ModuleInfo, !IO),
|
|
(
|
|
IfStatus = will_not_modify_trail,
|
|
ThenStatus = will_not_modify_trail,
|
|
ElseStatus = will_not_modify_trail
|
|
->
|
|
Status = will_not_modify_trail
|
|
;
|
|
Status = may_modify_trail
|
|
),
|
|
!:Goal = if_then_else(Vars, If, Then, Else).
|
|
annotate_goal_2(_, _, !Goal, Status, !ModuleInfo, !IO) :-
|
|
!.Goal = foreign_proc(Attributes, _, _, _, _, _),
|
|
Status = attributes_imply_trail_mod(Attributes).
|
|
annotate_goal_2(_, _, shorthand(_), _, _, _, _, _, _) :-
|
|
unexpected(this_file, "shorthand goal").
|
|
|
|
:- pred annotate_goal_list(vartypes::in, hlds_goals::in,
|
|
hlds_goals::out, trailing_status::out, module_info::in,
|
|
module_info::out, io::di, io::uo) is det.
|
|
|
|
annotate_goal_list(VarTypes, !Goals, Status, !ModuleInfo, !IO) :-
|
|
list.map2_foldl2(annotate_goal(VarTypes), !Goals, Statuses, !ModuleInfo,
|
|
!IO),
|
|
list.foldl(combine_trailing_status, Statuses, will_not_modify_trail,
|
|
Status).
|
|
|
|
:- pred annotate_cases(vartypes::in, list(case)::in, list(case)::out,
|
|
trailing_status::out, module_info::in, module_info::out,
|
|
io::di, io::uo) is det.
|
|
|
|
annotate_cases(VarTypes, !Cases, Status, !ModuleInfo, !IO) :-
|
|
list.map2_foldl2(annotate_case(VarTypes), !Cases, Statuses, !ModuleInfo,
|
|
!IO),
|
|
list.foldl(combine_trailing_status, Statuses, will_not_modify_trail,
|
|
Status).
|
|
|
|
:- pred annotate_case(vartypes::in, case::in, case::out,
|
|
trailing_status::out, module_info::in, module_info::out,
|
|
io::di, io::uo) is det.
|
|
|
|
annotate_case(VarTypes, !Case, Status, !ModuleInfo, !IO) :-
|
|
!.Case = case(ConsId, Goal0),
|
|
annotate_goal(VarTypes, Goal0, Goal, Status, !ModuleInfo, !IO),
|
|
!:Case = case(ConsId, Goal).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Stuff for intermodule optimization
|
|
%
|
|
|
|
:- pred make_opt_int(module_info::in, io::di, io::uo) is det.
|
|
|
|
make_opt_int(ModuleInfo, !IO) :-
|
|
module_info_get_name(ModuleInfo, ModuleName),
|
|
module_name_to_file_name(ModuleName, ".opt.tmp", no, OptFileName, !IO),
|
|
globals.io_lookup_bool_option(verbose, Verbose, !IO),
|
|
maybe_write_string(Verbose, "% Appending trailing_info pragmas to `", !IO),
|
|
maybe_write_string(Verbose, OptFileName, !IO),
|
|
maybe_write_string(Verbose, "'...", !IO),
|
|
maybe_flush_output(Verbose, !IO),
|
|
io.open_append(OptFileName, OptFileRes, !IO),
|
|
(
|
|
OptFileRes = ok(OptFile),
|
|
io.set_output_stream(OptFile, OldStream, !IO),
|
|
module_info_get_trailing_info(ModuleInfo, TrailingInfo),
|
|
module_info_predids(ModuleInfo, PredIds),
|
|
list.foldl(write_pragma_trailing_info(ModuleInfo, TrailingInfo),
|
|
PredIds, !IO),
|
|
io.set_output_stream(OldStream, _, !IO),
|
|
io.close_output(OptFile, !IO),
|
|
maybe_write_string(Verbose, " done.\n", !IO)
|
|
;
|
|
OptFileRes = error(IOError),
|
|
maybe_write_string(Verbose, " failed!\n", !IO),
|
|
io.error_message(IOError, IOErrorMessage),
|
|
io.write_strings(["Error opening file `",
|
|
OptFileName, "' for output: ", IOErrorMessage], !IO),
|
|
io.set_exit_status(1, !IO)
|
|
).
|
|
|
|
write_pragma_trailing_info(ModuleInfo, TrailingInfo, PredId, !IO) :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
should_write_trailing_info(ModuleInfo, PredId, PredInfo, ShouldWrite),
|
|
(
|
|
ShouldWrite = yes,
|
|
ModuleName = pred_info_module(PredInfo),
|
|
Name = pred_info_name(PredInfo),
|
|
Arity = pred_info_orig_arity(PredInfo),
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
ProcIds = pred_info_procids(PredInfo),
|
|
list.foldl((pred(ProcId::in, !.IO::di, !:IO::uo) is det :-
|
|
proc_id_to_int(ProcId, ModeNum),
|
|
(
|
|
map.search(TrailingInfo, proc(PredId, ProcId), ProcTrailInfo),
|
|
ProcTrailInfo = proc_trailing_info(Status, _)
|
|
->
|
|
mercury_output_pragma_trailing_info(PredOrFunc,
|
|
qualified(ModuleName, Name), Arity,
|
|
ModeNum, Status, !IO)
|
|
;
|
|
true
|
|
)), ProcIds, !IO)
|
|
;
|
|
ShouldWrite = no
|
|
).
|
|
|
|
:- pred should_write_trailing_info(module_info::in, pred_id::in,
|
|
pred_info::in, bool::out) is det.
|
|
|
|
should_write_trailing_info(ModuleInfo, PredId, PredInfo, ShouldWrite) :-
|
|
pred_info_get_import_status(PredInfo, ImportStatus),
|
|
(
|
|
( ImportStatus = exported
|
|
; ImportStatus = opt_exported
|
|
),
|
|
not is_unify_or_compare_pred(PredInfo),
|
|
module_info_get_type_spec_info(ModuleInfo, TypeSpecInfo),
|
|
TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
|
|
not set.member(PredId, TypeSpecForcePreds),
|
|
%
|
|
% XXX Writing out pragmas for the automatically generated class
|
|
% instance methods causes the compiler to abort when it reads them
|
|
% back in.
|
|
%
|
|
pred_info_get_markers(PredInfo, Markers),
|
|
not check_marker(Markers, class_instance_method),
|
|
not check_marker(Markers, named_class_instance_method)
|
|
->
|
|
ShouldWrite = yes
|
|
;
|
|
ShouldWrite = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Stuff for the intermodule analysis framework
|
|
%
|
|
|
|
:- type trailing_analysis_answer
|
|
---> trailing_analysis_answer(trailing_status).
|
|
|
|
:- func analysis_name = string.
|
|
analysis_name = "trail_usage".
|
|
|
|
:- instance analysis(any_call, trailing_analysis_answer) where [
|
|
analysis_name(_, _) = analysis_name,
|
|
analysis_version_number(_, _) = 1,
|
|
preferred_fixpoint_type(_, _) = least_fixpoint,
|
|
bottom(_) = trailing_analysis_answer(will_not_modify_trail),
|
|
top(_) = trailing_analysis_answer(may_modify_trail)
|
|
].
|
|
|
|
:- instance answer_pattern(trailing_analysis_answer) where [].
|
|
:- instance partial_order(trailing_analysis_answer) where [
|
|
(more_precise_than(
|
|
trailing_analysis_answer(Status1),
|
|
trailing_analysis_answer(Status2)) :-
|
|
trailing_status_more_precise_than(Status1, Status2)),
|
|
equivalent(Status, Status)
|
|
].
|
|
|
|
:- pred trailing_status_more_precise_than(trailing_status::in,
|
|
trailing_status::in) is semidet.
|
|
|
|
trailing_status_more_precise_than(will_not_modify_trail, may_modify_trail).
|
|
trailing_status_more_precise_than(will_not_modify_trail, conditional).
|
|
trailing_status_more_precise_than(conditional, may_modify_trail).
|
|
|
|
:- instance to_string(trailing_analysis_answer) where [
|
|
func(to_string/1) is trailing_analysis_answer_to_string,
|
|
func(from_string/1) is trailing_analysis_answer_from_string
|
|
].
|
|
|
|
:- func trailing_analysis_answer_to_string(trailing_analysis_answer) = string.
|
|
|
|
trailing_analysis_answer_to_string(trailing_analysis_answer(Status)) = Str :-
|
|
trailing_status_to_string(Status, Str).
|
|
|
|
:- func trailing_analysis_answer_from_string(string) =
|
|
trailing_analysis_answer is semidet.
|
|
|
|
trailing_analysis_answer_from_string(Str) = trailing_analysis_answer(Status) :-
|
|
trailing_status_to_string(Status, Str).
|
|
|
|
:- pred trailing_status_to_string(trailing_status, string).
|
|
:- mode trailing_status_to_string(in, out) is det.
|
|
:- mode trailing_status_to_string(out, in) is semidet.
|
|
|
|
trailing_status_to_string(may_modify_trail, "may_modify_trail").
|
|
trailing_status_to_string(will_not_modify_trail, "will_not_modify_trail").
|
|
trailing_status_to_string(conditional, "conditional").
|
|
|
|
:- pred search_analysis_status(pred_proc_id::in,
|
|
trailing_status::out, analysis_status::out, scc::in,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
search_analysis_status(PPId, Result, AnalysisStatus, CallerSCC,
|
|
!ModuleInfo, !IO) :-
|
|
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
|
|
search_analysis_status_2(!.ModuleInfo, PPId, Result, AnalysisStatus,
|
|
CallerSCC, AnalysisInfo0, AnalysisInfo, !IO),
|
|
module_info_set_analysis_info(AnalysisInfo, !ModuleInfo).
|
|
|
|
:- pred search_analysis_status_2(module_info::in, pred_proc_id::in,
|
|
trailing_status::out, analysis_status::out, scc::in,
|
|
analysis_info::in, analysis_info::out, io::di, io::uo) is det.
|
|
|
|
search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus, CallerSCC,
|
|
!AnalysisInfo, !IO) :-
|
|
mmc_analysis.module_id_func_id(ModuleInfo, PPId, ModuleId, FuncId),
|
|
Call = any_call,
|
|
analysis.lookup_best_result(ModuleId, FuncId, Call,
|
|
MaybeBestStatus, !AnalysisInfo, !IO),
|
|
globals__io_lookup_bool_option(make_analysis_registry,
|
|
MakeAnalysisRegistry, !IO),
|
|
(
|
|
MaybeBestStatus = yes({BestCall, trailing_analysis_answer(Result),
|
|
AnalysisStatus}),
|
|
(
|
|
MakeAnalysisRegistry = yes,
|
|
record_dependencies(ModuleId, FuncId, BestCall,
|
|
ModuleInfo, CallerSCC, !AnalysisInfo)
|
|
;
|
|
MakeAnalysisRegistry = no
|
|
)
|
|
;
|
|
MaybeBestStatus = no,
|
|
% If we do not have any information about the callee procedure
|
|
% then assume that it modifies the trail.
|
|
top(Call) = Answer,
|
|
Answer = trailing_analysis_answer(Result),
|
|
module_is_local(mmc, ModuleId, IsLocal, !IO),
|
|
(
|
|
IsLocal = yes,
|
|
AnalysisStatus = suboptimal,
|
|
(
|
|
MakeAnalysisRegistry = yes,
|
|
analysis.record_result(ModuleId, FuncId,
|
|
Call, Answer, AnalysisStatus, !AnalysisInfo),
|
|
analysis.record_request(analysis_name, ModuleId, FuncId, Call,
|
|
!AnalysisInfo),
|
|
record_dependencies(ModuleId, FuncId, Call,
|
|
ModuleInfo, CallerSCC, !AnalysisInfo)
|
|
;
|
|
MakeAnalysisRegistry = no
|
|
)
|
|
;
|
|
IsLocal = no,
|
|
% We can't do any better anyway.
|
|
AnalysisStatus = optimal
|
|
)
|
|
).
|
|
|
|
% XXX if the procedures in CallerSCC definitely come from the
|
|
% same module then we don't need to record the dependency so many
|
|
% times, at least while we only have module-level granularity.
|
|
%
|
|
:- pred record_dependencies(module_id::in, func_id::in, Call::in,
|
|
module_info::in, scc::in, analysis_info::in, analysis_info::out)
|
|
is det <= call_pattern(Call).
|
|
|
|
record_dependencies(ModuleId, FuncId, Call,
|
|
ModuleInfo, CallerSCC, !AnalysisInfo) :-
|
|
list.foldl((pred(CallerPPId::in, Info0::in, Info::out) is det :-
|
|
mmc_analysis.module_id_func_id(ModuleInfo, CallerPPId,
|
|
CallerModuleId, _),
|
|
analysis.record_dependency(CallerModuleId,
|
|
analysis_name, ModuleId, FuncId, Call, Info0, Info)
|
|
), CallerSCC, !AnalysisInfo).
|
|
|
|
:- pred record_trailing_analysis_results(trailing_status::in,
|
|
analysis_status::in, scc::in,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
record_trailing_analysis_results(Status, ResultStatus, SCC, !ModuleInfo) :-
|
|
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
|
|
list.foldl(
|
|
record_trailing_analysis_result(!.ModuleInfo, Status, ResultStatus),
|
|
SCC, AnalysisInfo0, AnalysisInfo),
|
|
module_info_set_analysis_info(AnalysisInfo, !ModuleInfo).
|
|
|
|
:- pred record_trailing_analysis_result(module_info::in, trailing_status::in,
|
|
analysis_status::in, pred_proc_id::in,
|
|
analysis_info::in, analysis_info::out) is det.
|
|
|
|
record_trailing_analysis_result(ModuleInfo, Status, ResultStatus,
|
|
PPId @ proc(PredId, _ProcId), AnalysisInfo0, AnalysisInfo) :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
should_write_trailing_info(ModuleInfo, PredId, PredInfo, ShouldWrite),
|
|
(
|
|
ShouldWrite = yes,
|
|
mmc_analysis.module_id_func_id(ModuleInfo, PPId, ModuleId, FuncId),
|
|
analysis.record_result(ModuleId, FuncId, any_call,
|
|
trailing_analysis_answer(Status), ResultStatus,
|
|
AnalysisInfo0, AnalysisInfo)
|
|
;
|
|
ShouldWrite = no,
|
|
AnalysisInfo = AnalysisInfo0
|
|
).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Code for printing out debugging traces
|
|
%
|
|
|
|
:- pred dump_trail_usage_debug_info(module_info::in, scc::in,
|
|
trailing_status::in, io::di, io::uo) is det.
|
|
|
|
dump_trail_usage_debug_info(ModuleInfo, SCC, Status, !IO) :-
|
|
io.write_string("SCC: ", !IO),
|
|
io.write(Status, !IO),
|
|
io.nl(!IO),
|
|
output_proc_names(ModuleInfo, SCC, !IO),
|
|
io.nl(!IO).
|
|
|
|
:- pred output_proc_names(module_info::in, scc::in, io::di, io::uo) is det.
|
|
|
|
output_proc_names(ModuleInfo, SCC, !IO) :-
|
|
list.foldl(output_proc_name(ModuleInfo), SCC, !IO).
|
|
|
|
:- pred output_proc_name(module_info::in, pred_proc_id::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_proc_name(Moduleinfo, PPId, !IO) :-
|
|
Pieces = describe_one_proc_name(Moduleinfo, should_module_qualify, PPId),
|
|
Str = error_pieces_to_string(Pieces),
|
|
io.format("\t%s\n", [s(Str)], !IO).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "trailing_analysis.m".
|
|
|
|
%----------------------------------------------------------------------------%
|
|
:- end_module trailing_analysis.
|
|
%----------------------------------------------------------------------------%
|