[m-rev.] for review: analysis file caching
Peter Wang
novalazy at gmail.com
Wed Jul 23 17:49:39 AEST 2008
Branches: main
Add a caching feature for `mmc --make' so as to avoid reparsing the same
`.analysis' files repeatedly when many modules in the program or library
import similar sets of modules.
An `.analysis_cache' file contains a binary representation of the parsed
information in its corresponding `.analysis' file. These can be faster to
load, under certain conditions. Cache files are stored in
`Mercury/analysis_cache' or `Mercury/<grade>/<arch>/Mercury/analysis_cache'
for the duration of a single make target. Afterwards the directory is
deleted. This avoids stale cache files lying around which are incompatible
between different versions of the compiler, host platform, etc.
compiler/libs.m:
compiler/pickle.m:
Add a module in libs to un/serialise arbitrary data structures.
compiler/options.m:
Add `--analysis-file-cache' and `--analysis-file-cache-dir <dir>'
(internal option).
compiler/analysis.file.m:
Read and write analysis cache files if the cache directory is set.
Cache files are written after `.analysis' files are written (if
changed) or after an `.analysis' file is read (if it didn't exist).
compiler/make.program_target.m:
For certain targets, set up the analysis cache directory before
running the build procedure, and remove it afterwards.
compiler/module_cmds.m:
Add a version of update_interface that returns whether the
interface file changed.
doc/user_guide.texi:
Add commented out documentation for `--analysis-file-cache'.
diff --git a/compiler/analysis.file.m b/compiler/analysis.file.m
index 03dafbc..f9fb1c7 100644
--- a/compiler/analysis.file.m
+++ b/compiler/analysis.file.m
@@ -36,7 +36,9 @@
% read_module_analysis_results(AnalysisInfo, ModuleName, AnalysisResults,
% !IO)
%
- % Read the analysis results from a `.analysis' file.
+ % Read the analysis results from a `.analysis' file,
+ % or from the analysis file cache (if enabled, and the cache file is
+ % up-to-date).
%
:- pred read_module_analysis_results(analysis_info::in, module_name::in,
module_analysis_map(some_analysis_result)::out, io::di, io::uo) is det.
@@ -45,6 +47,7 @@
% !IO)
%
% Write the analysis results for a module to its `.analysis' file.
+ % Optionally, also write the cache copy of the analysis file.
%
:- pred write_module_analysis_results(analysis_info::in,
module_name::in, module_analysis_map(some_analysis_result)::in,
@@ -98,13 +101,19 @@
:- import_module bool.
:- import_module char.
+:- import_module dir.
:- import_module exception.
:- import_module parser.
:- import_module term.
:- import_module term_io.
+:- import_module type_desc.
+:- import_module univ.
:- import_module varset.
:- import_module libs.compiler_util.
+:- import_module libs.globals.
+:- import_module libs.options.
+:- import_module libs.pickle.
:- import_module parse_tree.
:- import_module parse_tree.module_cmds. % XXX unwanted dependency
:- import_module parse_tree.prog_io.
@@ -255,8 +264,46 @@ read_module_analysis_results(Info, ModuleName, ModuleResults, !IO) :-
analysis_registry_suffix, MaybeAnalysisFileName, !IO),
(
MaybeAnalysisFileName = ok(AnalysisFileName),
- read_module_analysis_results_2(Compiler, AnalysisFileName,
- ModuleResults, !IO)
+
+ % If analysis file caching is enabled, and the cache file exists and is
+ % up-to-date, then read from the cache instead.
+ globals.io_lookup_string_option(analysis_file_cache_dir, CacheDir,
+ !IO),
+ ( CacheDir \= "" ->
+ CacheFileName = make_cache_filename(CacheDir, AnalysisFileName),
+ io.file_modification_time(AnalysisFileName, AnalysisTimeResult,
+ !IO),
+ io.file_modification_time(CacheFileName, CacheTimeResult, !IO),
+ (
+ AnalysisTimeResult = ok(AnalysisTime),
+ CacheTimeResult = ok(CacheTime),
+ CacheTime @>= AnalysisTime
+ ->
+ Unpicklers = init_analysis_unpicklers(Compiler),
+ unpickle_from_file(Unpicklers, CacheFileName, UnpickleResult,
+ !IO),
+ (
+ UnpickleResult = ok(ModuleResults)
+ ;
+ UnpickleResult = error(Error),
+ io.write_string("Error reading ", !IO),
+ io.write_string(CacheFileName, !IO),
+ io.write_string(": ", !IO),
+ io.write_string(io.error_message(Error), !IO),
+ io.nl(!IO),
+ read_module_analysis_results_2(Compiler, AnalysisFileName,
+ ModuleResults, !IO),
+ write_analysis_cache_file(CacheFileName, ModuleResults, !IO)
+ )
+ ;
+ read_module_analysis_results_2(Compiler, AnalysisFileName,
+ ModuleResults, !IO),
+ write_analysis_cache_file(CacheFileName, ModuleResults, !IO)
+ )
+ ;
+ read_module_analysis_results_2(Compiler, AnalysisFileName,
+ ModuleResults, !IO)
+ )
;
MaybeAnalysisFileName = error(_),
ModuleResults = map.init
@@ -615,7 +662,20 @@ write_module_analysis_results(Info, ModuleName, ModuleResults, !IO) :-
ToTmp = yes,
write_analysis_file(Info ^ compiler, ModuleName, analysis_registry_suffix,
ToTmp, write_result_entry, ModuleResults, FileName, !IO),
- update_interface(FileName, !IO).
+ update_interface_return_changed(FileName, Result, !IO),
+
+ % If analysis file caching is turned on, write the internal represention of
+ % the module results to disk right now.
+ globals.io_lookup_string_option(analysis_file_cache_dir, CacheDir, !IO),
+ (
+ CacheDir \= "",
+ Result = interface_new_or_changed
+ ->
+ CacheFileName = make_cache_filename(CacheDir, FileName),
+ write_analysis_cache_file(CacheFileName, ModuleResults, !IO)
+ ;
+ true
+ ).
:- pred write_result_entry
`with_type` write_entry(some_analysis_result)
@@ -699,8 +759,8 @@ write_module_analysis_requests(Info, ModuleName, ModuleRequests, !IO) :-
write_request_entry(Compiler, AnalysisName, FuncId, Request, !IO) :-
Request = analysis_request(Call, CallerModule),
(
- analysis_type(_ : unit(Call), _ : unit(Answer)) =
- analyses(Compiler, AnalysisName)
+ analysis_type(_ : unit(Call), _ : unit(Answer))
+ = analyses(Compiler, AnalysisName)
->
VersionNumber = analysis_version_number(_ : Call, _ : Answer)
;
@@ -854,5 +914,144 @@ empty_request_file(Info, ModuleName, !IO) :-
io.remove_file(RequestFileName, _, !IO).
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%
+% Analysis file caching
+%
+% An analysis cache file stores a binary representation of the parsed
+% information in the corresponding .analysis file. In some cases, the binary
+% format can be faster to read than the usual representation. The textual
+% analysis files are portable, more stable (doesn't depend on compiler
+% internals) and easier to debug, hence the reason we don't just use the
+% binary files exclusively.
+%
+
+:- func make_cache_filename(string, string) = string.
+
+make_cache_filename(Dir, FileName) = CacheFileName :-
+ Components = string.split_at_separator(dir_sep, FileName),
+ EscFileName = string.join_list(":", Components),
+ CacheFileName = Dir / EscFileName.
+
+:- pred dir_sep(char::in) is semidet.
+
+dir_sep(Char) :-
+ dir.is_directory_separator(Char).
+
+:- pred write_analysis_cache_file(string::in,
+ module_analysis_map(some_analysis_result)::in, io::di, io::uo) is det.
+
+write_analysis_cache_file(CacheFileName, ModuleResults, !IO) :-
+ % Write to a temporary file first and only move it into place once it is
+ % complete.
+ TmpFileName = CacheFileName ++ ".tmp",
+ io.tell_binary(TmpFileName, TellRes, !IO),
+ (
+ TellRes = ok,
+ pickle(init_analysis_picklers, ModuleResults, !IO),
+ io.told_binary(!IO),
+ io.rename_file(TmpFileName, CacheFileName, RenameRes, !IO),
+ (
+ RenameRes = ok
+ ;
+ RenameRes = error(Error),
+ io.write_string("Error renaming ", !IO),
+ io.write_string(CacheFileName, !IO),
+ io.write_string(": ", !IO),
+ io.write_string(io.error_message(Error), !IO),
+ io.nl(!IO),
+ io.remove_file(TmpFileName, _, !IO)
+ )
+ ;
+ TellRes = error(Error),
+ unexpected(this_file, "pickle_to_file: " ++ io.error_message(Error))
+ ).
+
+:- func init_analysis_picklers = picklers.
+
+init_analysis_picklers = Pickles :-
+ some [!Pickles] (
+ !:Pickles = init_picklers,
+ Dummy = 'new some_analysis_result'(any_call, dummy_answer, optimal),
+ Type = type_ctor(type_of(Dummy)),
+ register_pickler(Type, pickle_analysis_result, !Pickles),
+ Pickles = !.Pickles
+ ).
+
+:- pred pickle_analysis_result(picklers::in, univ::in, io::di, io::uo) is det.
+
+pickle_analysis_result(Pickles, Univ, !IO) :-
+ det_univ_to_type(Univ, some_analysis_result(Call, Answer, Status)),
+ Name = analysis_name(Call, Answer),
+ pickle(Pickles, Name, !IO),
+ pickle(Pickles, Call, !IO),
+ pickle(Pickles, Answer, !IO),
+ pickle(Pickles, Status, !IO).
+
+:- func init_analysis_unpicklers(Compiler) = unpicklers
+ <= compiler(Compiler).
+
+init_analysis_unpicklers(Compiler) = Unpicklers :-
+ some [!Unpicklers] (
+ !:Unpicklers = init_unpicklers,
+ Dummy = 'new some_analysis_result'(any_call, dummy_answer, optimal),
+ Type = type_ctor(type_of(Dummy)),
+ register_unpickler(Type, unpickle_analysis_result(Compiler),
+ !Unpicklers),
+ Unpicklers = !.Unpicklers
+ ).
+
+:- pred unpickle_analysis_result(Compiler::in, unpicklers::in,
+ unpickle_handle::in, type_desc::in, univ::out,
+ unpickle_state::di, unpickle_state::uo) is det
+ <= compiler(Compiler).
+
+unpickle_analysis_result(Compiler, Unpicklers, Handle, _Type, Univ, !State) :-
+ unpickle(Unpicklers, Handle, Name : string, !State),
+ (
+ analysis_type(_ : unit(Call), _ : unit(Answer))
+ = analyses(Compiler, Name)
+ ->
+ unpickle(Unpicklers, Handle, Call : Call, !State),
+ unpickle(Unpicklers, Handle, Answer : Answer, !State),
+ unpickle(Unpicklers, Handle, Status, !State),
+ Result = 'new some_analysis_result'(Call, Answer, Status),
+ type_to_univ(Result, Univ)
+ ;
+ unexpected(this_file, "unpickle_analysis_result: " ++ Name)
+ ).
+
+% This is only needed so we can get the type_ctor_desc of
+% `some_analysis_result' without referring to a real analysis.
+
+:- type dummy_answer
+ ---> dummy_answer.
+
+:- instance answer_pattern(no_func_info, dummy_answer) where [].
+:- instance partial_order(no_func_info, dummy_answer) where [
+ ( more_precise_than(no_func_info, _, _) :-
+ semidet_fail
+ ),
+ equivalent(no_func_info, dummy_answer, dummy_answer)
+].
+:- instance to_term(dummy_answer) where [
+ ( to_term(dummy_answer) = Term :-
+ Term = term.functor(atom("dummy"), [], context_init)
+ ),
+ ( from_term(Term, dummy_answer) :-
+ Term = term.functor(atom("dummy"), [], _)
+ )
+].
+
+:- instance analysis(no_func_info, any_call, dummy_answer) where [
+ analysis_name(_, _) = "dummy",
+ analysis_version_number(_, _) = 1,
+ preferred_fixpoint_type(_, _) = greatest_fixpoint,
+ bottom(_, _) = dummy_answer,
+ top(_, _) = dummy_answer,
+ get_func_info(_, _, _, _, _, no_func_info)
+].
+
+%-----------------------------------------------------------------------------%
:- end_module analysis.file.
%-----------------------------------------------------------------------------%
diff --git a/compiler/libs.m b/compiler/libs.m
index bcfc6bf..25ae3e0 100644
--- a/compiler/libs.m
+++ b/compiler/libs.m
@@ -26,6 +26,7 @@
:- include_module atsort.
:- include_module file_util.
:- include_module graph_colour.
+:- include_module pickle.
:- include_module tree.
% OS interfaces not provided by the standard library.
diff --git a/compiler/make.program_target.m b/compiler/make.program_target.m
index 3786c99..61f5b89 100644
--- a/compiler/make.program_target.m
+++ b/compiler/make.program_target.m
@@ -60,7 +60,7 @@
%-----------------------------------------------------------------------------%
make_linked_target(LinkedTargetFile, LinkedTargetSucceeded, !Info, !IO) :-
- LinkedTargetFile = linked_target_file(MainModuleName, FileType),
+ LinkedTargetFile = linked_target_file(_MainModuleName, FileType),
(
FileType = shared_library,
ExtraOptions = ["--compile-to-shared-lib"]
@@ -93,41 +93,49 @@ make_linked_target(LinkedTargetFile, LinkedTargetSucceeded, !Info, !IO) :-
LibgradeCheck = no,
LibgradeCheckSucceeded = yes
),
-
(
LibgradeCheckSucceeded = yes,
- % When using `--intermodule-analysis', perform an analysis pass
- % first. The analysis of one module may invalidate the results of
- % a module we analysed earlier, so this step must be carried out
- % until all the `.analysis' files are in a valid state before we
- % can continue.
- globals.io_lookup_bool_option(intermodule_analysis,
- IntermodAnalysis, !IO),
- (
- IntermodAnalysis = yes,
- make_misc_target_builder(
- MainModuleName - misc_target_build_analyses,
- ExtraOptions, IntermodAnalysisSucceeded, !Info, !IO)
- ;
- IntermodAnalysis = no,
- IntermodAnalysisSucceeded = yes
- )
- ;
- LibgradeCheckSucceeded = no,
- IntermodAnalysisSucceeded = no
- ),
-
- (
- IntermodAnalysisSucceeded = yes,
- build_with_module_options(MainModuleName, ExtraOptions,
- make_linked_target_2(LinkedTargetFile),
+ maybe_with_analysis_cache_dir(
+ make_linked_target_1(LinkedTargetFile, ExtraOptions),
LinkedTargetSucceeded, !Info, !IO)
;
- IntermodAnalysisSucceeded = no,
+ LibgradeCheckSucceeded = no,
LinkedTargetSucceeded = no
)
).
+:- pred make_linked_target_1(linked_target_file::in, list(string)::in,
+ bool::out, make_info::in, make_info::out, io::di, io::uo) is det.
+
+make_linked_target_1(LinkedTargetFile, ExtraOptions, Succeeded, !Info, !IO) :-
+ LinkedTargetFile = linked_target_file(MainModuleName, _FileType),
+
+ % When using `--intermodule-analysis', perform an analysis pass
+ % first. The analysis of one module may invalidate the results of
+ % a module we analysed earlier, so this step must be carried out
+ % until all the `.analysis' files are in a valid state before we
+ % can continue.
+ globals.io_lookup_bool_option(intermodule_analysis, IntermodAnalysis, !IO),
+ (
+ IntermodAnalysis = yes,
+ make_misc_target_builder(
+ MainModuleName - misc_target_build_analyses,
+ ExtraOptions, IntermodAnalysisSucceeded, !Info, !IO)
+ ;
+ IntermodAnalysis = no,
+ IntermodAnalysisSucceeded = yes
+ ),
+
+ (
+ IntermodAnalysisSucceeded = yes,
+ build_with_module_options(MainModuleName, ExtraOptions,
+ make_linked_target_2(LinkedTargetFile),
+ Succeeded, !Info, !IO)
+ ;
+ IntermodAnalysisSucceeded = no,
+ Succeeded = no
+ ).
+
:- pred make_linked_target_2(linked_target_file::in, list(string)::in,
bool::out, make_info::in, make_info::out, io::di, io::uo) is det.
@@ -663,22 +671,26 @@ make_misc_target_builder(MainModuleName - TargetType, _, Succeeded,
( Succeeded0 = no, KeepGoing = no ->
Succeeded = no
;
- foldl2_maybe_stop_at_error(KeepGoing,
- make_module_target,
- make_dependency_list(TargetModules, ModuleTargetType),
+ maybe_with_analysis_cache_dir(
+ foldl2_maybe_stop_at_error(KeepGoing,
+ make_module_target,
+ make_dependency_list(TargetModules, ModuleTargetType)),
Succeeded1, !Info, !IO),
Succeeded = Succeeded0 `and` Succeeded1
)
;
TargetType = misc_target_build_analyses,
- build_analysis_files(MainModuleName, AllModules, Succeeded0, Succeeded,
- !Info, !IO)
+ maybe_with_analysis_cache_dir(
+ build_analysis_files(MainModuleName, AllModules, Succeeded0),
+ Succeeded, !Info, !IO)
;
TargetType = misc_target_build_library,
make_all_interface_files(AllModules, IntSucceeded, !Info, !IO),
(
IntSucceeded = yes,
- build_library(MainModuleName, AllModules, Succeeded, !Info, !IO)
+ maybe_with_analysis_cache_dir(
+ build_library(MainModuleName, AllModules),
+ Succeeded, !Info, !IO)
;
IntSucceeded = no,
Succeeded = no
@@ -737,6 +749,98 @@ make_all_interface_files(AllModules, Succeeded, !Info, !IO) :-
%-----------------------------------------------------------------------------%
+ % If `--analysis-file-cache' is enabled, create a temporary directory for
+ % holding analysis cache files and pass that to child processes.
+ % After P is finished, remove the cache directory completely.
+ %
+:- pred maybe_with_analysis_cache_dir(build0(make_info)::in(build0),
+ bool::out, make_info::in, make_info::out, io::di, io::uo) is det.
+
+maybe_with_analysis_cache_dir(P, Succeeded, !Info, !IO) :-
+ globals.io_lookup_bool_option(intermodule_analysis, IntermodAnalysis, !IO),
+ globals.io_lookup_bool_option(analysis_file_cache, Caching, !IO),
+ globals.io_lookup_string_option(analysis_file_cache_dir, CacheDir0, !IO),
+ CacheDirOption = "--analysis-file-cache-dir",
+ (
+ (
+ IntermodAnalysis = no
+ ;
+ Caching = no
+ ;
+ % Cache directory given on command line.
+ CacheDir0 \= ""
+ ;
+ % Analysis file cache directory already set up in a parent call.
+ list.member(CacheDirOption, !.Info ^ option_args)
+ )
+ ->
+ P(Succeeded, !Info, !IO)
+ ;
+ create_analysis_cache_dir(Succeeded0, CacheDir, !IO),
+ (
+ Succeeded0 = yes,
+ OrigOptionArgs = !.Info ^ option_args,
+ % Pass the name of the cache directory to child processes
+ !Info ^ option_args := OrigOptionArgs ++
+ [CacheDirOption, CacheDir],
+ build_with_check_for_interrupt(P, remove_cache_dir(CacheDir),
+ Succeeded, !Info, !IO),
+ remove_cache_dir(CacheDir, !Info, !IO),
+ !Info ^ option_args := OrigOptionArgs
+ ;
+ Succeeded0 = no,
+ Succeeded = no
+ )
+ ).
+
+:- pred create_analysis_cache_dir(bool::out, string::out, io::di, io::uo)
+ is det.
+
+create_analysis_cache_dir(Succeeded, CacheDir, !IO) :-
+ choose_cache_dir_name(CacheDir, !IO),
+ verbose_msg(verbose_make,
+ io.format("Creating %s\n", [s(CacheDir)]), !IO),
+ dir.make_directory(CacheDir, MakeRes, !IO),
+ (
+ MakeRes = ok,
+ Succeeded = yes
+ ;
+ MakeRes = error(Error),
+ io.write_string("Error: making directory ", !IO),
+ io.write_string(CacheDir, !IO),
+ io.write_string(": ", !IO),
+ io.write_string(io.error_message(Error), !IO),
+ io.nl(!IO),
+ Succeeded = no
+ ).
+
+:- pred choose_cache_dir_name(string::out, io::di, io::uo) is det.
+
+choose_cache_dir_name(DirName, !IO) :-
+ globals.io_get_globals(Globals, !IO),
+ globals.lookup_bool_option(Globals, use_grade_subdirs, UseGradeSubdirs),
+ globals.lookup_string_option(Globals, fullarch, FullArch),
+ (
+ UseGradeSubdirs = yes,
+ grade_directory_component(Globals, Grade),
+ DirComponents = ["Mercury", Grade, FullArch, "Mercury",
+ "analysis_cache"]
+ ;
+ UseGradeSubdirs = no,
+ DirComponents = ["Mercury", "analysis_cache"]
+ ),
+ DirName = dir.relative_path_name_from_components(DirComponents).
+
+:- pred remove_cache_dir(string::in, make_info::in, make_info::out,
+ io::di, io::uo) is det.
+
+remove_cache_dir(CacheDir, !Info, !IO) :-
+ verbose_msg(verbose_make,
+ io.format("Removing %s\n", [s(CacheDir)]), !IO),
+ io.remove_file_recursively(CacheDir, _, !IO).
+
+%-----------------------------------------------------------------------------%
+
:- pred build_analysis_files(module_name::in, list(module_name)::in,
bool::in, bool::out, make_info::in, make_info::out, io::di, io::uo)
is det.
diff --git a/compiler/module_cmds.m b/compiler/module_cmds.m
index 76c512e..7df9df1 100644
--- a/compiler/module_cmds.m
+++ b/compiler/module_cmds.m
@@ -25,11 +25,18 @@
%-----------------------------------------------------------------------------%
- % update_interface_return_succeeded(FileName, Succeeded):
+:- type update_interface_result
+ ---> interface_new_or_changed
+ ; interface_unchanged
+ ; interface_error.
+
+ % update_interface_return_changed(FileName, Result):
%
- % Call the shell script mercury_update_interface to update the
- % interface file FileName from FileName.tmp if it has changed.
+ % Update the interface file FileName from FileName.tmp if it has changed.
%
+:- pred update_interface_return_changed(file_name::in,
+ update_interface_result::out, io::di, io::uo) is det.
+
:- pred update_interface_return_succeeded(file_name::in, bool::out,
io::di, io::uo) is det.
@@ -186,6 +193,18 @@ update_interface(OutputFileName, !IO) :-
).
update_interface_return_succeeded(OutputFileName, Succeeded, !IO) :-
+ update_interface_return_changed(OutputFileName, Result, !IO),
+ (
+ ( Result = interface_new_or_changed
+ ; Result = interface_unchanged
+ ),
+ Succeeded = yes
+ ;
+ Result = interface_error,
+ Succeeded = no
+ ).
+
+update_interface_return_changed(OutputFileName, Result, !IO) :-
globals.io_lookup_bool_option(verbose, Verbose, !IO),
maybe_write_string(Verbose, "% Updating interface:\n", !IO),
TmpOutputFileName = OutputFileName ++ ".tmp",
@@ -201,7 +220,7 @@ update_interface_return_succeeded(OutputFileName, Succeeded, !IO) :-
io.close_binary_input(TmpOutputFileStream, !IO),
(
FilesDiffer = ok(ok(no)),
- Succeeded = yes,
+ Result = interface_unchanged,
maybe_write_string(Verbose, "% ", !IO),
maybe_write_string(Verbose, OutputFileName, !IO),
maybe_write_string(Verbose, "' has not changed.\n", !IO),
@@ -209,10 +228,10 @@ update_interface_return_succeeded(OutputFileName, Succeeded, !IO) :-
;
FilesDiffer = ok(ok(yes)),
update_interface_create_file("CHANGED", OutputFileName,
- TmpOutputFileName, Succeeded, !IO)
+ TmpOutputFileName, Result, !IO)
;
FilesDiffer = ok(error(TmpFileError)),
- Succeeded = no,
+ Result = interface_error,
io.write_string("Error reading `", !IO),
io.write_string(TmpOutputFileName, !IO),
io.write_string("': ", !IO),
@@ -221,12 +240,12 @@ update_interface_return_succeeded(OutputFileName, Succeeded, !IO) :-
;
FilesDiffer = error(_, _),
update_interface_create_file("been CREATED", OutputFileName,
- TmpOutputFileName, Succeeded, !IO)
+ TmpOutputFileName, Result, !IO)
)
;
TmpOutputFileRes = error(TmpOutputFileError),
- Succeeded = no,
+ Result = interface_error,
io.close_binary_input(OutputFileStream, !IO),
io.write_string("Error creating `", !IO),
io.write_string(OutputFileName, !IO),
@@ -237,13 +256,13 @@ update_interface_return_succeeded(OutputFileName, Succeeded, !IO) :-
;
OutputFileRes = error(_),
update_interface_create_file("been CREATED", OutputFileName,
- TmpOutputFileName, Succeeded, !IO)
+ TmpOutputFileName, Result, !IO)
).
:- pred update_interface_create_file(string::in, string::in, string::in,
- bool::out, io::di, io::uo) is det.
+ update_interface_result::out, io::di, io::uo) is det.
-update_interface_create_file(Msg, OutputFileName, TmpOutputFileName, Succeeded,
+update_interface_create_file(Msg, OutputFileName, TmpOutputFileName, Result,
!IO) :-
globals.io_lookup_bool_option(verbose, Verbose, !IO),
maybe_write_string(Verbose,
@@ -251,10 +270,10 @@ update_interface_create_file(Msg, OutputFileName, TmpOutputFileName, Succeeded,
copy_file(TmpOutputFileName, OutputFileName, MoveRes, !IO),
(
MoveRes = ok,
- Succeeded = yes
+ Result = interface_new_or_changed
;
MoveRes = error(MoveError),
- Succeeded = no,
+ Result = interface_error,
io.write_string("Error creating `" ++ OutputFileName ++ "': " ++
io.error_message(MoveError), !IO),
io.nl(!IO)
diff --git a/compiler/options.m b/compiler/options.m
index a3668d0..eb22a41 100644
--- a/compiler/options.m
+++ b/compiler/options.m
@@ -533,6 +533,7 @@
; transitive_optimization
; intermodule_analysis
; analysis_repeat
+ ; analysis_file_cache
% - HLDS
; allow_inlining
@@ -868,6 +869,7 @@
; fullarch
; cross_compiling
; local_module_id
+ ; analysis_file_cache_dir
; compiler_sufficiently_recent
% This option is used to test that the compiler is sufficiently
% recent when no other test can easily be constructed in
@@ -1311,6 +1313,7 @@ option_defaults_2(special_optimization_option, [
transitive_optimization - bool(no),
intermodule_analysis - bool(no),
analysis_repeat - int(0),
+ analysis_file_cache - bool(no),
termination_check - bool(no),
verbose_check_termination - bool(no),
structure_sharing_analysis - bool(no),
@@ -1685,6 +1688,7 @@ option_defaults_2(miscellaneous_option, [
fullarch - string(""),
cross_compiling - bool(no),
local_module_id - accumulating([]),
+ analysis_file_cache_dir - string(""),
compiler_sufficiently_recent - bool(no),
experiment - string(""),
feedback_file - string("")
@@ -2109,6 +2113,7 @@ long_option("transitive-intermodule-optimisation",
long_option("trans-intermod-opt", transitive_optimization).
long_option("intermodule-analysis", intermodule_analysis).
long_option("analysis-repeat", analysis_repeat).
+long_option("analysis-file-cache", analysis_file_cache).
% HLDS->HLDS optimizations
long_option("inlining", inlining).
@@ -2539,6 +2544,7 @@ long_option("filenames-from-stdin", filenames_from_stdin).
long_option("fullarch", fullarch).
long_option("cross-compiling", cross_compiling).
long_option("local-module-id", local_module_id).
+long_option("analysis-file-cache-dir", analysis_file_cache_dir).
long_option("bug-intermod-2002-06-13", compiler_sufficiently_recent).
long_option("bug-intermod-2006-09-28", compiler_sufficiently_recent).
long_option("bug-foreign_import-2002-08-06", compiler_sufficiently_recent).
@@ -4372,6 +4378,10 @@ options_help_optimization -->
"\tThe maximum number of times to repeat analyses of",
"\tsuboptimal modules with `--intermodule-analysis'",
"\t(default: 0)."
+ % This is commented out as this feature is still experimental.
+% "--analysis-file-cache",
+% "\tEnable caching of parsed analysis files. This may",
+% "\timprove compile times with `--intermodule-analysis'."
]).
:- pred options_help_hlds_hlds_optimization(io::di, io::uo) is det.
@@ -5191,6 +5201,8 @@ options_help_misc -->
"\tplatform the compiler is running on.",
% The `--local-module-id' option is used by `mmc --make'.
+ % The `--analysis-file-cache-dir' option is used by `mmc --make'.
+
"--feedback-file",
"\tUse the specified profiling feedback file which may currently",
"\tonly be processed for implicit parallelism."
diff --git a/compiler/pickle.m b/compiler/pickle.m
new file mode 100644
index 0000000..f15c512
--- /dev/null
+++ b/compiler/pickle.m
@@ -0,0 +1,486 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2008 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: pickle.m
+% Main authors: petdr, wangp.
+%
+% This file contains routines to serialise arbitrary data structures into some
+% unspecified binary format which can be restored quickly.
+%
+% We don't preserve sharing in the pickled data structure. This would be
+% possible but would introduce slowdowns in both the pickling and unpickling
+% processes.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module libs.pickle.
+:- interface.
+
+:- import_module io.
+:- import_module type_desc.
+:- import_module univ.
+
+%-----------------------------------------------------------------------------%
+
+ % A type which holds custom pickling predicates.
+ %
+:- type picklers.
+
+:- type pickler_pred == pred(picklers, univ, io, io).
+:- inst pickler_pred == (pred(in, in, di, uo) is det).
+
+ % Initialize the custom pickling predicates.
+ %
+:- func init_picklers = picklers.
+
+ % For the type described by the type_ctor_desc, add the supplied custom
+ % pickle predicate to the set of registered pickle predicates.
+ %
+:- pred register_pickler(type_ctor_desc::in, pickler_pred::in(pickler_pred),
+ picklers::in, picklers::out) is det.
+
+ % Serialise an arbitrary data structure into the current binary output
+ % stream, using the picklers given to override the default pickling method.
+ %
+ % Existential, foreign and higher-order types are not supported
+ % generically. Register custom handlers to handle those types.
+ %
+:- pred pickle(picklers::in, T::in, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+ % A type which holds the custom unpickling predicates.
+ %
+:- type unpicklers.
+
+:- type unpickle_handle.
+
+:- type unpickle_state.
+
+:- type unpickler_pred == pred(unpicklers, unpickle_handle, type_desc, univ,
+ unpickle_state, unpickle_state).
+:- inst unpickler_pred == (pred(in, in, in, out, di, uo) is det).
+
+ % Initialize the custom unpickling predicates.
+ %
+:- func init_unpicklers = unpicklers.
+
+ % For the type described by the type_ctor_desc, add the supplied custom
+ % unpickle predicate to the set of registered unpickle predicates.
+ %
+:- pred register_unpickler(type_ctor_desc::in,
+ unpickler_pred::in(unpickler_pred), unpicklers::in, unpicklers::out)
+ is det.
+
+ % Get a pickled type back out from the file, using the unpicklers to
+ % override the default unpickling method.
+ %
+:- pred unpickle_from_file(unpicklers::in, string::in, io.res(T)::out,
+ io::di, io::uo) is det.
+
+ % Unpickle a single value.
+ %
+:- pred unpickle(unpicklers::in, unpickle_handle::in, T::out,
+ unpickle_state::di, unpickle_state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module libs.compiler_util.
+
+:- import_module bitmap.
+:- import_module bool.
+:- import_module char.
+:- import_module construct.
+:- import_module deconstruct.
+:- import_module exception.
+:- import_module int.
+:- import_module io.
+:- import_module list.
+:- import_module map.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+:- type picklers
+ ---> picklers(
+ map(type_ctor_desc, pickler_pred)
+ ).
+
+:- type unpicklers
+ ---> unpicklers(
+ map(type_ctor_desc, unpickler_pred)
+ ).
+
+:- type unpickle_handle == bitmap.
+:- type unpickle_state == int. % offset into bitmap
+
+:- type get_byte_out_of_range
+ ---> get_byte_out_of_range(string).
+
+%-----------------------------------------------------------------------------%
+%
+% Pickling
+%
+
+init_picklers = picklers(map.init).
+
+register_pickler(TypeCtorDesc, Pickle, Pickles0, Pickles) :-
+ Pickles0 = picklers(Map0),
+ map.det_insert(Map0, TypeCtorDesc, Pickle, Map),
+ Pickles = picklers(Map).
+
+pickle(Pickles, T, !IO) :-
+ ( dynamic_cast(T, String) ->
+ pickle_string(String, !IO)
+ ; dynamic_cast(T, Int) ->
+ pickle_int32(Int, !IO)
+ ; dynamic_cast(T, Float) ->
+ pickle_float(Float, !IO)
+ ; dynamic_cast(T, Char) ->
+ pickle_char(Char, !IO)
+ ;
+ TypeDesc = type_of(T),
+ TypeCtorDesc = type_ctor(TypeDesc),
+ user_defined_pickler(Pickles, TypeCtorDesc, Pickle)
+ ->
+ Pickle(Pickles, univ(T), !IO)
+ ;
+ deconstruct.functor(T, do_not_allow, Functor, Arity),
+ pickle_string(Functor, !IO),
+ pickle_int32(Arity, !IO),
+ pickle_args(Pickles, 0, Arity, T, !IO)
+ ).
+
+:- pred pickle_args(picklers::in, int::in, int::in, T::in, io::di, io::uo)
+ is det.
+
+pickle_args(Pickles, N, Arity, T, !IO) :-
+ ( N = Arity ->
+ true
+ ;
+ ( deconstruct.arg(T, do_not_allow, N, Arg) ->
+ pickle(Pickles, Arg, !IO),
+ pickle_args(Pickles, N + 1, Arity, T, !IO)
+ ;
+ unexpected(this_file, "pickle_args: unable to deconstruct arg")
+ )
+ ).
+
+:- pred user_defined_pickler(picklers::in, type_ctor_desc::in,
+ pickler_pred::out(pickler_pred)) is semidet.
+
+user_defined_pickler(picklers(Pickles), TypeCtorDesc, Pickle) :-
+ map.search(Pickles, TypeCtorDesc, Pickle0),
+ pickler_inst_cast(Pickle0, Pickle).
+
+:- pred pickler_inst_cast(pickler_pred::in, pickler_pred::out(pickler_pred))
+ is det.
+
+:- pragma foreign_proc("C",
+ pickler_inst_cast(A::in, B::out(pickler_pred)),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ B = A;
+").
+
+%-----------------------------------------------------------------------------%
+%
+% Unpickling
+%
+
+init_unpicklers = unpicklers(map.init).
+
+register_unpickler(TypeCtorDesc, Unpickle, Unpicklers0, Unpicklers) :-
+ Unpicklers0 = unpicklers(Map0),
+ map.det_insert(Map0, TypeCtorDesc, Unpickle, Map),
+ Unpicklers = unpicklers(Map).
+
+unpickle_from_file(Unpicklers, FileName, Result, !IO) :-
+ io.see_binary(FileName, SeeResult, !IO),
+ (
+ SeeResult = ok,
+ % Perform unpickling from an intermediate memory buffer, as it seems to
+ % be faster.
+ io.read_binary_file_as_bitmap(ReadResult, !IO),
+ io.seen_binary(!IO),
+ (
+ ReadResult = ok(Bitmap),
+ promise_equivalent_solutions [TryResult] (
+ try((pred(T0::out) is det :-
+ unpickle(Unpicklers, Bitmap, T0, 0, _State)
+ ), TryResult)
+ ),
+ (
+ TryResult = succeeded(T),
+ Result = ok(T)
+ ;
+ TryResult = exception(Excp),
+ ( univ_to_type(Excp, get_byte_out_of_range(Msg)) ->
+ Result = error(io.make_io_error(Msg))
+ ;
+ rethrow(TryResult)
+ )
+ )
+ ;
+ ReadResult = error(Error),
+ Result = error(Error)
+ )
+ ;
+ SeeResult = error(Error),
+ Result = error(Error)
+ ).
+
+unpickle(Unpicklers, Handle, T, !State) :-
+ unpickle_2(Unpicklers, Handle, type_of(T), Univ, !State),
+ det_univ_to_type(Univ, T).
+
+:- pred unpickle_2(unpicklers::in, unpickle_handle::in,
+ type_desc::in, univ::out, unpickle_state::di, unpickle_state::uo)
+ is det.
+
+unpickle_2(Unpicklers, Handle, TypeDesc, Univ, !State) :-
+ ( TypeDesc = type_of(_ : string) ->
+ unpickle_string(Handle, String, !State),
+ Univ = univ(String)
+ ; TypeDesc = type_of(_ : int) ->
+ unpickle_int32(Handle, Int, !State),
+ Univ = univ(Int)
+ ; TypeDesc = type_of(_ : float) ->
+ unpickle_float(Handle, Float, !State),
+ Univ = univ(Float)
+ ; TypeDesc = type_of(_ : character) ->
+ unpickle_char(Handle, Char, !State),
+ Univ = univ(Char)
+ ; user_defined_unpickler(Unpicklers, type_ctor(TypeDesc), Unpickle) ->
+ Unpickle(Unpicklers, Handle, TypeDesc, Univ, !State)
+ ;
+ unpickle_string(Handle, Functor, !State),
+ unpickle_int32(Handle, Arity, !State),
+ (
+ ( Functor = "{}" ->
+ IsTuple = yes,
+ type_ctor_and_args(TypeDesc, _, ArgTypes),
+ N = 0
+ ;
+ IsTuple = no,
+ % XXX consider tabling this call
+ find_functor(TypeDesc, Functor, Arity, N, ArgTypes)
+ )
+ ->
+ list.map_foldl(unpickle_2(Unpicklers, Handle), ArgTypes, ArgUnivs,
+ !State),
+ (
+ IsTuple = yes,
+ Univ = construct_tuple(ArgUnivs)
+ ;
+ IsTuple = no,
+ ( Univ0 = construct(TypeDesc, N, ArgUnivs) ->
+ Univ = Univ0
+ ;
+ unexpected(this_file, "unpickle_2: unable to construct")
+ )
+ )
+ ;
+ unexpected(this_file, "unpickle_2: unable to unpickle")
+ )
+ ).
+
+:- pred user_defined_unpickler(unpicklers::in, type_ctor_desc::in,
+ unpickler_pred::out(unpickler_pred)) is semidet.
+
+user_defined_unpickler(unpicklers(Unpicklers), TypeCtorDesc, Unpickle) :-
+ map.search(Unpicklers, TypeCtorDesc, Unpickle0),
+ unpickler_inst_cast(Unpickle0, Unpickle).
+
+:- pred unpickler_inst_cast(unpickler_pred::in,
+ unpickler_pred::out(unpickler_pred)) is det.
+
+:- pragma foreign_proc("C",
+ unpickler_inst_cast(A::in, B::out(unpickler_pred)),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ B = A;
+").
+
+%-----------------------------------------------------------------------------%
+%
+% Basic types picklers/unpicklers
+%
+
+:- pred pickle_int32(int::in, io::di, io::uo) is det.
+
+pickle_int32(Int, !IO) :-
+ A = (Int >> 24) /\ 0xff,
+ B = (Int >> 16) /\ 0xff,
+ C = (Int >> 8) /\ 0xff,
+ D = (Int >> 0) /\ 0xff,
+ io.write_byte(A, !IO),
+ io.write_byte(B, !IO),
+ io.write_byte(C, !IO),
+ io.write_byte(D, !IO).
+
+:- pred unpickle_int32(unpickle_handle::in, int::out,
+ unpickle_state::di, unpickle_state::uo) is det.
+
+unpickle_int32(Handle, Int, !State) :-
+ get_byte(Handle, A, !State),
+ get_byte(Handle, B, !State),
+ get_byte(Handle, C, !State),
+ get_byte(Handle, D, !State),
+ Int0 = (A `unchecked_left_shift` 24)
+ \/ (B `unchecked_left_shift` 16)
+ \/ (C `unchecked_left_shift` 8)
+ \/ (D `unchecked_left_shift` 0),
+ Int = sign_extend_32(Int0).
+
+:- func sign_extend_32(int) = int.
+
+sign_extend_32(X) = R :-
+ % http://graphics.stanford.edu/~seander/bithacks.html#FixedSignExtend
+ Mask = 1 `unchecked_left_shift` 31,
+ R = (X `xor` Mask) - Mask.
+
+:- pred pickle_char(char::in, io::di, io::uo) is det.
+
+pickle_char(Char, !IO) :-
+ char.to_int(Char, Int),
+ io.write_byte(Int, !IO).
+
+:- pred unpickle_char(unpickle_handle::in, char::out,
+ unpickle_state::di, unpickle_state::uo) is det.
+
+unpickle_char(Handle, Char, !State) :-
+ get_byte(Handle, Byte, !State),
+ char.det_from_int(Byte, Char).
+
+:- pred pickle_string(string::in, io::di, io::uo) is det.
+
+pickle_string(String, !IO) :-
+ Length = string.length(String),
+ pickle_int32(Length, !IO),
+ string.foldl(pickle_char, String, !IO).
+
+:- pred unpickle_string(unpickle_handle::in, string::uo,
+ unpickle_state::di, unpickle_state::uo) is det.
+
+unpickle_string(Handle, String, !State) :-
+ unpickle_int32(Handle, Length, !State),
+ allocate_string(Length, String0),
+ unpickle_string_2(Handle, 0, Length, String0, String, !State).
+
+:- pred unpickle_string_2(unpickle_handle::in, int::in, int::in,
+ string::di, string::uo, unpickle_state::di, unpickle_state::uo) is det.
+
+unpickle_string_2(Handle, Index, Length, !String, !State) :-
+ ( Index = Length ->
+ true
+ ;
+ unpickle_char(Handle, Char, !State),
+ local_unsafe_set_char(Char, Index, !String),
+ unpickle_string_2(Handle, Index + 1, Length, !String, !State)
+ ).
+
+:- pred allocate_string(int::in, string::uo) is det.
+
+:- pragma foreign_proc("C",
+ allocate_string(Length::in, Str::uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MR_allocate_aligned_string_msg(Str, Length, ""pickle.allocate_string"");
+ Str[Length] = '\\0';
+").
+
+ % string.unsafe_set_char is disabled in the standard library so we need our
+ % own copy.
+:- pred local_unsafe_set_char(char::in, int::in, string::di, string::uo)
+ is det.
+
+:- pragma foreign_proc("C",
+ local_unsafe_set_char(Chr::in, Index::in, Str0::di, Str::uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Str0[Index] = Chr;
+ Str = Str0;
+").
+
+:- pred pickle_float(float::in, io::di, io::uo) is det.
+
+pickle_float(Float, !IO) :-
+ reinterpret_float_as_ints(Float, A, B),
+ % We always write floats using 64 bits. Single precision floats are not
+ % the default and the compiler hardly uses floats anyhow.
+ pickle_int32(A, !IO),
+ pickle_int32(B, !IO).
+
+:- pred reinterpret_float_as_ints(float::in, int::out, int::out)
+ is det.
+
+:- pragma foreign_proc("C",
+ reinterpret_float_as_ints(Flt::in, A::out, B::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ if (sizeof(MR_Float) == sizeof(float)) {
+ MR_uint_least32_t *p = (MR_uint_least32_t *) &Flt;
+ A = *p;
+ B = 0;
+ } else {
+ MR_uint_least64_t *p = (MR_uint_least64_t *) &Flt;
+ A = (*p >> 32) & 0xffffffff;
+ B = (*p >> 0) & 0xffffffff;
+ }
+").
+
+:- pred unpickle_float(unpickle_handle::in, float::out,
+ unpickle_state::di, unpickle_state::uo) is det.
+
+unpickle_float(Handle, Float, !State) :-
+ unpickle_int32(Handle, A, !State),
+ unpickle_int32(Handle, B, !State),
+ reinterpret_ints_as_float(A, B, Float).
+
+:- pred reinterpret_ints_as_float(int::in, int::in, float::out) is det.
+
+:- pragma foreign_proc("C",
+ reinterpret_ints_as_float(A::in, B::in, Flt::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ if (sizeof(MR_Float) == sizeof(float)) {
+ MR_Float *p = (MR_Float *) &A;
+ Flt = *p;
+ (void) B;
+ } else {
+ MR_uint_least64_t tmp = (A << 32) | (B & 0xffffffff);
+ MR_Float *p = (MR_Float *) &tmp;
+ Flt = *p;
+ }
+").
+
+:- pred get_byte(unpickle_handle::in, int::out,
+ unpickle_state::di, unpickle_state::uo) is det.
+
+get_byte(Bitmap, Byte, Index, Index + 1) :-
+ ( bitmap.byte_in_range(Bitmap, Index) ->
+ Byte = Bitmap ^ unsafe_byte(Index)
+ ;
+ Msg = "byte " ++ string.from_int(Index) ++ " is out of range",
+ throw(get_byte_out_of_range(Msg))
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "libs.pickle".
+
+%-----------------------------------------------------------------------------%
+:- end_module libs.pickle.
+%-----------------------------------------------------------------------------%
diff --git a/doc/user_guide.texi b/doc/user_guide.texi
index 7970fae..d6f876f 100644
--- a/doc/user_guide.texi
+++ b/doc/user_guide.texi
@@ -8019,6 +8019,12 @@ The maximum number of times to repeat analyses of suboptimal modules with
@samp{--intermodule-analyses} (default: 0). This option only works with
@samp{mmc --make}.
+ at c This feature is still experimental.
+ at c @item --analysis-file-cache
+ at c @findex --analysis-file-cache
+ at c Enable caching of parsed analysis files. This may
+ at c improve compile times with @samp{--intermodule-analysis}.
+
@end table
@node High-level (HLDS -> HLDS) optimization options
--------------------------------------------------------------------------
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