[m-rev.] for review: improve I/O implementation for erlang backend

Peter Wang wangp at students.csse.unimelb.edu.au
Thu Jun 21 17:45:52 AEST 2007


Estimated hours taken: 6
Branches: main

Improve the Erlang I/O implementation.

library/io.m:
	In the Erlang implementation, implement:

	- support for pushback and line number tracking in I/O streams
	- seeking on binary streams
	- io.write_byte, io.write_bytes
	- io.make_temp
	- io.get_exit_status, io.set_exit_status

	Export some functions written in foreign_procs, otherwise they couldn't
	be called if foreign_procs got inlined into other modules.

	Fix some places in which we didn't convert Erlang error return values
	to strings.

library/erlang_builtin.m:
	Make the Erlang global server track the current exit status.

compiler/elds_to_erlang.m:
	Make the Erlang main wrapper, return the last set exit status to the
	operating system.

tests/hard_coded/Mmakefile:
tests/hard_coded/seek_test.exp:
tests/hard_coded/seek_test.m:
	Add simple test case for io.seek_binary_input.

tests/hard_coded/remove_file.exp2:
	Add expected output for Erlang backend.

tests/general/structure_reuse/Mmakefile:
	Don't test this directory in Erlang grades.


Index: compiler/elds_to_erlang.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds_to_erlang.m,v
retrieving revision 1.20
diff -u -r1.20 elds_to_erlang.m
--- compiler/elds_to_erlang.m	19 Jun 2007 01:10:52 -0000	1.20
+++ compiler/elds_to_erlang.m	21 Jun 2007 07:24:43 -0000
@@ -289,20 +289,34 @@
                 StackTrace = erlang:get_stacktrace(),
                 mercury__exception:'ML_report_uncaught_exception'(Excp),
                 mercury__maybe_dump_stacktrace(StackTrace),
-                mercury__shutdown(),
-                % init:stop is preferred to calling halt but there seems
-                % to be no way to choose the exit code otherwise.
-                halt(1)
+                mercury__shutdown(true)
         end,
-        mercury__shutdown().
+        mercury__shutdown(false).
 
     mercury__startup() ->
         mercury__erlang_builtin:'ML_start_global_server'(),
         mercury__io:'ML_io_init_state'().
 
-    mercury__shutdown() ->
+    mercury__shutdown(ForceBadExit) ->
         mercury__io:'ML_io_finalize_state'(),
-        mercury__erlang_builtin:'ML_stop_global_server'().
+        'ML_erlang_global_server' ! {get_exit_status, self()},
+        receive
+            {get_exit_status_ack, ExitStatus0} ->
+                void
+        end,
+        if
+            ExitStatus0 =:= 0 andalso ForceBadExit ->
+                ExitStatus = 1;
+            true ->
+                ExitStatus = ExitStatus0
+        end,
+        mercury__erlang_builtin:'ML_stop_global_server'(),
+        % init:stop is preferred to calling halt but there seems
+        % to be no way to choose the exit code otherwise.
+        case ExitStatus of
+            0 -> void;
+            _ -> halt(ExitStatus)
+        end.
 
     mercury__maybe_dump_stacktrace(StackTrace) ->
         case os:getenv(""MERCURY_SUPPRESS_STACK_TRACE"") of
Index: library/erlang_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/erlang_builtin.m,v
retrieving revision 1.2
diff -u -r1.2 erlang_builtin.m
--- library/erlang_builtin.m	14 Jun 2007 01:50:29 -0000	1.2
+++ library/erlang_builtin.m	21 Jun 2007 07:24:44 -0000
@@ -45,6 +45,7 @@
     [will_not_call_mercury, promise_pure, thread_safe],
 "
     Pid = spawn(fun global_server_loop/0),
+    Pid ! {set_exit_status, 0},
     register('ML_erlang_global_server', Pid)
 ").
 
@@ -101,6 +102,24 @@
             From ! {trace_evaluate_runtime_condition_ack, Ret},
             global_server_loop();
 
+        {init_std_streams, Streams} ->
+            put('ML_std_streams', Streams),
+            global_server_loop();
+
+        {get_std_streams, From} ->
+            Streams = get('ML_std_streams'),
+            From ! {get_std_streams_ack, Streams},
+            global_server_loop();
+
+        {get_exit_status, From} ->
+            ExitStatus = get('ML_exit_status'),
+            From ! {get_exit_status_ack, ExitStatus},
+            global_server_loop();
+
+        {set_exit_status, ExitStatus} ->
+            put('ML_exit_status', ExitStatus),
+            global_server_loop();
+
         {stop, From} ->
             From ! {stop_ack};
 
Index: library/io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.392
diff -u -r1.392 io.m
--- library/io.m	7 Jun 2007 07:23:45 -0000	1.392
+++ library/io.m	21 Jun 2007 07:24:44 -0000
@@ -2465,6 +2465,14 @@
     // XXX as for .NET above
 ").
 
+:- pragma foreign_proc("Erlang",
+    io.clear_err(_Stream::in, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    % XXX as for .NET above
+    void
+").
+
 :- pred io.input_check_err(io.input_stream::in, io.res::out, io::di, io::uo)
     is det.
 
@@ -2517,6 +2525,15 @@
     RetVal = 0;
 }").
 
+:- pragma foreign_proc("Erlang",
+    ferror(_Stream::in, RetVal::out, RetStr::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    % XXX see clearerr
+    RetVal = 0,
+    RetStr = """"
+").
+
 :- pred io.make_err_msg(string::in, string::out, io::di, io::uo) is det.
 
 io.make_err_msg(Msg0, Msg, !IO) :-
@@ -5055,6 +5072,7 @@
 :- pragma foreign_export("Erlang", io.init_state(di, uo), "ML_io_init_state").
 
 io.init_state(!IO) :-
+    init_std_streams(!IO),
     % 
     % In C grades the "current" streams are thread-local values, so can only be
     % set after the MR_Context has been initialised for the initial thread.
@@ -5074,6 +5092,41 @@
     io.set_globals(Globals, !IO),
     io.insert_std_stream_names(!IO).
 
+:- pred init_std_streams(io::di, io::uo) is det.
+
+init_std_streams(!IO).
+
+:- pragma foreign_proc("Erlang",
+    init_std_streams(_IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
+    F = (fun() -> mercury_file_server(group_leader(), 1, []) end),
+    StdinPid = spawn(F),
+    StdoutPid = spawn(F),
+    StderrPid = spawn(F),
+    StdinBinaryPid = spawn(F),
+    StdoutBinaryPid = spawn(F),
+
+    Stdin = {'ML_stream', make_ref(), StdinPid},
+    Stdout = {'ML_stream', make_ref(), StdoutPid},
+    Stderr = {'ML_stream', make_ref(), StderrPid},
+    StdinBinary = {'ML_stream', make_ref(), StdinBinaryPid},
+    StdoutBinary = {'ML_stream', make_ref(), StdoutBinaryPid},
+
+    % Initialise the process dictionary.
+    put('ML_stdin_stream', Stdin),
+    put('ML_stdout_stream', Stdout),
+    put('ML_stderr_stream', Stderr),
+    put('ML_stdin_binary_stream', StdinBinary),
+    put('ML_stdout_binary_stream', StdoutBinary),
+
+    % Save the standard streams to the global server. When we spawn a new
+    % Mercury thread later we will need to look it up in order to initialise
+    % the new process's process dictionary.
+    StdStreams = {Stdin, Stdout, Stderr, StdinBinary, StdoutBinaryPid},
+    'ML_erlang_global_server' ! {init_std_streams, StdStreams}
+").
+
 :- pred io.finalize_state(io::di, io::uo) is det.
 
     % For use by the Mercury runtime.
@@ -6057,13 +6110,248 @@
 static java.lang.Exception MR_io_exception;
 ").
 
+:- pragma foreign_decl("Erlang", "
+
+    % These need to be exported because code in foreign_procs may be inlined
+    % into other modules.  Hence, calls to these functions must be module
+    % qualified as well.
+    %
+-export([
+    mercury_open_stream/2,
+    mercury_close_stream/1,
+    mercury_getc/1,
+    mercury_putback/2,
+    mercury_write_string/2,
+    mercury_write_char/2,
+    mercury_write_int/2,
+    mercury_sync/1,
+    mercury_get_line_number/1,
+    mercury_set_line_number/2,
+    mercury_seek/2,
+
+    % We may want to inline the following by hand to avoid inter-module calls.
+    mercury_current_text_input/0,
+    mercury_current_text_output/0,
+    mercury_current_binary_input/0,
+    mercury_current_binary_output/0,
+    mercury_set_current_text_input/1,
+    mercury_set_current_text_output/1,
+    mercury_set_current_binary_input/1,
+    mercury_set_current_binary_output/1
+]).
+").
+
 :- pragma foreign_code("Erlang", "
 
-mercury_standard_io_stream(Id) ->
-    % See stdlib io.erl.  We don't use the atom standard_io as it only
-    % works with io: functions and not file: functions.
-    IoDevice = group_leader(),
-    {'ML_stream', Id, IoDevice}.
+    % For each open file we have a process running in the background.
+    % This is necessary so we can layer pushback support and line number
+    % tracking on top of what the Erlang runtime provides.
+    %
+mercury_file_server(IoDevice, LineNr0, PutBack0) ->
+    receive
+        {From, close} ->
+            From ! {self(), close_ack},
+            file:close(IoDevice)
+            % XXX check error?
+    ;
+        {From, read_char} ->
+            case PutBack0 of
+                [] ->
+                    case file:read(IoDevice, 1) of
+                        {ok, [Char]} ->
+                            Ret = Char,
+                            LineNr = LineNr0 + one_if_nl(Char);
+                        EofOrError ->
+                            Ret = EofOrError,
+                            LineNr = LineNr0
+                    end,
+                    PutBack = PutBack0;
+                [Char | PutBack] ->
+                    Ret = Char,
+                    LineNr = LineNr0 + one_if_nl(Char)
+            end,
+            From ! {self(), read_char_ack, Ret},
+            mercury_file_server(IoDevice, LineNr, PutBack)
+    ;
+        {From, putback, Char} ->
+            From ! {self(), putback_ack},
+            PutBack = [Char | PutBack0],
+            LineNr = LineNr0 - one_if_nl(Char),
+            mercury_file_server(IoDevice, LineNr, PutBack)
+    ;
+        {From, write_char, Char} ->
+            From ! {self(), write_char_ack},
+            % XXX use file:write with raw streams
+
+            io:put_chars(IoDevice, [Char]),
+            LineNr = LineNr0 + one_if_nl(Char),
+            mercury_file_server(IoDevice, LineNr, PutBack0)
+    ;
+        {From, write_string, Chars} ->
+            From ! {self(), write_string_ack},
+            % XXX use file:write with raw streams
+            io:put_chars(IoDevice, Chars),
+            LineNr = LineNr0 + count_nls(Chars, 0),
+            mercury_file_server(IoDevice, LineNr, PutBack0)
+    ;
+        {From, write_int, Val} ->
+            From ! {self(), write_int_ack},
+            % XXX use file:write with raw streams
+            io:format(IoDevice, ""~B"", [Val]),
+            mercury_file_server(IoDevice, LineNr0, PutBack0)
+    ;
+        {From, sync} ->
+            % XXX file:sync seems to hang if run on a pid, e.g. standard I/O
+            if
+                is_pid(IoDevice) ->
+                    void;
+                true ->
+                    file:sync(IoDevice)
+            end,
+            From ! {self(), sync_ack},
+            mercury_file_server(IoDevice, LineNr0, PutBack0)
+    ;
+        {From, get_line_number} ->
+            From ! {self(), get_line_number_ack, LineNr0},
+            mercury_file_server(IoDevice, LineNr0, PutBack0)
+    ;
+        {From, set_line_number, N} ->
+            From ! {self(), set_line_number_ack},
+            mercury_file_server(IoDevice, N, PutBack0)
+    ;
+        {From, seek, Loc} ->
+            SeekResult = file:position(IoDevice, Loc),
+            From ! {self(), seek_ack, SeekResult},
+            mercury_file_server(IoDevice, LineNr0, PutBack0)
+    ;
+        Other ->
+            io:format(""** io.m: unrecognised message ~p~n"", [Other]),
+            mercury_file_server(IoDevice, LineNr0, PutBack0)
+    end.
+
+one_if_nl($\\n) -> 1;
+one_if_nl(_)    -> 0.
+
+count_nls([], N) -> N;
+count_nls([$\\n | Cs], N) -> count_nls(Cs, N + 1);
+count_nls([_    | Cs], N) -> count_nls(Cs, N).
+
+% Client side.
+
+mercury_open_stream(FileName, Mode) ->
+    case Mode of
+        [$r | _] ->
+            ModeList = [read];
+        [$w | _] ->
+            ModeList = [write];
+        [$a | _] ->
+            ModeList = [append]
+    end,
+    case file:open(FileName, ModeList) of
+        {ok, IoDevice} ->
+            Pid = spawn(fun() -> 
+                mercury_file_server(IoDevice, 1, [])
+            end),
+            StreamId = make_ref(),
+            Stream = {'ML_stream', StreamId, Pid},
+            {ok, Stream};
+        {error, Reason} ->
+            {error, Reason}
+    end.
+
+mercury_close_stream(Stream) ->
+    {'ML_stream', _Id, Pid} = Stream,
+    Pid ! {self(), close},
+    receive
+        {Pid, close_ack} ->
+            void
+    end.
+
+mercury_getc(Stream) ->
+    {'ML_stream', _Id, Pid} = Stream,
+    Pid ! {self(), read_char},
+    receive
+        {Pid, read_char_ack, Ret} ->
+            case Ret of
+                C when is_integer(C) ->
+                    C;
+                eof ->
+                    -1;
+                {error, Reason} ->
+                    put('MR_io_exception', Reason),
+                    -2
+            end
+    end.
+
+mercury_putback(Stream, Character) ->
+    {'ML_stream', _Id, Pid} = Stream,
+    Pid ! {self(), putback, Character},
+    receive
+        {Pid, putback_ack} ->
+            void
+    end.
+
+mercury_write_string(Stream, Characters) ->
+    {'ML_stream', _Id, Pid} = Stream,
+    Pid ! {self(), write_string, Characters},
+    receive
+        {Pid, write_string_ack} ->
+            void
+    end.
+
+mercury_write_char(Stream, Character) ->
+    {'ML_stream', _Id, Pid} = Stream,
+    Pid ! {self(), write_char, Character},
+    receive
+        {Pid, write_char_ack} ->
+            void
+    end.
+
+mercury_write_int(Stream, Value) ->
+    {'ML_stream', _Id, Pid} = Stream,
+    Pid ! {self(), write_int, Value},
+    receive
+        {Pid, write_int_ack} ->
+            void
+    end.
+
+mercury_sync(Stream) ->
+    {'ML_stream', _Id, Pid} = Stream,
+    Pid ! {self(), sync},
+    receive
+        {Pid, sync_ack} ->
+            void
+    end.
+
+mercury_get_line_number(Stream) ->
+    {'ML_stream', _Id, Pid} = Stream,
+    Pid ! {self(), get_line_number},
+    receive
+        {Pid, get_line_number_ack, LineNum} ->
+            LineNum
+    end.
+
+mercury_set_line_number(Stream, LineNum) ->
+    {'ML_stream', _Id, Pid} = Stream,
+    Pid ! {self(), set_line_number, LineNum},
+    receive
+        {Pid, set_line_number_ack} ->
+            void
+    end.
+
+mercury_seek(Stream, Loc) ->
+    {'ML_stream', _Id, Pid} = Stream,
+    Pid ! {self(), seek, Loc},
+    receive
+        {Pid, seek_ack, Result} ->
+            case Result of
+                {ok, NewPosition} ->
+                    NewPosition;
+                {error, Reason} ->
+                    put('MR_io_exception', Reason),
+                    -1
+            end
+    end.
 
 mercury_current_text_input() ->
     get('ML_io_current_text_input').
@@ -6077,24 +6365,18 @@
 mercury_current_binary_output() ->
     get('ML_io_current_binary_output').
 
-set_mercury_current_text_input(Stream) ->
+mercury_set_current_text_input(Stream) ->
     put('ML_io_current_text_input', Stream).
 
-set_mercury_current_text_output(Stream) ->
+mercury_set_current_text_output(Stream) ->
     put('ML_io_current_text_output', Stream).
 
-set_mercury_current_binary_input(Stream) ->
+mercury_set_current_binary_input(Stream) ->
     put('ML_io_current_binary_input', Stream).
 
-set_mercury_current_binary_output(Stream) ->
+mercury_set_current_binary_output(Stream) ->
     put('ML_io_current_binary_output', Stream).
 
-% XXX file:sync seems to hang if run on a pid, e.g. standard I/O
-maybe_sync(File) when is_pid(File) ->
-    void;
-maybe_sync(File) ->
-    file:sync(File).
-
 % We also use the key 'MR_io_exception' in the process dictionary.
 
 ").
@@ -6815,16 +7097,29 @@
     [will_not_call_mercury, promise_pure, tabled_for_io,
         does_not_affect_liveness],
 "
-    {'ML_stream', _Id, IoDevice} = Stream,
-    case file:read(IoDevice, 1) of
-        {ok, [C]} ->
-            CharCode = C;
-        eof ->
-            CharCode = -1;
-        {error, Reason} ->
-            put('MR_io_exception', Reason),
-            CharCode = -2
-    end
+    CharCode = mercury__io:mercury_getc(Stream)
+").
+
+:- pragma foreign_proc("Erlang",
+    io.read_byte_val_2(Stream::in, ByteVal::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io,
+        does_not_affect_liveness],
+"
+    ByteVal = mercury__io:mercury_getc(Stream)
+").
+
+:- pragma foreign_proc("Erlang",
+    io.putback_char_2(File::in, Character::in, _IO0::di, _IO::uo),
+    [may_call_mercury, promise_pure, terminates],
+"
+    mercury__io:mercury_putback(File, Character)
+").
+
+:- pragma foreign_proc("Erlang",
+    io.putback_byte_2(File::in, Byte::in, _IO0::di, _IO::uo),
+    [may_call_mercury, promise_pure, terminates],
+"
+    mercury__io:mercury_putback(File, Byte)
 ").
 
 %-----------------------------------------------------------------------------%
@@ -7068,40 +7363,57 @@
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
         terminates],
 "
-    {'ML_stream', _Id, IoDevice} = mercury_current_text_output(),
-    io:put_chars(IoDevice, Message)
+    Stream = mercury__io:mercury_current_text_output(),
+    mercury__io:mercury_write_string(Stream, Message)
 ").
 :- pragma foreign_proc("Erlang",
     io.write_char(Character::in, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
         terminates],
 "
-    {'ML_stream', _Id, IoDevice} = mercury_current_text_output(),
-    io:put_chars(IoDevice, [Character])
+    Stream = mercury__io:mercury_current_text_output(),
+    mercury__io:mercury_write_char(Stream, Character)
 ").
 :- pragma foreign_proc("Erlang",
     io.write_int(Val::in, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
         terminates],
 "
-    {'ML_stream', _Id, IoDevice} = mercury_current_text_output(),
-    io:format(IoDevice, ""~B"", [Val])
+    Stream = mercury__io:mercury_current_text_output(),
+    mercury__io:mercury_write_int(Stream, Val)
 ").
+
+:- pragma foreign_proc("Erlang",
+    io.write_byte(Byte::in, _IO0::di, _IO::uo),
+    [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
+"
+    Stream = mercury__io:mercury_current_binary_output(),
+    mercury__io:mercury_write_char(Stream, Byte)
+").
+
+:- pragma foreign_proc("Erlang",
+    io.write_bytes(Bytes::in, _IO0::di, _IO::uo),
+    [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
+"
+    Stream = mercury__io:mercury_current_binary_output(),
+    mercury__io:mercury_write_string(Stream, Bytes)
+").
+
 :- pragma foreign_proc("Erlang",
     io.flush_output(_IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
         terminates],
 "
-    {'ML_stream', _Id, IoDevice} = mercury_current_text_output(),
-    maybe_sync(IoDevice)
+    Stream = mercury__io:mercury_current_text_output(),
+    mercury__io:mercury_sync(Stream)
 ").
 :- pragma foreign_proc("Erlang",
     io.flush_binary_output(_IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
         terminates],
 "
-    {'ML_stream', _Id, IoDevice} = mercury_current_binary_output(),
-    maybe_sync(IoDevice)
+    Stream = mercury__io:mercury_current_binary_output(),
+    mercury__io:mercury_sync(Stream)
 ").
 
 io.write_float(Float, !IO) :-
@@ -7503,20 +7815,41 @@
 ").
 
 :- pragma foreign_proc("Erlang",
+    io.seek_binary_2(Stream::in, Flag::in, Off::in, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
+        terminates],
+"
+    % Constants from whence_to_int.
+    case Flag of
+        0 -> Loc = {bof, Off};
+        1 -> Loc = {cur, Off};
+        2 -> Loc = {eof, Off}
+    end,
+    mercury__io:mercury_seek(Stream, Loc)
+    % XXX what to do on error?
+").
+
+:- pragma foreign_proc("Erlang",
+    io.binary_stream_offset_2(Stream::in, Offset::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
+        terminates],
+"
+    Offset = mercury__io:mercury_seek(Stream, cur)
+").
+
+:- pragma foreign_proc("Erlang",
     io.write_char_2(Stream::in, Character::in, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
         terminates],
 "
-    {'ML_stream', _Id, IoDevice} = Stream,
-    io:put_chars(IoDevice, [Character])
+    mercury__io:mercury_write_char(Stream, Character)
 ").
 
 :- pragma foreign_proc("Erlang",
     io.write_int_2(Stream::in, Val::in, _IO0::di, _IO::uo),
     [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
 "
-    {'ML_stream', _Id, IoDevice} = Stream,
-    io:write(IoDevice, Val)
+    mercury__io:mercury_write_int(Stream, Val)
 ").
 
 :- pragma foreign_proc("Erlang",
@@ -7524,8 +7857,21 @@
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
         terminates],
 "
-    {'ML_stream', _Id, IoDevice} = Stream,
-    io:put_chars(IoDevice, Message)
+    mercury__io:mercury_write_string(Stream, Message)
+").
+
+:- pragma foreign_proc("Erlang",
+    io.write_byte_2(Stream::in, Byte::in, _IO0::di, _IO::uo),
+    [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
+"
+    mercury__io:mercury_write_char(Stream, Byte)
+").
+
+:- pragma foreign_proc("Erlang",
+    io.write_bytes_2(Stream::in, Message::in, _IO0::di, _IO::uo),
+    [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
+"
+    mercury__io:mercury_write_string(Stream, Message)
 ").
 
 :- pragma foreign_proc("Erlang",
@@ -7533,17 +7879,15 @@
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
         terminates],
 "
-    {'ML_stream', _Id, IoDevice} = Stream,
-    maybe_sync(IoDevice)
+    mercury__io:mercury_sync(Stream)
 ").
 
 :- pragma foreign_proc("Erlang",
-    io.flush_binary_output(Stream::in, _IO0::di, _IO::uo),
+    io.flush_binary_output_2(Stream::in, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
         terminates],
 "
-    {'ML_stream', _Id, IoDevice} = Stream,
-    maybe_sync(IoDevice)
+    mercury__io:mercury_sync(Stream)
 ").
 
 io.write_float_2(Stream, Float, !IO) :-
@@ -8191,158 +8535,160 @@
     io.stdin_stream_2 = (Stream::out),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "
-    Stream = mercury_standard_io_stream(stdin_io)
+    Stream = get('ML_stdin_stream')
 ").
 
 :- pragma foreign_proc("Erlang",
     io.stdout_stream_2 = (Stream::out),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "
-    Stream = mercury_standard_io_stream(stdout_io)
+    Stream = get('ML_stdout_stream')
+").
+
+:- pragma foreign_proc("Erlang",
+    io.stderr_stream_2 = (Stream::out),
+    [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+"
+    Stream = get('ML_stderr_stream')
 ").
 
 :- pragma foreign_proc("Erlang",
     io.stdin_stream_2(Stream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "
-    Stream = mercury_standard_io_stream(stdin_io)
+    Stream = get('ML_stdin_stream')
 ").
 
 :- pragma foreign_proc("Erlang",
     io.stdout_stream_2(Stream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "
-    Stream = mercury_standard_io_stream(stdout_io)
+    Stream = get('ML_stdout_stream')
 ").
 
 :- pragma foreign_proc("Erlang",
     io.stderr_stream_2(Stream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "
-    % XXX can we do better?
-    Stream = mercury_standard_io_stream(stderr_io)
+    Stream = get('ML_stderr_stream')
 ").
 
 :- pragma foreign_proc("Erlang",
     io.stdin_binary_stream_2(Stream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "
-    Stream = mercury_standard_io_stream(stdin_binary_io)
+    Stream = get('ML_stdin_binary_stream')
 ").
 
 :- pragma foreign_proc("Erlang",
     io.stdout_binary_stream_2(Stream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "
-    Stream = mercury_standard_io_stream(stdout_binary_io)
+    Stream = get('ML_stdout_binary_stream')
 ").
 
 :- pragma foreign_proc("Erlang",
     io.input_stream_2(Stream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    Stream = mercury_current_text_input()
+    Stream = mercury__io:mercury_current_text_input()
 ").
 
 :- pragma foreign_proc("Erlang",
     io.output_stream_2(Stream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    Stream = mercury_current_text_output()
+    Stream = mercury__io:mercury_current_text_output()
 ").
 
 :- pragma foreign_proc("Erlang",
     io.binary_input_stream_2(Stream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    Stream = mercury_current_binary_input()
+    Stream = mercury__io:mercury_current_binary_input()
 ").
 
 :- pragma foreign_proc("Erlang",
     io.binary_output_stream_2(Stream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    Stream = mercury_current_binary_output()
+    Stream = mercury__io:mercury_current_binary_output()
 ").
 
 :- pragma foreign_proc("Erlang",
     io.get_line_number(LineNum::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    % XXX
-    LineNum = 0
+    Stream = mercury__io:mercury_current_text_input(),
+    LineNum = mercury__io:mercury_get_line_number(Stream)
 ").
 
 :- pragma foreign_proc("Erlang",
-    io.get_line_number(_Stream::in, LineNum::out, _IO0::di, _IO::uo),
+    io.get_line_number_2(Stream::in, LineNum::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    % XXX
-    LineNum = 0
+    LineNum = mercury__io:mercury_get_line_number(Stream)
 ").
 
 :- pragma foreign_proc("Erlang",
     io.set_line_number(LineNum::in, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    % XXX LineNum
-    void
+    Stream = mercury__io:mercury_current_text_input(),
+    mercury__io:mercury_set_line_number(Stream, LineNum)
 ").
 
 :- pragma foreign_proc("Erlang",
-    io.set_line_number(Stream::in, LineNum::in, _IO0::di, _IO::uo),
+    io.set_line_number_2(Stream::in, LineNum::in, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    % XXX Stream, LineNum
-    void
+    mercury__io:mercury_set_line_number(Stream, LineNum)
 ").
 
 :- pragma foreign_proc("Erlang",
     io.get_output_line_number(LineNum::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    % XXX
-    LineNum = 0
+    Stream = mercury__io:mercury_current_text_output(),
+    LineNum = mercury__io:mercury_get_line_number(Stream)
 ").
 
 :- pragma foreign_proc("Erlang",
-    io.get_output_line_number(Stream::in, LineNum::out, _IO0::di, _IO::uo),
+    io.get_output_line_number_2(Stream::in, LineNum::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    % XXX Stream
-    LineNum = 0
+    LineNum = mercury__io:mercury_get_line_number(Stream)
 ").
 
 :- pragma foreign_proc("Erlang",
     io.set_output_line_number(LineNum::in, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    % XXX LineNum
-    void
+    Stream = mercury__io:mercury_current_text_output(),
+    mercury__io:mercury_set_line_number(Stream, LineNum)
 ").
 
 :- pragma foreign_proc("Erlang",
-    io.set_output_line_number(Stream::in, LineNum::in, _IO0::di, _IO::uo),
+    io.set_output_line_number_2(Stream::in, LineNum::in, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    % XXX Stream LineNum
-    void
+    mercury__io:mercury_set_line_number(Stream, LineNum)
 ").
 
 :- pragma foreign_proc("Erlang",
     io.set_input_stream_2(NewStream::in, OutStream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    OutStream = mercury_current_text_input(),
-    set_mercury_current_text_input(NewStream)
+    OutStream = mercury__io:mercury_current_text_input(),
+    mercury__io:mercury_set_current_text_input(NewStream)
 ").
 
 :- pragma foreign_proc("Erlang",
     io.set_output_stream_2(NewStream::in, OutStream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    OutStream = mercury_current_text_output(),
-    set_mercury_current_text_output(NewStream)
+    OutStream = mercury__io:mercury_current_text_output(),
+    mercury__io:mercury_set_current_text_output(NewStream)
 ").
 
 :- pragma foreign_proc("Erlang",
@@ -8350,8 +8696,8 @@
         _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    OutStream = mercury_current_binary_input(),
-    set_mercury_current_binary_input(NewStream)
+    OutStream = mercury__io:mercury_current_binary_input(),
+    mercury__io:mercury_set_current_binary_input(NewStream)
 ").
 
 :- pragma foreign_proc("Erlang",
@@ -8359,8 +8705,8 @@
         _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    OutStream = mercury_current_binary_output(),
-    set_mercury_current_binary_output(NewStream)
+    OutStream = mercury__io:mercury_current_binary_output(),
+    mercury__io:mercury_set_current_binary_output(NewStream)
 ").
 
 % Stream open/close predicates.
@@ -8499,18 +8845,10 @@
         StreamId::out, Stream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "
-    case Mode of
-        [$r | _] ->
-            ModeList = [read];
-        [$w | _] ->
-            ModeList = [write];
-        [$a | _] ->
-            ModeList = [append]
-    end,
-    case file:open(FileName, ModeList) of
-        {ok, IoDevice} ->
-            StreamId = make_ref(),
-            Stream = {'ML_stream', StreamId, IoDevice},
+    % Text and binary streams are exactly the same so far.
+    case mercury__io:mercury_open_stream(FileName, Mode) of
+        {ok, Stream} ->
+            {'ML_stream', StreamId, _Pid} = Stream,
             ResultCode = 0;
         {error, Reason} ->
             put('MR_io_exception', Reason),
@@ -8525,26 +8863,10 @@
         StreamId::out, Stream::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "
-    %
-    % XX in older versions, only the functions `read/2' and `write/2' may be
-    % used on binary streams.  None of the functions from the Erlang `io'
-    % module can be used.
-    %
-    % XXX the documentation in `file' suggests that `raw' is required as well,
-    % but that has some limitations and maybe the documentation is out of date
-    %
-    case Mode of
-        [$r | _] ->
-            ModeList = [read, binary];
-        [$w | _] ->
-            ModeList = [write, binary];
-        [$a | _] ->
-            ModeList = [append, binary]
-    end,
-    case file:open(FileName, ModeList) of
-        {ok, IoDevice} ->
-            StreamId = make_ref(),
-            Stream = {'ML_stream', StreamId, IoDevice},
+    % Text and binary streams are exactly the same so far.
+    case mercury__io:mercury_open_stream(FileName, Mode) of
+        {ok, Stream} ->
+            {'ML_stream', StreamId, _Pid} = Stream,
             ResultCode = 0;
         {error, Reason} ->
             put('MR_io_exception', Reason),
@@ -8600,9 +8922,7 @@
     [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
         terminates],
 "
-    {'ML_stream', _Id, IoDevice} = Stream,
-    file:close(IoDevice)
-    % XXX delete ref?
+    mercury__io:mercury_close_stream(Stream)
 ").
 
 % Miscellaneous predicates.
@@ -8845,6 +9165,24 @@
     Args = init:get_plain_arguments()
 ").
 
+:- pragma foreign_proc("Erlang",
+    io.get_exit_status(ExitStatus::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    'ML_erlang_global_server' ! {get_exit_status, self()},
+    receive
+        {get_exit_status_ack, ExitStatus} ->
+            void
+    end
+").
+
+:- pragma foreign_proc("Erlang",
+    io.set_exit_status(ExitStatus::in, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    'ML_erlang_global_server' ! {set_exit_status, ExitStatus}
+").
+
 io.command_line_arguments(Args, IO, IO) :-
     build_command_line_args(0, Args).
 
@@ -9283,6 +9621,73 @@
     }
 ").
 
+:- pragma foreign_proc("Erlang",
+    io.do_make_temp(Dir::in, Prefix::in, Sep::in, FileName::out,
+        Error::out, ErrorMessage::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io,
+        does_not_affect_liveness],
+"
+    % Constructs a temporary name by concatenating Dir, Sep, Prefix
+    % three hex digits, '.', and 3 more hex digits.
+
+    % XXX we should try to mix in the Erlang process id in case two Erlang
+    % processes from the same Unix process are trying to create temporary files
+    % at the same time (it's not as far-fetched as it sounds, e.g. mmc --make)
+
+    MaxTries = 24,
+
+    {A1, A2, A3} = now(),
+    case string:to_integer(os:getpid()) of
+        {Pid, []} ->
+            void;
+        _ ->
+            Pid = 0
+    end,
+    Seed = {A1 + Pid, A2, A3},
+
+    case
+        mercury__io:'ML_do_make_temp_2'(Dir, Prefix, Sep, MaxTries, Seed)
+    of
+        {ok, FileName0} ->
+            FileName = FileName0,
+            Error = 0,
+            ErrorMessage = """";
+        {error, Reason} ->
+            FileName = """",
+            Error = -1,
+            ErrorMessage = Reason
+    end
+").
+
+:- pragma foreign_decl("Erlang", "
+    -export(['ML_do_make_temp_2'/5]).
+").
+:- pragma foreign_code("Erlang", "
+    'ML_do_make_temp_2'(_, _, _, 0, _) ->
+        {error, ""error opening temporary file""};
+    'ML_do_make_temp_2'(Dir, Prefix, Sep, Tries, Seed0) ->
+        {R1, Seed1} = random:uniform_s(16#1000, Seed0),
+        {R2, Seed}  = random:uniform_s(16#1000, Seed1),
+        FileName = lists:flatten(io_lib:format(""~s~s~s~3.16.0B.~3.16.0B"",
+            [Dir, Sep, Prefix, R1, R2])),
+        case filelib:is_file(FileName) of
+            true ->
+                'ML_do_make_temp_2'(Dir, Prefix, Sep, Tries - 1, Seed);
+            false ->
+                case file:open(FileName, [write]) of
+                    {ok, IoDevice} ->
+                        case file:close(IoDevice) of
+                            ok ->
+                                {ok, FileName};
+                            {error, Reason} ->
+                                {error, file:format_error(Reason)}
+                        end;
+                    {error, _} ->
+                        'ML_do_make_temp_2'(Dir, Prefix, Sep, Tries - 1, Seed)
+                end
+        end.
+").
+
 /*---------------------------------------------------------------------------*/
 
 :- pragma foreign_decl("C", "
@@ -9485,8 +9890,9 @@
         ok ->
             RetVal = 0,
             RetStr = """";
-        {error, RetStr} ->
-            RetVal = -1
+        {error, Reason} ->
+            RetVal = -1,
+            RetStr = ""remove failed: "" ++ file:format_error(Reason)
     end
 ").
 
@@ -9616,7 +10022,7 @@
             RetStr = """";
         {error, Reason} ->
             RetVal = -1,
-            RetStr = ""rename_file failed: "" ++ Reason
+            RetStr = ""rename_file failed: "" ++ file:format_error(Reason)
     end
 ").
 
@@ -9770,9 +10176,10 @@
         {ok, TargetFileName} ->
             Status = 1,
             Error = """";
-        {error, Error} ->
+        {error, Reason} ->
             Status = 0,
-            TargetFileName = """"
+            TargetFileName = """",
+            Error = file:format_error(Reason)
     end
 ").
 
Index: tests/general/structure_reuse/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/general/structure_reuse/Mmakefile,v
retrieving revision 1.4
diff -u -r1.4 Mmakefile
--- tests/general/structure_reuse/Mmakefile	12 Jan 2003 22:33:16 -0000	1.4
+++ tests/general/structure_reuse/Mmakefile	21 Jun 2007 07:24:44 -0000
@@ -9,8 +9,8 @@
 	internal_alias		\
 	interpret
 
-# We currently don't do any testing in grade java on this directory.
-ifneq "$(findstring java,$(GRADE))" ""
+# We currently don't do any testing in Java or Erlang grades on this directory.
+ifneq "$(filter java% erlang%,$(GRADE))" ""
 	PROGS=
 else
 	PROGS=$(STRUCTURE_REUSE_PROGS)
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.323
diff -u -r1.323 Mmakefile
--- tests/hard_coded/Mmakefile	14 Jun 2007 02:41:48 -0000	1.323
+++ tests/hard_coded/Mmakefile	21 Jun 2007 07:24:44 -0000
@@ -182,6 +182,7 @@
 	rtree_test \
 	rtti_strings \
 	runtime_opt \
+	seek_test \
 	setjmp_test \
 	shift_test \
 	solve_quadratic \
Index: tests/hard_coded/remove_file.exp2
===================================================================
RCS file: tests/hard_coded/remove_file.exp2
diff -N tests/hard_coded/remove_file.exp2
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/remove_file.exp2	21 Jun 2007 07:24:44 -0000
@@ -0,0 +1,2 @@
+Test passed
+Second remove failed, as expected: remove failed: no such file or directory
Index: tests/hard_coded/seek_test.exp
===================================================================
RCS file: tests/hard_coded/seek_test.exp
diff -N tests/hard_coded/seek_test.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/seek_test.exp	21 Jun 2007 07:24:44 -0000
@@ -0,0 +1 @@
+{ok(97), ok(98), ok(99), ok(100), 11}
Index: tests/hard_coded/seek_test.m
===================================================================
RCS file: tests/hard_coded/seek_test.m
diff -N tests/hard_coded/seek_test.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/seek_test.m	21 Jun 2007 07:24:44 -0000
@@ -0,0 +1,33 @@
+% Simple test of io.seek_binary_input.
+
+:- module seek_test.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+main(!IO) :-
+    io.open_binary_input("seek_test.data", OpenResult, !IO),
+    (
+        OpenResult = ok(Stream),
+        io.read_byte(Stream, ResultA, !IO),
+        io.seek_binary_input(Stream, cur, 4, !IO),
+        io.read_byte(Stream, ResultB, !IO),
+        io.seek_binary_input(Stream, end, -5, !IO),
+        io.read_byte(Stream, ResultC, !IO),
+        io.seek_binary_input(Stream, set, 10, !IO),
+        io.read_byte(Stream, ResultD, !IO),
+        io.binary_input_stream_offset(Stream, Offset, !IO),
+        io.close_binary_input(Stream, !IO),
+        io.print({ResultA, ResultB, ResultC, ResultD, Offset}, !IO),
+        io.nl(!IO)
+    ;
+        OpenResult = error(Error),
+        io.write_string(io.error_message(Error), !IO),
+        io.nl(!IO)
+    ).
+
+% vim: ft=mercury ts=8 sw=4 et wm=0 tw=0
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list