mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
d1402ec7b7
Previosly, there were three places in the compiler that had code to compute
the name of the directory where .class files are stored. Replace two of
these with calls to the third.
compiler/file_names.m:
Compute the three components of files, that is
- the dir names list that together specify a relative path,
- the file's base name and
- the file's extension string
in three separate predicates. Export the new predicate doing just
the first job; the functions doing the second and third jobs were
already exported.
Make the code computing the dir names list for .java and .class files
call get_java_dir_path. This replacement of the old get_class_dir_name
predicate is now the place that every part of the compiler calls
for this info.
As part of this last change, add the "jmercury" component to the path
for .java and .class files separately, since we need the path both
with and without this extension. This change allows a simplification
of the make_grade_subdir_name function.
compiler/compile_target_code.m:
Call the new get_java_dir_path predicate in file_names.m instead of
including a duplicate copy of its logic.
compiler/make.program_target.m:
Add an XXX on code that *looks like* it should either be in
file_names.m or use code in file_names.m, but which cannot be easily
updated using either approach, because its purpose is undocumented.
compiler/mercury_compile_main.m:
compiler/module_cmds.m:
Conform to the changes in file_names.m.
1263 lines
48 KiB
Mathematica
1263 lines
48 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2008-2012 The University of Melbourne.
|
|
% Copyright (C) 2013-2022 The Mercury team.
|
|
% 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 libs.
|
|
:- import_module libs.file_util.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.maybe_util.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.file_names.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type dot_tmp_copy_result
|
|
---> base_file_new_or_changed
|
|
; base_file_unchanged
|
|
; dot_tmp_copy_error.
|
|
|
|
% copy_dot_tmp_to_base_file_return_changed(Globals, ModuleName, FileName,
|
|
% Result, !IO):
|
|
%
|
|
% Update the interface file FileName from FileName.tmp if it has changed.
|
|
%
|
|
:- pred copy_dot_tmp_to_base_file_return_changed(globals::in, module_name::in,
|
|
file_name::in, dot_tmp_copy_result::out, io::di, io::uo) is det.
|
|
|
|
% copy_dot_tmp_to_base_file_return_succeeded(Globals, ModuleName,
|
|
% OutputFileName, Succeeded, !IO)
|
|
%
|
|
:- pred copy_dot_tmp_to_base_file_return_succeeded(globals::in,
|
|
module_name::in, file_name::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% copy_dot_tmp_to_base_file_report_any_error(Globals, FileKindStr,
|
|
% ModuleName, OutputFileName, Succeeded, !IO)
|
|
%
|
|
% As copy_dot_tmp_to_base_file_return_succeeded, but also print
|
|
% an error message if the update did not succeed.
|
|
%
|
|
:- pred copy_dot_tmp_to_base_file_report_any_error(globals::in, string::in,
|
|
module_name::in, file_name::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% copy_file(Globals, ProgressStream, ErrorStream,
|
|
% Source, Destination, Succeeded, !IO).
|
|
%
|
|
% XXX A version of this predicate belongs in the standard library.
|
|
%
|
|
:- pred copy_file(globals::in,
|
|
io.text_output_stream::in, io.text_output_stream::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,
|
|
maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
% make_symlink_or_copy_file(Globals, ProgressStream, ErrorStream,
|
|
% 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,
|
|
io.text_output_stream::in, io.text_output_stream::in,
|
|
file_name::in, file_name::in, maybe_succeeded::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,
|
|
io.text_output_stream::in, io.text_output_stream::in,
|
|
file_name::in, file_name::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% touch_module_ext_datestamp(Globals, ProgressStream, ErrorStream,
|
|
% ModuleName, Ext, Succeeded, !IO):
|
|
%
|
|
% Touch the datestamp file `ModuleName.Ext'. Datestamp files are used
|
|
% to record when each of the interface files was last updated.
|
|
%
|
|
:- pred touch_module_ext_datestamp(globals::in,
|
|
io.text_output_stream::in, io.text_output_stream::in,
|
|
module_name::in, ext::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
% touch_file_datestamp(Globals, ProgressStream, ErrorStream, FileName,
|
|
% Succeeded, !IO):
|
|
%
|
|
% Update the modification time for the given file,
|
|
% clobbering the contents of the file.
|
|
%
|
|
:- pred touch_file_datestamp(globals::in,
|
|
io.text_output_stream::in, io.text_output_stream::in,
|
|
file_name::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% If the argument is `did_not_succeed', set the exit status to 1.
|
|
%
|
|
:- pred maybe_set_exit_status(maybe_succeeded::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, ProgressStream, ErrorStream,
|
|
% CmdOutputStream, Verbosity, Command, Succeeded):
|
|
%
|
|
% Invoke an executable. Progress messages, error output and output from the
|
|
% invoked command will go to the specified output streams. It is expected
|
|
% that on most invocations, ErrorStream and CmdOutputStream will be the
|
|
% same stream.
|
|
%
|
|
:- pred invoke_system_command(globals::in, io.text_output_stream::in,
|
|
io.text_output_stream::in, io.text_output_stream::in,
|
|
command_verbosity::in, string::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% invoke_system_command_maybe_filter_output(Globals,
|
|
% ProgressStream, ErrorStream, CmdOutputStream, Verbosity, Command,
|
|
% MaybeProcessOutput, Succeeded)
|
|
%
|
|
% Invoke an executable. Progress messages and error output will go
|
|
% to the specified output streams after being piped through `ProcessOutput'
|
|
% if MaybeProcessOutput is yes(ProcessOutput).
|
|
%
|
|
:- pred invoke_system_command_maybe_filter_output(globals::in,
|
|
io.text_output_stream::in, io.text_output_stream::in,
|
|
io.text_output_stream::in, command_verbosity::in, string::in,
|
|
maybe(string)::in, maybe_succeeded::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,
|
|
maybe_succeeded::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.text_output_stream, io, io)::in(pred(in, di, uo) is det),
|
|
maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
:- pred create_launcher_batch_file(globals::in, module_name::in,
|
|
pred(io.text_output_stream, io, io)::in(pred(in, di, uo) is det),
|
|
maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.compute_grade. % for grade_directory_component
|
|
:- import_module libs.options.
|
|
:- import_module libs.process_util.
|
|
:- import_module parse_tree.java_names.
|
|
|
|
:- import_module bool.
|
|
:- import_module dir.
|
|
:- import_module int.
|
|
:- import_module io.call_system.
|
|
:- import_module io.environment.
|
|
:- import_module io.file.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
copy_dot_tmp_to_base_file_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.read_named_file_as_string(OutputFileName, OutputFileRes, !IO),
|
|
(
|
|
OutputFileRes = ok(OutputFileStr),
|
|
io.read_named_file_as_string(TmpOutputFileName, TmpOutputFileRes, !IO),
|
|
(
|
|
TmpOutputFileRes = ok(TmpOutputFileStr),
|
|
( if OutputFileStr = TmpOutputFileStr then
|
|
Result = base_file_unchanged,
|
|
string.format("%% `%s' has not changed.\n",
|
|
[s(OutputFileName)], NoChangeMsg),
|
|
maybe_write_string(ProgressStream, Verbose, NoChangeMsg, !IO),
|
|
io.file.remove_file(TmpOutputFileName, _, !IO)
|
|
else
|
|
copy_dot_tmp_to_base_file_create_file(Globals,
|
|
ProgressStream, ErrorStream, "CHANGED",
|
|
OutputFileName, TmpOutputFileName, Result, !IO)
|
|
)
|
|
;
|
|
TmpOutputFileRes = error(TmpOutputFileError),
|
|
io.error_message(TmpOutputFileError, TmpOutputFileErrorMsg),
|
|
Result = dot_tmp_copy_error,
|
|
% The error message is about TmpOutputFileName, but the
|
|
% message we print does not mention that file name.
|
|
io.format(ErrorStream, "Error creating `%s': %s\n",
|
|
[s(OutputFileName), s(TmpOutputFileErrorMsg)], !IO)
|
|
)
|
|
;
|
|
OutputFileRes = error(_),
|
|
copy_dot_tmp_to_base_file_create_file(Globals,
|
|
ProgressStream, ErrorStream, "been CREATED",
|
|
OutputFileName, TmpOutputFileName, Result, !IO)
|
|
).
|
|
|
|
copy_dot_tmp_to_base_file_return_succeeded(Globals, ModuleName,
|
|
OutputFileName, Succeeded, !IO) :-
|
|
copy_dot_tmp_to_base_file_return_changed(Globals, ModuleName,
|
|
OutputFileName, Result, !IO),
|
|
(
|
|
( Result = base_file_new_or_changed
|
|
; Result = base_file_unchanged
|
|
),
|
|
Succeeded = succeeded
|
|
;
|
|
Result = dot_tmp_copy_error,
|
|
Succeeded = did_not_succeed
|
|
).
|
|
|
|
copy_dot_tmp_to_base_file_report_any_error(Globals, FileKindStr,
|
|
ModuleName, OutputFileName, Succeeded, !IO) :-
|
|
copy_dot_tmp_to_base_file_return_succeeded(Globals, ModuleName,
|
|
OutputFileName, Succeeded, !IO),
|
|
(
|
|
Succeeded = did_not_succeed,
|
|
get_error_output_stream(Globals, ModuleName, ErrorStream, !IO),
|
|
string.format("problem updating %s files.", [s(FileKindStr)], Msg),
|
|
report_error(ErrorStream, Msg, !IO)
|
|
;
|
|
Succeeded = succeeded
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred copy_dot_tmp_to_base_file_create_file(globals::in,
|
|
io.text_output_stream::in, io.text_output_stream::in,
|
|
string::in, string::in, string::in, dot_tmp_copy_result::out,
|
|
io::di, io::uo) is det.
|
|
|
|
copy_dot_tmp_to_base_file_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, ProgressStream, ErrorStream,
|
|
TmpOutputFileName, OutputFileName, MoveRes, !IO),
|
|
(
|
|
MoveRes = ok,
|
|
Result = base_file_new_or_changed
|
|
;
|
|
MoveRes = error(MoveError),
|
|
Result = dot_tmp_copy_error,
|
|
io.format(ErrorStream, "Error creating `%s': %s\n",
|
|
[s(OutputFileName), s(io.error_message(MoveError))], !IO)
|
|
),
|
|
io.file.remove_file(TmpOutputFileName, _, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
copy_file(Globals, ProgressStream, ErrorStream, 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),
|
|
invoke_system_command(Globals, ProgressStream, ErrorStream, ErrorStream,
|
|
cmd_verbose, Command, Succeeded, !IO),
|
|
(
|
|
Succeeded = succeeded,
|
|
Res = ok
|
|
;
|
|
Succeeded = did_not_succeed,
|
|
do_copy_file(Source, Destination, Res, !IO)
|
|
).
|
|
|
|
% XXX TODO: copying the file byte-by-byte is inefficient.
|
|
% If the OS or platform we are on provides a system call for copying files,
|
|
% we should use that in preference to the code below.
|
|
% When the standard library has a byte_array type, the code below should be
|
|
% change the code below to read the file being copied into a byte_array and
|
|
% then write out that array using a single system call.
|
|
%
|
|
:- pred do_copy_file(file_name::in, file_name::in, io.res::out,
|
|
io::di, io::uo) is det.
|
|
|
|
do_copy_file(Source, Destination, Res, !IO) :-
|
|
io.open_binary_input(Source, SourceRes, !IO),
|
|
(
|
|
SourceRes = ok(SourceStream),
|
|
io.open_binary_output(Destination, DestRes, !IO),
|
|
(
|
|
DestRes = ok(DestStream),
|
|
copy_bytes(SourceStream, DestStream, 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_bytes(io.binary_input_stream::in, io.binary_output_stream::in,
|
|
io.res::out, io::di, io::uo) is det.
|
|
|
|
copy_bytes(Source, Destination, Res, !IO) :-
|
|
should_reduce_stack_usage(ShouldReduce),
|
|
(
|
|
ShouldReduce = no,
|
|
copy_bytes_plain(Source, Destination, Res, !IO)
|
|
;
|
|
ShouldReduce = yes,
|
|
copy_bytes_chunk(Source, Destination, Res, !IO)
|
|
).
|
|
|
|
:- pred copy_bytes_plain(io.binary_input_stream::in,
|
|
io.binary_output_stream::in, io.res::out, io::di, io::uo) is det.
|
|
|
|
copy_bytes_plain(Source, Destination, Res, !IO) :-
|
|
io.read_binary_uint8_unboxed(Source, ByteResult, Byte, !IO),
|
|
(
|
|
ByteResult = ok,
|
|
io.write_binary_uint8(Destination, Byte, !IO),
|
|
copy_bytes_plain(Source, Destination, Res, !IO)
|
|
;
|
|
ByteResult = eof,
|
|
Res = ok
|
|
;
|
|
ByteResult = error(Error),
|
|
Res = error(Error)
|
|
).
|
|
|
|
:- type copy_chunk_inner_res0
|
|
---> ccir0_ok
|
|
; ccir0_error(io.error)
|
|
; ccir0_more.
|
|
|
|
:- pred copy_bytes_chunk(io.binary_input_stream::in,
|
|
io.binary_output_stream::in, io.res::out, io::di, io::uo) is det.
|
|
|
|
copy_bytes_chunk(Source, Destination, Res, !IO) :-
|
|
% ChunkSize gives the maximum number of recursive calls we want to allow in
|
|
% the copy_bytes_inner predicate. Without such a limit, the depth of
|
|
% recursion, which depends on the size of the file they read, will cause
|
|
% exhaustion of the det stack in debug grades, since there is no tail
|
|
% recursion in such grades.
|
|
%
|
|
% With this arrangement, the maximum number of stack frames needed to
|
|
% process a file of size N is N/1000 + 1000, the former being the number of
|
|
% frames of copy_bytes_chunk predicate, the latter being the max number of
|
|
% frames of the copy_bytes_inner predicate.
|
|
%
|
|
ChunkSize = 1000,
|
|
copy_bytes_inner(ChunkSize, Source, Destination, InnerRes, !IO),
|
|
(
|
|
InnerRes = ccir0_ok,
|
|
Res = ok
|
|
;
|
|
InnerRes = ccir0_error(Error),
|
|
Res = error(Error)
|
|
;
|
|
InnerRes = ccir0_more,
|
|
copy_bytes_chunk(Source, Destination, Res, !IO)
|
|
).
|
|
|
|
:- pred copy_bytes_inner(int::in, io.binary_input_stream::in,
|
|
io.binary_output_stream::in, copy_chunk_inner_res0::out,
|
|
io::di, io::uo) is det.
|
|
|
|
copy_bytes_inner(Left, Source, Destination, Res, !IO) :-
|
|
( if Left > 0 then
|
|
io.read_binary_uint8_unboxed(Source, ByteResult, Byte, !IO),
|
|
(
|
|
ByteResult = ok,
|
|
io.write_binary_uint8(Destination, Byte, !IO),
|
|
copy_bytes_inner(Left - 1, Source, Destination, Res, !IO)
|
|
;
|
|
ByteResult = eof,
|
|
Res = ccir0_ok
|
|
;
|
|
ByteResult = error(Error),
|
|
Res = ccir0_error(Error)
|
|
)
|
|
else
|
|
Res = ccir0_more
|
|
).
|
|
|
|
:- pred should_reduce_stack_usage(bool::out) is det.
|
|
|
|
% For non-C backends.
|
|
should_reduce_stack_usage(yes).
|
|
|
|
:- pragma foreign_proc("C",
|
|
should_reduce_stack_usage(ShouldReduce::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness],
|
|
"
|
|
#ifdef MR_EXEC_TRACE
|
|
ShouldReduce = MR_YES;
|
|
#else
|
|
ShouldReduce = MR_NO;
|
|
#endif
|
|
").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred copy_dir(globals::in,
|
|
io.text_output_stream::in, io.text_output_stream::in,
|
|
dir_name::in, dir_name::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
copy_dir(Globals, ProgressStream, ErrorStream, Source, Destination,
|
|
Succeeded, !IO) :-
|
|
Command = make_install_dir_command(Globals, Source, Destination),
|
|
invoke_system_command(Globals, ProgressStream, ErrorStream, ErrorStream,
|
|
cmd_verbose, Command, Succeeded, !IO).
|
|
|
|
maybe_make_symlink(Globals, LinkTarget, LinkName, Result, !IO) :-
|
|
globals.lookup_bool_option(Globals, use_symlinks, UseSymLinks),
|
|
(
|
|
UseSymLinks = yes,
|
|
io.file.remove_file_recursively(LinkName, _, !IO),
|
|
io.file.make_symlink(LinkTarget, LinkName, LinkResult, !IO),
|
|
Result = ( if LinkResult = ok then succeeded else did_not_succeed )
|
|
;
|
|
UseSymLinks = no,
|
|
Result = did_not_succeed
|
|
).
|
|
|
|
make_symlink_or_copy_file(Globals, ProgressStream, ErrorStream,
|
|
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(ProgressStream, "%% Linking file `%s' -> `%s'\n",
|
|
[s(SourceFileName), s(DestinationFileName)], !IO),
|
|
io.flush_output(ProgressStream, !IO)
|
|
;
|
|
PrintCommand = no
|
|
),
|
|
io.file.make_symlink(SourceFileName, DestinationFileName, Result, !IO)
|
|
;
|
|
UseSymLinks = no,
|
|
LinkOrCopy = "copying",
|
|
(
|
|
PrintCommand = yes,
|
|
io.format(ProgressStream, "%% Copying file `%s' -> `%s'\n",
|
|
[s(SourceFileName), s(DestinationFileName)], !IO),
|
|
io.flush_output(ProgressStream, !IO)
|
|
;
|
|
PrintCommand = no
|
|
),
|
|
copy_file(Globals, ProgressStream, ErrorStream,
|
|
SourceFileName, DestinationFileName, Result, !IO)
|
|
),
|
|
(
|
|
Result = ok,
|
|
Succeeded = succeeded
|
|
;
|
|
Result = error(Error),
|
|
Succeeded = did_not_succeed,
|
|
io.progname_base("mercury_compile", ProgName, !IO),
|
|
io.error_message(Error, ErrorMsg),
|
|
io.format(ErrorStream, "%s: error %s `%s' to `%s', %s\n",
|
|
[s(ProgName), s(LinkOrCopy), s(SourceFileName),
|
|
s(DestinationFileName), s(ErrorMsg)], !IO),
|
|
io.flush_output(ErrorStream, !IO)
|
|
).
|
|
|
|
make_symlink_or_copy_dir(Globals, ProgressStream, ErrorStream,
|
|
SourceDirName, DestinationDirName, Succeeded, !IO) :-
|
|
globals.lookup_bool_option(Globals, use_symlinks, UseSymLinks),
|
|
(
|
|
UseSymLinks = yes,
|
|
io.file.make_symlink(SourceDirName, DestinationDirName, Result, !IO),
|
|
(
|
|
Result = ok,
|
|
Succeeded = succeeded
|
|
;
|
|
Result = error(Error),
|
|
Succeeded = did_not_succeed,
|
|
io.progname_base("mercury_compile", ProgName, !IO),
|
|
io.format(ErrorStream, "%s: error linking `%s' to `%s': %s\n",
|
|
[s(ProgName), s(SourceDirName), s(DestinationDirName),
|
|
s(io.error_message(Error))], !IO),
|
|
io.flush_output(ErrorStream, !IO)
|
|
)
|
|
;
|
|
UseSymLinks = no,
|
|
copy_dir(Globals, ProgressStream, ErrorStream,
|
|
SourceDirName, DestinationDirName, Succeeded, !IO),
|
|
(
|
|
Succeeded = succeeded
|
|
;
|
|
Succeeded = did_not_succeed,
|
|
io.progname_base("mercury_compile", ProgName, !IO),
|
|
io.format(ErrorStream,
|
|
"%s: error copying directory `%s' to `%s'\n",
|
|
[s(ProgName), s(SourceDirName), s(DestinationDirName)], !IO),
|
|
io.flush_output(ErrorStream, !IO)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
touch_module_ext_datestamp(Globals, ProgressStream, ErrorStream,
|
|
ModuleName, Ext, Succeeded, !IO) :-
|
|
module_name_to_file_name_create_dirs(Globals, $pred, Ext,
|
|
ModuleName, FileName, !IO),
|
|
touch_file_datestamp(Globals, ProgressStream, ErrorStream, FileName,
|
|
Succeeded, !IO).
|
|
|
|
touch_file_datestamp(Globals, ProgressStream, ErrorStream, FileName,
|
|
Succeeded, !IO) :-
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
maybe_write_string(ProgressStream, Verbose,
|
|
"% Touching `" ++ FileName ++ "'... ", !IO),
|
|
maybe_flush_output(ProgressStream, Verbose, !IO),
|
|
io.open_output(FileName, Result, !IO),
|
|
(
|
|
Result = ok(OutputStream),
|
|
% This write does the "touching", i.e. the updating of the file's
|
|
% time of last modification.
|
|
io.write_string(OutputStream, "\n", !IO),
|
|
io.close_output(OutputStream, !IO),
|
|
maybe_write_string(ProgressStream, Verbose, " done.\n", !IO),
|
|
Succeeded = succeeded
|
|
;
|
|
Result = error(IOError),
|
|
io.error_message(IOError, IOErrorMessage),
|
|
io.format(ErrorStream, "\nError opening `%s' for output: %s.\n",
|
|
[s(FileName), s(IOErrorMessage)], !IO),
|
|
Succeeded = did_not_succeed
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
maybe_set_exit_status(succeeded, !IO).
|
|
maybe_set_exit_status(did_not_succeed, !IO) :-
|
|
io.set_exit_status(1, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
invoke_system_command(Globals, ProgressStream,
|
|
ErrorStream, CmdOutputStream, Verbosity, Command, Succeeded, !IO) :-
|
|
invoke_system_command_maybe_filter_output(Globals, ProgressStream,
|
|
ErrorStream, CmdOutputStream, Verbosity, Command, no, Succeeded, !IO).
|
|
|
|
invoke_system_command_maybe_filter_output(Globals, ProgressStream, ErrorStream,
|
|
CmdOutputStream, 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(ProgressStream,
|
|
"%% Invoking system command `%s'...\n", [s(Command)], !IO),
|
|
io.flush_output(ProgressStream, !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.file.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 = string.format("%s > %s",
|
|
[s(Command), s(TmpFile)])
|
|
else
|
|
CommandRedirected = string.format("%s > %s 2>&1",
|
|
[s(Command), s(TmpFile)])
|
|
),
|
|
io.call_system.call_system_return_signal(CommandRedirected,
|
|
CmdResult, !IO),
|
|
(
|
|
CmdResult = ok(exited(Status)),
|
|
maybe_write_string(ProgressStream, PrintCommand, "% done.\n", !IO),
|
|
( if Status = 0 then
|
|
CommandSucceeded = succeeded
|
|
else
|
|
% The command should have produced output describing the error.
|
|
CommandSucceeded = did_not_succeed
|
|
)
|
|
;
|
|
CmdResult = 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.
|
|
io.stdout_stream(StdOut, !IO),
|
|
report_error(StdOut, 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 = did_not_succeed
|
|
;
|
|
CmdResult = error(Error),
|
|
report_error(ErrorStream, io.error_message(Error), !IO),
|
|
CommandSucceeded = did_not_succeed
|
|
)
|
|
;
|
|
TmpFileResult = error(Error),
|
|
report_error(ErrorStream,
|
|
"Could not create temporary file: " ++ error_message(Error), !IO),
|
|
TmpFile = "",
|
|
CommandSucceeded = did_not_succeed
|
|
),
|
|
|
|
( if
|
|
MaybeProcessOutput = yes(ProcessOutput),
|
|
% We can't do bash style redirection on .NET.
|
|
not use_dotnet
|
|
then
|
|
io.file.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.format(
|
|
"Get-context %s | %s > %s 2>&1",
|
|
[s(TmpFile), s(ProcessOutput), s(ProcessedTmpFile)])
|
|
else
|
|
% On windows, we can't in general redirect standard
|
|
% error in the shell.
|
|
ProcessOutputRedirected = string.format("%s < %s > %s",
|
|
[s(ProcessOutput), s(TmpFile), s(ProcessedTmpFile)])
|
|
)
|
|
else
|
|
ProcessOutputRedirected = string.format("%s < %s > %s 2>&1",
|
|
[s(ProcessOutput), s(TmpFile), s(ProcessedTmpFile)])
|
|
),
|
|
(
|
|
PrintCommand = yes,
|
|
io.format(ProgressStream,
|
|
"%% Invoking system command `%s'...\n",
|
|
[s(ProcessOutputRedirected)], !IO),
|
|
io.flush_output(ProgressStream, !IO)
|
|
;
|
|
PrintCommand = no
|
|
),
|
|
io.call_system.call_system_return_signal(ProcessOutputRedirected,
|
|
ProcessOutputResult, !IO),
|
|
io.file.remove_file(TmpFile, _, !IO),
|
|
(
|
|
ProcessOutputResult = ok(exited(ProcessOutputStatus)),
|
|
maybe_write_string(ProgressStream, PrintCommand,
|
|
"% done.\n", !IO),
|
|
( if ProcessOutputStatus = 0 then
|
|
ProcessOutputSucceeded = succeeded
|
|
else
|
|
% The command should have produced output
|
|
% describing the error.
|
|
ProcessOutputSucceeded = did_not_succeed
|
|
)
|
|
;
|
|
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 = did_not_succeed
|
|
;
|
|
ProcessOutputResult = error(ProcessOutputError),
|
|
ProcessOutputErrorMsg = io.error_message(ProcessOutputError),
|
|
report_error(ErrorStream, ProcessOutputErrorMsg, !IO),
|
|
ProcessOutputSucceeded = did_not_succeed
|
|
)
|
|
;
|
|
ProcessedTmpFileResult = error(ProcessTmpError),
|
|
ProcessTmpErrorMsg = io.error_message(ProcessTmpError),
|
|
report_error(ErrorStream, ProcessTmpErrorMsg, !IO),
|
|
ProcessOutputSucceeded = did_not_succeed,
|
|
ProcessedTmpFile = ""
|
|
)
|
|
else
|
|
ProcessOutputSucceeded = succeeded,
|
|
ProcessedTmpFile = TmpFile
|
|
),
|
|
Succeeded = CommandSucceeded `and` ProcessOutputSucceeded,
|
|
|
|
% Write the output to the error stream.
|
|
|
|
% XXX Why do we try to do this EVEN WHEN the code above had not Succeeded?
|
|
io.read_named_file_as_string(ProcessedTmpFile, TmpFileRes, !IO),
|
|
(
|
|
TmpFileRes = ok(TmpFileString),
|
|
io.write_string(CmdOutputStream, TmpFileString, !IO)
|
|
;
|
|
TmpFileRes = error(TmpFileError),
|
|
report_error(ErrorStream,
|
|
"error opening command output: " ++ io.error_message(TmpFileError),
|
|
!IO)
|
|
),
|
|
io.file.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) :-
|
|
module_name_to_file_name(Globals, $pred, ext_cur_gs(ext_cur_gs_lib_jar),
|
|
MainModuleName, JarFileName),
|
|
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.environment.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_accumulating_option(Globals, java_runtime_flags,
|
|
RuntimeFlags),
|
|
RuntimeOpts0 = string.join_list(" ", RuntimeFlags),
|
|
RuntimeOpts = escape_single_quotes_for_shell_script(RuntimeOpts0),
|
|
|
|
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",
|
|
"MERCURY_JAVA=${MERCURY_JAVA:-'", Java, "'}\n",
|
|
"MERCURY_JAVA_OPTIONS=${MERCURY_JAVA_OPTIONS:-'", RuntimeOpts, "'}\n",
|
|
"exec \"$MERCURY_JAVA\" $MERCURY_JAVA_OPTIONS 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_accumulating_option(Globals, java_runtime_flags,
|
|
RuntimeFlags),
|
|
RuntimeOpts0 = string.join_list(" ", RuntimeFlags),
|
|
RuntimeOpts = escape_single_quotes_for_shell_script(RuntimeOpts0),
|
|
|
|
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",
|
|
"MERCURY_JAVA=${MERCURY_JAVA:-'", Java, "'}\n",
|
|
"MERCURY_JAVA_OPTIONS=${MERCURY_JAVA_OPTIONS:-'", RuntimeOpts, "'}\n",
|
|
"exec \"$MERCURY_JAVA\" $MERCURY_JAVA_OPTIONS jmercury.", ClassName,
|
|
" \"$@\"\n"
|
|
], !IO).
|
|
|
|
:- func escape_single_quotes_for_shell_script(string) = string.
|
|
|
|
escape_single_quotes_for_shell_script(S) =
|
|
( if string.contains_char(S, '\'') then
|
|
string.replace_all(S, "'", "'\\''")
|
|
else
|
|
S
|
|
).
|
|
|
|
:- 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_accumulating_option(Globals, java_runtime_flags,
|
|
RuntimeFlags),
|
|
RuntimeOpts = string.join_list(" ", RuntimeFlags),
|
|
|
|
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 enableextensions\n",
|
|
"set DIR=%~dp0\n",
|
|
"set CLASSPATH=", ClassPath, "\n",
|
|
"if not defined MERCURY_JAVA_OPTIONS set MERCURY_JAVA_OPTIONS=",
|
|
RuntimeOpts, "\n",
|
|
Java, " %MERCURY_JAVA_OPTIONS% 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) :-
|
|
get_java_dir_path(Globals, ext_cur_ngs_gs_java_class, ClassSubDirPath),
|
|
ClassSubDir = dir.relative_path_name_from_components(ClassSubDirPath),
|
|
|
|
list.filter_map(make_nested_class_prefix, MainClassFiles,
|
|
NestedClassPrefixes),
|
|
NestedClassPrefixesSet = set.list_to_set(NestedClassPrefixes),
|
|
|
|
SearchDir = ClassSubDir / "jmercury",
|
|
SubDir = enter_subdirs(follow_symlinks),
|
|
FoldParams = fold_params(SubDir, on_error_keep_going),
|
|
% Unfortunately, dir.general_foldl2 is not *quite* general enough
|
|
% that we could tell it to not even try to open any file or directory
|
|
% that does not start with a prefix in NestedClassPrefixesSet.
|
|
dir.general_foldl2(FoldParams,
|
|
accumulate_nested_class_files(NestedClassPrefixesSet),
|
|
SearchDir, [], NestedClassFiles, Errors, !IO),
|
|
list.filter(file_error_is_relevant(NestedClassPrefixesSet),
|
|
Errors, RelevantErrors),
|
|
(
|
|
RelevantErrors = [],
|
|
AllClassFiles0 = MainClassFiles ++ NestedClassFiles,
|
|
% Remove the `Mercury/classes' 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)
|
|
;
|
|
RelevantErrors = [file_error(_, _, Error) | _],
|
|
unexpected($pred, io.error_message(Error))
|
|
).
|
|
|
|
list_class_files_for_jar_mmake(Globals, ClassFiles, ListClassFiles) :-
|
|
get_java_dir_path(Globals, ext_cur_ngs_gs_java_class, ClassSubDirPath),
|
|
(
|
|
ClassSubDirPath = [],
|
|
ListClassFiles = ClassFiles
|
|
;
|
|
ClassSubDirPath = [_ | _],
|
|
ClassSubDir = dir.relative_path_name_from_components(ClassSubDirPath),
|
|
% Here we use the `-C' option of jar to change directory during
|
|
% execution, then use sed to strip away the Mercury/classes/ prefix
|
|
% to the class files.
|
|
% Otherwise, the class files would be stored as
|
|
% Mercury/classes/*.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 ++ "/| |'`"
|
|
).
|
|
|
|
:- 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) :-
|
|
(
|
|
% These file types may be .class files.
|
|
( FileType = regular_file
|
|
; FileType = symbolic_link
|
|
),
|
|
IsNestedCF =
|
|
file_is_nested_class_file(NestedClassPrefixes, DirName, BaseName),
|
|
(
|
|
IsNestedCF = yes,
|
|
!:Acc = [DirName / BaseName | !.Acc]
|
|
;
|
|
IsNestedCF = no
|
|
)
|
|
;
|
|
% These file types cannot be .class files.
|
|
( FileType = directory
|
|
; FileType = named_pipe
|
|
; FileType = socket
|
|
; FileType = character_device
|
|
; FileType = block_device
|
|
; FileType = message_queue
|
|
; FileType = semaphore
|
|
; FileType = shared_memory
|
|
; FileType = unknown
|
|
)
|
|
),
|
|
Continue = yes.
|
|
|
|
:- func file_is_nested_class_file(set(string), string, string) = bool.
|
|
|
|
file_is_nested_class_file(NestedClassPrefixes, DirName, BaseName)
|
|
= IsNestedCF :-
|
|
( if
|
|
string.sub_string_search(BaseName, "$", Dollar),
|
|
BaseNameToDollar = string.left(BaseName, Dollar + 1),
|
|
set.contains(NestedClassPrefixes, DirName / BaseNameToDollar)
|
|
then
|
|
IsNestedCF = yes
|
|
else
|
|
IsNestedCF = no
|
|
).
|
|
|
|
:- pred file_error_is_relevant(set(string)::in, file_error::in)
|
|
is semidet.
|
|
|
|
file_error_is_relevant(NestedClassPrefixes, FileError) :-
|
|
FileError = file_error(PathName, _Op, _IOError),
|
|
( if split_name(PathName, DirName, BaseName) then
|
|
file_is_nested_class_file(NestedClassPrefixes, DirName, BaseName) = yes
|
|
else
|
|
% If we cannot read the top level SearchDir, that error is relevant.
|
|
true
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
get_env_classpath(Classpath, !IO) :-
|
|
io.environment.get_environment_var("CLASSPATH", MaybeCP, !IO),
|
|
(
|
|
MaybeCP = yes(Classpath)
|
|
;
|
|
MaybeCP = no,
|
|
io.environment.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_create_dirs(Globals, $pred,
|
|
ext_cur_gs(ext_cur_gs_exec_noext), MainModuleName, FileName, !IO),
|
|
|
|
get_progress_output_stream(Globals, MainModuleName, ProgressStream, !IO),
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
maybe_write_string(ProgressStream, Verbose,
|
|
"% Generating shell script `" ++ FileName ++ "'...\n", !IO),
|
|
|
|
% Remove symlink in the way, if any.
|
|
io.file.remove_file(FileName, _, !IO),
|
|
io.open_output(FileName, OpenResult, !IO),
|
|
(
|
|
OpenResult = ok(Stream),
|
|
Pred(Stream, !IO),
|
|
io.close_output(Stream, !IO),
|
|
io.call_system.call_system("chmod a+x " ++ FileName, ChmodResult, !IO),
|
|
(
|
|
ChmodResult = ok(Status),
|
|
( if Status = 0 then
|
|
Succeeded = succeeded,
|
|
maybe_write_string(ProgressStream, Verbose, "% done.\n", !IO)
|
|
else
|
|
unexpected($pred, "chmod exit status != 0"),
|
|
Succeeded = did_not_succeed
|
|
)
|
|
;
|
|
ChmodResult = error(Message),
|
|
unexpected($pred, io.error_message(Message)),
|
|
Succeeded = did_not_succeed
|
|
)
|
|
;
|
|
OpenResult = error(Message),
|
|
unexpected($pred, io.error_message(Message)),
|
|
Succeeded = did_not_succeed
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
create_launcher_batch_file(Globals, MainModuleName, Pred, Succeeded, !IO) :-
|
|
module_name_to_file_name_create_dirs(Globals, $pred,
|
|
ext_cur_gs(ext_cur_gs_exec_bat), MainModuleName, FileName, !IO),
|
|
|
|
get_progress_output_stream(Globals, MainModuleName, ProgressStream, !IO),
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
maybe_write_string(ProgressStream, Verbose,
|
|
"% Generating batch file `" ++ FileName ++ "'...\n", !IO),
|
|
|
|
% Remove an existing batch file of the same name, if any.
|
|
io.file.remove_file(FileName, _, !IO),
|
|
io.open_output(FileName, OpenResult, !IO),
|
|
(
|
|
OpenResult = ok(Stream),
|
|
Pred(Stream, !IO),
|
|
io.close_output(Stream, !IO),
|
|
Succeeded = succeeded
|
|
;
|
|
OpenResult = error(Message),
|
|
unexpected($pred, io.error_message(Message)),
|
|
Succeeded = did_not_succeed
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module parse_tree.module_cmds.
|
|
%-----------------------------------------------------------------------------%
|