[m-rev.] for review: structure sharing analysis using analysis framework
Peter Wang
novalazy at gmail.com
Tue Mar 25 15:08:17 AEDT 2008
Branches: main
Make the structure sharing analysis capable of using the intermodule analysis
framework.
This requires changes to the analysis framework. Structure sharing answer
patterns need information from the module_info and proc_info in order to be
compared. In Simon Taylor's original analysis framework implementation, this
would have been provided for by a `FuncInfo' parameter in the `partial_order'
typeclass. I removed it two years ago as it was causing difficulties which
couldn't be solved cleanly while the analysis framework was not specific to
the Mercury compiler. Also, there were no analyses at the time which needed
FuncInfos. Now that we do require it, and the analysis framework has been
made Mercury specific, we can restore the `FuncInfo' parameter.
Also make some more simplifications to the analysis framework.
compiler/analysis.m:
compiler/analysis.file.m:
Remove the `module_id' type and replace occurrences by `module_name'.
Remove "extra info" facilities. They were intended for storing
information needed by intermodule inlining and higher order
specialisation but now that information is in `.opt' files, even
when using `--intermodule-analysis'.
Change `func_id' from a string to a structured type so we can extract
its components easily.
Add a message argument to the `invalid_analysis_file' functor so when
we throw an exception due to being unable to parse a `.analysis'
we get a meaningful message.
Change the `.analysis' file format to account for the changes to
`module_id' and `func_id'. Bump the file version number.
Add a `FuncInfo' parameter to the `partial_order' typeclass, as
explained above.
Add a `no_func_info' dummy type.
Add a `get_func_info' method to the `analysis' framework. When
updating the analysis files after analysing a module, we need to be
able to materialise FuncInfos for each procedure in order to compare
its call or answer patterns. This is what couldn't be added cleanly
while the analysis framework was not specific to the Mercury compiler.
compiler/structure_sharing.analysis.m:
Make the structure sharing analysis capable of using the analysis
framework, i.e. use imported answers from the analysis registry,
record new answers, dependencies and requests, and keeping track of
the optimality of results during analysis.
compiler/structure_sharing.domain.m:
Add `sharing_as_and_status' to pair `sharing_as' with an
`analysis_status'.
Make `sharing_as_table' record the `analysis_status' alongside a
sharing domain. Update access predicates.
Move `sharing_as' into the interface section as it is needed by
structure_sharing.m to convert between `sharing_as' and
`structure_sharing_answer' values for the analysis framework.
When we can't look up the sharing result for an `:- external'
predicate, that should not be a sign that the analysis is non-optimal
since we can't get a better result by reanalysis.
Make special predicates be approximated by `bottom' sharing as we know
they don't introduce sharing.
Avoid an assertion failure in removing subsumed sharing pairs from a
sharing set.
compiler/ctgc.util.m:
Make `pred_requires_no_analysis' not succeed on special predicates
(unify, compare, index, init) which causes the analysis to assume all
possible sharing between its arguments, whereas we know that those
predicates don't introduce any sharing.
Also make `pred_requires_no_analysis' not succeed on `:- external'
predicates.
compiler/ctgc.selector.m:
Make type_on_path_2 fail instead of aborting if asked to select a
subtype which turns out to be existentially typed.
compiler/structure_reuse.direct.m:
Don't run direct structure reuse on compiler generated special
predicates. We need to handle them specifically now due to the change
to `pred_requires_no_analysis'.
compiler/structure_reuse.indirect.m:
Don't run indirect structure reuse on compiler generated special
predicates, as for the direct reuse pass.
Conform to change to `top_feedback'.
Change a semidet function to a predicate.
compiler/hlds_pred.m:
compiler/hlds_out.m:
Change `structure_sharing_info' to associate an analysis status with
the structure sharing domain of a procedure (if any). Add a type
`structure_sharing_domain_and_status' for this.
compiler/prog_data.m:
Make `top_feedback' a structured type instead of a string. Divide the
reasons that we might approximate structure sharing by `top' into
different classes.
compiler/exception_analysis.m:
compiler/tabling_analysis.m:
compiler/trailing_analysis.m:
Conform to analysis framework changes.
compiler/unused_args.m:
Conform to analysis framework changes.
Move the predicate arity from the call pattern into a FuncInfo,
where it belongs.
Bump the analysis version number.
compiler/prog_ctgc.m:
compiler/structure_reuse.direct.detect_garbage.m:
Conform to change to `top_feedback'.
compiler/make.dependencies.m:
compiler/make.module_target.m:
compiler/make.program_target.m:
compiler/make.util.m:
Conform to removal of `module_id' type.
compiler/mercury_compile.m:
Call mm_tabling_analysis, structure sharing and structure reuse passes
when making `.analysis' files.
Conform to removal of `module_id' type.
compiler/mmc_analysis.m:
Add structure sharing to the list of analyses.
Add `func_id_to_ppid'.
Conform to analysis framework changes.
compiler/ctgc.fixpoint_table.m:
Replace a semidet function by a predicate.
Index: compiler/analysis.file.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/analysis.file.m,v
retrieving revision 1.2
diff -u -r1.2 analysis.file.m
--- compiler/analysis.file.m 21 Feb 2008 04:22:40 -0000 1.2
+++ compiler/analysis.file.m 25 Mar 2008 03:39:02 -0000
@@ -17,75 +17,74 @@
:- interface.
- % read_module_overall_status(Compiler, ModuleId, MaybeModuleStatus, !IO)
+ % read_module_overall_status(Compiler, ModuleName, MaybeModuleStatus, !IO)
%
% Attempt to read the overall status from a module `.analysis' file.
% If the module has outstanding requests, then an overall status of
% `optimal' is downgraded to `suboptimal'.
%
-:- pred read_module_overall_status(Compiler::in, module_id::in,
+:- pred read_module_overall_status(Compiler::in, module_name::in,
maybe(analysis_status)::out, io::di, io::uo) is det <= compiler(Compiler).
- % read_module_analysis_results(AnalysisInfo, ModuleId,
- % OverallStatus, AnalysisResults, ExtraInfo, !IO)
+ % read_module_analysis_results(AnalysisInfo, ModuleName,
+ % OverallStatus, AnalysisResults, !IO)
%
- % Read the overall module status, analysis results and any extra info
- % from a `.analysis' file.
+ % Read the overall module status and analysis results from a `.analysis'
+ % file.
%
-:- pred read_module_analysis_results(analysis_info::in, module_id::in,
+:- pred read_module_analysis_results(analysis_info::in, module_name::in,
analysis_status::out, module_analysis_map(some_analysis_result)::out,
- module_extra_info_map::out, io::di, io::uo) is det.
+ io::di, io::uo) is det.
- % write_module_analysis_results(AnalysisInfo, ModuleId,
- % OverallStatus, AnalysisResults, ExtraInfo, !IO)
+ % write_module_analysis_results(AnalysisInfo, ModuleName,
+ % OverallStatus, AnalysisResults, !IO)
%
- % Write the overall module status, analysis results and extra info
- % to a `.analysis' file.
+ % Write the overall module status and analysis results to a `.analysis'
+ % file.
%
:- pred write_module_analysis_results(analysis_info::in,
- module_id::in, analysis_status::in,
- module_analysis_map(some_analysis_result)::in,
- module_extra_info_map::in, io::di, io::uo) is det.
+ module_name::in, analysis_status::in,
+ module_analysis_map(some_analysis_result)::in, io::di, io::uo) is det.
- % read_module_analysis_requests(AnalysisInfo, ModuleId, ModuleRequests,
+ % read_module_analysis_requests(AnalysisInfo, ModuleName, ModuleRequests,
% !IO)
%
% Read outstanding analysis requests to a module from disk.
%
:- pred read_module_analysis_requests(analysis_info::in,
- module_id::in, module_analysis_map(analysis_request)::out,
+ module_name::in, module_analysis_map(analysis_request)::out,
io::di, io::uo) is det.
- % write_module_analysis_requests(AnalysisInfo, ModuleId, ModuleRequests,
+ % write_module_analysis_requests(AnalysisInfo, ModuleName, ModuleRequests,
% !IO)
%
% Write outstanding analysis requests for a module to disk.
%
:- pred write_module_analysis_requests(analysis_info::in,
- module_id::in, module_analysis_map(analysis_request)::in,
+ module_name::in, module_analysis_map(analysis_request)::in,
io::di, io::uo) is det.
- % read_module_imdg(AnalysisInfo, ModuleId, ModuleEntries, !IO)
+ % read_module_imdg(AnalysisInfo, ModuleName, ModuleEntries, !IO)
%
% Read the intermodule dependencies graph entries for a module from disk.
%
-:- pred read_module_imdg(analysis_info::in, module_id::in,
+:- pred read_module_imdg(analysis_info::in, module_name::in,
module_analysis_map(imdg_arc)::out, io::di, io::uo) is det.
- % write_module_imdg(AnalysisInfo, ModuleId, ModuleEntries, !IO)
+ % write_module_imdg(AnalysisInfo, ModuleName, ModuleEntries, !IO)
%
% Write the intermodule dependencies graph entries for a module
% to disk.
%
-:- pred write_module_imdg(analysis_info::in, module_id::in,
+:- pred write_module_imdg(analysis_info::in, module_name::in,
module_analysis_map(imdg_arc)::in, io::di, io::uo) is det.
- % empty_request_file(AnalysisInfo, ModuleId, !IO)
+ % empty_request_file(AnalysisInfo, ModuleName, !IO)
%
% Delete the file containing outstanding analysis requests for a module.
% This means all the analysis requests should have been satisfied already.
%
-:- pred empty_request_file(analysis_info::in, module_id::in,
+:- pred empty_request_file(analysis_info::in, module_name::in,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -107,11 +106,8 @@
%
% version_number.
% module_status.
-% extra_info(key, extra_info).
% analysis_name(analysis_version, func_id, call_pattern, answer_pattern,
% result_status).
-%
-% All extra_infos, if any, must come before the analysis results.
% The format of an IMDG file is:
%
@@ -124,11 +120,11 @@
% analysis_name(analysis_version, func_id, call_pattern).
:- type invalid_analysis_file
- ---> invalid_analysis_file.
+ ---> invalid_analysis_file(string).
:- func version_number = int.
-version_number = 2.
+version_number = 3.
:- func analysis_registry_suffix = string.
@@ -144,15 +140,15 @@
%-----------------------------------------------------------------------------%
-read_module_overall_status(Compiler, ModuleId, MaybeModuleStatus, !IO) :-
- module_id_to_read_file_name(Compiler, ModuleId, analysis_registry_suffix,
+read_module_overall_status(Compiler, ModuleName, MaybeModuleStatus, !IO) :-
+ module_name_to_read_file_name(Compiler, ModuleName, analysis_registry_suffix,
MaybeAnalysisFileName, !IO),
(
MaybeAnalysisFileName = ok(AnalysisFileName),
read_module_overall_status_2(AnalysisFileName, MaybeModuleStatus0,
!IO),
( MaybeModuleStatus0 = yes(optimal) ->
- module_id_to_read_file_name(Compiler, ModuleId, request_suffix,
+ module_name_to_read_file_name(Compiler, ModuleName, request_suffix,
MaybeRequestFileName, !IO),
(
% There are outstanding requests for this module.
@@ -206,31 +202,30 @@
%-----------------------------------------------------------------------------%
-read_module_analysis_results(Info, ModuleId, ModuleStatus, ModuleResults,
- ExtraInfo, !IO) :-
+read_module_analysis_results(Info, ModuleName, ModuleStatus, ModuleResults,
+ !IO) :-
% If the module's overall status is `invalid' then at least one of its
% results is invalid. However, we can't just discard the results as we
% want to know which results change after we reanalyse the module.
Compiler = Info ^ compiler,
- module_id_to_read_file_name(Compiler, ModuleId, analysis_registry_suffix,
- MaybeAnalysisFileName, !IO),
+ module_name_to_read_file_name(Compiler, ModuleName,
+ analysis_registry_suffix, MaybeAnalysisFileName, !IO),
(
MaybeAnalysisFileName = ok(AnalysisFileName),
read_module_analysis_results_2(Compiler, AnalysisFileName,
- ModuleStatus, ModuleResults, ExtraInfo, !IO)
+ ModuleStatus, ModuleResults, !IO)
;
MaybeAnalysisFileName = error(_),
ModuleStatus = optimal,
- ModuleResults = map.init,
- ExtraInfo = map.init
+ ModuleResults = map.init
).
:- pred read_module_analysis_results_2(Compiler::in, string::in,
analysis_status::out, module_analysis_map(some_analysis_result)::out,
- module_extra_info_map::out, io::di, io::uo) is det <= compiler(Compiler).
+ io::di, io::uo) is det <= compiler(Compiler).
read_module_analysis_results_2(Compiler, AnalysisFileName,
- ModuleStatus, ModuleResults, ExtraInfo, !IO) :-
+ ModuleStatus, ModuleResults, !IO) :-
ModuleResults0 = map.init,
io.open_input(AnalysisFileName, OpenResult, !IO),
(
@@ -244,32 +239,22 @@
check_analysis_file_version_number(!IO),
read_module_status(ModuleStatus, !IO),
- read_module_extra_infos(map.init, ExtraInfo, MaybeFirstResultEntry,
- !IO),
+ promise_only_solution_io(
+ (pred(Results2::out, !.IO::di, !:IO::uo) is cc_multi :-
+ try_io((pred(Results1::out, !.IO::di, !:IO::uo) is det :-
+ read_analysis_file_2(parse_result_entry(Compiler),
+ ModuleResults0, Results1, !IO)
+ ), Results2, !IO)
+ ), Results, !IO),
(
- MaybeFirstResultEntry = yes(FirstResultEntry),
- ParseEntry = parse_result_entry(Compiler),
- promise_only_solution_io(
- (pred(Results3::out, !.IO::di, !:IO::uo) is cc_multi :-
- try_io((pred(Results2::out, !.IO::di, !:IO::uo) is det :-
- ParseEntry(FirstResultEntry, ModuleResults0, Results1),
- read_analysis_file_2(ParseEntry, Results1, Results2,
- !IO)
- ), Results3, !IO)
- ), Results, !IO),
- (
- Results = succeeded(ModuleResults)
- ;
- Results = failed,
- ModuleResults = ModuleResults0
- ;
- Results = exception(_),
- % XXX Report error.
- ModuleResults = ModuleResults0
- )
+ Results = succeeded(ModuleResults)
+ ;
+ Results = failed,
+ ModuleResults = ModuleResults0
;
- MaybeFirstResultEntry = no,
- ModuleResults = map.init
+ Results = exception(_),
+ % XXX Report error.
+ ModuleResults = ModuleResults0
),
io.set_input_stream(OldStream, _, !IO),
io.close_input(Stream, !IO)
@@ -281,8 +266,7 @@
io.nl(!IO)
), !IO),
ModuleStatus = optimal,
- ModuleResults = ModuleResults0,
- ExtraInfo = map.init
+ ModuleResults = ModuleResults0
).
:- pred read_module_status(analysis_status::out, io::di, io::uo) is det.
@@ -293,10 +277,12 @@
( analysis_status_to_string(Status0, String) ->
Status = Status0
;
- throw(invalid_analysis_file)
+ Msg = "expected analysis status: " ++ String,
+ throw(invalid_analysis_file(Msg))
)
;
- throw(invalid_analysis_file)
+ Msg = "parser.read_term: " ++ string(TermResult),
+ throw(invalid_analysis_file(Msg))
).
:- pred analysis_status_to_string(analysis_status, string).
@@ -307,38 +293,6 @@
analysis_status_to_string(suboptimal, "suboptimal").
analysis_status_to_string(optimal, "optimal").
-:- pred read_module_extra_infos(module_extra_info_map::in,
- module_extra_info_map::out, maybe(term)::out, io::di, io::uo) is det.
-
-read_module_extra_infos(ExtraInfo0, ExtraInfo, MaybeFirstResultEntry, !IO) :-
- parser.read_term(TermResult, !IO),
- (
- TermResult = eof,
- ExtraInfo = ExtraInfo0,
- MaybeFirstResultEntry = no
- ;
- TermResult = error(_, _),
- throw(invalid_analysis_file)
- ;
- TermResult = term(_, Term),
- ( Term = term.functor(atom("extra_info"), Args, _) ->
- (
- Args = [KeyTerm, ValueTerm],
- KeyTerm = term.functor(string(Key), [], _),
- ValueTerm = term.functor(string(Value), [], _)
- ->
- map.det_insert(ExtraInfo0, Key, Value, ExtraInfo1),
- read_module_extra_infos(ExtraInfo1, ExtraInfo,
- MaybeFirstResultEntry, !IO)
- ;
- throw(invalid_analysis_file)
- )
- ;
- ExtraInfo = ExtraInfo0,
- MaybeFirstResultEntry = yes(Term)
- )
- ).
-
:- pred parse_result_entry(Compiler::in)
`with_type` parse_entry(module_analysis_map(some_analysis_result))
`with_inst` parse_entry <= compiler(Compiler).
@@ -348,7 +302,7 @@
Term = term.functor(term.atom(AnalysisName),
[VersionNumberTerm, FuncIdTerm,
CallPatternTerm, AnswerPatternTerm, StatusTerm], _),
- FuncIdTerm = term.functor(term.string(FuncId), [], _),
+ term_to_type(FuncIdTerm, FuncId),
CallPatternTerm = term.functor(
term.string(CallPatternString), [], _),
AnswerPatternTerm = term.functor(
@@ -373,25 +327,26 @@
;
AnalysisResults1 = map.init
),
- ( FuncResults0 = map.search(AnalysisResults1, FuncId) ->
+ ( map.search(AnalysisResults1, FuncId, FuncResults0) ->
FuncResults = [Result | FuncResults0]
;
FuncResults = [Result]
),
- Results = map.set(Results0, AnalysisName,
- map.set(AnalysisResults1, FuncId, FuncResults))
- ;
+ map.set(AnalysisResults1, FuncId, FuncResults, AnalysisResults),
+ map.set(Results0, AnalysisName, AnalysisResults, Results)
+ ;
% Ignore results with an out-of-date version number.
Results = Results0
)
;
- throw(invalid_analysis_file)
+ Msg = "failed to parse result entry: " ++ string(Term),
+ throw(invalid_analysis_file(Msg))
).
%-----------------------------------------------------------------------------%
-read_module_analysis_requests(Info, ModuleId, ModuleRequests, !IO) :-
- read_analysis_file(Info ^ compiler, ModuleId, request_suffix,
+read_module_analysis_requests(Info, ModuleName, ModuleRequests, !IO) :-
+ read_analysis_file(Info ^ compiler, ModuleName, request_suffix,
parse_request_entry(Info ^ compiler),
map.init, ModuleRequests, !IO).
@@ -403,7 +358,7 @@
(
Term = term.functor(term.atom(AnalysisName),
[VersionNumberTerm, FuncIdTerm, CallPatternTerm], _),
- FuncIdTerm = term.functor(term.string(FuncId), [], _),
+ term_to_type(FuncIdTerm, FuncId),
CallPatternTerm = term.functor(
term.string(CallPatternString), [], _),
analysis_type(_ : unit(Call), _ : unit(Answer)) =
@@ -421,25 +376,26 @@
;
AnalysisRequests1 = map.init
),
- ( FuncRequests0 = map.search(AnalysisRequests1, FuncId) ->
+ ( map.search(AnalysisRequests1, FuncId, FuncRequests0) ->
FuncRequests = [Result | FuncRequests0]
;
FuncRequests = [Result]
),
- Requests = map.set(Requests0, AnalysisName,
- map.set(AnalysisRequests1, FuncId, FuncRequests))
+ map.set(AnalysisRequests1, FuncId, FuncRequests, AnalysisRequests),
+ map.set(Requests0, AnalysisName, AnalysisRequests, Requests)
;
% Ignore requests with an out-of-date version number.
Requests = Requests0
)
;
- throw(invalid_analysis_file)
+ Msg = "failed to parse request entry: " ++ string(Term),
+ throw(invalid_analysis_file(Msg))
).
%-----------------------------------------------------------------------------%
-read_module_imdg(Info, ModuleId, ModuleEntries, !IO) :-
- read_analysis_file(Info ^ compiler, ModuleId, imdg_suffix,
+read_module_imdg(Info, ModuleName, ModuleEntries, !IO) :-
+ read_analysis_file(Info ^ compiler, ModuleName, imdg_suffix,
parse_imdg_arc(Info ^ compiler),
map.init, ModuleEntries, !IO).
@@ -449,11 +405,11 @@
parse_imdg_arc(Compiler, Term, Arcs0, Arcs) :-
(
- Term = term.functor(atom("->"),
- [term.functor(string(DependentModule), [], _), ResultTerm], _),
+ Term = term.functor(atom("->"), [DependentModuleTerm, ResultTerm], _),
+ term_to_type(DependentModuleTerm, DependentModule),
ResultTerm = functor(atom(AnalysisName),
[VersionNumberTerm, FuncIdTerm, CallPatternTerm], _),
- FuncIdTerm = term.functor(term.string(FuncId), [], _),
+ term_to_type(FuncIdTerm, FuncId),
CallPatternTerm = functor(string(CallPatternString), [], _),
analysis_type(_ : unit(Call), _ : unit(Answer))
= analyses(Compiler, AnalysisName),
@@ -470,13 +426,13 @@
;
AnalysisArcs1 = map.init
),
- ( FuncArcs0 = map.search(AnalysisArcs1, FuncId) ->
+ ( map.search(AnalysisArcs1, FuncId, FuncArcs0) ->
FuncArcs = [Arc | FuncArcs0]
;
FuncArcs = [Arc]
),
- Arcs = map.set(Arcs0, AnalysisName,
- map.set(AnalysisArcs1, FuncId, FuncArcs))
+ map.set(AnalysisArcs1, FuncId, FuncArcs, AnalysisArcs),
+ map.set(Arcs0, AnalysisName, AnalysisArcs, Arcs)
;
% Ignore results with an out-of-date version number.
% XXX: is that the right thing to do?
@@ -484,7 +440,8 @@
Arcs = Arcs0
)
;
- throw(invalid_analysis_file)
+ Msg = "failed to parse IMDG arc: " ++ string(Term),
+ throw(invalid_analysis_file(Msg))
).
%-----------------------------------------------------------------------------%
@@ -495,13 +452,13 @@
:- type parse_entry(T) == pred(term, T, T).
:- inst parse_entry == (pred(in, in, out) is det).
-:- pred read_analysis_file(Compiler::in, module_id::in, string::in,
+:- pred read_analysis_file(Compiler::in, module_name::in, string::in,
parse_entry(T)::in(parse_entry), T::in, T::out, io::di, io::uo) is det
<= compiler(Compiler).
-read_analysis_file(Compiler, ModuleId, Suffix, ParseEntry,
+read_analysis_file(Compiler, ModuleName, Suffix, ParseEntry,
ModuleResults0, ModuleResults, !IO) :-
- module_id_to_read_file_name(Compiler, ModuleId, Suffix,
+ module_name_to_read_file_name(Compiler, ModuleName, Suffix,
MaybeAnalysisFileName, !IO),
(
MaybeAnalysisFileName = ok(AnalysisFileName),
@@ -513,7 +470,7 @@
io.write_string("Couldn't open ", !IO),
io.write_string(Suffix, !IO),
io.write_string(" for module ", !IO),
- io.write_string(ModuleId, !IO),
+ io.write(ModuleName, !IO),
io.write_string(": ", !IO),
io.write_string(Message, !IO),
io.nl(!IO)
@@ -574,7 +531,8 @@
->
true
;
- throw(invalid_analysis_file)
+ Msg = "bad analysis file version: " ++ string(TermResult),
+ throw(invalid_analysis_file(Msg))
).
:- pred read_analysis_file_2(parse_entry(T)::in(parse_entry), T::in, T::out,
@@ -590,32 +548,25 @@
TermResult = eof,
Results = Results0
;
- TermResult = error(_, _),
- throw(invalid_analysis_file)
+ TermResult = error(Msg, _),
+ throw(invalid_analysis_file(Msg))
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-write_module_analysis_results(Info, ModuleId, ModuleStatus, ModuleResults,
- ExtraInfo, !IO) :-
+write_module_analysis_results(Info, ModuleName, ModuleStatus, ModuleResults,
+ !IO) :-
debug_msg((pred(!.IO::di, !:IO::uo) is det :-
io.write_string("% Writing module analysis results for ", !IO),
- io.write_string(ModuleId, !IO),
+ io.write(ModuleName, !IO),
io.nl(!IO)
), !IO),
- WriteHeader = write_module_status_and_extra_info(ModuleStatus, ExtraInfo),
+ WriteHeader = write_module_status(ModuleStatus),
write_analysis_file(Info ^ compiler,
- ModuleId, analysis_registry_suffix,
+ ModuleName, analysis_registry_suffix,
WriteHeader, write_result_entry, ModuleResults, !IO).
-:- pred write_module_status_and_extra_info(analysis_status::in,
- module_extra_info_map::in, io::di, io::uo) is det.
-
-write_module_status_and_extra_info(Status, ExtraInfo, !IO) :-
- write_module_status(Status, !IO),
- map.foldl(write_extra_info, ExtraInfo, !IO).
-
:- pred write_module_status(analysis_status::in, io::di, io::uo) is det.
write_module_status(Status, !IO) :-
@@ -623,15 +574,6 @@
Term = functor(atom(String), [], context_init),
analysis_status_to_string(Status, String).
-:- pred write_extra_info(extra_info_key::in, string::in,
- io::di, io::uo) is det.
-
-write_extra_info(Key, Value, !IO) :-
- term_io.write_term_nl(varset.init : varset, Term, !IO),
- Term = functor(atom("extra_info"), [KeyTerm, ValueTerm], context_init),
- KeyTerm = functor(string(Key), [], context_init),
- ValueTerm = functor(string(Value), [], context_init).
-
:- pred write_result_entry
`with_type` write_entry(some_analysis_result)
`with_inst` write_entry.
@@ -643,7 +585,7 @@
term_io.write_term_nl(varset.init : varset,
functor(atom(AnalysisName), [
functor(integer(VersionNumber), [], context_init),
- functor(string(FuncId), [], context_init),
+ type_to_term(FuncId),
functor(string(to_string(Call)), [], context_init),
functor(string(to_string(Answer)), [], context_init),
functor(string(StatusString), [], context_init)
@@ -651,9 +593,9 @@
%-----------------------------------------------------------------------------%
-write_module_analysis_requests(Info, ModuleId, ModuleRequests, !IO) :-
+write_module_analysis_requests(Info, ModuleName, ModuleRequests, !IO) :-
Compiler = Info ^ compiler,
- module_id_to_write_file_name(Compiler, ModuleId, request_suffix,
+ module_name_to_write_file_name(Compiler, ModuleName, request_suffix,
AnalysisFileName, !IO),
debug_msg((pred(!.IO::di, !:IO::uo) is det :-
io.write_string("% Writing module analysis requests to ", !IO),
@@ -720,14 +662,14 @@
term_io.write_term_nl(varset.init : varset,
functor(atom(AnalysisName), [
functor(integer(VersionNumber), [], context_init),
- functor(string(FuncId), [], context_init),
+ type_to_term(FuncId),
functor(string(to_string(Call)), [], context_init)
], context_init), !IO).
%-----------------------------------------------------------------------------%
-write_module_imdg(Info, ModuleId, ModuleEntries, !IO) :-
- write_analysis_file(Info ^ compiler, ModuleId, imdg_suffix, nop,
+write_module_imdg(Info, ModuleName, ModuleEntries, !IO) :-
+ write_analysis_file(Info ^ compiler, ModuleName, imdg_suffix, nop,
write_imdg_arc(Info ^ compiler), ModuleEntries, !IO).
:- pred write_imdg_arc(Compiler::in)
@@ -747,14 +689,14 @@
),
term_io.write_term_nl(varset.init : varset,
functor(atom("->"), [
- functor(string(DependentModule), [], context_init),
+ type_to_term(DependentModule),
ResultTerm
], context_init), !IO),
ResultTerm = functor(atom(AnalysisName), [
functor(integer(VersionNumber), [], context_init),
- functor(string(FuncId), [], context_init),
+ type_to_term(FuncId),
functor(string(to_string(Call)), [], context_init)
- ], context_init).
+ ], context_init).
%-----------------------------------------------------------------------------%
@@ -764,14 +706,14 @@
:- type write_entry(T) == pred(analysis_name, func_id, T, io, io).
:- inst write_entry == (pred(in, in, in, di, uo) is det).
-:- pred write_analysis_file(Compiler::in, module_id::in, string::in,
+:- pred write_analysis_file(Compiler::in, module_name::in, string::in,
write_header::in(write_header),
write_entry(T)::in(write_entry), module_analysis_map(T)::in,
io::di, io::uo) is det <= compiler(Compiler).
-write_analysis_file(Compiler, ModuleId, Suffix, WriteHeader, WriteEntry,
+write_analysis_file(Compiler, ModuleName, Suffix, WriteHeader, WriteEntry,
ModuleResults, !IO) :-
- module_id_to_write_file_name(Compiler, ModuleId, Suffix,
+ module_name_to_write_file_name(Compiler, ModuleName, Suffix,
AnalysisFileName, !IO),
write_analysis_file(AnalysisFileName, WriteHeader, WriteEntry,
ModuleResults, !IO).
@@ -820,8 +762,8 @@
%-----------------------------------------------------------------------------%
-empty_request_file(Info, ModuleId, !IO) :-
- module_id_to_write_file_name(Info ^ compiler, ModuleId, request_suffix,
+empty_request_file(Info, ModuleName, !IO) :-
+ module_name_to_write_file_name(Info ^ compiler, ModuleName, request_suffix,
RequestFileName, !IO),
debug_msg((pred(!.IO::di, !:IO::uo) is det :-
io.write_string("% Removing request file ", !IO),
Index: compiler/analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/analysis.m,v
retrieving revision 1.2
diff -u -r1.2 analysis.m
--- compiler/analysis.m 21 Feb 2008 04:22:40 -0000 1.2
+++ compiler/analysis.m 25 Mar 2008 03:39:02 -0000
@@ -22,6 +22,12 @@
:- module analysis.
:- interface.
+:- import_module hlds.
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+:- import_module mdbcomp.
+:- import_module mdbcomp.prim_data.
+
:- import_module bool.
:- import_module io.
:- import_module list.
@@ -40,35 +46,34 @@
%
func analyses(Compiler, analysis_name) = analysis_type is semidet,
- % module_id_to_read_file_name(Compiler, ModuleId, Ext, FileName)
+ % module_name_to_read_file_name(Compiler, ModuleName, Ext, FileName)
%
- pred module_id_to_read_file_name(Compiler::in, module_id::in,
+ pred module_name_to_read_file_name(Compiler::in, module_name::in,
string::in, maybe_error(string)::out, io::di, io::uo) is det,
- % module_id_to_write_file_name(Compiler, ModuleId, Ext, FileName)
+ % module_name_to_write_file_name(Compiler, ModuleName, Ext, FileName)
%
- pred module_id_to_write_file_name(Compiler::in, module_id::in,
+ pred module_name_to_write_file_name(Compiler::in, module_name::in,
string::in, string::out, io::di, io::uo) is det
].
-:- type module_id == string.
-
:- type analysis_name == string.
:- type analysis_type
- ---> some [Call, Answer]
+ ---> some [FuncInfo, Call, Answer]
analysis_type(
unit(Call),
unit(Answer)
- ) => analysis(Call, Answer).
+ ) => analysis(FuncInfo, Call, Answer).
% An analysis is defined by a type describing call patterns and
% a type defining answer patterns. If the analysis needs to store
% more information about the function being analysed (e.g. arity)
% it should be stored as part of the type for call patterns.
%
-:- typeclass analysis(Call, Answer) <=
- (call_pattern(Call), answer_pattern(Answer))
+:- typeclass analysis(FuncInfo, Call, Answer)
+ <= (call_pattern(FuncInfo, Call),
+ answer_pattern(FuncInfo, Answer))
where
[
func analysis_name(Call::unused, Answer::unused) =
@@ -84,13 +89,11 @@
func preferred_fixpoint_type(Call::unused, Answer::unused) =
(fixpoint_type::out) is det,
- % `top' and `bottom' should not really depend on the call pattern.
- % However some analyses may choose to store extra information about
- % the function in their `Call' types that might be needed for the
- % answer pattern.
- %
- func bottom(Call) = Answer,
- func top(Call) = Answer
+ func bottom(FuncInfo::in, Call::unused) = (Answer::out) is det,
+ func top(FuncInfo::in, Call::unused) = (Answer::out) is det,
+
+ pred get_func_info(module_info::in, module_name::in, func_id::in,
+ Call::unused, Answer::unused, FuncInfo::out) is det
].
:- type fixpoint_type
@@ -102,19 +105,15 @@
% Start at `top'.
% Can stop at any time.
-:- typeclass call_pattern(Call)
- <= (partial_order(Call), to_string(Call)) where [].
-
-:- typeclass answer_pattern(Answer)
- <= (partial_order(Answer), to_string(Answer)) where [].
-
- % Extra information may be stored in a module's `.analysis' file, apart
- % from the analysis results. This information is indexed by a string key.
- % The extra information must be convertable to/from a string.
- %
-:- type extra_info_key == string.
-
-:- typeclass extra_info(ExtraInfo) <= to_string(ExtraInfo) where [].
+:- typeclass call_pattern(FuncInfo, Call)
+ <= (partial_order(FuncInfo, Call),
+ to_string(Call))
+ where [].
+
+:- typeclass answer_pattern(FuncInfo, Answer)
+ <= (partial_order(FuncInfo, Answer),
+ to_string(Answer))
+ where [].
:- type analysis_result(Call, Answer)
---> analysis_result(
@@ -123,9 +122,12 @@
ar_status :: analysis_status
).
-:- typeclass partial_order(T) where [
- pred more_precise_than(T::in, T::in) is semidet,
- pred equivalent(T::in, T::in) is semidet
+:- typeclass partial_order(FuncInfo, T)
+ <= (T -> FuncInfo)
+ where
+[
+ pred more_precise_than(FuncInfo::in, T::in, T::in) is semidet,
+ pred equivalent(FuncInfo::in, T::in, T::in) is semidet
].
:- typeclass to_string(S) where [
@@ -133,14 +135,17 @@
func from_string(string) = S is semidet
].
+:- type no_func_info
+ ---> no_func_info.
+
% A call pattern that can be used by analyses that do not need
% finer granularity.
%
:- type any_call
---> any_call.
-:- instance call_pattern(any_call).
-:- instance partial_order(any_call).
+:- instance call_pattern(no_func_info, any_call).
+:- instance partial_order(no_func_info, any_call).
:- instance to_string(any_call).
% The status of a module or a specific analysis result.
@@ -156,7 +161,13 @@
% This will need to encode language specific details like whether
% it is a predicate or a function, and the arity and mode number.
-:- type func_id == string.
+:- type func_id
+ ---> func_id(
+ fid_pf :: pred_or_func,
+ fid_name :: string,
+ fid_arity :: int,
+ fid_mode :: proc_id
+ ).
% Holds information used while analysing a module.
:- type analysis_info.
@@ -170,9 +181,9 @@
% N.B. Newly recorded results will NOT be found. This is intended
% for looking up results from _other_ modules.
%
-:- pred lookup_results(analysis_info::in, module_id::in, func_id::in,
+:- pred lookup_results(analysis_info::in, module_name::in, func_id::in,
list(analysis_result(Call, Answer))::out) is det
- <= analysis(Call, Answer).
+ <= analysis(FuncInfo, Call, Answer).
% Look up all results for a given function and call pattern CP such
% that the results have call patterns CP' that are equivalent to CP
@@ -181,9 +192,10 @@
% N.B. Newly recorded results will NOT be found. This is intended
% for looking up results from _other_ modules.
%
-:- pred lookup_matching_results(analysis_info::in, module_id::in, func_id::in,
- Call::in, list(analysis_result(Call, Answer))::out) is det
- <= analysis(Call, Answer).
+:- pred lookup_matching_results(analysis_info::in, module_name::in,
+ func_id::in, FuncInfo::in, Call::in,
+ list(analysis_result(Call, Answer))::out) is det
+ <= analysis(FuncInfo, Call, Answer).
% Look up the best result matching a given call.
%
@@ -195,89 +207,77 @@
% responsibility to request a more precise analysis from the called module,
% using `record_request'.
%
-:- pred lookup_best_result(analysis_info::in, module_id::in, func_id::in,
- Call::in, maybe(analysis_result(Call, Answer))::out) is det
- <= analysis(Call, Answer).
+:- pred lookup_best_result(analysis_info::in, module_name::in, func_id::in,
+ FuncInfo::in, Call::in, maybe(analysis_result(Call, Answer))::out) is det
+ <= analysis(FuncInfo, Call, Answer).
% Record an analysis result for a (usually local) function.
%
% XXX At the moment the result is assumed to be for a function local to
% the currently-compiled module and things will probably break if it isn't.
%
-:- pred record_result(module_id::in, func_id::in, Call::in, Answer::in,
+:- pred record_result(module_name::in, func_id::in, Call::in, Answer::in,
analysis_status::in, analysis_info::in, analysis_info::out) is det
- <= analysis(Call, Answer).
+ <= analysis(FuncInfo, Call, Answer).
% Record the dependency of a module on the analysis result of another
% module.
%
-:- pred record_dependency(module_id::in, analysis_name::in, module_id::in,
+:- pred record_dependency(module_name::in, analysis_name::in, module_name::in,
func_id::in, Call::in, analysis_info::in, analysis_info::out) is det
- <= call_pattern(Call).
+ <= call_pattern(FuncInfo, Call).
% Lookup all the requests for a given (usually local) function.
%
-:- pred lookup_requests(analysis_info::in, analysis_name::in, module_id::in,
+:- pred lookup_requests(analysis_info::in, analysis_name::in, module_name::in,
func_id::in, list(Call)::out) is det
- <= call_pattern(Call).
+ <= call_pattern(FuncInfo, Call).
% Record a request for a function in an imported module.
%
-:- pred record_request(analysis_name::in, module_id::in, func_id::in,
+:- pred record_request(analysis_name::in, module_name::in, func_id::in,
Call::in, analysis_info::in, analysis_info::out) is det
- <= call_pattern(Call).
-
-%-----------------------------------------------------------------------------%
-
- % Lookup extra information about a module, using the key given.
- %
-:- pred lookup_module_extra_info(analysis_info::in, module_id::in,
- extra_info_key::in, maybe(ExtraInfo)::out) is det
- <= extra_info(ExtraInfo).
-
- % Record extra information about a module under the given key.
- %
-:- pred record_module_extra_info(module_id::in, extra_info_key::in,
- ExtraInfo::in, analysis_info::in, analysis_info::out) is det
- <= extra_info(ExtraInfo).
+ <= call_pattern(FuncInfo, Call).
%-----------------------------------------------------------------------------%
- % prepare_intermodule_analysis(ModuleIds, LocalModuleIds, !Info, !IO)
+ % prepare_intermodule_analysis(ModuleNames, LocalModuleNames, !Info, !IO)
%
% This predicate should be called before any pass begins to use the
% analysis framework. It ensures that all the analysis files
- % are loaded so that lookups can be satisfied. ModuleIds is the set of
+ % are loaded so that lookups can be satisfied. ModuleNames is the set of
% all modules that are directly or indirectly imported by the module being
- % analysed. LocalModuleIds is the set of non-"library" modules.
+ % analysed. LocalModuleNames is the set of non-"library" modules.
%
-:- pred prepare_intermodule_analysis(set(module_id)::in, set(module_id)::in,
- analysis_info::in, analysis_info::out, io::di, io::uo) is det.
+:- pred prepare_intermodule_analysis(set(module_name)::in,
+ set(module_name)::in, analysis_info::in, analysis_info::out,
+ io::di, io::uo) is det.
- % module_is_local(Info, ModuleId, IsLocal).
+ % module_is_local(Info, ModuleName, IsLocal).
%
% IsLocal is `yes' if the module is not a "library" module, i.e. we are
% able to reanalyse the module. The set of local modules is set in
% `prepare_intermodule_analysis'.
%
-:- pred module_is_local(analysis_info::in, module_id::in, bool::out)
+:- pred module_is_local(analysis_info::in, module_name::in, bool::out)
is det.
% Should be called after all analysis is completed to write the
% requests and results for the current compilation to the
% analysis files.
%
-:- pred write_analysis_files(Compiler::in, module_id::in, set(module_id)::in,
- analysis_info::in, analysis_info::out, io::di, io::uo) is det
+:- pred write_analysis_files(Compiler::in, module_info::in, module_name::in,
+ set(module_name)::in, analysis_info::in, analysis_info::out,
+ io::di, io::uo) is det
<= compiler(Compiler).
%-----------------------------------------------------------------------------%
- % read_module_overall_status(Compiler, ModuleId, MaybeModuleStatus, !IO)
+ % read_module_overall_status(Compiler, ModuleName, MaybeModuleStatus, !IO)
%
% Attempt to read the overall status from a module `.analysis' file.
%
-:- pred read_module_overall_status(Compiler::in, module_id::in,
+:- pred read_module_overall_status(Compiler::in, module_name::in,
maybe(analysis_status)::out, io::di, io::uo) is det
<= compiler(Compiler).
@@ -309,7 +309,7 @@
% The set of local modules, i.e. for which we can issue
% requests.
%
- local_module_ids :: set(module_id),
+ local_module_names :: set(module_name),
% Holds outstanding requests for more specialised variants
% of procedures. Requests are added to this map as analyses
@@ -320,7 +320,7 @@
% The overall status of each module.
%
- module_statuses :: map(module_id, analysis_status),
+ module_statuses :: map(module_name, analysis_status),
% The "old" map stores analysis results read in from disk.
% New results generated while analysing the current module
@@ -333,12 +333,6 @@
old_analysis_results :: analysis_map(some_analysis_result),
new_analysis_results :: analysis_map(some_analysis_result),
- % The extra info map stores any extra information needed
- % by one or more analysis results.
- %
- old_extra_infos :: map(module_id, module_extra_info_map),
- new_extra_infos :: map(module_id, module_extra_info_map),
-
% The Inter-module Dependency Graph records dependencies
% of an entire module's analysis results on another module's
% answer patterns. e.g. assume module M1 contains function F1
@@ -365,48 +359,48 @@
% The result has a status associated with it.
%
:- type some_analysis_result
- ---> some [Call, Answer]
+ ---> some [FuncInfo, Call, Answer]
some_analysis_result(
some_ar_call :: Call,
some_ar_answer :: Answer,
some_ar_status :: analysis_status
)
- => analysis(Call, Answer).
+ => analysis(FuncInfo, Call, Answer).
:- type analysis_request
- ---> some [Call]
+ ---> some [FuncInfo, Call]
analysis_request(
Call
)
- => call_pattern(Call).
+ => call_pattern(FuncInfo, Call).
:- type imdg_arc
- ---> some [Call]
+ ---> some [FuncInfo, Call]
imdg_arc(
Call, % Call pattern of the analysis result
% being depended on.
- module_id % The module that _depends on_ this function's
+ module_name % The module that _depends on_ this function's
% result.
)
- => call_pattern(Call).
+ => call_pattern(FuncInfo, Call).
-:- type analysis_map(T) == map(module_id, module_analysis_map(T)).
+:- type analysis_map(T) == map(module_name, module_analysis_map(T)).
:- type module_analysis_map(T) == map(analysis_name, func_analysis_map(T)).
:- type func_analysis_map(T) == map(func_id, list(T)).
-:- type module_extra_info_map == map(extra_info_key, string).
-
%-----------------------------------------------------------------------------%
%
% The "any" call pattern
%
-:- instance call_pattern(any_call) where [].
-:- instance partial_order(any_call) where [
- more_precise_than(_, _) :-
- semidet_fail,
- equivalent(_, _) :-
+:- instance call_pattern(no_func_info, any_call) where [].
+:- instance partial_order(no_func_info, any_call) where [
+ ( more_precise_than(_, _, _) :-
+ semidet_fail
+ ),
+ ( equivalent(no_func_info, _, _) :-
semidet_succeed
+ )
].
:- instance to_string(any_call) where [
to_string(any_call) = "",
@@ -417,34 +411,34 @@
init_analysis_info(Compiler) =
'new analysis_info'(Compiler, set.init, map.init, map.init, map.init,
- map.init, map.init, map.init, map.init, map.init).
+ map.init, map.init, map.init).
%-----------------------------------------------------------------------------%
-lookup_results(Info, ModuleId, FuncId, ResultList) :-
- lookup_results(Info, ModuleId, FuncId, no, ResultList).
+lookup_results(Info, ModuleName, FuncId, ResultList) :-
+ lookup_results(Info, ModuleName, FuncId, no, ResultList).
-:- pred lookup_results(analysis_info::in, module_id::in, func_id::in,
+:- pred lookup_results(analysis_info::in, module_name::in, func_id::in,
bool::in, list(analysis_result(Call, Answer))::out) is det
- <= analysis(Call, Answer).
+ <= analysis(FuncInfo, Call, Answer).
-lookup_results(Info, ModuleId, FuncId, AllowInvalidModules, ResultList) :-
+lookup_results(Info, ModuleName, FuncId, AllowInvalidModules, ResultList) :-
trace [io(!IO)] (
debug_msg((pred(!.IO::di, !:IO::uo) is det :-
io.write_string("% Looking up analysis results for ", !IO),
- io.write_string(ModuleId, !IO),
+ io.write(ModuleName, !IO),
io.write_string(".", !IO),
- io.write_string(FuncId, !IO),
+ io.write(FuncId, !IO),
io.nl(!IO)
), !IO)
),
(
AllowInvalidModules = no,
- Info ^ module_statuses ^ det_elem(ModuleId) = invalid
+ Info ^ module_statuses ^ elem(ModuleName) = invalid
->
ResultList = []
;
- lookup_results_2(Info ^ old_analysis_results, ModuleId, FuncId,
+ lookup_results_2(Info ^ old_analysis_results, ModuleName, FuncId,
ResultList),
trace [io(!IO)] (
debug_msg((pred(!.IO::di, !:IO::uo) is det :-
@@ -455,14 +449,14 @@
)
).
-:- pred lookup_results_2(analysis_map(some_analysis_result)::in, module_id::in,
+:- pred lookup_results_2(analysis_map(some_analysis_result)::in, module_name::in,
func_id::in, list(analysis_result(Call, Answer))::out) is det
- <= analysis(Call, Answer).
+ <= analysis(FuncInfo, Call, Answer).
-lookup_results_2(Map, ModuleId, FuncId, ResultList) :-
+lookup_results_2(Map, ModuleName, FuncId, ResultList) :-
AnalysisName = analysis_name(_ : Call, _ : Answer),
(
- ModuleResults = Map ^ elem(ModuleId),
+ ModuleResults = Map ^ elem(ModuleName),
Results = ModuleResults ^ elem(AnalysisName) ^ elem(FuncId)
->
% XXX we might have to discard results which are
@@ -477,69 +471,62 @@
ResultList = []
).
-lookup_matching_results(Info, ModuleId, FuncId, Call, ResultList) :-
- lookup_results(Info, ModuleId, FuncId, AllResultsList),
+lookup_matching_results(Info, ModuleName, FuncId, FuncInfo, Call, ResultList) :-
+ lookup_results(Info, ModuleName, FuncId, AllResultsList),
ResultList = list.filter(
(pred(Result::in) is semidet :-
ResultCall = Result ^ ar_call,
- ( more_precise_than(Call, ResultCall)
- ; equivalent(Call, ResultCall)
+ ( more_precise_than(FuncInfo, Call, ResultCall)
+ ; equivalent(FuncInfo, Call, ResultCall)
)
), AllResultsList).
-lookup_best_result(Info, ModuleId, FuncId, Call, MaybeBestResult) :-
+lookup_best_result(Info, ModuleName, FuncId, FuncInfo, Call, MaybeBestResult) :-
trace [io(!IO)] (
debug_msg((pred(!.IO::di, !:IO::uo) is det :-
io.write_string("% Looking up best analysis result for ", !IO),
- io.write_string(ModuleId, !IO),
+ io.write(ModuleName, !IO),
io.write_string(".", !IO),
- io.write_string(FuncId, !IO),
+ io.write(FuncId, !IO),
io.nl(!IO)
), !IO)
),
- lookup_matching_results(Info, ModuleId, FuncId, Call, MatchingResults),
+ lookup_matching_results(Info, ModuleName, FuncId, FuncInfo, Call,
+ MatchingResults),
(
MatchingResults = [],
MaybeBestResult = no
;
- MatchingResults = [_ | _],
- MaybeBestResult = yes(BestResult),
- most_precise_answer(MatchingResults, BestResult)
+ MatchingResults = [Result | Results],
+ list.foldl(more_precise_answer(FuncInfo), Results, Result, BestResult),
+ MaybeBestResult = yes(BestResult)
).
-:- pred most_precise_answer(
- list(analysis_result(Call, Answer))::in(non_empty_list),
- analysis_result(Call, Answer)::out) is det
- <= analysis(Call, Answer).
-
-most_precise_answer([Result | Results], BestResult) :-
- list.foldl(more_precise_answer, Results, Result, BestResult).
-
-:- pred more_precise_answer(analysis_result(Call, Answer)::in,
- analysis_result(Call, Answer)::in,
+:- pred more_precise_answer(FuncInfo::in,
+ analysis_result(Call, Answer)::in, analysis_result(Call, Answer)::in,
analysis_result(Call, Answer)::out) is det
- <= analysis(Call, Answer).
+ <= analysis(FuncInfo, Call, Answer).
-more_precise_answer(Result, Best0, Best) :-
+more_precise_answer(FuncInfo, Result, Best0, Best) :-
ResultAnswer = Result ^ ar_answer,
BestAnswer0 = Best0 ^ ar_answer,
- ( more_precise_than(ResultAnswer, BestAnswer0) ->
+ ( more_precise_than(FuncInfo, ResultAnswer, BestAnswer0) ->
Best = Result
;
Best = Best0
).
:- pred lookup_exactly_matching_result_even_from_invalid_modules(
- analysis_info::in, module_id::in, func_id::in, Call::in,
+ analysis_info::in, module_name::in, func_id::in, FuncInfo::in, Call::in,
maybe(analysis_result(Call, Answer))::out) is det
- <= analysis(Call, Answer).
+ <= analysis(FuncInfo, Call, Answer).
-lookup_exactly_matching_result_even_from_invalid_modules(Info, ModuleId,
- FuncId, Call, MaybeResult) :-
- lookup_results(Info, ModuleId, FuncId, yes, AllResultsList),
+lookup_exactly_matching_result_even_from_invalid_modules(Info, ModuleName,
+ FuncId, FuncInfo, Call, MaybeResult) :-
+ lookup_results(Info, ModuleName, FuncId, yes, AllResultsList),
ResultList = list.filter(
(pred(R::in) is semidet :-
- equivalent(Call, R ^ ar_call)
+ equivalent(FuncInfo, Call, R ^ ar_call)
), AllResultsList),
(
ResultList = [],
@@ -556,21 +543,21 @@
%-----------------------------------------------------------------------------%
-record_result(ModuleId, FuncId, CallPattern, AnswerPattern, Status, !Info) :-
+record_result(ModuleName, FuncId, CallPattern, AnswerPattern, Status, !Info) :-
Map0 = !.Info ^ new_analysis_results,
- record_result_in_analysis_map(ModuleId, FuncId,
+ record_result_in_analysis_map(ModuleName, FuncId,
CallPattern, AnswerPattern, Status, Map0, Map),
!Info ^ new_analysis_results := Map.
-:- pred record_result_in_analysis_map(module_id::in, func_id::in,
+:- pred record_result_in_analysis_map(module_name::in, func_id::in,
Call::in, Answer::in, analysis_status::in,
analysis_map(some_analysis_result)::in,
analysis_map(some_analysis_result)::out) is det
- <= analysis(Call, Answer).
+ <= analysis(FuncInfo, Call, Answer).
-record_result_in_analysis_map(ModuleId, FuncId,
+record_result_in_analysis_map(ModuleName, FuncId,
CallPattern, AnswerPattern, Status, !Map) :-
- ( ModuleResults0 = map.search(!.Map, ModuleId) ->
+ ( ModuleResults0 = map.search(!.Map, ModuleName) ->
ModuleResults1 = ModuleResults0
;
ModuleResults1 = map.init
@@ -586,7 +573,7 @@
;
FuncResults1 = []
),
- !:Map = map.set(!.Map, ModuleId,
+ !:Map = map.set(!.Map, ModuleName,
map.set(ModuleResults1, AnalysisName,
map.set(AnalysisResults1, FuncId, FuncResults))),
FuncResults = [Result | FuncResults1],
@@ -594,8 +581,8 @@
%-----------------------------------------------------------------------------%
-lookup_requests(Info, AnalysisName, ModuleId, FuncId, CallPatterns) :-
- map.lookup(Info ^ analysis_requests, ModuleId, ModuleRequests),
+lookup_requests(Info, AnalysisName, ModuleName, FuncId, CallPatterns) :-
+ map.lookup(Info ^ analysis_requests, ModuleName, ModuleRequests),
( CallPatterns0 = ModuleRequests ^ elem(AnalysisName) ^ elem(FuncId) ->
CallPatterns = list.filter_map(
(func(analysis_request(Call0)) = Call is semidet :-
@@ -605,8 +592,8 @@
CallPatterns = []
).
-record_request(AnalysisName, ModuleId, FuncId, CallPattern, !Info) :-
- ( ModuleResults0 = map.search(!.Info ^ analysis_requests, ModuleId) ->
+record_request(AnalysisName, ModuleName, FuncId, CallPattern, !Info) :-
+ ( ModuleResults0 = map.search(!.Info ^ analysis_requests, ModuleName) ->
ModuleResults1 = ModuleResults0
;
ModuleResults1 = map.init
@@ -622,24 +609,24 @@
FuncResults1 = []
),
!Info ^ analysis_requests :=
- map.set(!.Info ^ analysis_requests, ModuleId,
+ map.set(!.Info ^ analysis_requests, ModuleName,
map.set(ModuleResults1, AnalysisName,
map.set(AnalysisResults1, FuncId,
['new analysis_request'(CallPattern) | FuncResults1]))).
%-----------------------------------------------------------------------------%
-record_dependency(CallerModuleId, AnalysisName, CalleeModuleId, FuncId, Call,
+record_dependency(CallerModuleName, AnalysisName, CalleeModuleName, FuncId, Call,
!Info) :-
- ( CallerModuleId = CalleeModuleId ->
+ ( CallerModuleName = CalleeModuleName ->
% XXX this assertion breaks compiling the standard library with
% --analyse-trail-usage at the moment
%
- % error("record_dependency: " ++ CalleeModuleId ++ " and " ++
- % CallerModuleId ++ " must be different")
+ % error("record_dependency: " ++ CalleeModuleName ++ " and " ++
+ % CallerModuleName ++ " must be different")
true
;
- ( Analyses0 = map.search(!.Info ^ new_imdg, CalleeModuleId) ->
+ ( Analyses0 = map.search(!.Info ^ new_imdg, CalleeModuleName) ->
Analyses1 = Analyses0
;
Analyses1 = map.init
@@ -654,13 +641,13 @@
;
FuncArcs1 = []
),
- Dep = 'new imdg_arc'(Call, CallerModuleId),
+ Dep = 'new imdg_arc'(Call, CallerModuleName),
% XXX this should really be a set to begin with
( list.member(Dep, FuncArcs1) ->
true
;
!Info ^ new_imdg :=
- map.set(!.Info ^ new_imdg, CalleeModuleId,
+ map.set(!.Info ^ new_imdg, CalleeModuleName,
map.set(Analyses1, AnalysisName,
map.set(Funcs1, FuncId, FuncArcs))),
FuncArcs = [Dep | FuncArcs1]
@@ -668,28 +655,6 @@
).
%-----------------------------------------------------------------------------%
-
-lookup_module_extra_info(Info, ModuleId, Key, MaybeExtraInfo) :-
- ModuleExtraInfos = Info ^ old_extra_infos ^ det_elem(ModuleId),
- (
- String = ModuleExtraInfos ^ elem(Key),
- ExtraInfo = from_string(String)
- ->
- MaybeExtraInfo = yes(ExtraInfo)
- ;
- MaybeExtraInfo = no
- ).
-
-record_module_extra_info(ModuleId, Key, ExtraInfo, !Info) :-
- ( ModuleMap0 = !.Info ^ new_extra_infos ^ elem(ModuleId) ->
- ModuleMap1 = ModuleMap0
- ;
- ModuleMap1 = map.init
- ),
- ModuleMap = map.set(ModuleMap1, Key, to_string(ExtraInfo)),
- !Info ^ new_extra_infos ^ elem(ModuleId) := ModuleMap.
-
-%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% The algorithm is from Nick's thesis, pp. 108-9.
@@ -716,61 +681,64 @@
% Finally, clear out the "new" analysis results map. When we write
% out the analysis files we will do it from the "old" results map.
%
-:- pred update_analysis_registry(analysis_info::in, analysis_info::out,
- io::di, io::uo) is det.
+:- pred update_analysis_registry(module_info::in,
+ analysis_info::in, analysis_info::out, io::di, io::uo) is det.
-update_analysis_registry(!Info, !IO) :-
+update_analysis_registry(ModuleInfo, !Info, !IO) :-
debug_msg(io.write_string("% Updating analysis registry.\n"), !IO),
- map.foldl2(update_analysis_registry_2, !.Info ^ new_analysis_results,
- !Info, !IO),
+ NewResults = !.Info ^ new_analysis_results,
+ map.foldl2(update_analysis_registry_2(ModuleInfo), NewResults, !Info, !IO),
!Info ^ new_analysis_results := map.init.
-:- pred update_analysis_registry_2(module_id::in,
+:- pred update_analysis_registry_2(module_info::in, module_name::in,
module_analysis_map(some_analysis_result)::in,
analysis_info::in, analysis_info::out, io::di, io::uo) is det.
-update_analysis_registry_2(ModuleId, ModuleMap, !Info, !IO) :-
- map.foldl2(update_analysis_registry_3(ModuleId), ModuleMap, !Info, !IO).
+update_analysis_registry_2(ModuleInfo, ModuleName, ModuleMap, !Info, !IO) :-
+ map.foldl2(update_analysis_registry_3(ModuleInfo, ModuleName), ModuleMap,
+ !Info, !IO).
-:- pred update_analysis_registry_3(module_id::in, analysis_name::in,
- func_analysis_map(some_analysis_result)::in,
+:- pred update_analysis_registry_3(module_info::in, module_name::in,
+ analysis_name::in, func_analysis_map(some_analysis_result)::in,
analysis_info::in, analysis_info::out, io::di, io::uo) is det.
-update_analysis_registry_3(ModuleId, AnalysisName, FuncMap, !Info, !IO) :-
- map.foldl2(update_analysis_registry_4(ModuleId, AnalysisName),
+update_analysis_registry_3(ModuleInfo, ModuleName, AnalysisName, FuncMap,
+ !Info, !IO) :-
+ map.foldl2(update_analysis_registry_4(ModuleInfo, ModuleName, AnalysisName),
FuncMap, !Info, !IO).
-:- pred update_analysis_registry_4(module_id::in, analysis_name::in,
- func_id::in, list(some_analysis_result)::in,
+:- pred update_analysis_registry_4(module_info::in, module_name::in,
+ analysis_name::in, func_id::in, list(some_analysis_result)::in,
analysis_info::in, analysis_info::out, io::di, io::uo) is det.
-update_analysis_registry_4(ModuleId, AnalysisName, FuncId, NewResults,
- !Info, !IO) :-
+update_analysis_registry_4(ModuleInfo, ModuleName, AnalysisName, FuncId,
+ NewResults, !Info, !IO) :-
% XXX Currently we do not prevent there being more than one recorded result
% for a given call pattern.
- list.foldl2(update_analysis_registry_5(ModuleId, AnalysisName, FuncId),
- NewResults, !Info, !IO).
+ list.foldl2(update_analysis_registry_5(ModuleInfo, ModuleName, AnalysisName,
+ FuncId), NewResults, !Info, !IO).
-:- pred update_analysis_registry_5(module_id::in, analysis_name::in,
- func_id::in, some_analysis_result::in,
+:- pred update_analysis_registry_5(module_info::in, module_name::in,
+ analysis_name::in, func_id::in, some_analysis_result::in,
analysis_info::in, analysis_info::out, io::di, io::uo) is det.
-update_analysis_registry_5(ModuleId, AnalysisName, FuncId, NewResult,
- !Info, !IO) :-
+update_analysis_registry_5(ModuleInfo, ModuleName, AnalysisName, FuncId,
+ NewResult, !Info, !IO) :-
NewResult = some_analysis_result(Call, NewAnswer, NewStatus),
+ get_func_info(ModuleInfo, ModuleName, FuncId, Call, NewAnswer, FuncInfo),
lookup_exactly_matching_result_even_from_invalid_modules(!.Info,
- ModuleId, FuncId, Call, MaybeResult),
+ ModuleName, FuncId, FuncInfo, Call, MaybeResult),
(
% There was a previous answer for this call pattern.
%
MaybeResult = yes(OldResult),
OldResult = analysis_result(_OldCall, OldAnswer, OldStatus),
- ( equivalent(NewAnswer, OldAnswer) ->
+ ( equivalent(FuncInfo, NewAnswer, OldAnswer) ->
debug_msg((pred(!.IO::di, !:IO::uo) is det :-
io.write_string("% No change in the result ", !IO),
- io.write_string(ModuleId, !IO),
+ io.write(ModuleName, !IO),
io.write_string(".", !IO),
- io.write_string(FuncId, !IO),
+ io.write(FuncId, !IO),
io.write_string(":", !IO),
io.write(Call, !IO),
io.write_string(" --> ", !IO),
@@ -780,7 +748,7 @@
( NewStatus \= OldStatus ->
OldMap0 = !.Info ^ old_analysis_results,
- replace_result_in_analysis_map(ModuleId, FuncId,
+ replace_result_in_analysis_map(ModuleName, FuncId, FuncInfo,
Call, NewAnswer, NewStatus, OldMap0, OldMap),
!Info ^ old_analysis_results := OldMap
;
@@ -790,14 +758,14 @@
% Answer has changed.
% Replace the old answer in the registry with the new answer.
OldMap0 = !.Info ^ old_analysis_results,
- replace_result_in_analysis_map(ModuleId, FuncId,
+ replace_result_in_analysis_map(ModuleName, FuncId, FuncInfo,
Call, NewAnswer, NewStatus, OldMap0, OldMap),
!Info ^ old_analysis_results := OldMap,
% If the answer is more precise than before then dependent modules
% should be marked suboptimal. Otherwise the answer is less precise
% than it was before, so dependent modules should be invalidated.
- ( more_precise_than(NewAnswer, OldAnswer) ->
+ ( more_precise_than(FuncInfo, NewAnswer, OldAnswer) ->
Status = suboptimal
;
Status = invalid
@@ -815,9 +783,9 @@
io.write(DepModules, !IO),
io.nl(!IO)
), !IO),
- DepModules = imdg_dependent_modules(
- !.Info ^ old_imdg ^ det_elem(ModuleId), AnalysisName,
- FuncId, Call),
+ OldArcs = !.Info ^ old_imdg ^ det_elem(ModuleName),
+ DepModules = imdg_dependent_modules(OldArcs, AnalysisName,
+ FuncId, FuncInfo, Call),
set.fold2(taint_module_overall_status(Status), DepModules,
!Info, !IO)
)
@@ -826,41 +794,39 @@
% Just add this result to the registry.
MaybeResult = no,
OldMap0 = !.Info ^ old_analysis_results,
- record_result_in_analysis_map(ModuleId, FuncId,
+ record_result_in_analysis_map(ModuleName, FuncId,
Call, NewAnswer, NewStatus, OldMap0, OldMap),
!Info ^ old_analysis_results := OldMap
).
- % replace_result_in_analysis_map(ModuleId, FuncId, Call, Answer, Status,
- % !Map)
- %
% Replace an analysis result for the given function/call pattern with a
% new result. A previous result _must_ already exist in the map with
% exactly the same call pattern.
%
-:- pred replace_result_in_analysis_map(module_id::in, func_id::in,
- Call::in, Answer::in, analysis_status::in,
+:- pred replace_result_in_analysis_map(module_name::in, func_id::in,
+ FuncInfo::in, Call::in, Answer::in, analysis_status::in,
analysis_map(some_analysis_result)::in,
analysis_map(some_analysis_result)::out) is det
- <= analysis(Call, Answer).
+ <= analysis(FuncInfo, Call, Answer).
-replace_result_in_analysis_map(ModuleId, FuncId, CallPattern, AnswerPattern,
- Status, Map0, Map) :-
+replace_result_in_analysis_map(ModuleName, FuncId, FuncInfo,
+ CallPattern, AnswerPattern, Status, Map0, Map) :-
AnalysisName = analysis_name(CallPattern, AnswerPattern),
- ModuleResults0 = map.lookup(Map0, ModuleId),
+ ModuleResults0 = map.lookup(Map0, ModuleName),
AnalysisResults0 = map.lookup(ModuleResults0, AnalysisName),
FuncResults0 = map.lookup(AnalysisResults0, FuncId),
- replace_result_in_list(CallPattern, AnswerPattern, Status,
+ replace_result_in_list(FuncInfo, CallPattern, AnswerPattern, Status,
FuncResults0, FuncResults),
- Map = map.det_update(Map0, ModuleId,
+ Map = map.det_update(Map0, ModuleName,
map.det_update(ModuleResults0, AnalysisName,
map.det_update(AnalysisResults0, FuncId, FuncResults))).
-:- pred replace_result_in_list(Call::in, Answer::in, analysis_status::in,
- list(some_analysis_result)::in, list(some_analysis_result)::out)
- is det <= analysis(Call, Answer).
+:- pred replace_result_in_list(FuncInfo::in, Call::in, Answer::in,
+ analysis_status::in,
+ list(some_analysis_result)::in, list(some_analysis_result)::out) is det
+ <= analysis(FuncInfo, Call, Answer).
-replace_result_in_list(Call, Answer, Status, Results0, Results) :-
+replace_result_in_list(FuncInfo, Call, Answer, Status, Results0, Results) :-
(
Results0 = [],
unexpected(this_file,
@@ -868,42 +834,44 @@
;
Results0 = [H0 | T0],
det_univ_to_type(univ(H0 ^ some_ar_call), HCall),
- ( equivalent(Call, HCall) ->
+ ( equivalent(FuncInfo, Call, HCall) ->
H = 'new some_analysis_result'(Call, Answer, Status),
T = T0
;
H = H0,
- replace_result_in_list(Call, Answer, Status, T0, T)
+ replace_result_in_list(FuncInfo, Call, Answer, Status, T0, T)
),
Results = [H | T]
).
:- func imdg_dependent_modules(module_analysis_map(imdg_arc), analysis_name,
- func_id, Call) = set(module_id)
- <= call_pattern(Call).
+ func_id, FuncInfo, Call) = set(module_name)
+ <= call_pattern(FuncInfo, Call).
-imdg_dependent_modules(ModuleMap, AnalysisName, FuncId, Call) =
+imdg_dependent_modules(ModuleMap, AnalysisName, FuncId, FuncInfo, Call) =
(
map.search(ModuleMap, AnalysisName, FuncAnalysisMap),
map.search(FuncAnalysisMap, FuncId, IMDGEntries)
->
- set.from_list(list.filter_map(arc_module_id(Call), IMDGEntries))
+ set.from_list(list.filter_map(arc_module_name(FuncInfo, Call),
+ IMDGEntries))
;
set.init
).
% XXX: compiler aborts if the modes are removed
-:- func arc_module_id(Call::in, imdg_arc::in) = (module_id::out) is semidet
- <= call_pattern(Call).
+:- func arc_module_name(FuncInfo::in, Call::in, imdg_arc::in) =
+ (module_name::out) is semidet
+ <= call_pattern(FuncInfo, Call).
-arc_module_id(CallA, imdg_arc(CallB0, ModuleId)) = ModuleId :-
+arc_module_name(FuncInfo, CallA, imdg_arc(CallB0, ModuleName)) = ModuleName :-
det_univ_to_type(univ(CallB0), CallB),
- equivalent(CallA, CallB).
+ equivalent(FuncInfo, CallA, CallB).
-:- pred taint_module_overall_status(analysis_status::in, module_id::in,
+:- pred taint_module_overall_status(analysis_status::in, module_name::in,
analysis_info::in, analysis_info::out, io::di, io::uo) is det.
-taint_module_overall_status(Status, ModuleId, !Info, !IO) :-
+taint_module_overall_status(Status, ModuleName, !Info, !IO) :-
(
Status = optimal
;
@@ -915,40 +883,18 @@
% Even though we loaded all the analysis files of modules reachable
% from the initial module beforehand, a _caller_ of the initial module
% may not be part of that set.
- ensure_old_module_analysis_results_loaded(ModuleId, !Info, !IO),
+ ensure_old_module_analysis_results_loaded(ModuleName, !Info, !IO),
- ModuleStatus0 = !.Info ^ module_statuses ^ det_elem(ModuleId),
+ ModuleStatus0 = !.Info ^ module_statuses ^ det_elem(ModuleName),
ModuleStatus = lub(ModuleStatus0, Status),
debug_msg((pred(!.IO::di, !:IO::uo) is det :-
io.print("% Tainting the overall module status of ", !IO),
- io.print(ModuleId, !IO),
+ io.print(ModuleName, !IO),
io.print(" with ", !IO),
io.print(ModuleStatus, !IO),
io.nl(!IO)
), !IO),
- !Info ^ module_statuses ^ elem(ModuleId) := ModuleStatus
- ).
-
-%-----------------------------------------------------------------------------%
-
-:- pred update_extra_infos(analysis_info::in, analysis_info::out) is det.
-
-update_extra_infos(!Info) :-
- map.foldl(update_extra_infos_2,
- !.Info ^ new_extra_infos, !.Info ^ old_extra_infos, ExtraInfos),
- !Info ^ old_extra_infos := ExtraInfos,
- !Info ^ new_extra_infos := map.init.
-
-:- pred update_extra_infos_2(module_id::in, module_extra_info_map::in,
- map(module_id, module_extra_info_map)::in,
- map(module_id, module_extra_info_map)::out) is det.
-
-update_extra_infos_2(ModuleId, ExtraInfoB, ModuleMap0, ModuleMap) :-
- ( ExtraInfoA = ModuleMap0 ^ elem(ModuleId) ->
- map.overlay(ExtraInfoA, ExtraInfoB, ExtraInfo),
- ModuleMap = ModuleMap0 ^ elem(ModuleId) := ExtraInfo
- ;
- ModuleMap = ModuleMap0 ^ elem(ModuleId) := ExtraInfoB
+ !Info ^ module_statuses ^ elem(ModuleName) := ModuleStatus
).
%-----------------------------------------------------------------------------%
@@ -959,57 +905,57 @@
% For each P^M:DP in S (call patterns to analyse):
% add P^M:DP --> Q^N:DQ to N's IMDG
%
-:- pred update_intermodule_dependencies(module_id::in, set(module_id)::in,
+:- pred update_intermodule_dependencies(module_name::in, set(module_name)::in,
analysis_info::in, analysis_info::out) is det.
-update_intermodule_dependencies(ModuleId, ImportedModules, !Info) :-
- set.fold(update_intermodule_dependencies_2(ModuleId), ImportedModules,
+update_intermodule_dependencies(ModuleName, ImportedModules, !Info) :-
+ set.fold(update_intermodule_dependencies_2(ModuleName), ImportedModules,
!Info).
-:- pred update_intermodule_dependencies_2(module_id::in, module_id::in,
+:- pred update_intermodule_dependencies_2(module_name::in, module_name::in,
analysis_info::in, analysis_info::out) is det.
-update_intermodule_dependencies_2(ModuleId, ImportedModuleId, !Info) :-
+update_intermodule_dependencies_2(ModuleName, ImportedModuleName, !Info) :-
trace [io(!IO)] (
debug_msg((pred(!.IO::di, !:IO::uo) is det :-
io.print("% Clearing entries involving ", !IO),
- io.print(ModuleId, !IO),
+ io.print(ModuleName, !IO),
io.print(" from ", !IO),
- io.print(ImportedModuleId, !IO),
+ io.print(ImportedModuleName, !IO),
io.print("'s IMDG.\n", !IO)
), !IO)
),
- IMDG0 = !.Info ^ old_imdg ^ det_elem(ImportedModuleId),
- clear_imdg_entries_pointing_at(ModuleId, IMDG0, IMDG1),
+ IMDG0 = !.Info ^ old_imdg ^ det_elem(ImportedModuleName),
+ clear_imdg_entries_pointing_at(ModuleName, IMDG0, IMDG1),
- ( NewArcs = !.Info ^ new_imdg ^ elem(ImportedModuleId) ->
+ ( NewArcs = !.Info ^ new_imdg ^ elem(ImportedModuleName) ->
map.union(combine_func_imdg, IMDG1, NewArcs, IMDG)
;
IMDG = IMDG1
),
- !Info ^ old_imdg ^ elem(ImportedModuleId) := IMDG,
- !Info ^ new_imdg := map.delete(!.Info ^ new_imdg, ImportedModuleId).
+ !Info ^ old_imdg ^ elem(ImportedModuleName) := IMDG,
+ !Info ^ new_imdg := map.delete(!.Info ^ new_imdg, ImportedModuleName).
-:- pred clear_imdg_entries_pointing_at(module_id::in,
+:- pred clear_imdg_entries_pointing_at(module_name::in,
module_analysis_map(imdg_arc)::in,
module_analysis_map(imdg_arc)::out) is det.
-clear_imdg_entries_pointing_at(ModuleId, Map0, Map) :-
- map.map_values(clear_imdg_entries_pointing_at_2(ModuleId), Map0, Map).
+clear_imdg_entries_pointing_at(ModuleName, Map0, Map) :-
+ map.map_values(clear_imdg_entries_pointing_at_2(ModuleName), Map0, Map).
-:- pred clear_imdg_entries_pointing_at_2(module_id::in, analysis_name::in,
+:- pred clear_imdg_entries_pointing_at_2(module_name::in, analysis_name::in,
func_analysis_map(imdg_arc)::in,
func_analysis_map(imdg_arc)::out) is det.
-clear_imdg_entries_pointing_at_2(ModuleId, _, FuncMap0, FuncMap) :-
- map.map_values(clear_imdg_entries_pointing_at_3(ModuleId),
+clear_imdg_entries_pointing_at_2(ModuleName, _, FuncMap0, FuncMap) :-
+ map.map_values(clear_imdg_entries_pointing_at_3(ModuleName),
FuncMap0, FuncMap).
-:- pred clear_imdg_entries_pointing_at_3(module_id::in, func_id::in,
+:- pred clear_imdg_entries_pointing_at_3(module_name::in, func_id::in,
list(imdg_arc)::in, list(imdg_arc)::out) is det.
-clear_imdg_entries_pointing_at_3(ModuleId, _, Arcs0, Arcs) :-
- list.filter((pred(imdg_arc(_, ModId)::in) is semidet :- ModuleId \= ModId),
+clear_imdg_entries_pointing_at_3(ModuleName, _, Arcs0, Arcs) :-
+ list.filter((pred(imdg_arc(_, ModId)::in) is semidet :- ModuleName \= ModId),
Arcs0, Arcs).
:- pred combine_func_imdg(func_analysis_map(imdg_arc)::in,
@@ -1025,48 +971,47 @@
%-----------------------------------------------------------------------------%
-prepare_intermodule_analysis(ModuleIds, LocalModuleIds, !Info, !IO) :-
- set.fold2(ensure_analysis_files_loaded, ModuleIds, !Info, !IO),
- !Info ^ local_module_ids := LocalModuleIds.
+prepare_intermodule_analysis(ModuleNames, LocalModuleNames, !Info, !IO) :-
+ set.fold2(ensure_analysis_files_loaded, ModuleNames, !Info, !IO),
+ !Info ^ local_module_names := LocalModuleNames.
-:- pred ensure_analysis_files_loaded(module_id::in,
+:- pred ensure_analysis_files_loaded(module_name::in,
analysis_info::in, analysis_info::out, io::di, io::uo) is det.
-ensure_analysis_files_loaded(ModuleId, !Info, !IO) :-
- ensure_old_module_analysis_results_loaded(ModuleId, !Info, !IO),
- ensure_old_imdg_loaded(ModuleId, !Info, !IO).
+ensure_analysis_files_loaded(ModuleName, !Info, !IO) :-
+ ensure_old_module_analysis_results_loaded(ModuleName, !Info, !IO),
+ ensure_old_imdg_loaded(ModuleName, !Info, !IO).
-:- pred ensure_old_module_analysis_results_loaded(module_id::in,
+:- pred ensure_old_module_analysis_results_loaded(module_name::in,
analysis_info::in, analysis_info::out, io::di, io::uo) is det.
-ensure_old_module_analysis_results_loaded(ModuleId, !Info, !IO) :-
- ( map.search(!.Info ^ old_analysis_results, ModuleId, _Results) ->
+ensure_old_module_analysis_results_loaded(ModuleName, !Info, !IO) :-
+ ( map.search(!.Info ^ old_analysis_results, ModuleName, _Results) ->
% sanity check
- map.lookup(!.Info ^ module_statuses, ModuleId, _StatusMustExist)
+ map.lookup(!.Info ^ module_statuses, ModuleName, _StatusMustExist)
;
- read_module_analysis_results(!.Info, ModuleId,
- ModuleStatus, ModuleResults, ExtraInfos, !IO),
- !Info ^ module_statuses ^ elem(ModuleId) := ModuleStatus,
- !Info ^ old_analysis_results ^ elem(ModuleId) := ModuleResults,
- !Info ^ old_extra_infos ^ elem(ModuleId) := ExtraInfos
+ read_module_analysis_results(!.Info, ModuleName,
+ ModuleStatus, ModuleResults, !IO),
+ !Info ^ module_statuses ^ elem(ModuleName) := ModuleStatus,
+ !Info ^ old_analysis_results ^ elem(ModuleName) := ModuleResults
).
-:- pred ensure_old_imdg_loaded(module_id::in, analysis_info::in,
+:- pred ensure_old_imdg_loaded(module_name::in, analysis_info::in,
analysis_info::out, io::di, io::uo) is det.
-ensure_old_imdg_loaded(ModuleId, !Info, !IO) :-
+ensure_old_imdg_loaded(ModuleName, !Info, !IO) :-
Map0 = !.Info ^ old_imdg,
- ( map.search(Map0, ModuleId, _) ->
+ ( map.search(Map0, ModuleName, _) ->
% already loaded
true
;
- read_module_imdg(!.Info, ModuleId, IMDG, !IO),
- map.det_insert(Map0, ModuleId, IMDG, Map),
+ read_module_imdg(!.Info, ModuleName, IMDG, !IO),
+ map.det_insert(Map0, ModuleName, IMDG, Map),
!Info ^ old_imdg := Map
).
-module_is_local(Info, ModuleId, IsLocal) :-
- ( set.contains(Info ^ local_module_ids, ModuleId) ->
+module_is_local(Info, ModuleName, IsLocal) :-
+ ( set.contains(Info ^ local_module_names, ModuleName) ->
IsLocal = yes
;
IsLocal = no
@@ -1074,39 +1019,34 @@
%-----------------------------------------------------------------------------%
- % In this procedure we have just finished compiling module ModuleId
+ % In this procedure we have just finished compiling module ModuleName
% and will write out data currently cached in the analysis_info structure
% out to disk.
%
-write_analysis_files(Compiler, ModuleId, ImportedModuleIds, !Info, !IO) :-
+write_analysis_files(Compiler, ModuleInfo, ModuleName, ImportedModuleNames,
+ !Info, !IO) :-
% The current module was just compiled so we set its status to the
% lub of all the new analysis results generated.
- ( NewResults = !.Info ^ new_analysis_results ^ elem(ModuleId) ->
+ ( NewResults = !.Info ^ new_analysis_results ^ elem(ModuleName) ->
ModuleStatus = lub_result_statuses(NewResults)
;
ModuleStatus = optimal,
% Force an `.analysis' file to be written out for this module,
% even though there are no results recorded for it.
- !Info ^ new_analysis_results ^ elem(ModuleId) := map.init
+ !Info ^ new_analysis_results ^ elem(ModuleName) := map.init
),
- update_analysis_registry(!Info, !IO),
- update_extra_infos(!Info),
+ update_analysis_registry(ModuleInfo, !Info, !IO),
- !Info ^ module_statuses ^ elem(ModuleId) := ModuleStatus,
+ !Info ^ module_statuses ^ elem(ModuleName) := ModuleStatus,
- update_intermodule_dependencies(ModuleId, ImportedModuleIds, !Info),
- (
- map.is_empty(!.Info ^ new_analysis_results),
- map.is_empty(!.Info ^ new_extra_infos)
- ->
+ update_intermodule_dependencies(ModuleName, ImportedModuleNames, !Info),
+ ( map.is_empty(!.Info ^ new_analysis_results) ->
true
;
- io.print("Warning: new_analysis_results or extra_infos is not empty\n",
+ io.print("Warning: new_analysis_results is not empty\n",
!IO),
io.print(!.Info ^ new_analysis_results, !IO),
- io.nl(!IO),
- io.print(!.Info ^ new_extra_infos, !IO),
io.nl(!IO)
),
@@ -1122,14 +1062,14 @@
% Remove the requests for the current module since we (should have)
% fulfilled them in this pass.
- empty_request_file(!.Info, ModuleId, !IO),
+ empty_request_file(!.Info, ModuleName, !IO),
% Write the intermodule dependency graphs.
write_local_modules(!.Info, write_module_imdg, !.Info ^ old_imdg, !IO),
% Touch a timestamp file to indicate the last time that this module was
% analysed.
- module_id_to_write_file_name(Compiler, ModuleId, ".analysis_date",
+ module_name_to_write_file_name(Compiler, ModuleName, ".analysis_date",
TimestampFileName, !IO),
io.open_output(TimestampFileName, Result, !IO),
(
@@ -1143,7 +1083,7 @@
).
:- type write_module_analysis_map(T) ==
- (pred(analysis_info, module_id, module_analysis_map(T), io, io)).
+ (pred(analysis_info, module_name, module_analysis_map(T), io, io)).
:- mode write_module_analysis_map == in(pred(in, in, in, di, uo) is det).
:- pred write_local_modules(analysis_info::in,
@@ -1155,39 +1095,34 @@
:- pred write_local_modules_2(analysis_info::in,
write_module_analysis_map(T)::write_module_analysis_map,
- module_id::in, module_analysis_map(T)::in, io::di, io::uo) is det.
+ module_name::in, module_analysis_map(T)::in, io::di, io::uo) is det.
-write_local_modules_2(Info, Write, ModuleId, ModuleResults, !IO) :-
- module_is_local(Info, ModuleId, IsLocal),
+write_local_modules_2(Info, Write, ModuleName, ModuleResults, !IO) :-
+ module_is_local(Info, ModuleName, IsLocal),
(
IsLocal = yes,
- Write(Info, ModuleId, ModuleResults, !IO)
+ Write(Info, ModuleName, ModuleResults, !IO)
;
IsLocal = no,
debug_msg((pred(!.IO::di, !:IO::uo) is det :-
io.write_string("% Not writing file for non-local module ", !IO),
- io.write_string(ModuleId, !IO),
+ io.write(ModuleName, !IO),
io.nl(!IO)
), !IO)
).
-:- pred write_module_analysis_results(analysis_info::in, module_id::in,
+:- pred write_module_analysis_results(analysis_info::in, module_name::in,
module_analysis_map(some_analysis_result)::in, io::di, io::uo) is det.
-write_module_analysis_results(Info, ModuleId, ModuleResults, !IO) :-
- ModuleStatus = Info ^ module_statuses ^ det_elem(ModuleId),
- ( ModuleExtraInfo0 = Info ^ old_extra_infos ^ elem(ModuleId) ->
- ModuleExtraInfo = ModuleExtraInfo0
- ;
- ModuleExtraInfo = map.init
- ),
- analysis.file.write_module_analysis_results(Info, ModuleId,
- ModuleStatus, ModuleResults, ModuleExtraInfo, !IO).
+write_module_analysis_results(Info, ModuleName, ModuleResults, !IO) :-
+ ModuleStatus = Info ^ module_statuses ^ det_elem(ModuleName),
+ analysis.file.write_module_analysis_results(Info, ModuleName,
+ ModuleStatus, ModuleResults, !IO).
%-----------------------------------------------------------------------------%
-read_module_overall_status(Compiler, ModuleId, MaybeModuleStatus, !IO) :-
- analysis.file.read_module_overall_status(Compiler, ModuleId,
+read_module_overall_status(Compiler, ModuleName, MaybeModuleStatus, !IO) :-
+ analysis.file.read_module_overall_status(Compiler, ModuleName,
MaybeModuleStatus, !IO).
%-----------------------------------------------------------------------------%
Index: compiler/ctgc.fixpoint_table.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.fixpoint_table.m,v
retrieving revision 1.5
diff -u -r1.5 ctgc.fixpoint_table.m
--- compiler/ctgc.fixpoint_table.m 1 Dec 2006 15:03:52 -0000 1.5
+++ compiler/ctgc.fixpoint_table.m 25 Mar 2008 03:39:02 -0000
@@ -81,8 +81,8 @@
% Same as get_final, but the predicate fails instead of aborting when
% the element is not present.
%
-:- func get_from_fixpoint_table_final_semidet(K, fixpoint_table(K, E)) = E
- is semidet.
+:- pred get_from_fixpoint_table_final_semidet(K::in, fixpoint_table(K, E)::in,
+ E::out) is semidet.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -204,13 +204,13 @@
!:T = !.T ^ recursive := is_recursive.
get_from_fixpoint_table_final(Index, T) = Elem :-
- ( TabledElem = get_from_fixpoint_table_final_semidet(Index, T) ->
+ ( get_from_fixpoint_table_final_semidet(Index, T, TabledElem) ->
Elem = TabledElem
;
- unexpected(this_file, "get_final: key not in map.")
+ unexpected(this_file, "get_from_fixpoint_table_final: key not in map.")
).
-get_from_fixpoint_table_final_semidet(Index, T) = Elem :-
+get_from_fixpoint_table_final_semidet(Index, T, Elem) :-
map.search(T ^ mapping, Index, Entry),
Elem = Entry ^ entry_elem.
Index: compiler/ctgc.selector.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.selector.m,v
retrieving revision 1.11
diff -u -r1.11 ctgc.selector.m
--- compiler/ctgc.selector.m 17 Mar 2008 01:56:11 -0000 1.11
+++ compiler/ctgc.selector.m 25 Mar 2008 03:39:02 -0000
@@ -303,7 +303,7 @@
)
;
UnitSelector = termsel(ConsId, Index),
- SubType = det_select_subtype(ModuleInfo, FromType, ConsId, Index),
+ select_subtype(ModuleInfo, FromType, ConsId, Index, SubType),
( SubType = ToType ->
(
% Check if the same type occurs anywhere further on the
Index: compiler/ctgc.util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.util.m,v
retrieving revision 1.18
diff -u -r1.18 ctgc.util.m
--- compiler/ctgc.util.m 19 Feb 2008 00:55:04 -0000 1.18
+++ compiler/ctgc.util.m 25 Mar 2008 03:39:02 -0000
@@ -82,15 +82,11 @@
%-----------------------------------------------------------------------------%
pred_requires_no_analysis(ModuleInfo, PredId) :-
- module_info_get_special_pred_map(ModuleInfo, SpecialPredMap),
- map.values(SpecialPredMap, SpecialPreds),
- (
- list.member(PredId, SpecialPreds)
- ;
- module_info_pred_info(ModuleInfo, PredId, PredInfo),
- pred_info_get_import_status(PredInfo, Status),
- status_defined_in_this_module(Status) = no
- ).
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_import_status(PredInfo, Status),
+ % We handle `:- external' predicates later. In that sense, they do *not*
+ % require that we don't analyse them.
+ Status = status_imported(_).
pred_requires_analysis(ModuleInfo, PredId) :-
\+ pred_requires_no_analysis(ModuleInfo, PredId).
Index: compiler/exception_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/exception_analysis.m,v
retrieving revision 1.46
diff -u -r1.46 exception_analysis.m
--- compiler/exception_analysis.m 27 Feb 2008 07:23:05 -0000 1.46
+++ compiler/exception_analysis.m 25 Mar 2008 03:39:02 -0000
@@ -117,9 +117,9 @@
%
:- type exception_analysis_answer.
-:- instance analysis(any_call, exception_analysis_answer).
-:- instance partial_order(exception_analysis_answer).
-:- instance answer_pattern(exception_analysis_answer).
+:- instance analysis(no_func_info, any_call, exception_analysis_answer).
+:- instance partial_order(no_func_info, exception_analysis_answer).
+:- instance answer_pattern(no_func_info, exception_analysis_answer).
:- instance to_string(exception_analysis_answer).
%----------------------------------------------------------------------------%
@@ -989,21 +989,25 @@
analysis_name = "exception_analysis".
-:- instance analysis(any_call, exception_analysis_answer) where [
+:- instance analysis(no_func_info, any_call, exception_analysis_answer)
+ where [
analysis_name(_, _) = analysis_name,
analysis_version_number(_, _) = 1,
preferred_fixpoint_type(_, _) = least_fixpoint,
- bottom(_) = exception_analysis_answer(will_not_throw),
- top(_) = exception_analysis_answer(may_throw(user_exception))
+ bottom(_, _) = exception_analysis_answer(will_not_throw),
+ top(_, _) = exception_analysis_answer(may_throw(user_exception)),
+ get_func_info(_, _, _, _, _, no_func_info)
].
-:- instance answer_pattern(exception_analysis_answer) where [].
-:- instance partial_order(exception_analysis_answer) where [
- (more_precise_than(
- exception_analysis_answer(Status1),
- exception_analysis_answer(Status2)) :-
- exception_status_more_precise_than(Status1, Status2)),
- equivalent(Status, Status)
+:- instance answer_pattern(no_func_info, exception_analysis_answer) where [].
+:- instance partial_order(no_func_info, exception_analysis_answer) where [
+ ( more_precise_than(no_func_info, Answer1, Answer2) :-
+ Answer1 = exception_analysis_answer(Status1),
+ Answer2 = exception_analysis_answer(Status2),
+ exception_status_more_precise_than(Status1, Status2)
+ ),
+
+ equivalent(no_func_info, Status, Status)
].
:- pred exception_status_more_precise_than(exception_status::in,
@@ -1063,9 +1067,9 @@
search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus, CallerSCC,
!AnalysisInfo) :-
- module_id_func_id(ModuleInfo, PPId, ModuleId, FuncId),
+ module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
Call = any_call,
- lookup_best_result(!.AnalysisInfo, ModuleId, FuncId, Call,
+ lookup_best_result(!.AnalysisInfo, ModuleName, FuncId, no_func_info, Call,
MaybeBestResult),
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, make_analysis_registry,
@@ -1076,7 +1080,7 @@
BestAnswer = exception_analysis_answer(Result),
(
MakeAnalysisRegistry = yes,
- record_dependencies(ModuleId, FuncId, BestCall, ModuleInfo,
+ record_dependencies(ModuleName, FuncId, BestCall, ModuleInfo,
CallerSCC, !AnalysisInfo)
;
MakeAnalysisRegistry = no
@@ -1085,19 +1089,19 @@
MaybeBestResult = no,
% If we do not have any information about the callee procedure then
% assume that it throws an exception.
- top(Call) = Answer,
+ top(no_func_info, Call) = Answer,
Answer = exception_analysis_answer(Result),
- module_is_local(!.AnalysisInfo, ModuleId, IsLocal),
+ module_is_local(!.AnalysisInfo, ModuleName, IsLocal),
(
IsLocal = yes,
AnalysisStatus = suboptimal,
(
MakeAnalysisRegistry = yes,
- analysis.record_result(ModuleId, FuncId,
+ analysis.record_result(ModuleName, FuncId,
Call, Answer, AnalysisStatus, !AnalysisInfo),
- analysis.record_request(analysis_name, ModuleId, FuncId, Call,
- !AnalysisInfo),
- record_dependencies(ModuleId, FuncId, Call,
+ analysis.record_request(analysis_name, ModuleName, FuncId,
+ Call, !AnalysisInfo),
+ record_dependencies(ModuleName, FuncId, Call,
ModuleInfo, CallerSCC, !AnalysisInfo)
;
MakeAnalysisRegistry = no
@@ -1113,17 +1117,16 @@
% 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,
+:- pred record_dependencies(module_name::in, func_id::in, Call::in,
module_info::in, scc::in, analysis_info::in, analysis_info::out)
- is det <= call_pattern(Call).
+ is det <= call_pattern(FuncInfo, Call).
-record_dependencies(ModuleId, FuncId, Call,
+record_dependencies(ModuleName, FuncId, Call,
ModuleInfo, CallerSCC, !AnalysisInfo) :-
list.foldl((pred(CallerPPId::in, Info0::in, Info::out) is det :-
- module_id_func_id(ModuleInfo, CallerPPId,
- CallerModuleId, _),
- record_dependency(CallerModuleId,
- analysis_name, ModuleId, FuncId, Call, Info0, Info)
+ module_name_func_id(ModuleInfo, CallerPPId, CallerModuleName, _),
+ record_dependency(CallerModuleName, analysis_name, ModuleName, FuncId,
+ Call, Info0, Info)
), CallerSCC, !AnalysisInfo).
:- pred record_exception_analysis_results(exception_status::in,
@@ -1147,9 +1150,9 @@
should_write_exception_info(ModuleInfo, PredId, PredInfo, ShouldWrite),
(
ShouldWrite = yes,
- module_id_func_id(ModuleInfo, PPId, ModuleId, FuncId),
- record_result(ModuleId, FuncId, any_call,
- exception_analysis_answer(Status), ResultStatus,
+ module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
+ Answer = exception_analysis_answer(Status),
+ record_result(ModuleName, FuncId, any_call, Answer, ResultStatus,
!AnalysisInfo)
;
ShouldWrite = no
@@ -1289,9 +1292,9 @@
UseAnalysisRegistry = yes,
some [!AnalysisInfo] (
module_info_get_analysis_info(!.ModuleInfo, !:AnalysisInfo),
- module_id_func_id(!.ModuleInfo, PPId, ModuleId, FuncId),
- lookup_best_result(!.AnalysisInfo, ModuleId, FuncId, any_call,
- MaybeBestResult),
+ module_name_func_id(!.ModuleInfo, PPId, ModuleName, FuncId),
+ lookup_best_result(!.AnalysisInfo, ModuleName, FuncId,
+ no_func_info, any_call, MaybeBestResult),
(
MaybeBestResult = yes(analysis_result(_Call, Answer,
AnalysisStatus)),
@@ -1310,9 +1313,8 @@
ExceptionStatus = may_throw(user_exception)
),
module_info_get_name(!.ModuleInfo, ThisModuleName),
- ThisModuleId = module_name_to_module_id(ThisModuleName),
- record_dependency(ThisModuleId, analysis_name, ModuleId, FuncId,
- any_call, !AnalysisInfo),
+ record_dependency(ThisModuleName, analysis_name,
+ ModuleName, FuncId, any_call, !AnalysisInfo),
module_info_set_analysis_info(!.AnalysisInfo, !ModuleInfo)
)
).
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.445
diff -u -r1.445 hlds_out.m
--- compiler/hlds_out.m 27 Feb 2008 08:35:16 -0000 1.445
+++ compiler/hlds_out.m 25 Mar 2008 03:39:02 -0000
@@ -3967,8 +3967,15 @@
( string.contains_char(Verbose, 'S') ->
write_indent(Indent, !IO),
io.write_string("% Structure sharing: \n", !IO),
- dump_maybe_structure_sharing_domain(VarSet, TVarSet,
- MaybeStructureSharing, !IO)
+ (
+ MaybeStructureSharing = yes(
+ structure_sharing_domain_and_status(Domain, _Status)),
+ dump_maybe_structure_sharing_domain(VarSet, TVarSet, yes(Domain),
+ !IO)
+ ;
+ MaybeStructureSharing = no,
+ dump_maybe_structure_sharing_domain(VarSet, TVarSet, no, !IO)
+ )
;
true
),
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.239
diff -u -r1.239 hlds_pred.m
--- compiler/hlds_pred.m 27 Feb 2008 08:35:16 -0000 1.239
+++ compiler/hlds_pred.m 25 Mar 2008 03:39:02 -0000
@@ -17,6 +17,7 @@
:- module hlds.hlds_pred.
:- interface.
+:- import_module analysis.
:- import_module check_hlds.mode_constraint_robdd.
:- import_module check_hlds.mode_errors.
:- import_module hlds.hlds_clauses.
@@ -1846,6 +1847,12 @@
return_debug :: string
).
+:- type structure_sharing_domain_and_status
+ ---> structure_sharing_domain_and_status(
+ structure_sharing_domain,
+ analysis_status
+ ).
+
:- type untuple_proc_info
---> untuple_proc_info(
map(prog_var, prog_vars)
@@ -1982,9 +1989,10 @@
proc_info::in, proc_info::out) is det.
:- pred proc_info_get_structure_sharing(proc_info::in,
- maybe(structure_sharing_domain)::out) is det.
+ maybe(structure_sharing_domain_and_status)::out) is det.
-:- pred proc_info_set_structure_sharing(structure_sharing_domain::in,
+:- pred proc_info_set_structure_sharing(
+ structure_sharing_domain_and_status::in,
proc_info::in, proc_info::out) is det.
:- pred proc_info_get_imported_structure_sharing(proc_info::in,
@@ -2303,12 +2311,12 @@
:- type structure_sharing_info
---> structure_sharing_info(
- maybe_sharing :: maybe(structure_sharing_domain),
- maybe_imported_sharing :: maybe(imported_sharing)
- % Records the sharing information from any `.opt' or
- % `.trans_opt' file. This information needs to be processed
- % at the beginning of structure sharing analysis. After
- % that, this field is of no use.
+ maybe_sharing :: maybe(structure_sharing_domain_and_status),
+ maybe_imported_sharing :: maybe(imported_sharing)
+ % Records the sharing information from any `.opt' or
+ % `.trans_opt' file. This information needs to be processed at
+ % the beginning of structure sharing analysis. After that,
+ % this field is of no use.
).
% Sharing information is expressed in terms of head variables and the
Index: compiler/make.dependencies.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.dependencies.m,v
retrieving revision 1.46
diff -u -r1.46 make.dependencies.m
--- compiler/make.dependencies.m 26 Feb 2008 05:02:39 -0000 1.46
+++ compiler/make.dependencies.m 25 Mar 2008 03:39:02 -0000
@@ -949,8 +949,9 @@
:- pred make_local_module_id_option(module_name::in, list(string)::in,
list(string)::out) is det.
-make_local_module_id_option(ModuleName, Opts,
- ["--local-module-id", module_name_to_module_id(ModuleName) | Opts]).
+make_local_module_id_option(ModuleName, Opts0, Opts) :-
+ ModuleNameStr = sym_name_to_string(ModuleName),
+ Opts = ["--local-module-id", ModuleNameStr | Opts0].
%-----------------------------------------------------------------------------%
Index: compiler/make.module_target.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.module_target.m,v
retrieving revision 1.60
diff -u -r1.60 make.module_target.m
--- compiler/make.module_target.m 23 Nov 2007 07:35:10 -0000 1.60
+++ compiler/make.module_target.m 25 Mar 2008 03:39:02 -0000
@@ -312,8 +312,7 @@
force_reanalysis_of_suboptimal_module(ModuleName, ForceReanalysis, Info,
!IO) :-
( Info ^ reanalysis_passes > 0 ->
- ModuleId = module_name_to_module_id(ModuleName),
- analysis.read_module_overall_status(mmc, ModuleId,
+ analysis.read_module_overall_status(mmc, ModuleName,
MaybeAnalysisStatus, !IO),
( MaybeAnalysisStatus = yes(suboptimal) ->
ForceReanalysis = yes
Index: compiler/make.program_target.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.program_target.m,v
retrieving revision 1.81
diff -u -r1.81 make.program_target.m
--- compiler/make.program_target.m 18 Feb 2008 23:57:44 -0000 1.81
+++ compiler/make.program_target.m 25 Mar 2008 03:39:02 -0000
@@ -834,8 +834,7 @@
modules_needing_reanalysis(_, [], [], [], !IO).
modules_needing_reanalysis(ReanalyseSuboptimal, [Module | Modules],
InvalidModules, SuboptimalModules, !IO) :-
- read_module_overall_status(mmc, module_name_to_module_id(Module),
- MaybeModuleStatus, !IO),
+ read_module_overall_status(mmc, Module, MaybeModuleStatus, !IO),
(
MaybeModuleStatus = yes(ModuleStatus),
(
Index: compiler/make.util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.util.m,v
retrieving revision 1.53
diff -u -r1.53 make.util.m
--- compiler/make.util.m 23 Nov 2007 07:35:10 -0000 1.53
+++ compiler/make.util.m 25 Mar 2008 03:39:03 -0000
@@ -973,8 +973,7 @@
get_target_timestamp_analysis_registry(Search, ModuleName, MaybeTimestamp,
!Info, !IO) :-
- ModuleId = module_name_to_module_id(ModuleName),
- analysis.read_module_overall_status(mmc, ModuleId, MaybeStatus, !IO),
+ analysis.read_module_overall_status(mmc, ModuleName, MaybeStatus, !IO),
(
MaybeStatus = yes(Status),
(
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.464
diff -u -r1.464 mercury_compile.m
--- compiler/mercury_compile.m 27 Feb 2008 07:23:09 -0000 1.464
+++ compiler/mercury_compile.m 25 Mar 2008 03:39:03 -0000
@@ -1560,16 +1560,16 @@
prepare_intermodule_analysis(!HLDS, !IO) :-
module_info_get_name(!.HLDS, ThisModuleName),
- module_info_get_all_deps(!.HLDS, ModuleNamesSet0),
- set.insert(ModuleNamesSet0, ThisModuleName, ModuleNamesSet),
- ModuleIds = set.map(module_name_to_module_id, ModuleNamesSet),
+ module_info_get_all_deps(!.HLDS, ModuleNames0),
+ set.insert(ModuleNames0, ThisModuleName, ModuleNames),
globals.io_lookup_accumulating_option(local_module_id, LocalModulesList,
!IO),
- LocalModuleIds = set.from_list(LocalModulesList),
+ SymNames = list.map(string_to_sym_name, LocalModulesList),
+ LocalModuleNames = set.from_list(SymNames),
module_info_get_analysis_info(!.HLDS, AnalysisInfo0),
- analysis.prepare_intermodule_analysis(ModuleIds, LocalModuleIds,
+ analysis.prepare_intermodule_analysis(ModuleNames, LocalModuleNames,
AnalysisInfo0, AnalysisInfo, !IO),
module_info_set_analysis_info(AnalysisInfo, !HLDS).
@@ -2446,12 +2446,16 @@
maybe_dump_hlds(!.HLDS, 165, "unused_args", !DumpInfo, !IO),
maybe_analyse_trail_usage(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 167, "trail_usage", !DumpInfo, !IO),
+ maybe_analyse_mm_tabling(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 185, "mm_tabling_analysis", !DumpInfo, !IO),
+ maybe_structure_sharing_analysis(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 190, "structure_sharing", !DumpInfo, !IO),
+ maybe_structure_reuse_analysis(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 195, "structure_reuse", !DumpInfo, !IO),
module_info_get_analysis_info(!.HLDS, AnalysisInfo),
module_info_get_all_deps(!.HLDS, ImportedModules),
- ModuleId = module_name_to_module_id(ModuleName),
- ImportedModuleIds = set.map(module_name_to_module_id, ImportedModules),
- analysis.write_analysis_files(mmc, ModuleId, ImportedModuleIds,
+ analysis.write_analysis_files(mmc, !.HLDS, ModuleName, ImportedModules,
AnalysisInfo, _AnalysisInfo, !IO).
:- pred frontend_pass_by_phases(module_info::in, module_info::out,
Index: compiler/mmc_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mmc_analysis.m,v
retrieving revision 1.22
diff -u -r1.22 mmc_analysis.m
--- compiler/mmc_analysis.m 21 Feb 2008 04:22:41 -0000 1.22
+++ compiler/mmc_analysis.m 25 Mar 2008 03:39:03 -0000
@@ -30,25 +30,30 @@
:- instance compiler(mmc).
-:- func module_name_to_module_id(module_name) = module_id.
-:- func module_id_to_module_name(module_id) = module_name.
-
:- func pred_or_func_name_arity_to_func_id(pred_or_func, string, arity,
proc_id) = func_id.
-:- pred module_id_func_id(module_info::in, pred_proc_id::in,
- module_id::out, func_id::out) is det.
+:- pred module_name_func_id(module_info::in, pred_proc_id::in,
+ module_name::out, func_id::out) is det.
+
+:- pred func_id_to_ppid(module_info::in, module_name::in,
+ func_id::in, pred_proc_id::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module hlds.pred_table.
+:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_io.
:- import_module parse_tree.prog_out.
+:- import_module transform_hlds.ctgc.
+:- import_module transform_hlds.ctgc.structure_sharing.
+:- import_module transform_hlds.ctgc.structure_sharing.analysis.
:- import_module transform_hlds.exception_analysis.
:- import_module transform_hlds.tabling_analysis.
:- import_module transform_hlds.trailing_analysis.
@@ -86,18 +91,22 @@
unit1 : unit(unused_args_call),
unit1 : unit(unused_args_answer)),
- module_id_to_read_file_name(mmc, ModuleId, Ext, FileName, !IO) :-
- mmc_module_id_to_read_file_name(ModuleId, Ext, FileName, !IO),
+ analyses(mmc, "structure_sharing") =
+ 'new analysis_type'(
+ unit1 : unit(structure_sharing_call),
+ unit1 : unit(structure_sharing_answer)),
+
+ module_name_to_read_file_name(mmc, ModuleName, Ext, FileName, !IO) :-
+ mmc_module_name_to_read_file_name(ModuleName, Ext, FileName, !IO),
- module_id_to_write_file_name(mmc, ModuleId, Ext, FileName, !IO) :-
- mmc_module_id_to_write_file_name(ModuleId, Ext, FileName, !IO)
+ module_name_to_write_file_name(mmc, ModuleName, Ext, FileName, !IO) :-
+ mmc_module_name_to_write_file_name(ModuleName, Ext, FileName, !IO)
].
-:- pred mmc_module_id_to_read_file_name(module_id::in, string::in,
+:- pred mmc_module_name_to_read_file_name(module_name::in, string::in,
maybe_error(string)::out, io::di, io::uo) is det.
-mmc_module_id_to_read_file_name(ModuleId, Ext, MaybeFileName, !IO) :-
- ModuleName = module_id_to_module_name(ModuleId),
+mmc_module_name_to_read_file_name(ModuleName, Ext, MaybeFileName, !IO) :-
modules.module_name_to_search_file_name(ModuleName, Ext, FileName0, !IO),
globals.io_lookup_accumulating_option(intermod_directories, Dirs, !IO),
search_for_file(Dirs, FileName0, MaybeFileName, !IO),
@@ -109,32 +118,42 @@
MaybeFileName = error(_)
).
-:- pred mmc_module_id_to_write_file_name(module_id::in, string::in, string::out,
- io::di, io::uo) is det.
+:- pred mmc_module_name_to_write_file_name(module_name::in, string::in,
+ string::out, io::di, io::uo) is det.
-mmc_module_id_to_write_file_name(ModuleId, Ext, FileName, !IO) :-
- ModuleName = module_id_to_module_name(ModuleId),
+mmc_module_name_to_write_file_name(ModuleName, Ext, FileName, !IO) :-
module_name_to_file_name(ModuleName, Ext, yes, FileName, !IO).
-module_name_to_module_id(ModuleName) = sym_name_to_string(ModuleName).
+pred_or_func_name_arity_to_func_id(PredOrFunc, Name, Arity, ProcId) =
+ func_id(PredOrFunc, Name, Arity, ProcId).
-module_id_to_module_name(ModuleId) = string_to_sym_name(ModuleId).
-
-pred_or_func_name_arity_to_func_id(PredOrFunc, Name, Arity, ProcId) = FuncId :-
- SimpleCallId = simple_call_id(PredOrFunc, unqualified(Name), Arity),
- FuncId0 = simple_call_id_to_string(SimpleCallId),
- proc_id_to_int(ProcId, ProcInt),
- FuncId = FuncId0 ++ "-" ++ int_to_string(ProcInt).
-
-module_id_func_id(ModuleInfo, proc(PredId, ProcId), ModuleId, FuncId) :-
+module_name_func_id(ModuleInfo, proc(PredId, ProcId), PredModule, FuncId) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
PredModule = pred_info_module(PredInfo),
PredName = pred_info_name(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
PredArity = pred_info_orig_arity(PredInfo),
- ModuleId = module_name_to_module_id(PredModule),
- FuncId = pred_or_func_name_arity_to_func_id(PredOrFunc,
- PredName, PredArity, ProcId).
+ FuncId = func_id(PredOrFunc, PredName, PredArity, ProcId).
+
+func_id_to_ppid(ModuleInfo, ModuleName, FuncId, PPId) :-
+ FuncId = func_id(PredOrFunc, FuncName, Arity, ProcId),
+ module_info_get_predicate_table(ModuleInfo, PredTable),
+ (
+ predicate_table_search_pf_m_n_a(PredTable, is_fully_qualified,
+ PredOrFunc, ModuleName, FuncName, Arity, PredIds),
+ PredIds = [PredId]
+ ->
+ PPId = proc(PredId, ProcId)
+ ;
+ unexpected(this_file,
+ "func_id_to_ppid: more than one predicate")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "mmc_analysis.m".
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/prog_ctgc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_ctgc.m,v
retrieving revision 1.16
diff -u -r1.16 prog_ctgc.m
--- compiler/prog_ctgc.m 25 Jan 2008 00:14:28 -0000 1.16
+++ compiler/prog_ctgc.m 25 Mar 2008 03:39:03 -0000
@@ -344,7 +344,7 @@
parse_structure_sharing_domain(Term) = SharingAs :-
(
- Term = term.functor(term.atom(Cons), _, Context),
+ Term = term.functor(term.atom(Cons), _, _Context),
(
Cons = "[|]",
SharingAs0 = structure_sharing_real(parse_structure_sharing(Term))
@@ -353,16 +353,16 @@
SharingAs0 = structure_sharing_bottom
;
Cons = "top",
- context_to_string(Context, ContextMsg),
SharingAs0 = structure_sharing_top(
- set.make_singleton_set("imported top: " ++ ContextMsg ++ "."))
+ set.make_singleton_set(
+ top_cannot_improve("from parse_structure_sharing_domain")))
)
->
SharingAs = SharingAs0
;
unexpected(this_file, "Error while parsing structure sharing domain.")
).
-
+
parse_structure_reuse_condition(Term) = ReuseCondition :-
(
Term = term.functor(term.atom(Cons), Args, _)
@@ -442,8 +442,9 @@
Term = term.functor(term.atom("unknown_sharing"), [], Context),
context_to_string(Context, ContextString),
Msg = "user declared top(" ++ ContextString ++ ")",
+ Reason = top_cannot_improve(Msg),
UserSharing = user_sharing(structure_sharing_top(
- set.make_singleton_set(Msg)), no)
+ set.make_singleton_set(Reason)), no)
;
Term = term.functor(term.atom("sharing"),
[TypesTerm, UserSharingTerm], _),
@@ -625,8 +626,7 @@
;
VerboseTop = yes,
io.write_string("top([", !IO),
- io.write_list(set.to_sorted_list(Msgs), Separator, io.write_string,
- !IO),
+ io.write_list(set.to_sorted_list(Msgs), Separator, io.write, !IO),
io.write_string("])", !IO)
)
;
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.209
diff -u -r1.209 prog_data.m
--- compiler/prog_data.m 4 Mar 2008 00:36:06 -0000 1.209
+++ compiler/prog_data.m 25 Mar 2008 03:39:03 -0000
@@ -342,10 +342,24 @@
% Whenever structure sharing analysis is unable to determine a good
% approximation of the set of structure sharing pairs that might exist
% during the execution of a program, it must use "top" as the only safe
- % approximation. In order to collect some useful basic feedback information
- % as to `why' a top was generated, we use:
+ % approximation.
%
-:- type top_feedback == string.
+ % We divide the reasons for approximating by `top' into two cases:
+ %
+ % - the procedure calls some imported procedure for which we don't have an
+ % answer (yet). The result might be improved if we did have that
+ % information.
+ %
+ % - the procedure calls some imported procedure for which we managed to
+ % look up the answer, and that answer was `top'.
+ %
+ % - the procedure contains a call to foreign or generic code.
+ % Reanalysis will not improve the result.
+ %
+:- type top_feedback
+ ---> top_failed_lookup(shrouded_pred_proc_id)
+ ; top_from_lookup(shrouded_pred_proc_id)
+ ; top_cannot_improve(string).
% Elements of the structure sharing domain lattice are either bottom
% (no structure sharing), top (any kind of structure sharing), or
Index: compiler/structure_reuse.direct.detect_garbage.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.detect_garbage.m,v
retrieving revision 1.14
diff -u -r1.14 structure_reuse.direct.detect_garbage.m
--- compiler/structure_reuse.direct.detect_garbage.m 27 Feb 2008 07:23:15 -0000 1.14
+++ compiler/structure_reuse.direct.detect_garbage.m 25 Mar 2008 03:39:03 -0000
@@ -115,7 +115,8 @@
Context = goal_info_get_context(GoalInfo),
context_to_string(Context, ContextString),
!:SharingAs = sharing_as_top_sharing_accumulate(
- "generic call (" ++ ContextString ++ ")", !.SharingAs)
+ top_cannot_improve("generic call (" ++ ContextString ++ ")"),
+ !.SharingAs)
;
GoalExpr = unify(_, _, _, Unification, _),
unification_verify_reuse(ModuleInfo, ProcInfo, GoalInfo,
Index: compiler/structure_reuse.direct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.m,v
retrieving revision 1.9
diff -u -r1.9 structure_reuse.direct.m
--- compiler/structure_reuse.direct.m 10 Jan 2008 04:29:53 -0000 1.9
+++ compiler/structure_reuse.direct.m 25 Mar 2008 03:39:03 -0000
@@ -119,9 +119,17 @@
direct_reuse_process_pred(Strategy, SharingTable, PredId, !ModuleInfo,
!ReuseTable, !IO):-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
- list.foldl3(direct_reuse_process_proc(Strategy, SharingTable, PredId),
- pred_info_non_imported_procids(PredInfo0), !ModuleInfo,
- !ReuseTable, !IO).
+ (
+ pred_info_get_origin(PredInfo0, Origin),
+ Origin = origin_special_pred(_)
+ ->
+ % We can't analyse compiler generated special predicates.
+ true
+ ;
+ list.foldl3(direct_reuse_process_proc(Strategy, SharingTable, PredId),
+ pred_info_non_imported_procids(PredInfo0), !ModuleInfo,
+ !ReuseTable, !IO)
+ ).
:- pred direct_reuse_process_proc(reuse_strategy::in, sharing_as_table::in,
pred_id::in, proc_id::in, module_info::in, module_info::out,
Index: compiler/structure_reuse.indirect.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.indirect.m,v
retrieving revision 1.17
diff -u -r1.17 structure_reuse.indirect.m
--- compiler/structure_reuse.indirect.m 27 Feb 2008 07:23:15 -0000 1.17
+++ compiler/structure_reuse.indirect.m 25 Mar 2008 03:39:03 -0000
@@ -48,6 +48,7 @@
:- implementation.
+:- import_module analysis.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module hlds.passes_aux.
@@ -130,6 +131,23 @@
indirect_reuse_analyse_pred_proc(SharingTable, ReuseTable, PPId,
!ModuleInfo, !FixpointTable, !IO):-
+ PPId = proc(PredId, _),
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+ pred_info_get_origin(PredInfo, Origin),
+ ( Origin = origin_special_pred(_) ->
+ % We can't analyse compiler generated special predicates.
+ true
+ ;
+ indirect_reuse_analyse_pred_proc_2(SharingTable, ReuseTable, PPId,
+ !ModuleInfo, !FixpointTable, !IO)
+ ).
+
+:- pred indirect_reuse_analyse_pred_proc_2(sharing_as_table::in,
+ reuse_as_table::in, pred_proc_id::in, module_info::in, module_info::out,
+ sr_fixpoint_table::in, sr_fixpoint_table::out, io::di, io::uo) is det.
+
+indirect_reuse_analyse_pred_proc_2(SharingTable, ReuseTable, PPId,
+ !ModuleInfo, !FixpointTable, !IO):-
globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo0, ProcInfo0),
@@ -291,10 +309,11 @@
GoalExpr0 = generic_call(_GenDetails, _, _, _),
Context = goal_info_get_context(GoalInfo0),
context_to_string(Context, ContextString),
+ SharingAs = !.AnalysisInfo ^ sharing_as,
+ Msg = "generic call (" ++ ContextString ++ ")",
!:AnalysisInfo = !.AnalysisInfo ^ sharing_as :=
- sharing_as_top_sharing_accumulate("generic call ("
- ++ ContextString ++ ")",
- !.AnalysisInfo ^ sharing_as)
+ sharing_as_top_sharing_accumulate(top_cannot_improve(Msg),
+ SharingAs)
;
GoalExpr0 = unify(_, _, _, Unification, _),
% Record the statically constructed variables.
@@ -649,8 +668,8 @@
% Same as sr_fixpoint_table_get_final_as, yet fails instead of aborting
% if the procedure is not in the table.
%
-:- func sr_fixpoint_table_get_final_as_semidet(pred_proc_id,
- sr_fixpoint_table) = reuse_as is semidet.
+:- pred sr_fixpoint_table_get_final_as_semidet(pred_proc_id::in,
+ sr_fixpoint_table::in, reuse_as::out) is semidet.
%-----------------------------------------------------------------------------%
@@ -689,7 +708,7 @@
;
Rec = "(non-rec)"
),
- ( As = sr_fixpoint_table_get_final_as_semidet(PPId, Table) ->
+ ( sr_fixpoint_table_get_final_as_semidet(PPId, Table, As) ->
Descr0 = reuse_as_short_description(As)
;
Descr0 = "-"
@@ -699,8 +718,8 @@
sr_fixpoint_table_get_final_as(PPId, T) =
get_from_fixpoint_table_final(PPId, T).
-sr_fixpoint_table_get_final_as_semidet(PPId, T) =
- get_from_fixpoint_table_final_semidet(PPId, T).
+sr_fixpoint_table_get_final_as_semidet(PPId, T, Elem) :-
+ get_from_fixpoint_table_final_semidet(PPId, T, Elem).
%------------------------------------------------------------------------------%
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.30
diff -u -r1.30 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m 27 Feb 2008 07:23:15 -0000 1.30
+++ compiler/structure_sharing.analysis.m 25 Mar 2008 03:39:03 -0000
@@ -17,6 +17,7 @@
:- module transform_hlds.ctgc.structure_sharing.analysis.
:- interface.
+:- import_module analysis.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
@@ -37,12 +38,36 @@
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
+
+:- type structure_sharing_call.
+:- type structure_sharing_answer.
+:- type structure_sharing_func_info.
+
+ % Only answer patterns actually require structure_sharing_func_info for
+ % comparisons.
+ %
+:- instance analysis(structure_sharing_func_info,
+ structure_sharing_call, structure_sharing_answer).
+
+:- instance call_pattern(structure_sharing_func_info, structure_sharing_call).
+:- instance partial_order(structure_sharing_func_info,
+ structure_sharing_call).
+:- instance to_string(structure_sharing_call).
+
+:- instance answer_pattern(structure_sharing_func_info,
+ structure_sharing_answer).
+:- instance partial_order(structure_sharing_func_info,
+ structure_sharing_answer).
+:- instance to_string(structure_sharing_answer).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.simplify.
:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_out.
:- import_module hlds.passes_aux.
:- import_module libs.compiler_util.
:- import_module libs.globals.
@@ -56,17 +81,16 @@
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
-:- import_module parse_tree.prog_type_subst.
:- import_module transform_hlds.ctgc.fixpoint_table.
:- import_module transform_hlds.ctgc.structure_sharing.domain.
:- import_module transform_hlds.ctgc.util.
:- 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 svmap.
@@ -74,11 +98,26 @@
%-----------------------------------------------------------------------------%
+ % During analysis we accumulate a list of imported procedures whose
+ % answers this module depends on. This doesn't include `opt_imported'
+ % procedures nor procedures that we can just predict the results for.
+ %
+:- type dep_procs == list(pred_proc_id).
+
+%-----------------------------------------------------------------------------%
+
structure_sharing_analysis(!ModuleInfo, !IO) :-
%
% Process all the imported sharing information.
%
- process_imported_sharing(!ModuleInfo),
+ globals.io_lookup_bool_option(intermodule_analysis, IntermodAnalysis, !IO),
+ (
+ IntermodAnalysis = yes,
+ process_intermod_analysis_imported_sharing(!ModuleInfo)
+ ;
+ IntermodAnalysis = no,
+ process_imported_sharing(!ModuleInfo)
+ ),
%
% Annotate the HLDS with liveness information.
%
@@ -97,8 +136,6 @@
%
globals.io_lookup_bool_option(make_optimization_interface,
MakeOptInt, !IO),
- globals.io_lookup_bool_option(intermodule_analysis,
- IntermodAnalysis, !IO),
(
MakeOptInt = yes,
IntermodAnalysis = no
@@ -113,7 +150,7 @@
% Preliminary steps
%
- % Process the imported sharing information.
+ % Process the imported sharing information from .opt files
%
:- pred process_imported_sharing(module_info::in, module_info::out) is det.
@@ -171,7 +208,11 @@
rename_structure_sharing_domain(VarRenaming, !.TypeSubst,
ImpSharing, Sharing)
),
- proc_info_set_structure_sharing(Sharing, !ProcInfo),
+ % Optimality does not apply to `--intermodule-optimisation'
+ % system, only `--intermodule-analysis'.
+ proc_info_set_structure_sharing(
+ structure_sharing_domain_and_status(Sharing, optimal),
+ !ProcInfo),
proc_info_reset_imported_structure_sharing(!ProcInfo),
svmap.det_update(ProcId, !.ProcInfo, !ProcTable)
;
@@ -181,6 +222,111 @@
%-----------------------------------------------------------------------------%
+ % Process the intermodule imported sharing information from the analysis
+ % framework
+ %
+:- pred process_intermod_analysis_imported_sharing(module_info::in,
+ module_info::out) is det.
+
+process_intermod_analysis_imported_sharing(!ModuleInfo):-
+ module_info_predids(PredIds, !ModuleInfo),
+ list.foldl(process_intermod_analysis_imported_sharing_in_pred, PredIds,
+ !ModuleInfo).
+
+:- pred process_intermod_analysis_imported_sharing_in_pred(pred_id::in,
+ module_info::in, module_info::out) is det.
+
+process_intermod_analysis_imported_sharing_in_pred(PredId, !ModuleInfo) :-
+ some [!PredTable] (
+ module_info_preds(!.ModuleInfo, !:PredTable),
+ PredInfo0 = !.PredTable ^ det_elem(PredId),
+ pred_info_get_import_status(PredInfo0, ImportStatus),
+ ( ImportStatus = status_imported(_) ->
+ module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo),
+ process_intermod_analysis_imported_sharing_in_procs(!.ModuleInfo,
+ AnalysisInfo, PredId, PredInfo0, PredInfo),
+ svmap.det_update(PredId, PredInfo, !PredTable),
+ module_info_set_preds(!.PredTable, !ModuleInfo)
+ ;
+ true
+ )
+ ).
+
+:- pred process_intermod_analysis_imported_sharing_in_procs(module_info::in,
+ analysis_info::in, pred_id::in, pred_info::in, pred_info::out) is det.
+
+process_intermod_analysis_imported_sharing_in_procs(ModuleInfo, AnalysisInfo,
+ PredId, !PredInfo) :-
+ some [!ProcTable] (
+ pred_info_get_procedures(!.PredInfo, !:ProcTable),
+ ProcIds = pred_info_procids(!.PredInfo),
+ list.foldl(
+ process_intermod_analysis_imported_sharing_in_proc(ModuleInfo,
+ AnalysisInfo, PredId, !.PredInfo),
+ ProcIds, !ProcTable),
+ pred_info_set_procedures(!.ProcTable, !PredInfo)
+ ).
+
+:- pred process_intermod_analysis_imported_sharing_in_proc(module_info::in,
+ analysis_info::in, pred_id::in, pred_info::in, proc_id::in,
+ proc_table::in, proc_table::out) is det.
+
+process_intermod_analysis_imported_sharing_in_proc(ModuleInfo, AnalysisInfo,
+ PredId, PredInfo, ProcId, !ProcTable) :-
+ PPId = proc(PredId, ProcId),
+ some [!ProcInfo] (
+ !:ProcInfo = !.ProcTable ^ det_elem(ProcId),
+
+ module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
+ FuncInfo = structure_sharing_func_info(ModuleInfo, !.ProcInfo),
+ lookup_best_result(AnalysisInfo, ModuleName, FuncId, FuncInfo,
+ structure_sharing_call, MaybeBestResult),
+ (
+ MaybeBestResult = yes(analysis_result(_Call, Answer,
+ ResultStatus)),
+ structure_sharing_answer_to_domain(PPId, PredInfo, !.ProcInfo,
+ Answer, Sharing),
+ proc_info_set_structure_sharing(
+ structure_sharing_domain_and_status(Sharing, ResultStatus),
+ !ProcInfo),
+ svmap.det_update(ProcId, !.ProcInfo, !ProcTable)
+ ;
+ MaybeBestResult = no
+ )
+ ).
+
+:- pred structure_sharing_answer_to_domain(pred_proc_id::in, pred_info::in,
+ proc_info::in, structure_sharing_answer::in, structure_sharing_domain::out)
+ is det.
+
+structure_sharing_answer_to_domain(PPId, PredInfo, ProcInfo, Answer, Sharing)
+ :-
+ (
+ Answer = structure_sharing_answer_bottom,
+ Sharing = structure_sharing_bottom
+ ;
+ Answer = structure_sharing_answer_top,
+ Sharing = structure_sharing_top(set.make_singleton_set(
+ top_from_lookup(shroud_pred_proc_id(PPId))))
+ ;
+ Answer = structure_sharing_answer_real(ImpHeadVars, ImpTypes,
+ ImpSharingAs),
+ proc_info_get_headvars(ProcInfo, HeadVars),
+ pred_info_get_arg_types(PredInfo, HeadVarTypes),
+ map.from_corresponding_lists(ImpHeadVars, HeadVars, VarRenaming),
+ ( type_unify_list(ImpTypes, HeadVarTypes, [], map.init, TypeSubst) ->
+ ImpSharingDomain = to_structure_sharing_domain( ImpSharingAs),
+ rename_structure_sharing_domain(VarRenaming, TypeSubst,
+ ImpSharingDomain, Sharing)
+ ;
+ unexpected(this_file,
+ "structure_sharing_answer_to_domain: type_unify_list failed")
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
% Annotate the HLDS with pre-birth and post-death information, as
% used by the liveness pass (liveness.m). This information is used to
% eliminate useless sharing pairs during sharing analysis.
@@ -222,7 +368,8 @@
(
MaybeDepInfo = yes(DepInfo),
hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
- list.foldl2(analyse_scc(!.ModuleInfo), SCCs, !SharingTable, !IO)
+ list.foldl3(analyse_scc(!.ModuleInfo), SCCs,
+ !SharingTable, [], DepProcs, !IO)
;
MaybeDepInfo = no,
unexpected(this_file, "No dependency information.")
@@ -230,43 +377,81 @@
%
% Record the sharing results in the HLDS.
%
- map.foldl(save_sharing_in_module_info, !.SharingTable, !ModuleInfo).
+ map.foldl(save_sharing_in_module_info, !.SharingTable, !ModuleInfo),
+ %
+ % If making a `.analysis' file, record structure sharing results, analysis
+ % dependencies, assumed answers and requests in the analysis framework.
+ %
+ globals.io_lookup_bool_option(make_analysis_registry,
+ MakeAnalysisRegistry, !IO),
+ (
+ MakeAnalysisRegistry = yes,
+ some [!AnalysisInfo] (
+ module_info_get_analysis_info(!.ModuleInfo, !:AnalysisInfo),
+ list.foldl(
+ record_sharing_analysis_results(!.ModuleInfo, !.SharingTable),
+ SCCs, !AnalysisInfo),
+ list.foldl(handle_dep_procs(!.ModuleInfo), DepProcs,
+ !AnalysisInfo),
+ module_info_set_analysis_info(!.AnalysisInfo, !ModuleInfo)
+ )
+ ;
+ MakeAnalysisRegistry = no
+ ).
-:- pred save_sharing_in_module_info(pred_proc_id::in, sharing_as::in,
- module_info::in, module_info::out) is det.
+:- pred save_sharing_in_module_info(pred_proc_id::in,
+ sharing_as_and_status::in, module_info::in, module_info::out) is det.
-save_sharing_in_module_info(PPId, SharingAs, !ModuleInfo) :-
+save_sharing_in_module_info(PPId, SharingAs_Status, !ModuleInfo) :-
+ SharingAs_Status = sharing_as_and_status(SharingAs, Status),
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, ProcInfo0),
- proc_info_set_structure_sharing(to_structure_sharing_domain(SharingAs),
+ SharingDomain = to_structure_sharing_domain(SharingAs),
+ proc_info_set_structure_sharing(
+ structure_sharing_domain_and_status(SharingDomain, Status),
ProcInfo0, ProcInfo),
module_info_set_pred_proc_info(PPId, PredInfo, ProcInfo, !ModuleInfo).
:- pred analyse_scc(module_info::in, list(pred_proc_id)::in,
- sharing_as_table::in, sharing_as_table::out, io::di, io::uo) is det.
+ sharing_as_table::in, sharing_as_table::out,
+ dep_procs::in, dep_procs::out, io::di, io::uo) is det.
-analyse_scc(ModuleInfo, SCC, !SharingTable, !IO) :-
+analyse_scc(ModuleInfo, SCC, !SharingTable, !DepProcs, !IO) :-
( some_preds_requiring_no_analysis(ModuleInfo, SCC) ->
- true
+ % At least one procedure in the SCC requires that we don't analyse it.
+ % We update the sharing table otherwise procedures which call it will
+ % not be able to find a result, and therefore conclude that the
+ % analysis is suboptimal.
+ ProcsStrings = list.map(pred_proc_id_to_string(ModuleInfo), SCC),
+ ProcsString = string.join_list(", ", ProcsStrings),
+ Msg = "SCC cannot be analysed: " ++ ProcsString,
+ SharingAs = sharing_as_top_sharing(top_cannot_improve(Msg)),
+ SharingAndStatus = sharing_as_and_status(SharingAs, optimal),
+ list.foldl(
+ (pred(PPId::in, ST0::in, ST::out) is det :-
+ sharing_as_table_set(PPId, SharingAndStatus, ST0, ST)
+ ),
+ SCC, !SharingTable)
;
+ FixpointTable0 = ss_fixpoint_table_init(SCC),
analyse_scc_until_fixpoint(ModuleInfo, SCC, !.SharingTable,
- ss_fixpoint_table_init(SCC), FixpointTable, !IO),
+ FixpointTable0, FixpointTable, !DepProcs, !IO),
list.foldl(update_sharing_in_table(FixpointTable), SCC, !SharingTable)
).
:- pred analyse_scc_until_fixpoint(module_info::in, list(pred_proc_id)::in,
sharing_as_table::in, ss_fixpoint_table::in, ss_fixpoint_table::out,
- io::di, io::uo) is det.
+ dep_procs::in, dep_procs::out, io::di, io::uo) is det.
analyse_scc_until_fixpoint(ModuleInfo, SCC, SharingTable,
- !FixpointTable, !IO) :-
- list.foldl2(analyse_pred_proc(ModuleInfo, SharingTable), SCC,
- !FixpointTable, !IO),
+ !FixpointTable, !DepProcs, !IO) :-
+ list.foldl3(analyse_pred_proc(ModuleInfo, SharingTable), SCC,
+ !FixpointTable, !DepProcs, !IO),
( ss_fixpoint_table_stable(!.FixpointTable) ->
true
;
ss_fixpoint_table_new_run(!FixpointTable),
analyse_scc_until_fixpoint(ModuleInfo, SCC, SharingTable,
- !FixpointTable, !IO)
+ !FixpointTable, !DepProcs, !IO)
).
%-----------------------------------------------------------------------------%
@@ -276,9 +461,10 @@
:- pred analyse_pred_proc(module_info::in, sharing_as_table::in,
pred_proc_id::in, ss_fixpoint_table::in, ss_fixpoint_table::out,
- io::di, io::uo) is det.
+ dep_procs::in, dep_procs::out, io::di, io::uo) is det.
-analyse_pred_proc(ModuleInfo, SharingTable, PPId, !FixpointTable, !IO) :-
+analyse_pred_proc(ModuleInfo, SharingTable, PPId, !FixpointTable, !DepProcs,
+ !IO) :-
% Collect relevant compiler options.
globals.io_lookup_bool_option(very_verbose, Verbose, !IO),
globals.io_lookup_int_option(structure_sharing_widening, WideningLimit,
@@ -303,13 +489,18 @@
%
some [!Sharing] (
!:Sharing = sharing_as_init,
- ( bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo) ->
- maybe_write_string(Verbose, "\t\t: bottom predicted", !IO)
+ (
+ bottom_sharing_is_safe_approximation(ModuleInfo, PredInfo,
+ ProcInfo)
+ ->
+ maybe_write_string(Verbose, "\t\t: bottom predicted", !IO),
+ Status = optimal
;
% Start analysis.
proc_info_get_goal(ProcInfo, Goal),
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable,
- Verbose, Goal, !FixpointTable, !Sharing, !IO),
+ Verbose, Goal, !FixpointTable, !DepProcs, !Sharing,
+ optimal, Status),
FullAsDescr = sharing_as_short_description(!.Sharing),
sharing_as_project(HeadVars, !Sharing),
@@ -331,11 +522,12 @@
ProjAsDescr ++ "/" ++
WidenAsDescr, !IO)
),
- ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, PPId, !.Sharing,
+ SharingAs_Status = sharing_as_and_status(!.Sharing, Status),
+ ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, PPId, SharingAs_Status,
!FixpointTable)
),
- maybe_write_string(Verbose, "\t\t (ft = " ++
- ss_fixpoint_table_description(!.FixpointTable) ++ ")\n", !IO).
+ Desc = ss_fixpoint_table_description(!.FixpointTable),
+ maybe_write_string(Verbose, "\t\t (ft = " ++ Desc ++ ")\n", !IO).
%-----------------------------------------------------------------------------%
%
@@ -345,30 +537,48 @@
:- pred analyse_goal(module_info::in, pred_info::in, proc_info::in,
sharing_as_table::in, bool::in, hlds_goal::in,
ss_fixpoint_table::in, ss_fixpoint_table::out,
- sharing_as::in, sharing_as::out, io::di, io::uo) is det.
+ dep_procs::in, dep_procs::out, sharing_as::in, sharing_as::out,
+ analysis_status::in, analysis_status::out) is det.
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose, Goal,
- !FixpointTable, !SharingAs, !IO) :-
+ !FixpointTable, !DepProcs, !SharingAs, !Status) :-
Goal = hlds_goal(GoalExpr, GoalInfo),
(
GoalExpr = conj(ConjType, Goals),
(
ConjType = plain_conj,
- list.foldl3(analyse_goal_with_progress(ModuleInfo, PredInfo,
+ list.foldl4(analyse_goal_with_progress(ModuleInfo, PredInfo,
ProcInfo, SharingTable, Verbose), Goals,
- !FixpointTable, !SharingAs, !IO)
+ !FixpointTable, !DepProcs, !SharingAs, !Status)
;
ConjType = parallel_conj,
Context = goal_info_get_context(GoalInfo),
context_to_string(Context, ContextString),
!:SharingAs = sharing_as_top_sharing_accumulate(
- "par_conj (" ++ ContextString ++ ")", !.SharingAs)
+ top_cannot_improve("par_conj (" ++ ContextString ++ ")"),
+ !.SharingAs)
)
;
GoalExpr = plain_call(CalleePredId, CalleeProcId, CallArgs,_, _, _),
CalleePPId = proc(CalleePredId, CalleeProcId),
lookup_sharing(ModuleInfo, SharingTable, CalleePPId,
- !FixpointTable, CalleeSharing),
+ !FixpointTable, CalleeSharing, CalleeStatus, IsPredicted),
+
+ % If the called procedure was imported (not opt_imported) and its
+ % result is not predictable, then remember that this module depends on
+ % the results for that procedure.
+ (
+ IsPredicted = no,
+ pred_info_get_import_status(PredInfo, PredImportStatus),
+ status_defined_in_this_module(PredImportStatus) = yes,
+ module_info_pred_info(ModuleInfo, CalleePredId, CalleePredInfo),
+ pred_info_get_import_status(CalleePredInfo, CalleeImportStatus),
+ CalleeImportStatus = status_imported(_)
+ ->
+ !:DepProcs = [CalleePPId | !.DepProcs]
+ ;
+ true
+ ),
% Rename
proc_info_get_vartypes(ProcInfo, CallerVarTypes),
@@ -381,29 +591,33 @@
% Combine
!:SharingAs = sharing_as_comb(ModuleInfo, ProcInfo,
- RenamedSharing, !.SharingAs)
+ RenamedSharing, !.SharingAs),
+ !:Status = lub(CalleeStatus, !.Status)
;
GoalExpr = generic_call(_GenDetails, _, _, _),
Context = goal_info_get_context(GoalInfo),
context_to_string(Context, ContextString),
!:SharingAs = sharing_as_top_sharing_accumulate(
- "generic call (" ++ ContextString ++ ")", !.SharingAs)
+ top_cannot_improve("generic call (" ++ ContextString ++ ")"),
+ !.SharingAs)
;
GoalExpr = unify(_, _, _, Unification, _),
!:SharingAs = add_unify_sharing(ModuleInfo, ProcInfo, Unification,
GoalInfo, !.SharingAs)
;
GoalExpr = disj(Goals),
- list.foldl3(
+ list.foldl4(
analyse_disj(ModuleInfo, PredInfo, ProcInfo,
SharingTable, !.SharingAs, Verbose),
- Goals, !FixpointTable, sharing_as_init, !:SharingAs, !IO)
+ Goals, !FixpointTable, !DepProcs,
+ sharing_as_init, !:SharingAs, !Status)
;
GoalExpr = switch(_, _, Cases),
- list.foldl3(
+ list.foldl4(
analyse_case(ModuleInfo, PredInfo, ProcInfo,
SharingTable, !.SharingAs, Verbose),
- Cases, !FixpointTable, sharing_as_init, !:SharingAs, !IO)
+ Cases, !FixpointTable, !DepProcs,
+ sharing_as_init, !:SharingAs, !Status)
;
GoalExpr = negation(_Goal)
% XXX Check theory, but a negated goal can not create bindings,
@@ -412,15 +626,18 @@
GoalExpr = scope(_, SubGoal),
% XXX Check theory.
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose,
- SubGoal, !FixpointTable, !SharingAs, !IO)
+ SubGoal, !FixpointTable, !DepProcs, !SharingAs, !Status)
;
GoalExpr = if_then_else(_, IfGoal, ThenGoal, ElseGoal),
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose,
- IfGoal, !FixpointTable, !.SharingAs, IfSharingAs, !IO),
+ IfGoal, !FixpointTable, !DepProcs,
+ !.SharingAs, IfSharingAs, !Status),
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose,
- ThenGoal, !FixpointTable, IfSharingAs, ThenSharingAs, !IO),
+ ThenGoal, !FixpointTable, !DepProcs,
+ IfSharingAs, ThenSharingAs, !Status),
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose,
- ElseGoal, !FixpointTable, !.SharingAs, ElseSharingAs, !IO),
+ ElseGoal, !FixpointTable, !DepProcs,
+ !.SharingAs, ElseSharingAs, !Status),
!:SharingAs = sharing_as_least_upper_bound(ModuleInfo, ProcInfo,
ThenSharingAs, ElseSharingAs)
;
@@ -439,19 +656,22 @@
:- pred analyse_goal_with_progress(module_info::in, pred_info::in,
proc_info::in, sharing_as_table::in, bool::in, hlds_goal::in,
ss_fixpoint_table::in, ss_fixpoint_table::out,
- sharing_as::in, sharing_as::out, io::di, io::uo) is det.
+ dep_procs::in, dep_procs::out, sharing_as::in, sharing_as::out,
+ analysis_status::in, analysis_status::out) is det.
analyse_goal_with_progress(ModuleInfo, PredInfo, ProcInfo, SharingTable,
- Verbose, Goal, !FixpointTable, !SharingAs, !IO) :-
+ Verbose, Goal, !FixpointTable, !DepProcs, !SharingAs, !Status) :-
(
Verbose = yes,
- io.write_char('.', !IO),
- io.flush_output(!IO)
+ trace [io(!IO)] (
+ io.write_char('.', !IO),
+ io.flush_output(!IO)
+ )
;
Verbose = no
),
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose, Goal,
- !FixpointTable, !SharingAs, !IO).
+ !FixpointTable, !DepProcs, !SharingAs, !Status).
%-----------------------------------------------------------------------------%
%
@@ -461,12 +681,14 @@
:- pred analyse_disj(module_info::in, pred_info::in, proc_info::in,
sharing_as_table::in, sharing_as::in, bool::in, hlds_goal::in,
ss_fixpoint_table::in, ss_fixpoint_table::out,
- sharing_as::in, sharing_as::out, io::di, io::uo) is det.
+ dep_procs::in, dep_procs::out, sharing_as::in, sharing_as::out,
+ analysis_status::in, analysis_status::out) is det.
analyse_disj(ModuleInfo, PredInfo, ProcInfo, SharingTable, SharingBeforeDisj,
- Verbose, Goal, !FixpointTable, !Sharing, !IO) :-
+ Verbose, Goal, !FixpointTable, !DepProcs, !Sharing, !Status) :-
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose, Goal,
- !FixpointTable, SharingBeforeDisj, GoalSharing, !IO),
+ !FixpointTable, !DepProcs, SharingBeforeDisj, GoalSharing,
+ !Status),
!:Sharing = sharing_as_least_upper_bound(ModuleInfo, ProcInfo, !.Sharing,
GoalSharing).
@@ -478,13 +700,14 @@
:- pred analyse_case(module_info::in, pred_info::in, proc_info::in,
sharing_as_table::in, sharing_as::in, bool::in, case::in,
ss_fixpoint_table::in, ss_fixpoint_table::out,
- sharing_as::in, sharing_as::out, io::di, io::uo) is det.
+ dep_procs::in, dep_procs::out, sharing_as::in, sharing_as::out,
+ analysis_status::in, analysis_status::out) is det.
analyse_case(ModuleInfo, PredInfo, ProcInfo, SharingTable, Sharing0,
- Verbose, Case, !FixpointTable, !Sharing, !IO) :-
+ Verbose, Case, !FixpointTable, !DepProcs, !Sharing, !Status) :-
Case = case(_, _, Goal),
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose, Goal,
- !FixpointTable, Sharing0, CaseSharing, !IO),
+ !FixpointTable, !DepProcs, Sharing0, CaseSharing, !Status),
!:Sharing = sharing_as_least_upper_bound(ModuleInfo, ProcInfo, !.Sharing,
CaseSharing).
@@ -497,16 +720,20 @@
% pred_proc_id.
%
:- pred lookup_sharing(module_info::in, sharing_as_table::in, pred_proc_id::in,
- ss_fixpoint_table::in, ss_fixpoint_table::out, sharing_as::out) is det.
+ ss_fixpoint_table::in, ss_fixpoint_table::out, sharing_as::out,
+ analysis_status::out, bool::out) is det.
-lookup_sharing(ModuleInfo, SharingTable, PPId, !FixpointTable, SharingAs) :-
+lookup_sharing(ModuleInfo, SharingTable, PPId, !FixpointTable, SharingAs,
+ Status, IsPredicted) :-
(
% check fixpoint table
- ss_fixpoint_table_get_as(PPId, SharingAs0, !FixpointTable)
+ ss_fixpoint_table_get_as(PPId, SharingAs_Status, !FixpointTable)
->
- SharingAs = SharingAs0
+ SharingAs_Status = sharing_as_and_status(SharingAs, Status),
+ IsPredicted = no
;
- lookup_sharing_or_predict(ModuleInfo, SharingTable, PPId, SharingAs)
+ lookup_sharing_or_predict(ModuleInfo, SharingTable, PPId, SharingAs,
+ Status, IsPredicted)
).
%-----------------------------------------------------------------------------%
@@ -515,16 +742,16 @@
sharing_as_table::in, sharing_as_table::out) is det.
update_sharing_in_table(FixpointTable, PPId, !SharingTable) :-
- sharing_as_table_set(PPId,
- ss_fixpoint_table_get_final_as(PPId, FixpointTable),
- !SharingTable).
+ ss_fixpoint_table_get_final_as(PPId, FixpointTable, SharingAs_Status),
+ sharing_as_table_set(PPId, SharingAs_Status, !SharingTable).
%-----------------------------------------------------------------------------%
%
% Structure sharing fixpoint table.
%
-:- type ss_fixpoint_table == fixpoint_table(pred_proc_id, sharing_as).
+:- type ss_fixpoint_table ==
+ fixpoint_table(pred_proc_id, sharing_as_and_status).
% Initialise the fixpoint table for the given set of pred_proc_id's.
%
@@ -557,7 +784,7 @@
% Software error if the procedure is not in the fixpoint table.
%
:- pred ss_fixpoint_table_new_as(module_info::in, proc_info::in,
- pred_proc_id::in, sharing_as::in,
+ pred_proc_id::in, sharing_as_and_status::in,
ss_fixpoint_table::in, ss_fixpoint_table::out) is det.
% Retrieve the structure sharing description for a given pred_proc_id.
@@ -569,7 +796,7 @@
%
% If the id is not part of the fixpoint table: fail.
%
-:- pred ss_fixpoint_table_get_as(pred_proc_id::in, sharing_as::out,
+:- pred ss_fixpoint_table_get_as(pred_proc_id::in, sharing_as_and_status::out,
ss_fixpoint_table::in, ss_fixpoint_table::out) is semidet.
:- func ss_fixpoint_table_get_short_description(pred_proc_id,
@@ -579,20 +806,20 @@
% To be used after fixpoint has been reached.
% Software error if the procedure is not in the table.
%
-:- func ss_fixpoint_table_get_final_as(pred_proc_id,
- ss_fixpoint_table) = sharing_as.
+:- pred ss_fixpoint_table_get_final_as(pred_proc_id::in,
+ ss_fixpoint_table::in, sharing_as_and_status::out) is det.
- % Same as ss_fixpoint_table_get_final_as, yet fails instead of aborting
+ % Same as ss_fixpoint_table_get_final_as, but fails instead of aborting
% if the procedure is not in the table.
%
-:- func ss_fixpoint_table_get_final_as_semidet(pred_proc_id,
- ss_fixpoint_table) = sharing_as is semidet.
+:- pred ss_fixpoint_table_get_final_as_semidet(pred_proc_id::in,
+ ss_fixpoint_table::in, sharing_as_and_status::out) is semidet.
%-----------------------------------------------------------------------------%
-:- func wrapped_init(pred_proc_id) = sharing_as.
+:- func wrapped_init(pred_proc_id) = sharing_as_and_status.
-wrapped_init(_Id) = sharing_as_init.
+wrapped_init(_Id) = sharing_as_and_status(sharing_as_init, optimal).
ss_fixpoint_table_init(Keys) = init_fixpoint_table(wrapped_init, Keys).
@@ -607,24 +834,26 @@
ss_fixpoint_table_description(Table) = fixpoint_table.description(Table).
ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, Id, SharingAs, !Table) :-
- add_to_fixpoint_table(sharing_as_is_subsumed_by(ModuleInfo, ProcInfo),
+ add_to_fixpoint_table(
+ sharing_as_and_status_is_subsumed_by(ModuleInfo, ProcInfo),
Id, SharingAs, !Table).
ss_fixpoint_table_get_as(PPId, SharingAs, !Table) :-
get_from_fixpoint_table(PPId, SharingAs, !Table).
ss_fixpoint_table_get_short_description(PPId, Table) = Descr :-
- ( As = ss_fixpoint_table_get_final_as_semidet(PPId, Table) ->
+ ( ss_fixpoint_table_get_final_as_semidet(PPId, Table, SharingAs_Status) ->
+ SharingAs_Status = sharing_as_and_status(As, _Status),
Descr = sharing_as_short_description(As)
;
Descr = "-"
).
-ss_fixpoint_table_get_final_as(PPId, T) =
- get_from_fixpoint_table_final(PPId, T).
+ss_fixpoint_table_get_final_as(PPId, T, SharingAs_Status) :-
+ SharingAs_Status = get_from_fixpoint_table_final(PPId, T).
-ss_fixpoint_table_get_final_as_semidet(PPId, T) =
- get_from_fixpoint_table_final_semidet(PPId, T).
+ss_fixpoint_table_get_final_as_semidet(PPId, T, SharingAs_Status) :-
+ get_from_fixpoint_table_final_semidet(PPId, T, SharingAs_Status).
%-----------------------------------------------------------------------------%
%
@@ -667,22 +896,9 @@
write_pred_sharing_info(ModuleInfo, PredId, !IO) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
- pred_info_get_import_status(PredInfo, ImportStatus),
- module_info_get_type_spec_info(ModuleInfo, TypeSpecInfo),
- TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
+ should_write_sharing_info(ModuleInfo, PredId, PredInfo, ShouldWrite),
(
- (
- ImportStatus = status_exported
- ;
- ImportStatus = status_opt_exported
- ),
- \+ is_unify_or_compare_pred(PredInfo),
-
- % XXX These should be allowed, but the predicate declaration for the
- % specialized predicate is not produced before the structure_sharing
- % pragmas are read in, resulting in an undefined predicate error.
- \+ set.member(PredId, TypeSpecForcePreds)
- ->
+ ShouldWrite = yes,
PredName = pred_info_name(PredInfo),
ProcIds = pred_info_procids(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
@@ -696,7 +912,7 @@
SymName, Context, TypeVarSet),
ProcIds, !IO)
;
- true
+ ShouldWrite = no
).
:- pred write_proc_sharing_info(pred_id::in, proc_table::in,
@@ -710,21 +926,361 @@
(
SharingAnalysis = yes,
map.lookup(ProcTable, ProcId, ProcInfo),
- proc_info_get_structure_sharing(ProcInfo, MaybeSharingAs),
+ proc_info_get_structure_sharing(ProcInfo, MaybeSharingStatus),
proc_info_declared_argmodes(ProcInfo, Modes),
proc_info_get_varset(ProcInfo, VarSet),
proc_info_get_headvars(ProcInfo, HeadVars),
proc_info_get_vartypes(ProcInfo, VarTypes),
- list.map(map.lookup(VarTypes), HeadVars, HeadVarTypes),
+ map.apply_to_list(HeadVars, VarTypes, HeadVarTypes),
+ (
+ MaybeSharingStatus = yes(
+ structure_sharing_domain_and_status(Sharing, _Status)),
+ MaybeSharing = yes(Sharing)
+ ;
+ MaybeSharingStatus = no,
+ MaybeSharing = no
+ ),
write_pragma_structure_sharing_info(PredOrFunc, SymName, Modes,
Context, HeadVars, yes(VarSet), HeadVarTypes, yes(TypeVarSet),
- MaybeSharingAs, !IO)
+ MaybeSharing, !IO)
;
SharingAnalysis = no
).
%-----------------------------------------------------------------------------%
+%
+% Types and instances for the intermodule analysis framework
+%
+
+:- type structure_sharing_call
+ ---> structure_sharing_call.
+
+:- type structure_sharing_answer
+ ---> structure_sharing_answer_bottom
+ ; structure_sharing_answer_top
+ ; structure_sharing_answer_real(
+ prog_vars,
+ list(mer_type),
+ sharing_as
+ ).
+
+:- type structure_sharing_func_info
+ ---> structure_sharing_func_info(
+ module_info,
+ proc_info
+ ).
+
+:- func analysis_name = string.
+
+analysis_name = "structure_sharing".
+
+:- instance analysis(structure_sharing_func_info, structure_sharing_call,
+ structure_sharing_answer) where
+[
+ analysis_name(_, _) = analysis_name,
+ analysis_version_number(_, _) = 1,
+ preferred_fixpoint_type(_, _) = greatest_fixpoint,
+ bottom(_, _) = structure_sharing_answer_bottom,
+ top(_, _) = structure_sharing_answer_top,
+
+ ( get_func_info(ModuleInfo, ModuleName, FuncId, _, _, FuncInfo) :-
+ func_id_to_ppid(ModuleInfo, ModuleName, FuncId, PPId),
+ module_info_proc_info(ModuleInfo, PPId, ProcInfo),
+ FuncInfo = structure_sharing_func_info(ModuleInfo, ProcInfo)
+ )
+].
+
+:- instance call_pattern(structure_sharing_func_info,
+ structure_sharing_call) where [].
+
+:- instance partial_order(structure_sharing_func_info,
+ structure_sharing_call) where [
+ (more_precise_than(_, _, _) :-
+ semidet_fail
+ ),
+ equivalent(_, Call, Call)
+].
+
+:- instance to_string(structure_sharing_call) where [
+ to_string(structure_sharing_call) = "",
+ from_string("") = structure_sharing_call
+].
+
+:- instance answer_pattern(structure_sharing_func_info,
+ structure_sharing_answer) where [].
+
+:- instance partial_order(structure_sharing_func_info,
+ structure_sharing_answer) where [
+ (more_precise_than(FuncInfo, Answer1, Answer2) :-
+ % Fast path (maybe).
+ Answer1 \= Answer2,
+
+ % XXX can we implement this more efficiently?
+ FuncInfo = structure_sharing_func_info(ModuleInfo, ProcInfo),
+ SharingAs1 = structure_sharing_answer_to_sharing_as(Answer1),
+ SharingAs2 = structure_sharing_answer_to_sharing_as(Answer2),
+ sharing_as_is_subsumed_by(ModuleInfo, ProcInfo,
+ SharingAs1, SharingAs2),
+ not sharing_as_is_subsumed_by(ModuleInfo, ProcInfo,
+ SharingAs2, SharingAs1)
+ ),
+
+ (equivalent(FuncInfo, Answer1, Answer2) :-
+ (
+ % Fast path (maybe).
+ Answer1 = Answer2
+ ;
+ FuncInfo = structure_sharing_func_info(ModuleInfo, ProcInfo),
+ SharingAs1 = structure_sharing_answer_to_sharing_as(Answer1),
+ SharingAs2 = structure_sharing_answer_to_sharing_as(Answer2),
+ % XXX can we implement this more efficiently?
+ sharing_as_is_subsumed_by(ModuleInfo, ProcInfo,
+ SharingAs2, SharingAs1),
+ sharing_as_is_subsumed_by(ModuleInfo, ProcInfo,
+ SharingAs1, SharingAs2)
+ )
+ )
+].
+
+:- func structure_sharing_answer_to_sharing_as(structure_sharing_answer) =
+ sharing_as.
+
+structure_sharing_answer_to_sharing_as(Answer) = SharingAs :-
+ (
+ Answer = structure_sharing_answer_bottom,
+ SharingAs = sharing_as_init
+ ;
+ Answer = structure_sharing_answer_top,
+ % No feedback is okay because we won't be using it.
+ SharingAs = sharing_as_top_no_feedback
+ ;
+ Answer = structure_sharing_answer_real(_, _, SharingAs)
+ ).
+
+:- instance to_string(structure_sharing_answer) where [
+ func(to_string/1) is sharing_answer_to_string,
+ func(from_string/1) is sharing_answer_from_string
+].
+
+:- func sharing_answer_to_string(structure_sharing_answer) = string.
+
+sharing_answer_to_string(Answer) = String :-
+ (
+ Answer = structure_sharing_answer_bottom,
+ String = "b"
+ ;
+ Answer = structure_sharing_answer_top,
+ String = "t"
+ ;
+ Answer = structure_sharing_answer_real(HeadVars, Types, SharingAs),
+ SharingDomain = to_structure_sharing_domain(SharingAs),
+ String = string({HeadVars, Types, SharingDomain})
+ ).
+
+:- func sharing_answer_from_string(string::in) =
+ (structure_sharing_answer::out) is det.
+
+sharing_answer_from_string(String) = Answer :-
+ ( String = "b" ->
+ Answer = structure_sharing_answer_bottom
+ ; String = "t" ->
+ Answer = structure_sharing_answer_top
+ ;
+ % XXX this is ugly. Later we should move to writing call and answer
+ % patterns in analysis files as terms rather than strings which will
+ % clean this up.
+ StringStop = String ++ ".",
+ io.read_from_string("", StringStop, string.length(StringStop), Res,
+ posn(0, 0, 0), _Posn),
+ (
+ Res = ok({HeadVars, Types, SharingDomain}),
+ SharingAs = from_structure_sharing_domain(SharingDomain),
+ Answer = structure_sharing_answer_real(HeadVars, Types, SharingAs)
+ ;
+ ( Res = eof
+ ; Res = error(_, _)
+ ),
+ unexpected(this_file, "sharing_answer_from_string: " ++ String)
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Additional predicates used for intermodule analysis
+%
+
+:- pred record_sharing_analysis_results(module_info::in, sharing_as_table::in,
+ list(pred_proc_id)::in, analysis_info::in, analysis_info::out) is det.
+
+record_sharing_analysis_results(ModuleInfo, SharingAsTable, SCC,
+ !AnalysisInfo) :-
+ list.foldl(record_sharing_analysis_result(ModuleInfo, SharingAsTable),
+ SCC, !AnalysisInfo).
+
+:- pred record_sharing_analysis_result(module_info::in, sharing_as_table::in,
+ pred_proc_id::in, analysis_info::in, analysis_info::out) is det.
+
+record_sharing_analysis_result(ModuleInfo, SharingAsTable, PPId,
+ !AnalysisInfo) :-
+ PPId = proc(PredId, ProcId),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
+ should_write_sharing_info(ModuleInfo, PredId, PredInfo, ShouldWrite),
+ (
+ ShouldWrite = yes,
+ (
+ sharing_as_table_search(PPId, SharingAsTable,
+ sharing_as_and_status(SharingAsPrime, StatusPrime))
+ ->
+ SharingAs = SharingAsPrime,
+ Status0 = StatusPrime
+ ;
+ unexpected(this_file, "record_sharing_analysis_result")
+ ),
+ (
+ SharingAs = sharing_as_bottom,
+ Answer = structure_sharing_answer_bottom,
+ Status = optimal
+ ;
+ SharingAs = sharing_as_top(Reasons),
+ Answer = structure_sharing_answer_top,
+ % If the procedure contains a generic or foreign foreign call, or
+ % it calls a procedure in a non-local module for which we have no
+ % results, we won't be able to do better upon reanalysis.
+ (
+ set.member(Reason, Reasons),
+ reason_implies_optimal(ModuleInfo, !.AnalysisInfo, Reason)
+ ->
+ Status = optimal
+ ;
+ Status = Status0
+ ),
+ trace [io(!IO),
+ compile_time(flag("structure_sharing")),
+ run_time(env("TOP_REASONS"))
+ ] (
+ ReasonsList = set.to_sorted_list(Reasons),
+ write_pred_proc_id(ModuleInfo, PPId, !IO),
+ io.write_string(":\n", !IO),
+ io.write_list(ReasonsList, "\n",
+ write_top_feedback(ModuleInfo), !IO),
+ io.nl(!IO),
+ io.write_string("\t", !IO),
+ io.write(Status, !IO),
+ io.nl(!IO)
+ )
+ ;
+ SharingAs = sharing_as_real_as(_),
+ proc_info_get_headvars(ProcInfo, HeadVars),
+ proc_info_get_vartypes(ProcInfo, VarTypes),
+ map.apply_to_list(HeadVars, VarTypes, HeadVarTypes),
+ Answer = structure_sharing_answer_real(HeadVars, HeadVarTypes,
+ SharingAs),
+ Status = Status0
+ ),
+ module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
+ record_result(ModuleName, FuncId, structure_sharing_call, Answer,
+ Status, !AnalysisInfo)
+ ;
+ ShouldWrite = no
+ ).
+
+:- pred reason_implies_optimal(module_info::in, analysis_info::in,
+ top_feedback::in) is semidet.
+
+reason_implies_optimal(ModuleInfo, AnalysisInfo, Reason) :-
+ (
+ Reason = top_cannot_improve(_)
+ ;
+ Reason = top_failed_lookup(ShroudedPPId),
+ proc(PredId, _) = unshroud_pred_proc_id(ShroudedPPId),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ PredModule = pred_info_module(PredInfo),
+ module_is_local(AnalysisInfo, PredModule, no)
+ ).
+
+:- pred handle_dep_procs(module_info::in, pred_proc_id::in,
+ analysis_info::in, analysis_info::out) is det.
+
+handle_dep_procs(ModuleInfo, DepPPId, !AnalysisInfo) :-
+ % Record that we depend on the result for the called procedure.
+ module_info_get_name(ModuleInfo, ThisModuleName),
+ module_name_func_id(ModuleInfo, DepPPId, DepModuleName, DepFuncId),
+ Call = structure_sharing_call,
+ record_dependency(ThisModuleName, analysis_name, DepModuleName, DepFuncId,
+ Call, !AnalysisInfo),
+
+ % If the called procedure didn't have an answer in the analysis registry,
+ % record the assumed answer (top) for it so that when it does get
+ % analysed, it will have something to compare against.
+ module_info_proc_info(ModuleInfo, DepPPId, ProcInfo),
+ FuncInfo = structure_sharing_func_info(ModuleInfo, ProcInfo),
+ lookup_matching_results(!.AnalysisInfo, DepModuleName, DepFuncId, FuncInfo,
+ Call, AnyResults : list(analysis_result(structure_sharing_call,
+ structure_sharing_answer))),
+ (
+ AnyResults = [],
+ Answer = top(FuncInfo, Call) : structure_sharing_answer,
+ record_result(DepModuleName, DepFuncId, Call, Answer, suboptimal,
+ !AnalysisInfo),
+ % Record a request as well.
+ record_request(analysis_name, DepModuleName, DepFuncId, Call,
+ !AnalysisInfo)
+ ;
+ AnyResults = [_ | _]
+ ).
+
+:- pred write_top_feedback(module_info::in, top_feedback::in, io::di, io::uo)
+ is det.
+
+write_top_feedback(ModuleInfo, Reason, !IO) :-
+ io.write_string("\t", !IO),
+ (
+ Reason = top_failed_lookup(ShroudedPPId),
+ PPId = unshroud_pred_proc_id(ShroudedPPId),
+ io.write_string("failed_lookup: ", !IO),
+ write_pred_proc_id(ModuleInfo, PPId, !IO)
+ ;
+ Reason = top_from_lookup(ShroudedPPId),
+ PPId = unshroud_pred_proc_id(ShroudedPPId),
+ io.write_string("from_lookup: ", !IO),
+ write_pred_proc_id(ModuleInfo, PPId, !IO)
+ ;
+ Reason = top_cannot_improve(String),
+ io.write_string("cannot_improve: ", !IO),
+ io.write_string(String, !IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred should_write_sharing_info(module_info::in, pred_id::in, pred_info::in,
+ bool::out) is det.
+
+should_write_sharing_info(ModuleInfo, PredId, PredInfo, ShouldWrite) :-
+ pred_info_get_import_status(PredInfo, ImportStatus),
+ module_info_get_type_spec_info(ModuleInfo, TypeSpecInfo),
+ TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
+ (
+ (
+ ImportStatus = status_exported
+ ;
+ ImportStatus = status_opt_exported
+ % XXX status_exported_to_submodules?
+ ),
+ \+ is_unify_or_compare_pred(PredInfo),
+
+ % XXX These should be allowed, but the predicate declaration for the
+ % specialized predicate is not produced before the structure_sharing
+ % pragmas are read in, resulting in an undefined predicate error.
+ \+ set.member(PredId, TypeSpecForcePreds)
+ ->
+ ShouldWrite = yes
+ ;
+ ShouldWrite = no
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- func this_file = string.
this_file = "structure_sharing.analysis.m".
Index: compiler/structure_sharing.domain.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.domain.m,v
retrieving revision 1.28
diff -u -r1.28 structure_sharing.domain.m
--- compiler/structure_sharing.domain.m 17 Mar 2008 01:56:11 -0000 1.28
+++ compiler/structure_sharing.domain.m 25 Mar 2008 03:39:03 -0000
@@ -52,6 +52,7 @@
:- module transform_hlds.ctgc.structure_sharing.domain.
:- interface.
+:- import_module analysis.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
@@ -74,11 +75,12 @@
:- pred sharing_as_is_bottom(sharing_as::in) is semidet.
% Operations w.r.t. the "top" element of the lattice. When sharing
- % becomes top, it is useful to know why it has become top. This can
- % be recorded and passed to the top-value as a string.
+ % becomes top, it is useful to know why it has become top.
%
-:- func sharing_as_top_sharing(string) = sharing_as.
-:- func sharing_as_top_sharing_accumulate(string, sharing_as) = sharing_as.
+:- func sharing_as_top_no_feedback = sharing_as.
+:- func sharing_as_top_sharing(top_feedback) = sharing_as.
+:- func sharing_as_top_sharing_accumulate(top_feedback, sharing_as)
+ = sharing_as.
:- pred sharing_as_is_top(sharing_as::in) is semidet.
% Return the size of the sharing set. Fail when sharing is top.
@@ -165,6 +167,9 @@
:- pred sharing_as_is_subsumed_by(module_info::in, proc_info::in,
sharing_as::in, sharing_as::in) is semidet.
+:- pred sharing_as_and_status_is_subsumed_by(module_info::in, proc_info::in,
+ sharing_as_and_status::in, sharing_as_and_status::in) is semidet.
+
% Compute the least upper bound.
%
:- func sharing_as_least_upper_bound(module_info, proc_info,
@@ -218,7 +223,13 @@
% Mapping between pred_proc_ids and sharing information that has been
% derived for the corresponding procedure definitions.
%
-:- type sharing_as_table == map(pred_proc_id, sharing_as).
+:- type sharing_as_table == map(pred_proc_id, sharing_as_and_status).
+
+:- type sharing_as_and_status
+ ---> sharing_as_and_status(
+ sharing_as,
+ analysis_status
+ ).
% Initialisation.
%
@@ -227,12 +238,12 @@
% Look up the sharing information of a specific procedure. Fail if the
% procedure id is not in the map.
%
-:- func sharing_as_table_search(pred_proc_id, sharing_as_table)
- = sharing_as is semidet.
+:- pred sharing_as_table_search(pred_proc_id::in, sharing_as_table::in,
+ sharing_as_and_status::out) is semidet.
% Set the sharing information for a given pred_proc_id.
%
-:- pred sharing_as_table_set(pred_proc_id::in, sharing_as::in,
+:- pred sharing_as_table_set(pred_proc_id::in, sharing_as_and_status::in,
sharing_as_table::in, sharing_as_table::out) is det.
%-----------------------------------------------------------------------------%
@@ -245,7 +256,6 @@
sharing_as_table::in, pred_id::in, proc_id::in, prog_vars::in,
sharing_as::in, sharing_as::out) is det.
-
% Lookup the sharing information in the sharing table, or if it is not
% in there, try to predict it using the information available in the
% module_info.
@@ -259,14 +269,16 @@
% 3 - react appropriately if the calls happen to be to
% * either compiler generated predicates
% * or predicates from builtin.m and private_builtin.m
+ % * :- external predicates
%
:- pred lookup_sharing_or_predict(module_info::in, sharing_as_table::in,
- pred_proc_id::in, sharing_as::out) is det.
+ pred_proc_id::in, sharing_as::out, analysis_status::out, bool::out) is det.
% Succeeds if the sharing of a procedure can safely be approximated by
- % "bottom", simply by looking at the modes and types of the arguments.
+ % "bottom", simply by looking at the modes and types of the arguments,
+ % or because the procedure is of a generated special predicate.
%
-:- pred bottom_sharing_is_safe_approximation(module_info::in,
+:- pred bottom_sharing_is_safe_approximation(module_info::in, pred_info::in,
proc_info::in) is semidet.
% Load all the structure sharing information present in the HLDS into
@@ -304,15 +316,27 @@
%-----------------------------------------------------------------------------%
+:- interface.
+
+ % The intention was for this type to be hidden, but we need to expose it
+ % for structure_sharing.m to convert between `structure_sharing_answer'
+ % and `sharing_as'.
+ %
:- type sharing_as
---> sharing_as_real_as(sharing_set)
; sharing_as_bottom
- ; sharing_as_top(set(string)).
+ ; sharing_as_top(set(top_feedback)).
+
+:- implementation.
+
+%-----------------------------------------------------------------------------%
sharing_as_init = sharing_as_bottom.
sharing_as_is_bottom(sharing_as_bottom).
+sharing_as_top_no_feedback = sharing_as_top(set.init).
+
sharing_as_top_sharing(Msg) = sharing_as_top(set.make_singleton_set(Msg)).
sharing_as_top_sharing_accumulate(Msg, SharingAs) = TopSharing :-
@@ -611,7 +635,7 @@
context_to_string(ProgContext, ContextString),
Msg = "foreign proc with unknown sharing ("
++ ContextString ++ ")",
- SharingAs = sharing_as_top_sharing(Msg)
+ SharingAs = sharing_as_top_sharing(top_cannot_improve(Msg))
).
:- pred sharing_as_from_user_annotated_sharing(
@@ -639,7 +663,6 @@
UserSharingAs = !.SharingAs
).
-
sharing_as_is_subsumed_by(ModuleInfo, ProcInfo, Sharing1, Sharing2) :-
(
Sharing2 = sharing_as_top(_)
@@ -652,6 +675,13 @@
SharingSet2)
).
+sharing_as_and_status_is_subsumed_by(ModuleInfo, ProcInfo,
+ SharingAs_Status1, SharingAs_Status2) :-
+ SharingAs_Status1 = sharing_as_and_status(Sharing1, _Status1),
+ SharingAs_Status2 = sharing_as_and_status(Sharing2, _Status2),
+ sharing_as_is_subsumed_by(ModuleInfo, ProcInfo, Sharing1, Sharing2).
+ % XXX do we need to compare Status1 and Status2?
+
sharing_as_least_upper_bound(ModuleInfo, ProcInfo, Sharing1, Sharing2)
= Sharing :-
(
@@ -736,8 +766,8 @@
SharingSet = from_sharing_pair_list(StructureSharing),
wrap(SharingSet, SharingAs)
;
- SharingDomain = structure_sharing_top(Msgs),
- SharingAs = sharing_as_top(Msgs)
+ SharingDomain = structure_sharing_top(Reasons),
+ SharingAs = sharing_as_top(Reasons)
).
to_structure_sharing_domain(SharingAs) = SharingDomain :-
@@ -759,9 +789,12 @@
%
sharing_as_table_init = map.init.
-sharing_as_table_search(PPId, Table) = Table ^ elem(PPId).
-sharing_as_table_set(PPId, Sharing, !Table) :-
- !:Table = !.Table ^ elem(PPId) := Sharing.
+
+sharing_as_table_search(PPId, Table, SharingAs_Status) :-
+ map.search(Table, PPId, SharingAs_Status).
+
+sharing_as_table_set(PPId, SharingAs_Status, !Table) :-
+ !Table ^ elem(PPId) := SharingAs_Status.
%-----------------------------------------------------------------------------%
@@ -769,7 +802,10 @@
PredId, ProcId, ActualVars, !Sharing):-
PPId = proc(PredId, ProcId),
- lookup_sharing_or_predict(ModuleInfo, SharingTable, PPId, FormalSharing),
+ % XXX make use of the status once the structure reuse passes use the
+ % analysis framework
+ lookup_sharing_or_predict(ModuleInfo, SharingTable, PPId, FormalSharing,
+ _Status, _IsPredicted),
proc_info_get_vartypes(ProcInfo, VarTypes),
map.apply_to_list(ActualVars, VarTypes, ActualTypes),
@@ -783,12 +819,16 @@
!:Sharing = sharing_as_comb(ModuleInfo, ProcInfo,
ActualSharing, !.Sharing).
-lookup_sharing_or_predict(ModuleInfo, SharingTable, PPId, SharingAs) :-
+lookup_sharing_or_predict(ModuleInfo, SharingTable, PPId, SharingAs, Status,
+ IsPredicted) :-
(
% look up in SharingTable
- SharingAs0 = sharing_as_table_search(PPId, SharingTable)
+ sharing_as_table_search(PPId, SharingTable,
+ sharing_as_and_status(SharingAs0, Status0))
->
- SharingAs = SharingAs0
+ SharingAs = SharingAs0,
+ Status = Status0,
+ IsPredicted = no
;
% or predict bottom sharing
%
@@ -798,10 +838,24 @@
% the sharing the called procedure creates is bottom.
predict_called_pred_is_bottom(ModuleInfo, PPId)
->
- SharingAs = sharing_as_init
+ SharingAs = sharing_as_init,
+ Status = optimal,
+ IsPredicted = yes
+ ;
+ PPId = proc(PredId, _),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_import_status(PredInfo, ImportStatus),
+ ImportStatus = status_external(_)
+ ->
+ SharingAs = sharing_as_top_sharing(top_cannot_improve(
+ "external predicate")),
+ Status = optimal,
+ IsPredicted = no
;
% or use top-sharing with appropriate message.
- SharingAs = top_sharing_not_found(ModuleInfo, PPId)
+ SharingAs = top_sharing_not_found(PPId),
+ Status = suboptimal,
+ IsPredicted = no
).
:- pred predict_called_pred_is_bottom(module_info::in, pred_proc_id::in)
@@ -819,7 +873,7 @@
)
;
% 2. bottom_sharing_is_safe_approximation
- bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo)
+ bottom_sharing_is_safe_approximation(ModuleInfo, PredInfo, ProcInfo)
;
% 3. call to a compiler generate special predicate:
% "unify", "index", "compare" or "initialise".
@@ -832,20 +886,13 @@
any_mercury_builtin_module(PredModule)
).
-:- func top_sharing_not_found(module_info, pred_proc_id) = sharing_as.
-
-top_sharing_not_found(ModuleInfo, PPId) = TopSharing :-
- module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, _),
- PPId = proc(PredId, ProcId),
- PredModuleName = pred_info_module(PredInfo),
-
- TopSharing = sharing_as_top_sharing("Lookup sharing failed for " ++
- sym_name_to_escaped_string(PredModuleName) ++ "." ++
- pred_info_name(PredInfo) ++ "/" ++
- int_to_string(pred_info_orig_arity(PredInfo)) ++ " (id = " ++
- int_to_string(pred_id_to_int(PredId)) ++ "," ++
- int_to_string(proc_id_to_int(ProcId))).
+:- func top_sharing_not_found(pred_proc_id) = sharing_as.
+top_sharing_not_found(PPId) = TopSharing :-
+ ShroudedPredProcId = shroud_pred_proc_id(PPId),
+ Reason = top_failed_lookup(ShroudedPredProcId),
+ TopSharing = sharing_as_top_sharing(Reason).
+
%-----------------------------------------------------------------------------%
load_structure_sharing_table(ModuleInfo) = SharingTable :-
@@ -869,43 +916,49 @@
module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo),
proc_info_get_structure_sharing(ProcInfo, MaybePublicSharing),
(
- MaybePublicSharing = yes(PublicSharing),
+ MaybePublicSharing = yes(
+ structure_sharing_domain_and_status(PublicSharing, Status)),
PPId = proc(PredId, ProcId),
PrivateSharing = from_structure_sharing_domain(PublicSharing),
- sharing_as_table_set(PPId, PrivateSharing, !SharingTable)
+ sharing_as_table_set(PPId,
+ sharing_as_and_status(PrivateSharing, Status), !SharingTable)
;
MaybePublicSharing = no
).
+
%-----------------------------------------------------------------------------%
-
- % Succeeds if the sharing of a procedure can safely be approximated by
- % "bottom", simply by looking at the modes and types of the arguments.
- %
-bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo) :-
- proc_info_get_headvars(ProcInfo, HeadVars),
- proc_info_get_argmodes(ProcInfo, Modes),
- proc_info_get_vartypes(ProcInfo, VarTypes),
- list.map(map.lookup(VarTypes), HeadVars, Types),
- ModeTypePairs = assoc_list.from_corresponding_lists(Modes, Types),
+bottom_sharing_is_safe_approximation(ModuleInfo, PredInfo, ProcInfo) :-
+ (
+ % Generated special predicates don't introduce sharing.
+ pred_info_get_origin(PredInfo, Origin),
+ Origin = origin_special_pred(_)
+ ;
+ proc_info_get_headvars(ProcInfo, HeadVars),
+ proc_info_get_argmodes(ProcInfo, Modes),
+ proc_info_get_vartypes(ProcInfo, VarTypes),
+ list.map(map.lookup(VarTypes), HeadVars, Types),
- Test = (pred(Pair::in) is semidet :-
- Pair = Mode - Type,
+ ModeTypePairs = assoc_list.from_corresponding_lists(Modes, Types),
- % Mode is not unique nor clobbered.
- mode_get_insts(ModuleInfo, Mode, _LeftInst, RightInst),
- \+ inst_is_unique(ModuleInfo, RightInst),
- \+ inst_is_clobbered(ModuleInfo, RightInst),
+ Test = (pred(Pair::in) is semidet :-
+ Pair = Mode - Type,
- % Mode is output.
- mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
- ArgMode = top_out,
+ % Mode is not unique nor clobbered.
+ mode_get_insts(ModuleInfo, Mode, _LeftInst, RightInst),
+ \+ inst_is_unique(ModuleInfo, RightInst),
+ \+ inst_is_clobbered(ModuleInfo, RightInst),
- % Type is not primitive.
- \+ type_is_atomic(ModuleInfo, Type)
- ),
- list.filter(Test, ModeTypePairs, TrueModeTypePairs),
- TrueModeTypePairs = [].
+ % Mode is output.
+ mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
+ ArgMode = top_out,
+
+ % Type is not primitive.
+ \+ type_is_atomic(ModuleInfo, Type)
+ ),
+ list.filter(Test, ModeTypePairs, TrueModeTypePairs),
+ TrueModeTypePairs = []
+ ).
%-----------------------------------------------------------------------------%
% Type: sharing_set.
@@ -1312,7 +1365,11 @@
;
sharing_set_subsumed_subset(ModuleInfo, ProcInfo,
!.SharingSet, SharingPair, SubsumedPairs),
- remove_entries(SubsumedPairs, !SharingSet),
+ % For any two pairs (A,B) and (B,A) keep only one pair in the list.
+ % Otherwise we'll get an assertion failure in `remove_entries' when we
+ % try to remove (B,A) after having removed (A,B).
+ remove_swapped_dup_pairs(SubsumedPairs, [], SubsumedPairsNoDups),
+ remove_entries(SubsumedPairsNoDups, !SharingSet),
new_entry_no_controls(SharingPair, !SharingSet)
).
@@ -1495,6 +1552,19 @@
SubsumedPairs = []
).
+:- pred remove_swapped_dup_pairs(list(structure_sharing_pair)::in,
+ list(structure_sharing_pair)::in, list(structure_sharing_pair)::out)
+ is det.
+
+remove_swapped_dup_pairs([], Acc, Acc).
+remove_swapped_dup_pairs([H | T], Acc0, Acc) :-
+ H = A - B,
+ ( list.member(B - A, Acc0) ->
+ remove_swapped_dup_pairs(T, Acc0, Acc)
+ ;
+ remove_swapped_dup_pairs(T, [H | Acc0], Acc)
+ ).
+
:- pred new_entries(module_info::in, proc_info::in, structure_sharing::in,
sharing_set::in, sharing_set::out) is det.
@@ -1946,13 +2016,14 @@
set_cross_product(DataSet1, DataSet2, SetOfPairs),
set.to_sorted_list(SetOfPairs, SharingPairs).
-:- pred set_cross_product(set(T1)::in, set(T2)::in,
- set(pair(T1, T2))::out) is det.
+:- pred set_cross_product(set(datastruct)::in, set(datastruct)::in,
+ set(pair(datastruct, datastruct))::out) is det.
set_cross_product(SetA, SetB, CrossProduct):-
solutions_set(cross_product(SetA, SetB), CrossProduct).
-:- pred cross_product(set(T1)::in, set(T2)::in, pair(T1, T2)::out) is nondet.
+:- pred cross_product(set(datastruct)::in, set(datastruct)::in,
+ pair(datastruct, datastruct)::out) is nondet.
cross_product(SetA, SetB, Pair) :-
set.member(ElemA, SetA),
Index: compiler/tabling_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tabling_analysis.m,v
retrieving revision 1.14
diff -u -r1.14 tabling_analysis.m
--- compiler/tabling_analysis.m 21 Feb 2008 04:22:42 -0000 1.14
+++ compiler/tabling_analysis.m 25 Mar 2008 03:39:03 -0000
@@ -76,9 +76,9 @@
%
:- type mm_tabling_analysis_answer.
-:- instance analysis(any_call, mm_tabling_analysis_answer).
-:- instance partial_order(mm_tabling_analysis_answer).
-:- instance answer_pattern(mm_tabling_analysis_answer).
+:- instance analysis(no_func_info, any_call, mm_tabling_analysis_answer).
+:- instance partial_order(no_func_info, mm_tabling_analysis_answer).
+:- instance answer_pattern(no_func_info, mm_tabling_analysis_answer).
:- instance to_string(mm_tabling_analysis_answer).
%----------------------------------------------------------------------------%
@@ -882,21 +882,24 @@
analysis_name = "mm_tabling_analysis".
-:- instance analysis(any_call, mm_tabling_analysis_answer) where [
+:- instance analysis(no_func_info, any_call, mm_tabling_analysis_answer) where [
analysis_name(_, _) = analysis_name,
analysis_version_number(_, _) = 1,
preferred_fixpoint_type(_, _) = least_fixpoint,
- bottom(_) = mm_tabling_analysis_answer(mm_tabled_will_not_call),
- top(_) = mm_tabling_analysis_answer(mm_tabled_may_call)
+ bottom(_, _) = mm_tabling_analysis_answer(mm_tabled_will_not_call),
+ top(_, _) = mm_tabling_analysis_answer(mm_tabled_may_call),
+ get_func_info(_, _, _, _, _, no_func_info)
].
-:- instance answer_pattern(mm_tabling_analysis_answer) where [].
-:- instance partial_order(mm_tabling_analysis_answer) where [
- (more_precise_than(
- mm_tabling_analysis_answer(Status1),
- mm_tabling_analysis_answer(Status2)) :-
- mm_tabling_status_more_precise_than(Status1, Status2)),
- equivalent(Status, Status)
+:- instance answer_pattern(no_func_info, mm_tabling_analysis_answer) where [].
+:- instance partial_order(no_func_info, mm_tabling_analysis_answer) where [
+ ( more_precise_than(no_func_info, Answer1, Answer2) :-
+ Answer1 = mm_tabling_analysis_answer(Status1),
+ Answer2 = mm_tabling_analysis_answer(Status2),
+ mm_tabling_status_more_precise_than(Status1, Status2)
+ ),
+
+ equivalent(no_func_info, Status, Status)
].
:- pred mm_tabling_status_more_precise_than(mm_tabling_status::in,
@@ -956,10 +959,10 @@
search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus, CallerSCC,
!AnalysisInfo) :-
- mmc_analysis.module_id_func_id(ModuleInfo, PPId, ModuleId, FuncId),
+ mmc_analysis.module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
Call = any_call,
- analysis.lookup_best_result(!.AnalysisInfo, ModuleId, FuncId, Call,
- MaybeBestStatus),
+ analysis.lookup_best_result(!.AnalysisInfo, ModuleName, FuncId,
+ no_func_info, Call, MaybeBestStatus),
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, make_analysis_registry,
MakeAnalysisRegistry),
@@ -968,7 +971,7 @@
mm_tabling_analysis_answer(Result), AnalysisStatus)),
(
MakeAnalysisRegistry = yes,
- record_dependencies(ModuleId, FuncId, BestCall,
+ record_dependencies(ModuleName, FuncId, BestCall,
ModuleInfo, CallerSCC, !AnalysisInfo)
;
MakeAnalysisRegistry = no
@@ -978,19 +981,19 @@
% If we do not have any information about the callee procedure
% then assume that it modifies the calls a minimal model tabled
% procedure.
- top(Call) = Answer,
+ top(no_func_info, Call) = Answer,
Answer = mm_tabling_analysis_answer(Result),
- module_is_local(!.AnalysisInfo, ModuleId, IsLocal),
+ module_is_local(!.AnalysisInfo, ModuleName, IsLocal),
(
IsLocal = yes,
AnalysisStatus = suboptimal,
(
MakeAnalysisRegistry = yes,
- analysis.record_result(ModuleId, FuncId, Call, Answer,
+ analysis.record_result(ModuleName, FuncId, Call, Answer,
AnalysisStatus, !AnalysisInfo),
- analysis.record_request(analysis_name, ModuleId, FuncId, Call,
- !AnalysisInfo),
- record_dependencies(ModuleId, FuncId, Call,
+ analysis.record_request(analysis_name, ModuleName, FuncId,
+ Call, !AnalysisInfo),
+ record_dependencies(ModuleName, FuncId, Call,
ModuleInfo, CallerSCC, !AnalysisInfo)
;
MakeAnalysisRegistry = no
@@ -1006,15 +1009,15 @@
% 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,
+:- pred record_dependencies(module_name::in, func_id::in, Call::in,
module_info::in, scc::in, analysis_info::in, analysis_info::out)
- is det <= call_pattern(Call).
+ is det <= call_pattern(FuncInfo, Call).
-record_dependencies(ModuleId, FuncId, Call, ModuleInfo, CallerSCC,
+record_dependencies(ModuleName, FuncId, Call, ModuleInfo, CallerSCC,
!AnalysisInfo) :-
RecordDependency = (pred(CallerPPId::in, Info0::in, Info::out) is det :-
- module_id_func_id(ModuleInfo, CallerPPId, CallerModuleId, _),
- record_dependency(CallerModuleId, analysis_name, ModuleId, FuncId,
+ module_name_func_id(ModuleInfo, CallerPPId, CallerModuleName, _),
+ record_dependency(CallerModuleName, analysis_name, ModuleName, FuncId,
Call, Info0, Info)
),
list.foldl(RecordDependency, CallerSCC, !AnalysisInfo).
@@ -1039,9 +1042,9 @@
should_write_mm_tabling_info(ModuleInfo, PredId, PredInfo, ShouldWrite),
(
ShouldWrite = yes,
- mmc_analysis.module_id_func_id(ModuleInfo, PPId, ModuleId, FuncId),
+ mmc_analysis.module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
Answer = mm_tabling_analysis_answer(Status),
- record_result(ModuleId, FuncId, any_call, Answer, ResultStatus,
+ record_result(ModuleName, FuncId, any_call, Answer, ResultStatus,
!AnalysisInfo)
;
ShouldWrite = no
Index: compiler/trailing_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trailing_analysis.m,v
retrieving revision 1.33
diff -u -r1.33 trailing_analysis.m
--- compiler/trailing_analysis.m 21 Feb 2008 04:22:42 -0000 1.33
+++ compiler/trailing_analysis.m 25 Mar 2008 03:39:03 -0000
@@ -74,9 +74,9 @@
% 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 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_string(trailing_analysis_answer).
%----------------------------------------------------------------------------%
@@ -1123,21 +1123,23 @@
analysis_name = "trail_usage".
-:- instance analysis(any_call, trailing_analysis_answer) where [
+:- 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)
+ bottom(_, _) = trailing_analysis_answer(trail_will_not_modify),
+ top(_, _) = trailing_analysis_answer(trail_may_modify),
+ get_func_info(_, _, _, _, _, no_func_info)
].
-:- 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)
+:- 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,
@@ -1188,10 +1190,10 @@
search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus, CallerSCC,
!AnalysisInfo) :-
- mmc_analysis.module_id_func_id(ModuleInfo, PPId, ModuleId, FuncId),
+ mmc_analysis.module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
Call = any_call,
- analysis.lookup_best_result(!.AnalysisInfo, ModuleId, FuncId, Call,
- MaybeBestStatus),
+ analysis.lookup_best_result(!.AnalysisInfo, ModuleName, FuncId,
+ no_func_info, Call, MaybeBestStatus),
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, make_analysis_registry,
MakeAnalysisRegistry),
@@ -1200,7 +1202,7 @@
trailing_analysis_answer(Result), AnalysisStatus)),
(
MakeAnalysisRegistry = yes,
- record_dependencies(ModuleId, FuncId, BestCall,
+ record_dependencies(ModuleName, FuncId, BestCall,
ModuleInfo, CallerSCC, !AnalysisInfo)
;
MakeAnalysisRegistry = no
@@ -1209,9 +1211,9 @@
MaybeBestStatus = no,
% If we do not have any information about the callee procedure
% then assume that it modifies the trail.
- top(Call) = Answer,
+ top(no_func_info, Call) = Answer,
Answer = trailing_analysis_answer(Result),
- module_is_local(!.AnalysisInfo, ModuleId, IsLocal),
+ module_is_local(!.AnalysisInfo, ModuleName, IsLocal),
(
IsLocal = yes,
AnalysisStatus = suboptimal,
@@ -1223,11 +1225,11 @@
ShouldWrite),
(
ShouldWrite = yes,
- analysis.record_result(ModuleId, FuncId,
+ analysis.record_result(ModuleName, FuncId,
Call, Answer, AnalysisStatus, !AnalysisInfo),
- analysis.record_request(analysis_name, ModuleId, FuncId,
+ analysis.record_request(analysis_name, ModuleName, FuncId,
Call, !AnalysisInfo),
- record_dependencies(ModuleId, FuncId, Call,
+ record_dependencies(ModuleName, FuncId, Call,
ModuleInfo, CallerSCC, !AnalysisInfo)
;
ShouldWrite = no
@@ -1246,17 +1248,17 @@
% 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,
+:- pred record_dependencies(module_name::in, func_id::in, Call::in,
module_info::in, scc::in, analysis_info::in, analysis_info::out)
- is det <= call_pattern(Call).
+ is det <= call_pattern(FuncInfo, Call).
-record_dependencies(ModuleId, FuncId, Call,
- ModuleInfo, CallerSCC, !AnalysisInfo) :-
+record_dependencies(ModuleName, 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)
+ mmc_analysis.module_name_func_id(ModuleInfo, CallerPPId,
+ CallerModuleName, _),
+ analysis.record_dependency(CallerModuleName, analysis_name,
+ ModuleName, FuncId, Call, Info0, Info)
), CallerSCC, !AnalysisInfo).
:- pred record_trailing_analysis_results(trailing_status::in,
@@ -1280,8 +1282,8 @@
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,
+ mmc_analysis.module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
+ analysis.record_result(ModuleName, FuncId, any_call,
trailing_analysis_answer(Status), ResultStatus,
AnalysisInfo0, AnalysisInfo)
;
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.152
diff -u -r1.152 unused_args.m
--- compiler/unused_args.m 5 Mar 2008 03:51:04 -0000 1.152
+++ compiler/unused_args.m 25 Mar 2008 03:39:03 -0000
@@ -64,14 +64,19 @@
% Instances used by mmc_analysis.m
%
+:- type unused_args_func_info.
:- type unused_args_call.
:- type unused_args_answer.
-:- instance analysis(unused_args_call, unused_args_answer).
-:- instance partial_order(unused_args_call).
-:- instance call_pattern(unused_args_call).
+
+:- instance analysis(unused_args_func_info, unused_args_call,
+ unused_args_answer).
+
+:- instance partial_order(unused_args_func_info, unused_args_call).
+:- instance call_pattern(unused_args_func_info, unused_args_call).
:- instance to_string(unused_args_call).
-:- instance partial_order(unused_args_answer).
-:- instance answer_pattern(unused_args_answer).
+
+:- instance partial_order(unused_args_func_info, unused_args_answer).
+:- instance answer_pattern(unused_args_func_info, unused_args_answer).
:- instance to_string(unused_args_answer).
%-----------------------------------------------------------------------------%
@@ -144,14 +149,15 @@
% Types and instances used by mmc_analysis.m
%
+:- type unused_args_func_info
+ ---> unused_args_func_info(arity).
+
:- type unused_args_call
- ---> unused_args_call(arity).
- % Stands for any call. The arity is extra information which is
- % not part of the call pattern.
+ ---> unused_args_call.
- % The list of unused arguments is in sorted order.
:- type unused_args_answer
---> unused_args(
+ % The list of unused arguments is in sorted order.
args :: list(int)
).
@@ -159,45 +165,45 @@
get_unused_args(UnusedArgs) = UnusedArgs ^ args.
-:- instance analysis(unused_args_call, unused_args_answer)
- where [
+:- instance analysis(unused_args_func_info, unused_args_call,
+ unused_args_answer) where
+[
analysis_name(_, _) = analysis_name,
- analysis_version_number(_, _) = 2,
+ analysis_version_number(_, _) = 3,
preferred_fixpoint_type(_, _) = least_fixpoint,
- bottom(unused_args_call(Arity)) = unused_args(1 .. Arity),
- top(_) = unused_args([])
+ bottom(unused_args_func_info(Arity), _) = unused_args(1 .. Arity),
+ top(_, _) = unused_args([]),
+ (get_func_info(ModuleInfo, ModuleName, FuncId, _, _, FuncInfo) :-
+ func_id_to_ppid(ModuleInfo, ModuleName, FuncId, proc(PredId, _)),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ Arity = pred_info_orig_arity(PredInfo),
+ FuncInfo = unused_args_func_info(Arity)
+ )
].
:- func analysis_name = string.
+
analysis_name = "unused_args".
-:- instance call_pattern(unused_args_call) where [].
-:- instance partial_order(unused_args_call) where [
- (more_precise_than(_, _) :- semidet_fail),
- equivalent(Call, Call)
+:- instance call_pattern(unused_args_func_info, unused_args_call) where [].
+:- instance partial_order(unused_args_func_info, unused_args_call) where [
+ (more_precise_than(_, _, _) :- semidet_fail),
+ equivalent(_, Call, Call)
].
:- instance to_string(unused_args_call) where [
- func(to_string/1) is unused_args_call_to_string,
- func(from_string/1) is unused_args_call_from_string
+ to_string(_) = "",
+ from_string(_) = unused_args_call
].
-:- func unused_args_call_to_string(unused_args_call) = string.
-
-unused_args_call_to_string(unused_args_call(Arity)) =
- string.from_int(Arity).
-
-:- func unused_args_call_from_string(string) = unused_args_call is semidet.
-
-unused_args_call_from_string(String) = unused_args_call(Arity) :-
- string.to_int(String, Arity).
-
-:- instance answer_pattern(unused_args_answer) where [].
-:- instance partial_order(unused_args_answer) where [
- (more_precise_than(unused_args(Args1), unused_args(Args2)) :-
+:- instance answer_pattern(unused_args_func_info, unused_args_answer) where [].
+:- instance partial_order(unused_args_func_info, unused_args_answer) where [
+ (more_precise_than(_, Answer1, Answer2) :-
+ Answer1 = unused_args(Args1),
+ Answer2 = unused_args(Args2),
set.subset(sorted_list_to_set(Args2), sorted_list_to_set(Args1))
),
- equivalent(Args, Args)
+ equivalent(_, Args, Args)
].
:- instance to_string(unused_args_answer) where [
@@ -408,16 +414,15 @@
pred_info_is_imported(PredInfo)
->
PredModule = pred_info_module(PredInfo),
- PredModuleId = module_name_to_module_id(PredModule),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
PredName = pred_info_name(PredInfo),
PredArity = pred_info_orig_arity(PredInfo),
FuncId = pred_or_func_name_arity_to_func_id(PredOrFunc,
PredName, PredArity, ProcId),
- Call = unused_args_call(PredArity),
+ FuncInfo = unused_args_func_info(PredArity),
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
- lookup_best_result(AnalysisInfo0, PredModuleId, FuncId, Call,
- MaybeBestResult),
+ lookup_best_result(AnalysisInfo0, PredModule, FuncId,
+ FuncInfo, unused_args_call, MaybeBestResult),
(
MaybeBestResult = yes(analysis_result(_, BestAnswer, _)),
BestAnswer = unused_args(UnusedArgs),
@@ -444,7 +449,7 @@
AnalysisInfo = AnalysisInfo0
;
MaybeBestResult = no,
- module_is_local(AnalysisInfo0, PredModuleId, IsLocal),
+ module_is_local(AnalysisInfo0, PredModule, IsLocal),
(
IsLocal = yes,
% XXX makes too many requests
@@ -455,12 +460,14 @@
( is_unify_or_compare_pred(PredInfo) ->
AnalysisInfo = AnalysisInfo0
;
- analysis.record_result(PredModuleId, FuncId,
- Call, top(Call) : unused_args_answer,
- suboptimal, AnalysisInfo0, AnalysisInfo1),
+ Answer = top(FuncInfo, unused_args_call)
+ : unused_args_answer,
+ analysis.record_result(PredModule, FuncId,
+ unused_args_call, Answer, suboptimal,
+ AnalysisInfo0, AnalysisInfo1),
analysis.record_request(analysis_name,
- PredModuleId, FuncId, Call, AnalysisInfo1,
- AnalysisInfo)
+ PredModule, FuncId, unused_args_call,
+ AnalysisInfo1, AnalysisInfo)
)
;
MakeAnalysisRegistry = no,
@@ -1005,13 +1012,12 @@
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
PredOrFunc = pred_info_is_pred_or_func(OrigPredInfo),
PredArity = pred_info_orig_arity(OrigPredInfo),
- ModuleId = module_name_to_module_id(PredModule),
FuncId = pred_or_func_name_arity_to_func_id(PredOrFunc,
PredName, PredArity, ProcId),
- Call = unused_args_call(PredArity),
+ FuncInfo = unused_args_func_info(PredArity),
Answer = unused_args(UnusedArgs),
- analysis.lookup_results(AnalysisInfo0, ModuleId, FuncId,
+ analysis.lookup_results(AnalysisInfo0, PredModule, FuncId,
IntermodResultsTriples : list(analysis_result(unused_args_call,
unused_args_answer))),
IntermodOldAnswers = list.map((func(R) = R ^ ar_answer),
@@ -1019,7 +1025,7 @@
FilterUnused = (pred(VersionAnswer::in) is semidet :-
VersionAnswer \= Answer,
VersionAnswer \= unused_args([]),
- Answer `more_precise_than` VersionAnswer
+ more_precise_than(FuncInfo, Answer, VersionAnswer)
),
IntermodOldArgLists = list.map(get_unused_args,
list.filter(FilterUnused, IntermodOldAnswers)),
@@ -1038,8 +1044,8 @@
% intermodule-optimization; they may not be here.)
% (See exception_analysis.should_write_exception_info/4).
->
- analysis.record_result(ModuleId, FuncId, Call, Answer, optimal,
- AnalysisInfo0, AnalysisInfo)
+ analysis.record_result(PredModule, FuncId, unused_args_call,
+ Answer, optimal, AnalysisInfo0, AnalysisInfo)
;
AnalysisInfo = AnalysisInfo0
),
@@ -1937,13 +1943,10 @@
CalleePredProcId @ proc(CalleePredId, _), !AnalysisInfo) :-
module_info_pred_info(ModuleInfo, CalleePredId, CalleePredInfo),
( pred_info_is_imported(CalleePredInfo) ->
- CallerModuleId = module_name_to_module_id(CallerModule),
- module_id_func_id(ModuleInfo, CalleePredProcId,
- CalleeModuleId, CalleeFuncId),
- CalleePredArity = pred_info_orig_arity(CalleePredInfo),
- Call = unused_args_call(CalleePredArity),
- analysis.record_dependency(CallerModuleId, analysis_name,
- CalleeModuleId, CalleeFuncId, Call, !AnalysisInfo)
+ module_name_func_id(ModuleInfo, CalleePredProcId,
+ CalleeModule, CalleeFuncId),
+ analysis.record_dependency(CallerModule, analysis_name,
+ CalleeModule, CalleeFuncId, unused_args_call, !AnalysisInfo)
;
true
).
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list