[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