%-----------------------------------------------------------------------------% % 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 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, FileName, Result): % % Update the interface file FileName from FileName.tmp if it has changed. % :- pred update_interface_return_changed(globals::in, file_name::in, update_interface_result::out, io::di, io::uo) is det. :- pred update_interface_return_succeeded(globals::in, file_name::in, bool::out, io::di, io::uo) is det. :- pred update_interface(globals::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, string::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. %-----------------------------------------------------------------------------% % % Erlang utilities. % % Create a shell script with the same name as the given module to invoke % the Erlang runtime system and execute the main/2 predicate in that % module. % :- pred create_erlang_shell_script(globals::in, module_name::in, bool::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.error_util. :- import_module parse_tree.file_names. :- import_module parse_tree.java_names. :- import_module dir. :- import_module getopt_io. :- import_module int. :- import_module require. :- import_module set. :- import_module string. %-----------------------------------------------------------------------------% update_interface(Globals, OutputFileName, !IO) :- update_interface_return_succeeded(Globals, OutputFileName, Succeeded, !IO), ( Succeeded = no, report_error("problem updating interface files.", !IO) ; Succeeded = yes ). update_interface_return_succeeded(Globals, OutputFileName, Succeeded, !IO) :- update_interface_return_changed(Globals, OutputFileName, Result, !IO), ( ( Result = interface_new_or_changed ; Result = interface_unchanged ), Succeeded = yes ; Result = interface_error, Succeeded = no ). update_interface_return_changed(Globals, OutputFileName, Result, !IO) :- globals.lookup_bool_option(Globals, verbose, Verbose), maybe_write_string(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, maybe_write_string(Verbose, "% ", !IO), maybe_write_string(Verbose, OutputFileName, !IO), maybe_write_string(Verbose, "' has not changed.\n", !IO), io.remove_file(TmpOutputFileName, _, !IO) ; FilesDiffer = ok(ok(yes)), update_interface_create_file(Globals, "CHANGED", OutputFileName, TmpOutputFileName, Result, !IO) ; FilesDiffer = ok(error(TmpFileError)), Result = interface_error, io.write_string("Error reading `", !IO), io.write_string(TmpOutputFileName, !IO), io.write_string("': ", !IO), io.write_string(io.error_message(TmpFileError), !IO), io.nl(!IO) ; FilesDiffer = error(_, _), update_interface_create_file(Globals, "been CREATED", OutputFileName, TmpOutputFileName, Result, !IO) ) ; TmpOutputFileRes = error(TmpOutputFileError), Result = interface_error, io.close_binary_input(OutputFileStream, !IO), io.write_string("Error creating `", !IO), io.write_string(OutputFileName, !IO), io.write_string("': ", !IO), io.write_string(io.error_message(TmpOutputFileError), !IO), io.nl(!IO) ) ; OutputFileRes = error(_), update_interface_create_file(Globals, "been CREATED", OutputFileName, TmpOutputFileName, Result, !IO) ). :- pred update_interface_create_file(globals::in, string::in, string::in, string::in, update_interface_result::out, io::di, io::uo) is det. update_interface_create_file(Globals, Msg, OutputFileName, TmpOutputFileName, Result, !IO) :- globals.lookup_bool_option(Globals, verbose, Verbose), maybe_write_string(Verbose, "% `" ++ OutputFileName ++ "' has " ++ Msg ++ ".\n", !IO), copy_file(Globals, TmpOutputFileName, OutputFileName, MoveRes, !IO), ( MoveRes = ok, Result = interface_new_or_changed ; MoveRes = error(MoveError), Result = interface_error, io.write_string("Error creating `" ++ OutputFileName ++ "': " ++ io.error_message(MoveError), !IO), io.nl(!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.write_string(ProgName, !IO), io.write_string(": error linking", !IO), io.write_string(" `", !IO), io.write_string(SourceDirName, !IO), io.write_string("' to `", !IO), io.write_string(DestinationDirName, !IO), io.write_string("': ", !IO), io.write_string(io.error_message(Error), !IO), io.nl(!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.write_string(ProgName, !IO), io.write_string(": error copying directory", !IO), io.write_string(" `", !IO), io.write_string(SourceDirName, !IO), io.write_string("' to `", !IO), io.write_string(DestinationDirName, !IO), io.nl(!IO), io.flush_output(!IO) ) ). %-----------------------------------------------------------------------------% touch_interface_datestamp(Globals, ModuleName, Ext, !IO) :- module_name_to_file_name(Globals, do_create_dirs, Ext, 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.write_string("\nError opening `" ++ OutputFileName ++ "' for output: " ++ IOErrorMessage ++ ".\n", !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.write_string("% Invoking system command `", !IO), io.write_string(Command, !IO), io.write_string("'...\n", !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)), report_error_to_stream(ErrorStream, "system command received signal " ++ int_to_string(Signal) ++ ".", !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("system command received signal " ++ int_to_string(Signal) ++ ".", !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_to_stream(ErrorStream, io.error_message(Error), !IO), CommandSucceeded = no ) ; TmpFileResult = error(Error), report_error_to_stream(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_to_stream(ErrorStream, "system command received signal " ++ int_to_string(ProcessOutputSignal) ++ ".", !IO), ProcessOutputSucceeded = no ; ProcessOutputResult = error(ProcessOutputError), report_error_to_stream(ErrorStream, io.error_message(ProcessOutputError), !IO), ProcessOutputSucceeded = no ) ; ProcessedTmpFileResult = error(ProcessTmpError), report_error_to_stream(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_to_stream(ErrorStream, "error reading command output: " ++ io.error_message(TmpFileReadError), !IO) ), io.close_input(TmpFileStream, !IO) ; TmpFileRes = error(TmpFileError), report_error_to_stream(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 = ".jar", module_name_to_file_name(Globals, 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.from_list(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 = "" ) ). %-----------------------------------------------------------------------------% % % Erlang utilities. % create_erlang_shell_script(Globals, MainModuleName, Succeeded, !IO) :- get_target_env_type(Globals, TargetEnvType), ( ( TargetEnvType = env_type_posix ; TargetEnvType = env_type_cygwin ; TargetEnvType = env_type_msys ), create_launcher_shell_script(Globals, MainModuleName, write_erlang_shell_script(Globals, MainModuleName), Succeeded, !IO) ; ( TargetEnvType = env_type_win_cmd ; TargetEnvType = env_type_powershell ), create_launcher_batch_file(Globals, MainModuleName, write_erlang_batch_file(Globals, MainModuleName), Succeeded, !IO) ). :- pred write_erlang_shell_script(globals::in, module_name::in, io.text_output_stream::in, io::di, io::uo) is det. write_erlang_shell_script(Globals, MainModuleName, Stream, !IO) :- globals.lookup_string_option(Globals, erlang_object_file_extension, BeamExt), module_name_to_file_name(Globals, do_not_create_dirs, BeamExt, MainModuleName, BeamFileName, !IO), BeamDirName = dir.dirname(BeamFileName), module_name_to_file_name_stem(MainModuleName, BeamBaseNameNoExt), % Add `-pa ' option to find the standard library. % (-pa adds the directory to the beginning of the list of paths to search % for .beam files) grade_directory_component(Globals, GradeDir), globals.lookup_maybe_string_option(Globals, mercury_standard_library_directory, MaybeStdLibDir), ( MaybeStdLibDir = yes(StdLibDir), StdLibBeamsPath = StdLibDir/"lib"/GradeDir/"libmer_std.beams", SearchStdLib = pa_option(yes, yes, StdLibBeamsPath), % Added by elds_to_erlang.m MainFunc = "mercury__main_wrapper" ; MaybeStdLibDir = no, SearchStdLib = "", MainFunc = "main_2_p_0" ), % Add `-pa ' options to find any other libraries specified % by the user. globals.lookup_accumulating_option(Globals, mercury_library_directories, MercuryLibDirs0), MercuryLibDirs = list.map((func(LibDir) = LibDir/"lib"/GradeDir), MercuryLibDirs0), globals.lookup_accumulating_option(Globals, link_libraries, LinkLibrariesList0), list.map_foldl(find_erlang_library_path(Globals, MercuryLibDirs), LinkLibrariesList0, LinkLibrariesList, !IO), globals.lookup_string_option(Globals, erlang_interpreter, Erlang), SearchLibs = string.append_list(list.map(pa_option(yes, yes), list.sort_and_remove_dups(LinkLibrariesList))), % XXX main_2_p_0 is not necessarily in the main module itself and % could be in a submodule. We don't handle that yet. SearchProg = pa_option(yes, no, """$DIR""/" ++ quote_arg(BeamDirName)), % Write the shell script. % Note we need to use '-extra' instead of '--' for "-flag" and % "+flag" arguments to be pass through to the Mercury program. io.write_strings(Stream, [ "#!/bin/sh\n", "# Generated by the Mercury compiler.\n", "DIR=`dirname ""$0""`\n", "exec ", Erlang, " -noshell \\\n", SearchStdLib, SearchLibs, SearchProg, " -s ", BeamBaseNameNoExt, " ", MainFunc, " -s init stop -extra ""$@""\n" ], !IO). :- pred write_erlang_batch_file(globals::in, module_name::in, io.text_output_stream::in, io::di, io::uo) is det. write_erlang_batch_file(Globals, MainModuleName, Stream, !IO) :- % XXX It should be possible to avoid some of the code duplication with % the Unix version above. globals.lookup_string_option(Globals, erlang_object_file_extension, BeamExt), module_name_to_file_name(Globals, do_not_create_dirs, BeamExt, MainModuleName, BeamFileName, !IO), BeamDirName = dir.dirname(BeamFileName), module_name_to_file_name_stem(MainModuleName, BeamBaseNameNoExt), % Add `-pa ' option to find the standard library. % (-pa adds the directory to the beginning of the list of paths to search % for .beam files) grade_directory_component(Globals, GradeDir), globals.lookup_maybe_string_option(Globals, mercury_standard_library_directory, MaybeStdLibDir), ( MaybeStdLibDir = yes(StdLibDir), StdLibBeamsPath = StdLibDir/"lib"/GradeDir/"libmer_std.beams", SearchStdLib = pa_option(no, yes, StdLibBeamsPath), % Added by elds_to_erlang.m MainFunc = "mercury__main_wrapper" ; MaybeStdLibDir = no, SearchStdLib = "", MainFunc = "main_2_p_0" ), % Add `-pa ' options to find any other libraries specified % by the user. globals.lookup_accumulating_option(Globals, mercury_library_directories, MercuryLibDirs0), MercuryLibDirs = list.map((func(LibDir) = LibDir/"lib"/GradeDir), MercuryLibDirs0), globals.lookup_accumulating_option(Globals, link_libraries, LinkLibrariesList0), list.map_foldl(find_erlang_library_path(Globals, MercuryLibDirs), LinkLibrariesList0, LinkLibrariesList, !IO), globals.lookup_string_option(Globals, erlang_interpreter, Erlang), SearchLibs = string.append_list(list.map(pa_option(no, yes), list.sort_and_remove_dups(LinkLibrariesList))), % XXX main_2_p_0 is not necessarily in the main module itself and % could be in a submodule. We don't handle that yet. SearchProg = pa_option(no, no, "%DIR%\\" ++ quote_arg(BeamDirName)), io.write_strings(Stream, [ "@echo off\n", "rem Generated by the Mercury compiler.\n", "setlocal\n", "set DIR=%~dp0\n", Erlang, " -noshell ", SearchStdLib, SearchLibs, SearchProg, " -s ", BeamBaseNameNoExt, " ", MainFunc, " -s init stop -extra %*\n" ], !IO). :- pred find_erlang_library_path(globals::in, list(dir_name)::in, string::in, string::out, io::di, io::uo) is det. find_erlang_library_path(Globals, MercuryLibDirs, LibName, LibPath, !IO) :- file_name_to_module_name(LibName, LibModuleName), globals.set_option(use_grade_subdirs, bool(no), Globals, NoSubdirsGlobals), module_name_to_lib_file_name(NoSubdirsGlobals, "lib", LibModuleName, ".beams", do_not_create_dirs, LibFileName, !IO), search_for_file_returning_dir(MercuryLibDirs, LibFileName, MaybeDirName, !IO), ( MaybeDirName = ok(DirName), LibPath = DirName / LibFileName ; MaybeDirName = error(Error), LibPath = "", write_error_pieces_maybe_with_context(Globals, no, 0, [words(Error)], !IO) ). :- func pa_option(bool, bool, dir_name) = string. pa_option(BreakLines, Quote, Dir0) = Option :- ( Quote = yes, Dir = quote_arg(Dir0) ; Quote = no, Dir = Dir0 ), ( BreakLines = yes, LineContinuation = " \\\n" ; BreakLines = no, LineContinuation = "" ), Option = " -pa " ++ Dir ++ LineContinuation. %-----------------------------------------------------------------------------% create_launcher_shell_script(Globals, MainModuleName, Pred, Succeeded, !IO) :- Extension = "", module_name_to_file_name(Globals, do_create_dirs, Extension, 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) :- Extension = ".bat", module_name_to_file_name(Globals, do_create_dirs, Extension, 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. %-----------------------------------------------------------------------------%