mercury/compiler/module_cmds.m

%-----------------------------------------------------------------------------%
% 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 <dir>' 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 <dir>' 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 <dir>' 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 <dir>' 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.
%-----------------------------------------------------------------------------%