mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 09:23:44 +00:00
4e6a6357c4
compiler/file_util.m:
Define standard routines for reporting that we couldn't open a file
for either input or output. Rename the one other predicate in this file
that the compiler used for that purpose, so that its call sites
can be redirected to use one of the routines intended for this purpose.
Give these routines the ability to standardize path names (by removing
"./" prefixes from relative path names, and removing all directory names
from adsolute path names) if a new option is given.
compiler/options.m:
Add that (developer-only) option.
compiler/compile_target_code.m:
compiler/copy_util.m:
compiler/export.m:
compiler/llds_out_file.m:
compiler/mercury_compile_front_end.m:
compiler/mercury_compile_make_hlds.m:
compiler/mercury_compile_middle_passes.m:
compiler/mercury_compile_mlds_back_end.m:
compiler/mlds_to_c_file.m:
compiler/mlds_to_cs_file.m:
compiler/mlds_to_java_file.m:
compiler/module_cmds.m:
compiler/opt_deps_spec.m:
compiler/output_imports_graph.m:
compiler/passes_aux.m:
compiler/system_cmds.m:
compiler/write_deps_file.m:
compiler/xml_documentation.m:
Replace all call sites to the file_util.m predicates modified
by this diff. In many cases, it replaces duplicate copies of the
same code with a call. In some cases, redirect the error message
to the progress stream, where it belongs.
tests/invalid/Mercury.options:
tests/invalid/foreign_include_file_missing.err_exp3:
Compile the foreign_include_file_missing test case with the new option,
and add the expected output in C# grades, which (thanks to the option)
no longer includes the pathname of the test directory.
tests/invalid/foreign_include_file_missing.m:
Record what the new .err_exp3 file is for.
tests/warnings/help_text.err_exp:
Expect the new option.
813 lines
31 KiB
Mathematica
813 lines
31 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2008-2012 The University of Melbourne.
|
|
% Copyright (C) 2013-2025 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.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% copy_dot_tmp_to_base_file_return_succeeded(ProgressStream, Globals,
|
|
% ModuleName, OutputFileName, Succeeded, !IO)
|
|
%
|
|
% Update the interface file FileName from FileName.tmp if it has changed,
|
|
% and return whether the update succeeded (if it was needed).
|
|
%
|
|
:- pred copy_dot_tmp_to_base_file_return_succeeded(io.text_output_stream::in,
|
|
globals::in, file_name::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
% copy_dot_tmp_to_base_file_report_any_error(ProgressStream, Globals,
|
|
% FileKindStr, OutputFileName, Succeeded, !IO)
|
|
%
|
|
% As copy_dot_tmp_to_base_file_return_succeeded, but also print
|
|
% an error message (which includes FileKindStr) if the update failed.
|
|
%
|
|
:- pred copy_dot_tmp_to_base_file_report_any_error(io.text_output_stream::in,
|
|
globals::in, string::in, file_name::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- 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(ProgressStream, Globals,
|
|
% FileName, Result, !IO):
|
|
%
|
|
% Update the interface file FileName from FileName.tmp if it has changed.
|
|
% Report whether the update was needed, and if it was, whether it
|
|
% succeeded.
|
|
%
|
|
:- pred copy_dot_tmp_to_base_file_return_changed(io.text_output_stream::in,
|
|
globals::in, file_name::in, dot_tmp_copy_result::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.
|
|
|
|
% definitely_make_symlink(TargetFile, LinkName, Result, !IO):
|
|
%
|
|
% Attempt to make LinkName a symlink pointing to LinkTarget.
|
|
% Assumes that the caller has checked that `--use-symlinks' is set.
|
|
%
|
|
:- pred definitely_make_symlink(file_name::in, file_name::in,
|
|
maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
% make_symlink_or_copy_file(Globals, ProgressStream, 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,
|
|
file_name::in, file_name::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% touch_module_ext_datestamp(Globals, ProgressStream,
|
|
% 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,
|
|
module_name::in, ext::in, maybe_succeeded::out, io::di, io::uo) is det.
|
|
|
|
% touch_file_datestamp(Globals, ProgressStream, 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,
|
|
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.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% 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(io.text_output_stream::in, 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(io.text_output_stream::in,
|
|
globals::in, module_name::in, string::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pred create_launcher_batch_file(io.text_output_stream::in,
|
|
globals::in, module_name::in, string::in, maybe_succeeded::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.copy_util.
|
|
:- import_module libs.options.
|
|
:- 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 maybe.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
copy_dot_tmp_to_base_file_return_succeeded(ProgressStream, Globals,
|
|
OutputFileName, Succeeded, !IO) :-
|
|
copy_dot_tmp_to_base_file_return_changed(ProgressStream, Globals,
|
|
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(ProgressStream, Globals,
|
|
FileKindStr, OutputFileName, Succeeded, !IO) :-
|
|
copy_dot_tmp_to_base_file_return_changed(ProgressStream, Globals,
|
|
OutputFileName, Result, !IO),
|
|
(
|
|
Result = dot_tmp_copy_error,
|
|
Succeeded = did_not_succeed,
|
|
% XXX The call about should have told us: what was the actual problem?
|
|
string.format("problem updating %s files.", [s(FileKindStr)], Msg),
|
|
report_arbitrary_error(ProgressStream, Msg, !IO)
|
|
;
|
|
( Result = base_file_new_or_changed
|
|
; Result = base_file_unchanged
|
|
),
|
|
Succeeded = succeeded
|
|
).
|
|
|
|
copy_dot_tmp_to_base_file_return_changed(ProgressStream, Globals,
|
|
OutputFileName, Result, !IO) :-
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
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,
|
|
"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(ProgressStream, "Error creating `%s': %s\n",
|
|
[s(OutputFileName), s(TmpOutputFileErrorMsg)], !IO)
|
|
)
|
|
;
|
|
OutputFileRes = error(_),
|
|
copy_dot_tmp_to_base_file_create_file(Globals, ProgressStream,
|
|
"been CREATED", OutputFileName, TmpOutputFileName, Result, !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred copy_dot_tmp_to_base_file_create_file(globals::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,
|
|
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_to_file_name(Globals, ProgressStream, TmpOutputFileName,
|
|
OutputFileName, MoveRes, !IO),
|
|
(
|
|
MoveRes = succeeded,
|
|
Result = base_file_new_or_changed
|
|
;
|
|
MoveRes = did_not_succeed,
|
|
Result = dot_tmp_copy_error
|
|
% copy_file_to_file_name/7 writes an error message to ProgressStream
|
|
% if the copy fails.
|
|
% XXX FILE COPY: we used to generate the following error message
|
|
% here, but I suspect it wasn't really possible to trigger it.
|
|
%MoveRes = error(MoveError),
|
|
%io.format(ProgressStream, "Error creating `%s': %s\n",
|
|
% [s(OutputFileName), s(io.error_message(MoveError))], !IO)
|
|
),
|
|
io.file.remove_file(TmpOutputFileName, _, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
maybe_make_symlink(Globals, LinkTarget, LinkName, Result, !IO) :-
|
|
globals.lookup_bool_option(Globals, use_symlinks, UseSymLinks),
|
|
(
|
|
UseSymLinks = yes,
|
|
definitely_make_symlink(LinkTarget, LinkName, Result, !IO)
|
|
;
|
|
UseSymLinks = no,
|
|
Result = did_not_succeed
|
|
).
|
|
|
|
definitely_make_symlink(LinkTarget, LinkName, Result, !IO) :-
|
|
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 ).
|
|
|
|
make_symlink_or_copy_file(Globals, ProgressStream,
|
|
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),
|
|
(
|
|
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(ProgressStream, "%s: error %s `%s' to `%s', %s\n",
|
|
[s(ProgName), s(LinkOrCopy), s(SourceFileName),
|
|
s(DestinationFileName), s(ErrorMsg)], !IO),
|
|
io.flush_output(ProgressStream, !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
|
|
),
|
|
% XXX FILE COPY
|
|
% copy_file_to_file_name/7 will write an error message
|
|
% to ProgressStream itself if the file copy fails. We used to generate
|
|
% an error similar to the symlink case above here.
|
|
copy_file_to_file_name(Globals, ProgressStream, SourceFileName,
|
|
DestinationFileName, Succeeded, !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
touch_module_ext_datestamp(Globals, ProgressStream, ModuleName, Ext,
|
|
Succeeded, !IO) :-
|
|
% XXX LEGACY
|
|
module_name_to_file_name_create_dirs(Globals, $pred, Ext,
|
|
ModuleName, FileName, _FileNameProposed, !IO),
|
|
touch_file_datestamp(Globals, ProgressStream, FileName, Succeeded, !IO).
|
|
|
|
touch_file_datestamp(Globals, ProgressStream, 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(FileStream),
|
|
% This write does the "touching", i.e. the updating of the file's
|
|
% time of last modification.
|
|
io.write_string(FileStream, "\n", !IO),
|
|
io.close_output(FileStream, !IO),
|
|
maybe_write_string(ProgressStream, Verbose, " done.\n", !IO),
|
|
Succeeded = succeeded
|
|
;
|
|
Result = error(IOError),
|
|
io.error_message(IOError, IOErrorMessage),
|
|
io.format(ProgressStream, "\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).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Java command-line utilities.
|
|
%
|
|
|
|
create_java_shell_script(ProgressStream, Globals, MainModuleName,
|
|
Succeeded, !IO) :-
|
|
% XXX LEGACY
|
|
module_name_to_file_name(Globals, $pred, ext_cur_gs(ext_cur_gs_lib_jar),
|
|
MainModuleName, JarFileName, _JarFileNameProposed),
|
|
get_target_env_type(Globals, TargetEnvType),
|
|
(
|
|
( TargetEnvType = env_type_posix
|
|
; TargetEnvType = env_type_cygwin
|
|
),
|
|
io.environment.get_environment_var("MERCURY_STAGE2_LAUNCHER_BASE",
|
|
MaybeStage2Base, !IO),
|
|
construct_java_shell_script(Globals, MaybeStage2Base,
|
|
MainModuleName, JarFileName, ContentStr),
|
|
create_launcher_shell_script(ProgressStream, Globals, MainModuleName,
|
|
ContentStr, Succeeded, !IO)
|
|
;
|
|
TargetEnvType = env_type_msys,
|
|
construct_java_msys_shell_script(Globals, MainModuleName, JarFileName,
|
|
ContentStr),
|
|
create_launcher_shell_script(ProgressStream, Globals, MainModuleName,
|
|
ContentStr, Succeeded, !IO)
|
|
;
|
|
% XXX should create a .ps1 file on PowerShell.
|
|
( TargetEnvType = env_type_win_cmd
|
|
; TargetEnvType = env_type_powershell
|
|
),
|
|
construct_java_batch_file(Globals, MainModuleName, JarFileName,
|
|
ContentStr),
|
|
create_launcher_batch_file(ProgressStream, Globals, MainModuleName,
|
|
ContentStr, Succeeded, !IO)
|
|
).
|
|
|
|
:- pred construct_java_shell_script(globals::in, maybe(string)::in,
|
|
module_name::in, file_name::in, string::out) is det.
|
|
|
|
construct_java_shell_script(Globals, MaybeStage2Base,
|
|
MainModuleName, JarFileName, ContentStr) :-
|
|
(
|
|
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),
|
|
|
|
ContentStr = string.append_list([
|
|
"#!/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"
|
|
]).
|
|
|
|
% 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 construct_java_msys_shell_script(globals::in, module_name::in,
|
|
file_name::in, string::out) is det.
|
|
|
|
construct_java_msys_shell_script(Globals, MainModuleName, JarFileName,
|
|
ContentStr) :-
|
|
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),
|
|
|
|
ContentStr = string.append_list([
|
|
"#!/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"
|
|
]).
|
|
|
|
:- 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 construct_java_batch_file(globals::in, module_name::in, file_name::in,
|
|
string::out) is det.
|
|
|
|
construct_java_batch_file(Globals, MainModuleName, JarFileName, ContentStr) :-
|
|
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),
|
|
|
|
ContentStr = string.append_list([
|
|
"@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"
|
|
]).
|
|
|
|
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),
|
|
globals.get_grade_dir(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) :-
|
|
% XXX LEGACY
|
|
get_java_dir_path(Globals, ext_cur_ngs_gs_java_class,
|
|
ClassSubDirPath, _ClassSubDirPathProposed),
|
|
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) :-
|
|
% XXX LEGACY
|
|
get_java_dir_path(Globals, ext_cur_ngs_gs_java_class,
|
|
ClassSubDirPath, _ClassSubDirPathProposed),
|
|
(
|
|
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, IO) :-
|
|
% The I/O state arguments, which we do not use, are required
|
|
% by dir.general_foldl2.
|
|
(
|
|
% 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(ProgressStream, Globals, MainModuleName,
|
|
ContentStr, Succeeded, !IO) :-
|
|
Ext = ext_cur_gas(ext_cur_gas_exec_noext),
|
|
% XXX LEGACY
|
|
module_name_to_file_name_create_dirs(Globals, $pred, Ext,
|
|
MainModuleName, LauncherFileName, _LauncherFileNameProposed, !IO),
|
|
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
maybe_write_string(ProgressStream, Verbose,
|
|
"% Generating shell script `" ++ LauncherFileName ++ "'...\n", !IO),
|
|
|
|
% Remove symlink in the way, if any.
|
|
io.file.remove_file(LauncherFileName, _, !IO),
|
|
io.open_output(LauncherFileName, OpenResult, !IO),
|
|
(
|
|
OpenResult = ok(Stream),
|
|
io.write_string(Stream, ContentStr, !IO),
|
|
io.close_output(Stream, !IO),
|
|
io.call_system.call_system("chmod a+x " ++ LauncherFileName,
|
|
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(ProgressStream, Globals, MainModuleName,
|
|
ContentStr, Succeeded, !IO) :-
|
|
% XXX LEGACY
|
|
module_name_to_file_name_create_dirs(Globals, $pred,
|
|
ext_cur_gas(ext_cur_gas_exec_bat), MainModuleName,
|
|
FileName, _FileNameProposed, !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),
|
|
io.write_string(Stream, ContentStr, !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.
|
|
%-----------------------------------------------------------------------------%
|