mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
4455f0450e
Besides this main purpose, this diff also replaces code that calls
io.write_string several times in a row with code that prints the
thing to be printed in one go with io.format. In a couple of places,
this has caught (and fixed) bugs where we wanted to put `' quotes
around a filename, but printed only one of the two quotes.
compiler/file_util.m:
Provide alternatives to the existing maybe_report_stats,
maybe_write_string and maybe_flush_output predicates that explicitly
specify the output stream.
Rename report_error_to_stream as report_error, to allow
--warn-implicit-stream-calls to report calls to the existing report_error
predicate, which does not take an explicit output stream.
Add a module_name argument to the output_to_file_stream predicate,
to allow its code to figure out where to print both progress and
error messages.
compiler/module_cmds.m:
Add a module_name argument to the predicates that update interface,
to allow their code to figure out where to print both progress and
error messages.
For now, leave the predicates that issue commands that are not
clearly linked to a single module using implicit streams.
compiler/pd_debug.m:
compiler/analysis.file.m:
Specify output streams in some places.
In other places, doing so would require redoing the whole debug
infrastructure, since the current one is based on higher order predicates
that always write to the non-explicitly-specified *current* output stream.
compiler/passes_aux.m:
Provide predicates that get progress, debug and error streams
given a module_info, by extracting the globals and the module name
from the module_info, and then calling the predicates in globals.m
to get those streams. Doing this sequence of actions here factors out
what would otherwise be repeated code in many other parts of the compiler.
Delete two predicates that were not used anywhere in the compiler.
compiler/deforest.m:
compiler/export.m:
compiler/intermod.m:
compiler/llds_out_file.m:
compiler/mlds_to_c_file.m:
compiler/mlds_to_cs_file.m:
compiler/mlds_to_java_file.m:
compiler/recompilation.usage.m:
compiler/simplify_goal_conj.m:
compiler/type_assign.m:
compiler/typecheck.m:
compiler/write_deps_file.m:
compiler/write_module_interface_files.m:
Use explicit streams everywhere where --warn-implicit-stream-calls
says this is possible.
compiler/Mercury.options:
Specify --warn-implicit-stream-calls for the modules above
with the listed exceptions, and with the exception of the modules
for which it was already specified.
compiler/compile_target_code.m:
compiler/mercury_compile_front_end.m:
compiler/mercury_compile_middle_passes.m:
Conform to the changes above.
1096 lines
40 KiB
Mathematica
1096 lines
40 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2008-2012 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: module_cmds.m.
|
|
%
|
|
% This module handles the most of the commands generated by the
|
|
% parse_tree package.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module parse_tree.module_cmds.
|
|
:- interface.
|
|
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module libs.
|
|
:- import_module libs.file_util.
|
|
:- import_module libs.globals.
|
|
:- import_module parse_tree.file_names.
|
|
|
|
:- import_module bool.
|
|
:- import_module list.
|
|
:- import_module io.
|
|
:- import_module maybe.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type update_interface_result
|
|
---> interface_new_or_changed
|
|
; interface_unchanged
|
|
; interface_error.
|
|
|
|
% update_interface_return_changed(Globals, ModuleName, FileName,
|
|
% Result, !IO):
|
|
%
|
|
% Update the interface file FileName from FileName.tmp if it has changed.
|
|
%
|
|
:- pred update_interface_return_changed(globals::in, module_name::in,
|
|
file_name::in, update_interface_result::out, io::di, io::uo) is det.
|
|
|
|
:- pred update_interface_return_succeeded(globals::in, module_name::in,
|
|
file_name::in, bool::out, io::di, io::uo) is det.
|
|
|
|
:- pred update_interface(globals::in, module_name::in, file_name::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% copy_file(Globals, Source, Destination, Succeeded, !IO).
|
|
%
|
|
% XXX A version of this predicate belongs in the standard library.
|
|
%
|
|
:- pred copy_file(globals::in, file_name::in, file_name::in, io.res::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% maybe_make_symlink(Globals, TargetFile, LinkName, Result, !IO):
|
|
%
|
|
% If `--use-symlinks' is set, attempt to make LinkName a symlink
|
|
% pointing to LinkTarget.
|
|
%
|
|
:- pred maybe_make_symlink(globals::in, file_name::in, file_name::in,
|
|
bool::out, io::di, io::uo) is det.
|
|
|
|
% make_symlink_or_copy_file(Globals, LinkTarget, LinkName, Succeeded, !IO):
|
|
%
|
|
% Attempt to make LinkName a symlink pointing to LinkTarget, copying
|
|
% LinkTarget to LinkName if that fails (or if `--use-symlinks' is not set).
|
|
%
|
|
:- pred make_symlink_or_copy_file(globals::in, file_name::in, file_name::in,
|
|
bool::out, io::di, io::uo) is det.
|
|
|
|
% As above, but for when LinkTarget is a directory rather than a file.
|
|
%
|
|
:- pred make_symlink_or_copy_dir(globals::in, file_name::in, file_name::in,
|
|
bool::out, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% touch_interface_datestamp(Globals, ModuleName, Ext, !IO):
|
|
%
|
|
% Touch the datestamp file `ModuleName.Ext'. Datestamp files are used
|
|
% to record when each of the interface files was last updated.
|
|
%
|
|
:- pred touch_interface_datestamp(globals::in, module_name::in, other_ext::in,
|
|
io::di, io::uo) is det.
|
|
|
|
% touch_datestamp(Globals, FileName, !IO):
|
|
%
|
|
% Update the modification time for the given file,
|
|
% clobbering the contents of the file.
|
|
%
|
|
:- pred touch_datestamp(globals::in, file_name::in, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% If the bool is `no', set the exit status to 1.
|
|
%
|
|
:- pred maybe_set_exit_status(bool::in, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type quote_char
|
|
---> forward % '
|
|
; double. % "
|
|
|
|
:- type command_verbosity
|
|
---> cmd_verbose
|
|
% Output the command line only with `--verbose'.
|
|
|
|
; cmd_verbose_commands.
|
|
% Output the command line with `--verbose-commands'. This should be
|
|
% used for commands that may be of interest to the user.
|
|
|
|
% invoke_system_command(Globals, ErrorStream, Verbosity, Command,
|
|
% Succeeded):
|
|
%
|
|
% Invoke an executable. Both standard and error output will go to the
|
|
% specified output stream.
|
|
%
|
|
:- pred invoke_system_command(globals::in, io.output_stream::in,
|
|
command_verbosity::in, string::in, bool::out, io::di, io::uo) is det.
|
|
|
|
% invoke_system_command_maybe_filter_output(Globals, ErrorStream,
|
|
% Verbosity, Command, MaybeProcessOutput, Succeeded)
|
|
%
|
|
% Invoke an executable. Both standard and error output will go to the
|
|
% specified output stream after being piped through `ProcessOutput'
|
|
% if MaybeProcessOutput is yes(ProcessOutput).
|
|
%
|
|
:- pred invoke_system_command_maybe_filter_output(globals::in,
|
|
io.output_stream::in, command_verbosity::in, string::in, maybe(string)::in,
|
|
bool::out, io::di, io::uo) is det.
|
|
|
|
% Make a command string, which needs to be invoked in a shell environment.
|
|
%
|
|
:- pred make_command_string(string::in, quote_char::in, string::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Java command-line tools utilities.
|
|
%
|
|
|
|
% Create a shell script with the same name as the given module to invoke
|
|
% Java with the appropriate options on the class of the same name.
|
|
%
|
|
:- pred create_java_shell_script(globals::in, module_name::in, bool::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Return the standard Mercury libraries needed for a Java program.
|
|
% Return the empty list if --mercury-standard-library-directory
|
|
% is not set.
|
|
%
|
|
:- pred get_mercury_std_libs_for_java(globals::in, list(string)::out) is det.
|
|
|
|
% Given a list .class files, return the list of .class files that should be
|
|
% passed to `jar'. This is required because nested classes are in separate
|
|
% files which we don't know about, so we have to scan the directory to
|
|
% figure out which files were produced by `javac'.
|
|
%
|
|
:- pred list_class_files_for_jar(globals::in, list(string)::in, string::out,
|
|
list(string)::out, io::di, io::uo) is det.
|
|
|
|
% Given a `mmake' variable reference to a list of .class files, return an
|
|
% expression that generates the list of arguments for `jar' to reference
|
|
% those class files.
|
|
%
|
|
:- pred list_class_files_for_jar_mmake(globals::in, string::in, string::out)
|
|
is det.
|
|
|
|
% Get the value of the Java class path from the environment. (Normally
|
|
% it will be obtained from the CLASSPATH environment variable, but if
|
|
% that isn't present then the java.class.path variable may be used instead.
|
|
% This is used for the Java back-end, which doesn't support environment
|
|
% variables properly.)
|
|
%
|
|
:- pred get_env_classpath(string::out, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred create_launcher_shell_script(globals::in, module_name::in,
|
|
pred(io.output_stream, io, io)::in(pred(in, di, uo) is det),
|
|
bool::out, io::di, io::uo) is det.
|
|
|
|
:- pred create_launcher_batch_file(globals::in, module_name::in,
|
|
pred(io.output_stream, io, io)::in(pred(in, di, uo) is det),
|
|
bool::out, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.process_util.
|
|
:- import_module libs.compute_grade. % for grade_directory_component
|
|
:- import_module libs.options.
|
|
:- import_module parse_tree.java_names.
|
|
|
|
:- import_module dir.
|
|
:- import_module int.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
update_interface_return_changed(Globals, ModuleName, OutputFileName,
|
|
Result, !IO) :-
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
get_progress_output_stream(Globals, ModuleName, ProgressStream, !IO),
|
|
get_error_output_stream(Globals, ModuleName, ErrorStream, !IO),
|
|
maybe_write_string(ProgressStream, Verbose,
|
|
"% Updating interface:\n", !IO),
|
|
TmpOutputFileName = OutputFileName ++ ".tmp",
|
|
io.open_binary_input(OutputFileName, OutputFileRes, !IO),
|
|
(
|
|
OutputFileRes = ok(OutputFileStream),
|
|
io.open_binary_input(TmpOutputFileName, TmpOutputFileRes, !IO),
|
|
(
|
|
TmpOutputFileRes = ok(TmpOutputFileStream),
|
|
binary_input_stream_cmp(OutputFileStream, TmpOutputFileStream,
|
|
FilesDiffer, !IO),
|
|
io.close_binary_input(OutputFileStream, !IO),
|
|
io.close_binary_input(TmpOutputFileStream, !IO),
|
|
(
|
|
FilesDiffer = ok(ok(no)),
|
|
Result = interface_unchanged,
|
|
string.format("%% `%s' has not changed.\n",
|
|
[s(OutputFileName)], NoChangeMsg),
|
|
maybe_write_string(ProgressStream, Verbose, NoChangeMsg, !IO),
|
|
io.remove_file(TmpOutputFileName, _, !IO)
|
|
;
|
|
FilesDiffer = ok(ok(yes)),
|
|
update_interface_create_file(Globals,
|
|
ProgressStream, ErrorStream, "CHANGED",
|
|
OutputFileName, TmpOutputFileName, Result, !IO)
|
|
;
|
|
FilesDiffer = ok(error(TmpFileError)),
|
|
io.error_message(TmpFileError, TmpFileErrorMsg),
|
|
Result = interface_error,
|
|
io.format(ErrorStream, "Error reading `%s': %s\n",
|
|
[s(TmpOutputFileName), s(TmpFileErrorMsg)], !IO)
|
|
;
|
|
FilesDiffer = error(_, _),
|
|
update_interface_create_file(Globals,
|
|
ProgressStream, ErrorStream, "been CREATED",
|
|
OutputFileName, TmpOutputFileName, Result, !IO)
|
|
)
|
|
;
|
|
|
|
TmpOutputFileRes = error(TmpOutputFileError),
|
|
io.error_message(TmpOutputFileError, TmpOutputFileErrorMsg),
|
|
Result = interface_error,
|
|
io.close_binary_input(OutputFileStream, !IO),
|
|
io.format(ErrorStream, "Error creating `%s': %s\n",
|
|
[s(OutputFileName), s(TmpOutputFileErrorMsg)], !IO)
|
|
)
|
|
;
|
|
OutputFileRes = error(_),
|
|
update_interface_create_file(Globals,
|
|
ProgressStream, ErrorStream, "been CREATED",
|
|
OutputFileName, TmpOutputFileName, Result, !IO)
|
|
).
|
|
|
|
update_interface_return_succeeded(Globals, ModuleName, OutputFileName,
|
|
Succeeded, !IO) :-
|
|
update_interface_return_changed(Globals, ModuleName, OutputFileName,
|
|
Result, !IO),
|
|
(
|
|
( Result = interface_new_or_changed
|
|
; Result = interface_unchanged
|
|
),
|
|
Succeeded = yes
|
|
;
|
|
Result = interface_error,
|
|
Succeeded = no
|
|
).
|
|
|
|
update_interface(Globals, ModuleName, OutputFileName, !IO) :-
|
|
update_interface_return_succeeded(Globals, ModuleName, OutputFileName,
|
|
Succeeded, !IO),
|
|
(
|
|
Succeeded = no,
|
|
report_error("problem updating interface files.", !IO)
|
|
;
|
|
Succeeded = yes
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred update_interface_create_file(globals::in,
|
|
io.text_output_stream::in, io.text_output_stream::in,
|
|
string::in, string::in, string::in, update_interface_result::out,
|
|
io::di, io::uo) is det.
|
|
|
|
update_interface_create_file(Globals, ProgressStream, ErrorStream,
|
|
ChangedStr, OutputFileName, TmpOutputFileName, Result, !IO) :-
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
string.format("%% `%s' has %s.\n", [s(OutputFileName), s(ChangedStr)],
|
|
ChangedMsg),
|
|
maybe_write_string(ProgressStream, Verbose, ChangedMsg, !IO),
|
|
copy_file(Globals, TmpOutputFileName, OutputFileName, MoveRes, !IO),
|
|
(
|
|
MoveRes = ok,
|
|
Result = interface_new_or_changed
|
|
;
|
|
MoveRes = error(MoveError),
|
|
Result = interface_error,
|
|
io.format(ErrorStream, "Error creating `%s': %s\n",
|
|
[s(OutputFileName), s(io.error_message(MoveError))], !IO)
|
|
),
|
|
io.remove_file(TmpOutputFileName, _, !IO).
|
|
|
|
:- pred binary_input_stream_cmp(io.binary_input_stream::in,
|
|
io.binary_input_stream::in, io.maybe_partial_res(io.res(bool))::out,
|
|
io::di, io::uo) is det.
|
|
|
|
binary_input_stream_cmp(OutputFileStream, TmpOutputFileStream, FilesDiffer,
|
|
!IO) :-
|
|
io.binary_input_stream_foldl2_io_maybe_stop(OutputFileStream,
|
|
binary_input_stream_cmp_2(TmpOutputFileStream),
|
|
ok(no), FilesDiffer0, !IO),
|
|
|
|
% Check whether there is anything left in TmpOutputFileStream
|
|
( if FilesDiffer0 = ok(ok(no)) then
|
|
io.read_byte(TmpOutputFileStream, TmpByteResult2, !IO),
|
|
(
|
|
TmpByteResult2 = ok(_),
|
|
FilesDiffer = ok(ok(yes))
|
|
;
|
|
TmpByteResult2 = eof,
|
|
FilesDiffer = FilesDiffer0
|
|
;
|
|
TmpByteResult2 = error(Error),
|
|
FilesDiffer = ok(error(Error))
|
|
)
|
|
else
|
|
FilesDiffer = FilesDiffer0
|
|
).
|
|
|
|
:- pred binary_input_stream_cmp_2(io.binary_input_stream::in, int::in,
|
|
bool::out, io.res(bool)::in, io.res(bool)::out, io::di, io::uo) is det.
|
|
|
|
binary_input_stream_cmp_2(TmpOutputFileStream, Byte, Continue, _, Differ,
|
|
!IO) :-
|
|
io.read_byte(TmpOutputFileStream, TmpByteResult, !IO),
|
|
(
|
|
TmpByteResult = ok(TmpByte),
|
|
( if TmpByte = Byte then
|
|
Differ = ok(no),
|
|
Continue = yes
|
|
else
|
|
Differ = ok(yes),
|
|
Continue = no
|
|
)
|
|
;
|
|
TmpByteResult = eof,
|
|
Differ = ok(yes),
|
|
Continue = no
|
|
;
|
|
TmpByteResult = error(TmpByteError),
|
|
Differ = error(TmpByteError) : io.res(bool),
|
|
Continue = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
copy_file(Globals, Source, Destination, Res, !IO) :-
|
|
% Try to use the system's cp command in order to preserve metadata.
|
|
Command = make_install_file_command(Globals, Source, Destination),
|
|
io.output_stream(OutputStream, !IO),
|
|
invoke_system_command(Globals, OutputStream, cmd_verbose, Command,
|
|
Succeeded, !IO),
|
|
(
|
|
Succeeded = yes,
|
|
Res = ok
|
|
;
|
|
Succeeded = no,
|
|
io.open_binary_input(Source, SourceRes, !IO),
|
|
(
|
|
SourceRes = ok(SourceStream),
|
|
io.open_binary_output(Destination, DestRes, !IO),
|
|
(
|
|
DestRes = ok(DestStream),
|
|
WriteByte = io.write_byte(DestStream),
|
|
io.binary_input_stream_foldl_io(SourceStream, WriteByte, Res,
|
|
!IO),
|
|
io.close_binary_input(SourceStream, !IO),
|
|
io.close_binary_output(DestStream, !IO)
|
|
;
|
|
DestRes = error(Error),
|
|
Res = error(Error)
|
|
)
|
|
;
|
|
SourceRes = error(Error),
|
|
Res = error(Error)
|
|
)
|
|
).
|
|
|
|
:- pred copy_dir(globals::in, dir_name::in, dir_name::in, bool::out,
|
|
io::di, io::uo) is det.
|
|
|
|
copy_dir(Globals, Source, Destination, Succeeded, !IO) :-
|
|
Command = make_install_dir_command(Globals, Source, Destination),
|
|
io.output_stream(OutputStream, !IO),
|
|
invoke_system_command(Globals, OutputStream, cmd_verbose, Command,
|
|
Succeeded, !IO).
|
|
|
|
maybe_make_symlink(Globals, LinkTarget, LinkName, Result, !IO) :-
|
|
globals.lookup_bool_option(Globals, use_symlinks, UseSymLinks),
|
|
(
|
|
UseSymLinks = yes,
|
|
io.remove_file_recursively(LinkName, _, !IO),
|
|
io.make_symlink(LinkTarget, LinkName, LinkResult, !IO),
|
|
Result = ( if LinkResult = ok then yes else no )
|
|
;
|
|
UseSymLinks = no,
|
|
Result = no
|
|
).
|
|
|
|
make_symlink_or_copy_file(Globals, SourceFileName, DestinationFileName,
|
|
Succeeded, !IO) :-
|
|
globals.lookup_bool_option(Globals, use_symlinks, UseSymLinks),
|
|
globals.lookup_bool_option(Globals, verbose_commands, PrintCommand),
|
|
(
|
|
UseSymLinks = yes,
|
|
LinkOrCopy = "linking",
|
|
(
|
|
PrintCommand = yes,
|
|
io.format("%% Linking file `%s' -> `%s'\n",
|
|
[s(SourceFileName), s(DestinationFileName)], !IO),
|
|
io.flush_output(!IO)
|
|
;
|
|
PrintCommand = no
|
|
),
|
|
io.make_symlink(SourceFileName, DestinationFileName, Result, !IO)
|
|
;
|
|
UseSymLinks = no,
|
|
LinkOrCopy = "copying",
|
|
(
|
|
PrintCommand = yes,
|
|
io.format("%% Copying file `%s' -> `%s'\n",
|
|
[s(SourceFileName), s(DestinationFileName)], !IO),
|
|
io.flush_output(!IO)
|
|
;
|
|
PrintCommand = no
|
|
),
|
|
copy_file(Globals, SourceFileName, DestinationFileName, Result, !IO)
|
|
),
|
|
(
|
|
Result = ok,
|
|
Succeeded = yes
|
|
;
|
|
Result = error(Error),
|
|
Succeeded = no,
|
|
io.progname_base("mercury_compile", ProgName, !IO),
|
|
io.error_message(Error, ErrorMsg),
|
|
io.format("%s: error %s `%s' to `%s', %s\n",
|
|
[s(ProgName), s(LinkOrCopy), s(SourceFileName),
|
|
s(DestinationFileName), s(ErrorMsg)], !IO),
|
|
io.flush_output(!IO)
|
|
).
|
|
|
|
make_symlink_or_copy_dir(Globals, SourceDirName, DestinationDirName,
|
|
Succeeded, !IO) :-
|
|
globals.lookup_bool_option(Globals, use_symlinks, UseSymLinks),
|
|
(
|
|
UseSymLinks = yes,
|
|
io.make_symlink(SourceDirName, DestinationDirName, Result, !IO),
|
|
(
|
|
Result = ok,
|
|
Succeeded = yes
|
|
;
|
|
Result = error(Error),
|
|
Succeeded = no,
|
|
io.progname_base("mercury_compile", ProgName, !IO),
|
|
io.format("%s: error linking `%s' to `%s': %s\n",
|
|
[s(ProgName), s(SourceDirName), s(DestinationDirName),
|
|
s(io.error_message(Error))], !IO),
|
|
io.flush_output(!IO)
|
|
)
|
|
;
|
|
UseSymLinks = no,
|
|
copy_dir(Globals, SourceDirName, DestinationDirName, Succeeded, !IO),
|
|
(
|
|
Succeeded = yes
|
|
;
|
|
Succeeded = no,
|
|
io.progname_base("mercury_compile", ProgName, !IO),
|
|
io.format("%s: error copying directory `%s' to `%s'\n",
|
|
[s(ProgName), s(SourceDirName), s(DestinationDirName)], !IO),
|
|
io.flush_output(!IO)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
touch_interface_datestamp(Globals, ModuleName, OtherExt, !IO) :-
|
|
module_name_to_file_name(Globals, $pred, do_create_dirs,
|
|
ext_other(OtherExt), ModuleName, OutputFileName, !IO),
|
|
touch_datestamp(Globals, OutputFileName, !IO).
|
|
|
|
touch_datestamp(Globals, OutputFileName, !IO) :-
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
maybe_write_string(Verbose,
|
|
"% Touching `" ++ OutputFileName ++ "'... ", !IO),
|
|
maybe_flush_output(Verbose, !IO),
|
|
io.open_output(OutputFileName, Result, !IO),
|
|
(
|
|
Result = ok(OutputStream),
|
|
io.write_string(OutputStream, "\n", !IO),
|
|
io.close_output(OutputStream, !IO),
|
|
maybe_write_string(Verbose, " done.\n", !IO)
|
|
;
|
|
Result = error(IOError),
|
|
io.error_message(IOError, IOErrorMessage),
|
|
io.format("\nError opening `%s' for output: %s.\n",
|
|
[s(OutputFileName), s(IOErrorMessage)], !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
maybe_set_exit_status(yes, !IO).
|
|
maybe_set_exit_status(no, !IO) :-
|
|
io.set_exit_status(1, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
invoke_system_command(Globals, ErrorStream, Verbosity,
|
|
Command, Succeeded, !IO) :-
|
|
invoke_system_command_maybe_filter_output(Globals, ErrorStream, Verbosity,
|
|
Command, no, Succeeded, !IO).
|
|
|
|
invoke_system_command_maybe_filter_output(Globals, ErrorStream, Verbosity,
|
|
Command, MaybeProcessOutput, Succeeded, !IO) :-
|
|
% This predicate shouldn't alter the exit status of mercury_compile.
|
|
io.get_exit_status(OldStatus, !IO),
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
(
|
|
Verbosity = cmd_verbose,
|
|
PrintCommand = Verbose
|
|
;
|
|
Verbosity = cmd_verbose_commands,
|
|
globals.lookup_bool_option(Globals, verbose_commands, PrintCommand)
|
|
),
|
|
(
|
|
PrintCommand = yes,
|
|
io.format("%%s Invoking system command `%s'...\n", [s(Command)], !IO),
|
|
io.flush_output(!IO)
|
|
;
|
|
PrintCommand = no
|
|
),
|
|
|
|
% The output from the command is written to a temporary file,
|
|
% which is then written to the output stream. Without this,
|
|
% the output from the command would go to the current C output
|
|
% and error streams.
|
|
|
|
io.make_temp_file(TmpFileResult, !IO),
|
|
(
|
|
TmpFileResult = ok(TmpFile),
|
|
( if use_dotnet then
|
|
% XXX can't use Bourne shell syntax to redirect on .NET
|
|
% XXX the output will go to the wrong place!
|
|
CommandRedirected = Command
|
|
else if use_win32 then
|
|
% On windows we can't in general redirect standard error in the
|
|
% shell.
|
|
CommandRedirected = Command ++ " > " ++ TmpFile
|
|
else
|
|
CommandRedirected =
|
|
string.append_list([Command, " > ", TmpFile, " 2>&1"])
|
|
),
|
|
io.call_system_return_signal(CommandRedirected, Result, !IO),
|
|
(
|
|
Result = ok(exited(Status)),
|
|
maybe_write_string(PrintCommand, "% done.\n", !IO),
|
|
( if Status = 0 then
|
|
CommandSucceeded = yes
|
|
else
|
|
% The command should have produced output describing the error.
|
|
CommandSucceeded = no
|
|
)
|
|
;
|
|
Result = ok(signalled(Signal)),
|
|
string.format("system command received signal %d.", [i(Signal)],
|
|
ErrorMsg),
|
|
report_error(ErrorStream, ErrorMsg, !IO),
|
|
% Also report the error to standard output, because if we raise the
|
|
% signal, this error may not ever been seen, the process stops, and
|
|
% the user is confused.
|
|
report_error(ErrorMsg, !IO),
|
|
|
|
% Make sure the current process gets the signal. Some systems (e.g.
|
|
% Linux) ignore SIGINT during a call to system().
|
|
raise_signal(Signal, !IO),
|
|
CommandSucceeded = no
|
|
;
|
|
Result = error(Error),
|
|
report_error(ErrorStream, io.error_message(Error), !IO),
|
|
CommandSucceeded = no
|
|
)
|
|
;
|
|
TmpFileResult = error(Error),
|
|
report_error(ErrorStream,
|
|
"Could not create temporary file: " ++ error_message(Error), !IO),
|
|
TmpFile = "",
|
|
CommandSucceeded = no
|
|
),
|
|
|
|
( if
|
|
% We can't do bash style redirection on .NET.
|
|
not use_dotnet,
|
|
MaybeProcessOutput = yes(ProcessOutput)
|
|
then
|
|
io.make_temp_file(ProcessedTmpFileResult, !IO),
|
|
(
|
|
ProcessedTmpFileResult = ok(ProcessedTmpFile),
|
|
|
|
% XXX we should get rid of use_win32
|
|
( if use_win32 then
|
|
get_system_env_type(Globals, SystemEnvType),
|
|
( if SystemEnvType = env_type_powershell then
|
|
ProcessOutputRedirected = string.append_list(
|
|
["Get-Content ", TmpFile, " | ", ProcessOutput,
|
|
" > ", ProcessedTmpFile, " 2>&1"])
|
|
else
|
|
% On windows we can't in general redirect standard
|
|
% error in the shell.
|
|
ProcessOutputRedirected = string.append_list(
|
|
[ProcessOutput, " < ", TmpFile, " > ",
|
|
ProcessedTmpFile])
|
|
)
|
|
else
|
|
ProcessOutputRedirected = string.append_list(
|
|
[ProcessOutput, " < ", TmpFile, " > ",
|
|
ProcessedTmpFile, " 2>&1"])
|
|
),
|
|
io.call_system_return_signal(ProcessOutputRedirected,
|
|
ProcessOutputResult, !IO),
|
|
io.remove_file(TmpFile, _, !IO),
|
|
(
|
|
ProcessOutputResult = ok(exited(ProcessOutputStatus)),
|
|
maybe_write_string(PrintCommand, "% done.\n", !IO),
|
|
( if ProcessOutputStatus = 0 then
|
|
ProcessOutputSucceeded = yes
|
|
else
|
|
% The command should have produced output
|
|
% describing the error.
|
|
ProcessOutputSucceeded = no
|
|
)
|
|
;
|
|
ProcessOutputResult = ok(signalled(ProcessOutputSignal)),
|
|
% Make sure the current process gets the signal. Some
|
|
% systems (e.g. Linux) ignore SIGINT during a call to
|
|
% system().
|
|
raise_signal(ProcessOutputSignal, !IO),
|
|
report_error(ErrorStream,
|
|
"system command received signal "
|
|
++ int_to_string(ProcessOutputSignal) ++ ".", !IO),
|
|
ProcessOutputSucceeded = no
|
|
;
|
|
ProcessOutputResult = error(ProcessOutputError),
|
|
report_error(ErrorStream,
|
|
io.error_message(ProcessOutputError), !IO),
|
|
ProcessOutputSucceeded = no
|
|
)
|
|
;
|
|
ProcessedTmpFileResult = error(ProcessTmpError),
|
|
report_error(ErrorStream,
|
|
io.error_message(ProcessTmpError), !IO),
|
|
ProcessOutputSucceeded = no,
|
|
ProcessedTmpFile = ""
|
|
)
|
|
else
|
|
ProcessOutputSucceeded = yes,
|
|
ProcessedTmpFile = TmpFile
|
|
),
|
|
Succeeded = CommandSucceeded `and` ProcessOutputSucceeded,
|
|
|
|
% Write the output to the error stream.
|
|
|
|
io.open_input(ProcessedTmpFile, TmpFileRes, !IO),
|
|
(
|
|
TmpFileRes = ok(TmpFileStream),
|
|
io.input_stream_foldl_io(TmpFileStream, io.write_char(ErrorStream),
|
|
Res, !IO),
|
|
(
|
|
Res = ok
|
|
;
|
|
Res = error(TmpFileReadError),
|
|
report_error(ErrorStream,
|
|
"error reading command output: " ++
|
|
io.error_message(TmpFileReadError), !IO)
|
|
),
|
|
io.close_input(TmpFileStream, !IO)
|
|
;
|
|
TmpFileRes = error(TmpFileError),
|
|
report_error(ErrorStream,
|
|
"error opening command output: " ++ io.error_message(TmpFileError),
|
|
!IO)
|
|
),
|
|
io.remove_file(ProcessedTmpFile, _, !IO),
|
|
io.set_exit_status(OldStatus, !IO).
|
|
|
|
make_command_string(String0, QuoteType, String) :-
|
|
( if use_win32 then
|
|
(
|
|
QuoteType = forward,
|
|
Quote = " '"
|
|
;
|
|
QuoteType = double,
|
|
Quote = " """
|
|
),
|
|
string.append_list(["sh -c ", Quote, String0, Quote], String)
|
|
else
|
|
String = String0
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Are we compiling in a .NET environment?
|
|
%
|
|
:- pred use_dotnet is semidet.
|
|
:- pragma foreign_proc("C#",
|
|
use_dotnet,
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
SUCCESS_INDICATOR = true;
|
|
").
|
|
% The following clause is only used if there is no matching foreign_proc.
|
|
use_dotnet :-
|
|
semidet_fail.
|
|
|
|
% Are we compiling in a win32 environment?
|
|
%
|
|
% If in doubt, use_win32 should succeed. This is only used to decide
|
|
% whether to invoke Bourne shell command and shell scripts directly,
|
|
% or whether to invoke them via `sh -c ...'. The latter should work
|
|
% correctly in a Unix environment too, but is a little less efficient
|
|
% since it invokes another process.
|
|
%
|
|
:- pred use_win32 is semidet.
|
|
:- pragma foreign_proc("C",
|
|
use_win32,
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
#ifdef MR_WIN32
|
|
SUCCESS_INDICATOR = 1;
|
|
#else
|
|
SUCCESS_INDICATOR = 0;
|
|
#endif
|
|
").
|
|
% The following clause is only used if there is no matching foreign_proc.
|
|
% See comment above for why it is OK to just succeed here.
|
|
use_win32 :-
|
|
semidet_succeed.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Java command-line utilities.
|
|
%
|
|
|
|
create_java_shell_script(Globals, MainModuleName, Succeeded, !IO) :-
|
|
Ext = ext_other(other_ext(".jar")),
|
|
module_name_to_file_name(Globals, $pred, do_not_create_dirs, Ext,
|
|
MainModuleName, JarFileName, !IO),
|
|
get_target_env_type(Globals, TargetEnvType),
|
|
(
|
|
( TargetEnvType = env_type_posix
|
|
; TargetEnvType = env_type_cygwin
|
|
),
|
|
create_launcher_shell_script(Globals, MainModuleName,
|
|
write_java_shell_script(Globals, MainModuleName, JarFileName),
|
|
Succeeded, !IO)
|
|
;
|
|
TargetEnvType = env_type_msys,
|
|
create_launcher_shell_script(Globals, MainModuleName,
|
|
write_java_msys_shell_script(Globals, MainModuleName, JarFileName),
|
|
Succeeded, !IO)
|
|
;
|
|
% XXX should create a .ps1 file on PowerShell.
|
|
( TargetEnvType = env_type_win_cmd
|
|
; TargetEnvType = env_type_powershell
|
|
),
|
|
create_launcher_batch_file(Globals, MainModuleName,
|
|
write_java_batch_file(Globals, MainModuleName, JarFileName),
|
|
Succeeded, !IO)
|
|
).
|
|
|
|
:- pred write_java_shell_script(globals::in, module_name::in,
|
|
file_name::in, io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
write_java_shell_script(Globals, MainModuleName, JarFileName, Stream, !IO) :-
|
|
io.get_environment_var("MERCURY_STAGE2_LAUNCHER_BASE", MaybeStage2Base,
|
|
!IO),
|
|
(
|
|
MaybeStage2Base = no,
|
|
get_mercury_std_libs_for_java(Globals, MercuryStdLibs)
|
|
;
|
|
MaybeStage2Base = yes(Stage2Base),
|
|
MercuryStdLibs = [
|
|
Stage2Base / "library/mer_rt.jar",
|
|
Stage2Base / "library/mer_std.jar"
|
|
]
|
|
),
|
|
globals.lookup_accumulating_option(Globals, java_classpath,
|
|
UserClasspath),
|
|
% We prepend the .class files' directory and the current CLASSPATH.
|
|
Java_Incl_Dirs = ["\"$DIR/" ++ JarFileName ++ "\""] ++
|
|
MercuryStdLibs ++ ["$CLASSPATH" | UserClasspath],
|
|
ClassPath = string.join_list("${SEP}", Java_Incl_Dirs),
|
|
|
|
globals.lookup_string_option(Globals, java_interpreter, Java),
|
|
mangle_sym_name_for_java(MainModuleName, module_qual, ".", ClassName),
|
|
|
|
io.write_strings(Stream, [
|
|
"#!/bin/sh\n",
|
|
"DIR=${0%/*}\n",
|
|
"DIR=$( cd \"${DIR}\" && pwd -P )\n",
|
|
"case $WINDIR in\n",
|
|
" '') SEP=':' ;;\n",
|
|
" *) SEP=';' ;;\n",
|
|
"esac\n",
|
|
"CLASSPATH=", ClassPath, "\n",
|
|
"export CLASSPATH\n",
|
|
"JAVA=${JAVA:-", Java, "}\n",
|
|
"exec \"$JAVA\" jmercury.", ClassName, " \"$@\"\n"
|
|
], !IO).
|
|
|
|
% For the MSYS version of the Java launcher script, there are a few
|
|
% differences:
|
|
%
|
|
% 1. The value of the CLASSPATH environment variable we construct for the
|
|
% Java interpreter must contain Windows style paths.
|
|
%
|
|
% 2. We use forward slashes as directory separators rather than back
|
|
% slashes since the latter require escaping inside the shell script.
|
|
%
|
|
% 3. The path separator character, ';', in the value of CLASSPATH must be
|
|
% escaped because it is a statement separator in sh.
|
|
%
|
|
% 4. The path of the Java interpreter must be a Unix style path as it will
|
|
% be invoked directly from the MSYS shell.
|
|
%
|
|
% XXX TODO: handle MERCURY_STAGE2_LAUNCHER_BASE for this case.
|
|
%
|
|
:- pred write_java_msys_shell_script(globals::in, module_name::in,
|
|
file_name::in, io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
write_java_msys_shell_script(Globals, MainModuleName, JarFileName, Stream,
|
|
!IO) :-
|
|
get_mercury_std_libs_for_java(Globals, MercuryStdLibs),
|
|
globals.lookup_accumulating_option(Globals, java_classpath,
|
|
UserClasspath),
|
|
% We prepend the .class files' directory and the current CLASSPATH.
|
|
Java_Incl_Dirs0 = ["\"$DIR/" ++ JarFileName ++ "\""] ++
|
|
MercuryStdLibs ++ ["$CLASSPATH" | UserClasspath],
|
|
Java_Incl_Dirs = list.map(func(S) = string.replace_all(S, "\\", "/"),
|
|
Java_Incl_Dirs0),
|
|
ClassPath = string.join_list("\\;", Java_Incl_Dirs),
|
|
|
|
globals.lookup_string_option(Globals, java_interpreter, Java),
|
|
mangle_sym_name_for_java(MainModuleName, module_qual, ".", ClassName),
|
|
|
|
io.write_strings(Stream, [
|
|
"#!/bin/sh\n",
|
|
"DIR=${0%/*}\n",
|
|
"DIR=$( cd \"${DIR}\" && pwd -W )\n",
|
|
"CLASSPATH=", ClassPath, "\n",
|
|
"export CLASSPATH\n",
|
|
"JAVA=${JAVA:-", Java, "}\n",
|
|
"exec \"$JAVA\" jmercury.", ClassName, " \"$@\"\n"
|
|
], !IO).
|
|
|
|
:- pred write_java_batch_file(globals::in, module_name::in, file_name::in,
|
|
io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
write_java_batch_file(Globals, MainModuleName, JarFileName, Stream, !IO) :-
|
|
get_mercury_std_libs_for_java(Globals, MercuryStdLibs),
|
|
globals.lookup_accumulating_option(Globals, java_classpath,
|
|
UserClasspath),
|
|
% We prepend the .class files' directory and the current CLASSPATH.
|
|
Java_Incl_Dirs = ["%DIR%\\" ++ JarFileName] ++ MercuryStdLibs ++
|
|
["%CLASSPATH%" | UserClasspath],
|
|
ClassPath = string.join_list(";", Java_Incl_Dirs),
|
|
|
|
globals.lookup_string_option(Globals, java_interpreter, Java),
|
|
mangle_sym_name_for_java(MainModuleName, module_qual, ".", ClassName),
|
|
|
|
io.write_strings(Stream, [
|
|
"@echo off\n",
|
|
"rem Automatically generated by the Mercury compiler.\n",
|
|
"setlocal\n",
|
|
"set DIR=%~dp0\n",
|
|
"set CLASSPATH=", ClassPath, "\n",
|
|
Java, " jmercury.", ClassName, " %*\n"
|
|
], !IO).
|
|
|
|
get_mercury_std_libs_for_java(Globals, !:StdLibs) :-
|
|
% NOTE: changes here may require changes to get_mercury_std_libs.
|
|
|
|
!:StdLibs = [],
|
|
globals.lookup_maybe_string_option(Globals,
|
|
mercury_standard_library_directory, MaybeStdlibDir),
|
|
(
|
|
MaybeStdlibDir = yes(StdLibDir),
|
|
grade_directory_component(Globals, GradeDir),
|
|
% Source-to-source debugging libraries.
|
|
globals.lookup_bool_option(Globals, link_ssdb_libs,
|
|
SourceDebug),
|
|
(
|
|
SourceDebug = yes,
|
|
list.cons(StdLibDir/"lib"/GradeDir/"mer_browser.jar", !StdLibs),
|
|
list.cons(StdLibDir/"lib"/GradeDir/"mer_mdbcomp.jar", !StdLibs),
|
|
list.cons(StdLibDir/"lib"/GradeDir/"mer_ssdb.jar", !StdLibs)
|
|
;
|
|
SourceDebug = no
|
|
),
|
|
list.cons(StdLibDir/"lib"/GradeDir/"mer_std.jar", !StdLibs),
|
|
list.cons(StdLibDir/"lib"/GradeDir/"mer_rt.jar", !StdLibs)
|
|
;
|
|
MaybeStdlibDir = no
|
|
).
|
|
|
|
list_class_files_for_jar(Globals, MainClassFiles, ClassSubDir,
|
|
ListClassFiles, !IO) :-
|
|
globals.lookup_bool_option(Globals, use_subdirs, UseSubdirs),
|
|
globals.lookup_bool_option(Globals, use_grade_subdirs, UseGradeSubdirs),
|
|
AnySubdirs = UseSubdirs `or` UseGradeSubdirs,
|
|
(
|
|
AnySubdirs = yes,
|
|
get_class_dir_name(Globals, ClassSubDir)
|
|
;
|
|
AnySubdirs = no,
|
|
ClassSubDir = dir.this_directory
|
|
),
|
|
|
|
list.filter_map(make_nested_class_prefix, MainClassFiles,
|
|
NestedClassPrefixes),
|
|
NestedClassPrefixesSet = set.list_to_set(NestedClassPrefixes),
|
|
|
|
SearchDir = ClassSubDir / "jmercury",
|
|
FollowSymLinks = yes,
|
|
dir.recursive_foldl2(
|
|
accumulate_nested_class_files(NestedClassPrefixesSet),
|
|
SearchDir, FollowSymLinks, [], Result, !IO),
|
|
(
|
|
Result = ok(NestedClassFiles),
|
|
AllClassFiles0 = MainClassFiles ++ NestedClassFiles,
|
|
% Remove the `Mercury/classs' prefix if present.
|
|
( if ClassSubDir = dir.this_directory then
|
|
AllClassFiles = AllClassFiles0
|
|
else
|
|
ClassSubDirSep = ClassSubDir / "",
|
|
AllClassFiles = list.map(
|
|
string.remove_prefix_if_present(ClassSubDirSep),
|
|
AllClassFiles0)
|
|
),
|
|
list.sort(AllClassFiles, ListClassFiles)
|
|
;
|
|
Result = error(_, Error),
|
|
unexpected($pred, io.error_message(Error))
|
|
).
|
|
|
|
list_class_files_for_jar_mmake(Globals, ClassFiles, ListClassFiles) :-
|
|
globals.lookup_bool_option(Globals, use_subdirs, UseSubdirs),
|
|
globals.lookup_bool_option(Globals, use_grade_subdirs, UseGradeSubdirs),
|
|
AnySubdirs = UseSubdirs `or` UseGradeSubdirs,
|
|
(
|
|
AnySubdirs = yes,
|
|
get_class_dir_name(Globals, ClassSubdir),
|
|
% Here we use the `-C' option of jar to change directory during
|
|
% execution, then use sed to strip away the Mercury/classs/
|
|
% prefix to the class files.
|
|
% Otherwise, the class files would be stored as
|
|
% Mercury/classs/*.class
|
|
% within the jar file, which is not what we want.
|
|
% XXX It would be nice to avoid this dependency on sed.
|
|
ListClassFiles = "-C " ++ ClassSubdir ++ " \\\n" ++
|
|
"\t\t`echo "" " ++ ClassFiles ++ """" ++
|
|
" | sed 's| '" ++ ClassSubdir ++ "/| |'`"
|
|
;
|
|
AnySubdirs = no,
|
|
ListClassFiles = ClassFiles
|
|
).
|
|
|
|
:- pred make_nested_class_prefix(string::in, string::out) is semidet.
|
|
|
|
make_nested_class_prefix(ClassFileName, ClassPrefix) :-
|
|
% Nested class files are named "Class$Nested_1$Nested_2.class".
|
|
string.remove_suffix(ClassFileName, ".class", BaseName),
|
|
ClassPrefix = BaseName ++ "$".
|
|
|
|
:- pred accumulate_nested_class_files(set(string)::in, string::in, string::in,
|
|
io.file_type::in, bool::out, list(string)::in, list(string)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
accumulate_nested_class_files(NestedClassPrefixes, DirName, BaseName,
|
|
_FileType, Continue, !Acc, !IO) :-
|
|
( if
|
|
string.sub_string_search(BaseName, "$", Dollar),
|
|
BaseNameToDollar = string.left(BaseName, Dollar + 1),
|
|
set.contains(NestedClassPrefixes, DirName / BaseNameToDollar)
|
|
then
|
|
!:Acc = [DirName / BaseName | !.Acc]
|
|
else
|
|
true
|
|
),
|
|
Continue = yes.
|
|
|
|
get_env_classpath(Classpath, !IO) :-
|
|
io.get_environment_var("CLASSPATH", MaybeCP, !IO),
|
|
(
|
|
MaybeCP = yes(Classpath)
|
|
;
|
|
MaybeCP = no,
|
|
io.get_environment_var("java.class.path", MaybeJCP, !IO),
|
|
(
|
|
MaybeJCP = yes(Classpath)
|
|
;
|
|
MaybeJCP = no,
|
|
Classpath = ""
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
create_launcher_shell_script(Globals, MainModuleName, Pred, Succeeded, !IO) :-
|
|
module_name_to_file_name(Globals, $pred, do_create_dirs,
|
|
ext_other(other_ext("")), MainModuleName, FileName, !IO),
|
|
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
maybe_write_string(Verbose, "% Generating shell script `" ++
|
|
FileName ++ "'...\n", !IO),
|
|
|
|
% Remove symlink in the way, if any.
|
|
io.remove_file(FileName, _, !IO),
|
|
io.open_output(FileName, OpenResult, !IO),
|
|
(
|
|
OpenResult = ok(Stream),
|
|
Pred(Stream, !IO),
|
|
io.close_output(Stream, !IO),
|
|
io.call_system("chmod a+x " ++ FileName, ChmodResult, !IO),
|
|
(
|
|
ChmodResult = ok(Status),
|
|
( if Status = 0 then
|
|
Succeeded = yes,
|
|
maybe_write_string(Verbose, "% done.\n", !IO)
|
|
else
|
|
unexpected($pred, "chmod exit status != 0"),
|
|
Succeeded = no
|
|
)
|
|
;
|
|
ChmodResult = error(Message),
|
|
unexpected($pred, io.error_message(Message)),
|
|
Succeeded = no
|
|
)
|
|
;
|
|
OpenResult = error(Message),
|
|
unexpected($pred, io.error_message(Message)),
|
|
Succeeded = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
create_launcher_batch_file(Globals, MainModuleName, Pred, Succeeded, !IO) :-
|
|
module_name_to_file_name(Globals, $pred, do_create_dirs,
|
|
ext_other(other_ext(".bat")), MainModuleName, FileName, !IO),
|
|
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
maybe_write_string(Verbose, "% Generating batch file `" ++
|
|
FileName ++ "'...\n", !IO),
|
|
|
|
% Remove an existing batch file of the same name, if any.
|
|
io.remove_file(FileName, _, !IO),
|
|
io.open_output(FileName, OpenResult, !IO),
|
|
(
|
|
OpenResult = ok(Stream),
|
|
Pred(Stream, !IO),
|
|
io.close_output(Stream, !IO),
|
|
Succeeded = yes
|
|
;
|
|
OpenResult = error(Message),
|
|
unexpected($pred, io.error_message(Message)),
|
|
Succeeded = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module parse_tree.module_cmds.
|
|
%-----------------------------------------------------------------------------%
|