[m-rev.] for review: automatically choosing --install-command (part 1)
Julien Fischer
jfischer at opturion.com
Mon Jul 29 15:32:02 AEST 2013
For review by anyone.
Allow the possibility of the compiler automatically deciding what command(s) to
use to install files and directories instead of using the value of
--install-command (which defaults to "cp"). The eventual intention (NYI) is
that in the absence of a value for --install-command, the compiler will choose
an appropriate command based on the setting of --host-env-type (and possibly
some other stuff, for the example the OS version).
The rationale for all this to try to improve the current situation on Windows
(in the absence of Cygwin or MSYS) where file copying is a bit of a mess. It
should also mean that the same Mercury installation can be more easily used
from both MSYS and cmd.exe.
NOTE: for the moment --install-command is still specified in Mercury.config.
This will be removed in a later change and the compiler will default to
choosing automatically.
compiler/globals.m:
Add a type whose values describe how we should install files and
directories.
Add a field of that type, file_install_cmd, to the globals structure.
Add access predicates.
compiler/handle_options.m:
Set the new field in the globals.
compiler/file_util.m:
Provide functions for constructing a command line for installing files
and directories based on the value of the file_install_cmd field in
the globals.
compiler/make.program_target.m:
compiler/module_cmds.m:
Use the new functions in file_util.m.
Julien.
diff --git a/compiler/file_util.m b/compiler/file_util.m
index 2b39af5..f8085c8 100644
--- a/compiler/file_util.m
+++ b/compiler/file_util.m
@@ -105,6 +105,20 @@
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
+
+ % make_install_command(Globals, FileName, InstallDir) = Command:
+ % Command is the command required to install file FileName in directory
+ % InstallDir.
+ %
+:- func make_install_file_command(globals, string, string) = string.
+
+ % make_install_dir_command(Globals, SourceDirName, InstallDir) = Command:
+ % Command is the command required to install directory SourceDirName
+ % in directory InstallDir.
+ %
+:- func make_install_dir_command(globals, string, string) = string.
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -292,5 +306,32 @@ report_error_to_stream(Stream, ErrorMessage, !IO) :-
io.set_output_stream(OldStream, _, !IO).
%-----------------------------------------------------------------------------%
+
+make_install_file_command(Globals, FileName, InstallDir) = Command :-
+ globals.get_file_install_cmd(Globals, FileInstallCmd),
+ (
+ FileInstallCmd = install_cmd_user(InstallCmd, _InstallCmdDirOpt)
+ ;
+ FileInstallCmd = install_cmd_cp,
+ InstallCmd = "cp"
+ ),
+ Command = string.join_list(" ", list.map(quote_arg,
+ [InstallCmd, FileName, InstallDir])).
+
+make_install_dir_command(Globals, SourceDirName, InstallDir) = Command :-
+ globals.get_file_install_cmd(Globals, FileInstallCmd),
+ (
+ FileInstallCmd = install_cmd_user(InstallCmd, InstallCmdDirOpt)
+ ;
+ FileInstallCmd = install_cmd_cp,
+ InstallCmd = "cp",
+ % XXX the POSIX option is -R but for some reason the default in
+ % options.m is -r.
+ InstallCmdDirOpt = "-R"
+ ),
+ Command = string.join_list(" ", list.map(quote_arg,
+ [InstallCmd, InstallCmdDirOpt, SourceDirName, InstallDir])).
+
+%-----------------------------------------------------------------------------%
:- end_module libs.file_util.
%-----------------------------------------------------------------------------%
diff --git a/compiler/globals.m b/compiler/globals.m
index 723942b..99e3932 100644
--- a/compiler/globals.m
+++ b/compiler/globals.m
@@ -200,6 +200,20 @@
% Deep trace all procedures in this module
.
+ % This type specifies the command compiler uses to install files.
+ %
+:- type file_install_cmd
+ ---> install_cmd_user(
+ string, % Cmd.
+ string % Flag for copying directories.
+ )
+ % Command specified by the user using --install-command and the
+ % option for copying directories specified by
+ % --install-command-dir-option.
+
+ ; install_cmd_cp.
+ % POSIX conformant cp command.
+
% Map from module name to file name.
%
:- type source_file_map == map(module_name, string).
@@ -240,7 +254,7 @@
may_be_thread_safe::in, c_compiler_type::in, csharp_compiler_type::in,
reuse_strategy::in,
maybe(il_version_number)::in, maybe(feedback_info)::in, env_type::in,
- env_type::in, globals::out) is det.
+ env_type::in, file_install_cmd::in, globals::out) is det.
:- pred get_options(globals::in, option_table::out) is det.
:- pred get_target(globals::in, compilation_target::out) is det.
@@ -263,6 +277,7 @@
:- pred get_maybe_feedback_info(globals::in, maybe(feedback_info)::out) is det.
:- pred get_host_env_type(globals::in, env_type::out) is det.
:- pred get_target_env_type(globals::in, env_type::out) is det.
+:- pred get_file_install_cmd(globals::in, file_install_cmd::out) is det.
:- pred set_option(option::in, option_data::in, globals::in, globals::out)
is det.
@@ -275,6 +290,8 @@
globals::in, globals::out) is det.
:- pred set_maybe_feedback_info(maybe(feedback_info)::in,
globals::in, globals::out) is det.
+:- pred set_file_install_cmd(file_install_cmd::in,
+ globals::in, globals::out) is det.
:- pred lookup_option(globals::in, option::in, option_data::out) is det.
@@ -591,7 +608,7 @@ gc_is_conservative(gc_automatic) = no.
g_termination2_norm :: termination_norm,
g_trace_level :: trace_level,
g_trace_suppress_items :: trace_suppress_items,
- g_ssdb_trace_level :: ssdb_trace_level,
+ g_ssdb_trace_level :: ssdb_trace_level,
g_may_be_thread_safe :: bool,
g_c_compiler_type :: c_compiler_type,
g_csharp_compiler_type :: csharp_compiler_type,
@@ -599,19 +616,20 @@ gc_is_conservative(gc_automatic) = no.
g_maybe_il_version_number :: maybe(il_version_number),
g_maybe_feedback :: maybe(feedback_info),
g_host_env_type :: env_type,
- g_target_env_type :: env_type
+ g_target_env_type :: env_type,
+ g_file_install_cmd :: file_install_cmd
).
globals_init(Options, Target, GC_Method, TagsMethod,
TerminationNorm, Termination2Norm, TraceLevel, TraceSuppress,
SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
ReuseStrategy, MaybeILVersion,
- MaybeFeedback, HostEnvType, TargetEnvType, Globals) :-
+ MaybeFeedback, HostEnvType, TargetEnvType, FileInstallCmd, Globals) :-
Globals = globals(Options, Target, GC_Method, TagsMethod,
TerminationNorm, Termination2Norm, TraceLevel, TraceSuppress,
SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
ReuseStrategy, MaybeILVersion,
- MaybeFeedback, HostEnvType, TargetEnvType).
+ MaybeFeedback, HostEnvType, TargetEnvType, FileInstallCmd).
get_options(Globals, Globals ^ g_options).
get_target(Globals, Globals ^ g_target).
@@ -630,6 +648,8 @@ get_maybe_il_version_number(Globals, Globals ^ g_maybe_il_version_number).
get_maybe_feedback_info(Globals, Globals ^ g_maybe_feedback).
get_host_env_type(Globals, Globals ^ g_host_env_type).
get_target_env_type(Globals, Globals ^ g_target_env_type).
+get_file_install_cmd(Globals, Globals ^ g_file_install_cmd).
+
get_backend_foreign_languages(Globals, ForeignLangs) :-
lookup_accumulating_option(Globals, backend_foreign_languages, LangStrs),
@@ -665,6 +685,9 @@ set_ssdb_trace_level(SSTraceLevel, !Globals) :-
set_maybe_feedback_info(MaybeFeedback, !Globals) :-
!Globals ^ g_maybe_feedback := MaybeFeedback.
+set_file_install_cmd(FileInstallCmd, !Globals) :-
+ !Globals ^ g_file_install_cmd := FileInstallCmd.
+
lookup_option(Globals, Option, OptionData) :-
get_options(Globals, OptionTable),
map.lookup(OptionTable, Option, OptionData).
diff --git a/compiler/handle_options.m b/compiler/handle_options.m
index 5f80ae1..64f4006 100644
--- a/compiler/handle_options.m
+++ b/compiler/handle_options.m
@@ -621,11 +621,22 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
ReuseStrategy, MaybeILVersion, MaybeFeedbackInfo,
HostEnvType, TargetEnvType, !Errors, !:Globals, !IO) :-
+
+ lookup_string_option(OptionTable0, install_command, InstallCmd),
+ ( if InstallCmd = "" then
+ FileInstallCmd = install_cmd_cp
+ else
+ lookup_string_option(OptionTable0, install_command_dir_option,
+ InstallCmdDirOption),
+ FileInstallCmd = install_cmd_user(InstallCmd,
+ InstallCmdDirOption)
+ ),
+
globals_init(OptionTable0, Target, GC_Method, TagsMethod0,
TermNorm, Term2Norm, TraceLevel, TraceSuppress, SSTraceLevel,
MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
ReuseStrategy, MaybeILVersion, MaybeFeedbackInfo,
- HostEnvType, TargetEnvType, !:Globals),
+ HostEnvType, TargetEnvType, FileInstallCmd, !:Globals),
globals.lookup_string_option(!.Globals, event_set_file_name,
EventSetFileName0),
diff --git a/compiler/make.program_target.m b/compiler/make.program_target.m
index 03c32b3..bbaeb4f 100644
--- a/compiler/make.program_target.m
+++ b/compiler/make.program_target.m
@@ -1752,9 +1752,7 @@ install_file(Globals, FileName, InstallDir, Succeeded, !IO) :-
io.write_string(InstallDir, !IO),
io.nl(!IO)
), !IO),
- globals.lookup_string_option(Globals, install_command, InstallCommand),
- Command = string.join_list(" ", list.map(quote_arg,
- [InstallCommand, FileName, InstallDir])),
+ Command = make_install_file_command(Globals, FileName, InstallDir),
io.output_stream(OutputStream, !IO),
invoke_system_command(Globals, OutputStream, cmd_verbose, Command,
Succeeded, !IO).
@@ -1771,11 +1769,7 @@ install_directory(Globals, SourceDirName, InstallDir, Succeeded, !IO) :-
io.write_string(InstallDir, !IO),
io.nl(!IO)
), !IO),
- globals.lookup_string_option(Globals, install_command, InstallCommand),
- globals.lookup_string_option(Globals, install_command_dir_option,
- InstallCommandDirOption),
- Command = string.join_list(" ", list.map(quote_arg,
- [InstallCommand, InstallCommandDirOption, SourceDirName, InstallDir])),
+ Command = make_install_dir_command(Globals, SourceDirName, InstallDir),
io.output_stream(OutputStream, !IO),
invoke_system_command(Globals, OutputStream, cmd_verbose, Command,
Succeeded, !IO).
diff --git a/compiler/module_cmds.m b/compiler/module_cmds.m
index 37171d2..06dc54d 100644
--- a/compiler/module_cmds.m
+++ b/compiler/module_cmds.m
@@ -372,9 +372,7 @@ binary_input_stream_cmp_2(TmpOutputFileStream, Byte, Continue, _, Differ,
copy_file(Globals, Source, Destination, Res, !IO) :-
% Try to use the system's cp command in order to preserve metadata.
- globals.lookup_string_option(Globals, install_command, InstallCommand),
- Command = string.join_list(" ", list.map(quote_arg,
- [InstallCommand, Source, Destination])),
+ Command = make_install_file_command(Globals, Source, Destination),
io.output_stream(OutputStream, !IO),
invoke_system_command(Globals, OutputStream, cmd_verbose, Command,
Succeeded, !IO),
@@ -408,11 +406,7 @@ copy_file(Globals, Source, Destination, Res, !IO) :-
io::di, io::uo) is det.
copy_dir(Globals, Source, Destination, Succeeded, !IO) :-
- globals.lookup_string_option(Globals, install_command, InstallCommand),
- globals.lookup_string_option(Globals, install_command_dir_option,
- InstallCommandDirOption),
- Command = string.join_list(" ", list.map(quote_arg,
- [InstallCommand, InstallCommandDirOption, Source, Destination])),
+ Command = make_install_dir_command(Globals, Source, Destination),
io.output_stream(OutputStream, !IO),
invoke_system_command(Globals, OutputStream, cmd_verbose, Command,
Succeeded, !IO).
More information about the reviews
mailing list