mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 18:03:36 +00:00
library/io.m:
Add a version of io.write_line_cc that takes an explicit stream argument.
NEWS:
Announce the addition.
browser/interactive_query.m:
Use the new predicate.
12930 lines
399 KiB
Mathematica
12930 lines
399 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1993-2012 The University of Melbourne.
|
|
% Copyright (C) 2013-2020 The Mercury team.
|
|
% This file is distributed under the terms specified in COPYING.LIB.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: io.m.
|
|
% Main author: fjh.
|
|
% Stability: medium to high.
|
|
%
|
|
% This file encapsulates all the file I/O.
|
|
%
|
|
% We implement a purely logical I/O system using non-logical I/O primitives of
|
|
% the underlying system. We ensure referential transparency by passing around
|
|
% a ``state-of-the-world'' argument using unique modes. The compiler will check
|
|
% that the state of the world argument is properly single-threaded, and will
|
|
% also ensure that the program doesn't attempt to backtrack over any I/O.
|
|
%
|
|
% Attempting any operation on a stream which has already been closed results
|
|
% in undefined behaviour.
|
|
%
|
|
% In multithreaded programs, each thread in the program has its own set of
|
|
% "current" input and output streams. At the time it is created, a child
|
|
% thread inherits the current streams from its parent. Predicates that
|
|
% change which stream is current affect only the calling thread.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module io.
|
|
:- interface.
|
|
|
|
:- import_module array.
|
|
:- import_module bitmap.
|
|
:- import_module bool.
|
|
:- import_module char.
|
|
:- import_module deconstruct.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module stream.
|
|
:- import_module string.
|
|
:- import_module time.
|
|
:- import_module univ.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Exported types.
|
|
%
|
|
|
|
% The state of the universe.
|
|
%
|
|
:- type io.state.
|
|
|
|
% An alternative, more concise name for `io.state'.
|
|
%
|
|
:- type io == io.state.
|
|
|
|
% Opaque handles for text I/O streams.
|
|
%
|
|
:- type input_stream.
|
|
:- type output_stream.
|
|
|
|
% Alternative names for the above.
|
|
%
|
|
:- type text_input_stream == input_stream.
|
|
:- type text_output_stream == output_stream.
|
|
|
|
% Opaque handles for binary I/O streams.
|
|
%
|
|
:- type binary_input_stream.
|
|
:- type binary_output_stream.
|
|
|
|
% A unique identifier for an I/O stream.
|
|
%
|
|
:- type stream_id.
|
|
|
|
% Various types used for the result from the access predicates.
|
|
%
|
|
:- type res
|
|
---> ok
|
|
; error(io.error).
|
|
|
|
:- type res(T)
|
|
---> ok(T)
|
|
; error(io.error).
|
|
|
|
% maybe_partial_res is used where it is possible to return a partial result
|
|
% when an error occurs.
|
|
%
|
|
:- type maybe_partial_res(T)
|
|
---> ok(T)
|
|
; error(T, io.error).
|
|
|
|
:- type maybe_partial_res_2(T1, T2)
|
|
---> ok2(T1, T2)
|
|
; error2(T1, T2, io.error).
|
|
|
|
:- inst maybe_partial_res(T) for maybe_partial_res/1
|
|
---> ok(T)
|
|
; error(T, ground).
|
|
|
|
:- type result
|
|
---> ok
|
|
; eof
|
|
; error(io.error).
|
|
|
|
:- type result(T)
|
|
---> ok(T)
|
|
; eof
|
|
; error(io.error).
|
|
|
|
% maybe_incomplete_result is returned when reading multibyte values from a
|
|
% binary stream. `incomplete(Bytes)' is returned when at least one byte of
|
|
% a value has already been read but there are insufficient bytes
|
|
% remaining the stream to complete the value. In that case, `Bytes' will
|
|
% contain the bytes that have already been read from the stream, in the
|
|
% order in which they were read.
|
|
%
|
|
:- type maybe_incomplete_result(T)
|
|
---> ok(T)
|
|
; eof
|
|
; incomplete(list(uint8))
|
|
; error(io.error).
|
|
|
|
:- type read_result(T)
|
|
---> ok(T)
|
|
; eof
|
|
; error(string, int). % error message, line number
|
|
|
|
:- type io.error. % Use error_message to decode it.
|
|
|
|
% whence denotes the base for a seek operation.
|
|
% set - seek relative to the start of the file
|
|
% cur - seek relative to the current position in the file
|
|
% end - seek relative to the end of the file.
|
|
%
|
|
:- type whence
|
|
---> set
|
|
; cur
|
|
; end.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Opening and closing streams, both text and binary.
|
|
%
|
|
|
|
% Attempts to open a text file for input.
|
|
% Result is either 'ok(Stream)' or 'error(ErrorCode)'.
|
|
%
|
|
:- pred open_input(string::in, io.res(io.text_input_stream)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Attempts to open a binary file for input.
|
|
% Result is either 'ok(Stream)' or 'error(ErrorCode)'.
|
|
%
|
|
:- pred open_binary_input(string::in,
|
|
io.res(io.binary_input_stream)::out, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Attempts to open a text file for output.
|
|
% Result is either 'ok(Stream)' or 'error(ErrorCode)'.
|
|
%
|
|
:- pred open_output(string::in, io.res(io.text_output_stream)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Attempts to open a file for binary output.
|
|
% Result is either 'ok(Stream)' or 'error(ErrorCode)'.
|
|
%
|
|
:- pred open_binary_output(string::in,
|
|
io.res(io.binary_output_stream)::out, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Attempts to open a text file for appending.
|
|
% Result is either 'ok(Stream)' or 'error(ErrorCode)'.
|
|
%
|
|
:- pred open_append(string::in, io.res(io.text_output_stream)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Attempts to open a file for binary appending.
|
|
% Result is either 'ok(Stream)' or 'error(ErrorCode)'.
|
|
%
|
|
:- pred open_binary_append(string::in,
|
|
io.res(io.binary_output_stream)::out, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Closes an open text input stream.
|
|
% Throw an io.error exception if an I/O error occurs.
|
|
%
|
|
:- pred close_input(io.text_input_stream::in, io::di, io::uo) is det.
|
|
|
|
% Closes an open binary input stream. This will throw an io.error
|
|
% exception if an I/O error occurs.
|
|
%
|
|
:- pred close_binary_input(io.binary_input_stream::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Closes an open text output stream.
|
|
% This will throw an io.error exception if an I/O error occurs.
|
|
%
|
|
:- pred close_output(io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
% Closes an open binary output stream.
|
|
% This will throw an io.error exception if an I/O error occurs.
|
|
%
|
|
:- pred close_binary_output(io.binary_output_stream::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Switching streams.
|
|
%
|
|
|
|
% set_input_stream(NewStream, OldStream, !IO):
|
|
% Changes the current input stream to NewStream.
|
|
% Returns the previous input stream as OldStream.
|
|
%
|
|
:- pred set_input_stream(io.text_input_stream::in,
|
|
io.text_input_stream::out, io::di, io::uo) is det.
|
|
|
|
% Changes the current input stream to the stream specified.
|
|
% Returns the previous stream.
|
|
%
|
|
:- pred set_binary_input_stream(io.binary_input_stream::in,
|
|
io.binary_input_stream::out, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% set_output_stream(NewStream, OldStream, !IO):
|
|
% Changes the current output stream to NewStream.
|
|
% Returns the previous output stream as OldStream.
|
|
%
|
|
:- pred set_output_stream(io.text_output_stream::in,
|
|
io.text_output_stream::out, io::di, io::uo) is det.
|
|
|
|
% Changes the current binary output stream to the stream specified.
|
|
% Returns the previous stream.
|
|
%
|
|
:- pred set_binary_output_stream(io.binary_output_stream::in,
|
|
io.binary_output_stream::out, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Prolog style predicates for opening and switching streams.
|
|
%
|
|
|
|
% see(FileName, Result, !IO):
|
|
% Attempts to open the named file for input, and if successful,
|
|
% sets the current input stream to the newly opened stream.
|
|
% Result is either 'ok' or 'error(ErrorCode)'.
|
|
%
|
|
:- pred see(string::in, io.res::out, io::di, io::uo) is det.
|
|
|
|
% Attempts to open a file for binary input, and if successful sets
|
|
% the current binary input stream to the newly opened stream.
|
|
% Result is either 'ok' or 'error(ErrorCode)'.
|
|
%
|
|
:- pred see_binary(string::in, io.res::out, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% seen(!IO):
|
|
% Closes the current input stream.
|
|
% The current input stream reverts to standard input.
|
|
% This will throw an io.error exception if an I/O error occurs.
|
|
%
|
|
:- pred seen(io::di, io::uo) is det.
|
|
|
|
% Closes the current input stream. The current input stream reverts
|
|
% to standard input. This will throw an io.error exception if
|
|
% an I/O error occurs.
|
|
%
|
|
:- pred seen_binary(io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% tell(FileName, Result, !IO):
|
|
% Attempts to open the named file for output, and if successful,
|
|
% sets the current output stream to the newly opened stream.
|
|
% Result is either 'ok' or 'error(ErrCode)'.
|
|
%
|
|
:- pred tell(string::in, io.res::out, io::di, io::uo) is det.
|
|
|
|
% Attempts to open a file for binary output, and if successful sets
|
|
% the current binary output stream to the newly opened stream.
|
|
% As per Prolog tell/1. Result is either 'ok' or 'error(ErrCode)'.
|
|
%
|
|
:- pred tell_binary(string::in, io.res::out, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% told(!IO):
|
|
% Closes the current output stream.
|
|
% The current output stream reverts to standard output.
|
|
% This will throw an io.error exception if an I/O error occurs.
|
|
%
|
|
:- pred told(io::di, io::uo) is det.
|
|
|
|
% Closes the current binary output stream. The default binary output
|
|
% stream reverts to standard output. As per Prolog told/0. This will
|
|
% throw an io.error exception if an I/O error occurs.
|
|
%
|
|
:- pred told_binary(io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Seeking on binary streams.
|
|
%
|
|
|
|
% Seek to an offset relative to Whence (documented above)
|
|
% on a specified binary input stream. Attempting to seek on a pipe
|
|
% or tty results in implementation dependent behaviour.
|
|
%
|
|
% A successful seek undoes any effects of putback_byte on the stream.
|
|
%
|
|
:- pred seek_binary_input(io.binary_input_stream::in, io.whence::in,
|
|
int::in, io::di, io::uo) is det.
|
|
|
|
% As above, but the offset is always a 64-bit value.
|
|
%
|
|
:- pred seek_binary_input64(io.binary_input_stream::in, io.whence::in,
|
|
int64::in, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Seek to an offset relative to Whence (documented above)
|
|
% on a specified binary output stream. Attempting to seek on a pipe
|
|
% or tty results in implementation dependent behaviour.
|
|
%
|
|
:- pred seek_binary_output(io.binary_output_stream::in, io.whence::in,
|
|
int::in, io::di, io::uo) is det.
|
|
|
|
% As above, but the offset is always a 64-bit value.
|
|
%
|
|
:- pred seek_binary_output64(io.binary_output_stream::in, io.whence::in,
|
|
int64::in, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Returns the offset (in bytes) into the specified binary input stream.
|
|
% Throws an exception if the offset is outside the range that can be
|
|
% represented by the int type. To avoid this possibility, you can use the
|
|
% 64-bit offset version of this predicate below.
|
|
%
|
|
:- pred binary_input_stream_offset(io.binary_input_stream::in, int::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% As above, but the offset is always a 64-bit value.
|
|
%
|
|
:- pred binary_input_stream_offset64(io.binary_input_stream::in, int64::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Returns the offset (in bytes) into the specified binary output stream.
|
|
% Throws an exception if the offset is outside the range that can be
|
|
% represented by the int type. To avoid this possibility, you can use the
|
|
% 64-bit offset version of this predicate below.
|
|
%
|
|
:- pred binary_output_stream_offset(io.binary_output_stream::in, int::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% As above, but the offset is always a 64-bit value.
|
|
%
|
|
:- pred binary_output_stream_offset64(io.binary_output_stream::in, int64::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Standard stream id predicates.
|
|
%
|
|
|
|
% Retrieves the standard input stream.
|
|
%
|
|
:- func stdin_stream = io.text_input_stream.
|
|
|
|
% Retrieves the standard input stream.
|
|
% Does not modify the I/O state.
|
|
%
|
|
:- pred stdin_stream(io.text_input_stream::out, io::di, io::uo) is det.
|
|
|
|
% Retrieves the standard binary input stream.
|
|
% Does not modify the I/O state.
|
|
%
|
|
:- pred stdin_binary_stream(io.binary_input_stream::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Retrieves the standard output stream.
|
|
%
|
|
:- func stdout_stream = io.text_output_stream.
|
|
|
|
% Retrieves the standard output stream.
|
|
% Does not modify the I/O state.
|
|
%
|
|
:- pred stdout_stream(io.text_output_stream::out, io::di, io::uo) is det.
|
|
|
|
% Retrieves the standard binary output stream.
|
|
% Does not modify the I/O state.
|
|
%
|
|
:- pred stdout_binary_stream(io.binary_output_stream::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Retrieves the standard error stream.
|
|
%
|
|
:- func stderr_stream = io.text_output_stream.
|
|
|
|
% Retrieves the standard error stream.
|
|
% Does not modify the I/O state.
|
|
%
|
|
:- pred stderr_stream(io.text_output_stream::out, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Current stream id predicates.
|
|
%
|
|
|
|
% Retrieves the current input stream.
|
|
% Does not modify the I/O state.
|
|
%
|
|
:- pred input_stream(io.text_input_stream::out, io::di, io::uo) is det.
|
|
|
|
% Retrieves the current binary input stream.
|
|
% Does not modify the I/O state.
|
|
%
|
|
:- pred binary_input_stream(io.binary_input_stream::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Retrieves the current output stream.
|
|
% Does not modify the I/O state.
|
|
%
|
|
:- pred output_stream(io.text_output_stream::out, io::di, io::uo) is det.
|
|
|
|
% Retrieves the current binary output stream.
|
|
% Does not modify the I/O state.
|
|
%
|
|
:- pred binary_output_stream(io.binary_output_stream::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Getting and setting stream properties.
|
|
%
|
|
|
|
% Retrieves the human-readable name associated with the current input
|
|
% stream or the specified output stream. For file streams, this is
|
|
% the filename. For stdin, this is the string "<standard input>".
|
|
%
|
|
:- pred input_stream_name(string::out, io::di, io::uo) is det.
|
|
:- pred input_stream_name(io.text_input_stream::in, string::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Retrieves the human-readable name associated with the current binary
|
|
% input stream or the specified binary input stream. For file streams,
|
|
% this is the filename.
|
|
%
|
|
:- pred binary_input_stream_name(string::out, io::di, io::uo) is det.
|
|
:- pred binary_input_stream_name(io.binary_input_stream::in, string::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Retrieves the human-readable name associated with the current
|
|
% output stream or the specified output stream.
|
|
% For file streams, this is the filename.
|
|
% For stdout this is the string "<standard output>".
|
|
% For stderr this is the string "<standard error>".
|
|
%
|
|
:- pred output_stream_name(string::out, io::di, io::uo) is det.
|
|
:- pred output_stream_name(io.text_output_stream::in, string::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Retrieves the human-readable name associated with the current
|
|
% binary output stream or the specified binary output stream.
|
|
% For file streams, this is the filename.
|
|
%
|
|
:- pred binary_output_stream_name(string::out, io::di, io::uo) is det.
|
|
:- pred binary_output_stream_name(io.binary_output_stream::in,
|
|
string::out, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Return the line number of the current input stream or the specified
|
|
% input stream. Lines are normally numbered starting at 1, but this
|
|
% can be overridden by calling set_line_number.
|
|
%
|
|
:- pred get_line_number(int::out, io::di, io::uo) is det.
|
|
:- pred get_line_number(io.text_input_stream::in, int::out, io::di, io::uo)
|
|
is det.
|
|
|
|
% Set the line number of the current input stream or the specified
|
|
% input stream.
|
|
%
|
|
:- pred set_line_number(int::in, io::di, io::uo) is det.
|
|
:- pred set_line_number(io.text_input_stream::in, int::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Return the line number of the current output stream or the
|
|
% specified output stream. Lines are normally numbered starting at 1,
|
|
% but this can be overridden by calling set_output_line_number.
|
|
%
|
|
:- pred get_output_line_number(int::out, io::di, io::uo) is det.
|
|
:- pred get_output_line_number(io.text_output_stream::in, int::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Set the line number of the current output stream.
|
|
%
|
|
:- pred set_output_line_number(int::in, io::di, io::uo) is det.
|
|
:- pred set_output_line_number(io.text_output_stream::in, int::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Reading values of primitive types.
|
|
%
|
|
|
|
% Read a character (code point) from the current input stream
|
|
% or from the specified stream.
|
|
%
|
|
:- pred read_char(io.result(char)::out, io::di, io::uo) is det.
|
|
:- pred read_char(io.text_input_stream::in, io.result(char)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Reads a character (code point) from the specified stream.
|
|
% This interface avoids memory allocation when there is no error.
|
|
%
|
|
:- pred read_char_unboxed(io.text_input_stream::in, io.result::out, char::out,
|
|
io::di, io::uo) is det.
|
|
% NOTE_TO_IMPLEMENTORS there is no version without an explicit stream argument
|
|
|
|
% Un-read a character (code point) from the current input stream
|
|
% or from the specified stream.
|
|
% You can put back as many characters as you like.
|
|
% You can even put back something that you didn't actually read.
|
|
%
|
|
% On some systems and backends, only one byte of pushback is guaranteed.
|
|
% `putback_char' will throw an io.error exception if the pushback buffer
|
|
% is full.
|
|
%
|
|
:- pred putback_char(char::in, io::di, io::uo) is det.
|
|
:- pred putback_char(io.text_input_stream::in, char::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Note that there are no read equivalents of write_int, write_intN,
|
|
% write_uint, write_uintN, or write_float. Mercury programs that want to read
|
|
% numbers must first read in strings, and try to convert the appropriate
|
|
% parts of those strings to numbers. This allows them to handle any errors
|
|
% in that conversion process in whatever way they like. Since there are many
|
|
% possible ways to handle conversion failures, it is not very likely that
|
|
% a programmer's chosen method would agree with the one used by a
|
|
% system-supplied predicate for reading in e.g. floats, if this module had one.
|
|
|
|
%---------------------%
|
|
|
|
% Reads a single 8-bit byte from the current binary input stream
|
|
% or from the specified binary input stream.
|
|
%
|
|
:- pred read_byte(io.result(int)::out, io::di, io::uo) is det.
|
|
:- pred read_byte(io.binary_input_stream::in, io.result(int)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Reads a single signed 8-bit integer from the current binary input
|
|
% stream or from the specified binary input stream.
|
|
%
|
|
:- pred read_binary_int8(io.result(int8)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_int8(io.binary_input_stream::in, io.result(int8)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Reads a single unsigned 8-bit integer from the current binary input
|
|
% stream or from the specified binary input stream.
|
|
%
|
|
:- pred read_binary_uint8(io.result(uint8)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_uint8(io.binary_input_stream::in, io.result(uint8)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Un-reads a byte from the current binary input stream or from the
|
|
% specified stream. The byte is taken from the bottom 8 bits of the
|
|
% specified int.
|
|
%
|
|
% You can put back as many bytes as you like.
|
|
% You can even put back something that you did not actually read.
|
|
%
|
|
% On some systems and backends, only one byte of pushback is guaranteed.
|
|
% `putback_byte' will throw an io.error exception if the pushback buffer
|
|
% is full.
|
|
%
|
|
% Pushing back a byte decrements the file position by one, except when
|
|
% the file position is already zero, in which case the new file position
|
|
% is unspecified.
|
|
%
|
|
:- pred putback_byte(int::in, io::di, io::uo) is det.
|
|
:- pred putback_byte(io.binary_input_stream::in, int::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Like putback_byte, but where the byte value un-read is the 8 bits of the
|
|
% int8 reinterpreted as a uint8.
|
|
%
|
|
:- pred putback_int8(int8::in, io::di, io::uo) is det.
|
|
:- pred putback_int8(io.binary_input_stream::in, int8::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Like putback_byte, but where the byte value un-read is the 8 bits of the
|
|
% uint8.
|
|
%
|
|
:- pred putback_uint8(uint8::in, io::di, io::uo) is det.
|
|
:- pred putback_uint8(io.binary_input_stream::in, uint8::in, io::di, io::uo)
|
|
is det.
|
|
|
|
%---------------------%
|
|
|
|
% The following predicates read multibyte integer values, either from
|
|
% the current binary input stream, or from the specified binary
|
|
% input stream.
|
|
%
|
|
% The names of these predicates have the form:
|
|
%
|
|
% read_binary_<TYPE><SUFFIX>
|
|
%
|
|
% where <TYPE> is the name of one of the Mercury multibyte fixed size
|
|
% integer types. The optional <SUFFIX> specifies the order in which
|
|
% the bytes that make up the multibyte integer occur in input stream.
|
|
% The suffix may be one of:
|
|
%
|
|
% "_le": the bytes are in little endian byte order.
|
|
% "_be": the bytes are in big endian byte order.
|
|
% none: the bytes are in the byte order of the underlying platform.
|
|
|
|
:- pred read_binary_int16(maybe_incomplete_result(int16)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_int16(io.binary_input_stream::in,
|
|
maybe_incomplete_result(int16)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_int16_le(maybe_incomplete_result(int16)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_int16_le(io.binary_input_stream::in,
|
|
maybe_incomplete_result(int16)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_int16_be(maybe_incomplete_result(int16)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_int16_be(io.binary_input_stream::in,
|
|
maybe_incomplete_result(int16)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_uint16(maybe_incomplete_result(uint16)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_uint16(io.binary_input_stream::in,
|
|
maybe_incomplete_result(uint16)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_uint16_le(maybe_incomplete_result(uint16)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_uint16_le(io.binary_input_stream::in,
|
|
maybe_incomplete_result(uint16)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_uint16_be(maybe_incomplete_result(uint16)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_uint16_be(io.binary_input_stream::in,
|
|
maybe_incomplete_result(uint16)::out, io::di, io::uo) is det.
|
|
|
|
:- pred read_binary_int32(maybe_incomplete_result(int32)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_int32(io.binary_input_stream::in,
|
|
maybe_incomplete_result(int32)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_int32_le(maybe_incomplete_result(int32)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_int32_le(io.binary_input_stream::in,
|
|
maybe_incomplete_result(int32)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_int32_be(maybe_incomplete_result(int32)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_int32_be(io.binary_input_stream::in,
|
|
maybe_incomplete_result(int32)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_uint32(maybe_incomplete_result(uint32)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_uint32(io.binary_input_stream::in,
|
|
maybe_incomplete_result(uint32)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_uint32_le(maybe_incomplete_result(uint32)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_uint32_le(io.binary_input_stream::in,
|
|
maybe_incomplete_result(uint32)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_uint32_be(maybe_incomplete_result(uint32)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_uint32_be(io.binary_input_stream::in,
|
|
maybe_incomplete_result(uint32)::out, io::di, io::uo) is det.
|
|
|
|
:- pred read_binary_int64(maybe_incomplete_result(int64)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_int64(io.binary_input_stream::in,
|
|
maybe_incomplete_result(int64)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_int64_le(maybe_incomplete_result(int64)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_int64_le(io.binary_input_stream::in,
|
|
maybe_incomplete_result(int64)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_int64_be(maybe_incomplete_result(int64)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_int64_be(io.binary_input_stream::in,
|
|
maybe_incomplete_result(int64)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_uint64(maybe_incomplete_result(uint64)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_uint64(io.binary_input_stream::in,
|
|
maybe_incomplete_result(uint64)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_uint64_le(maybe_incomplete_result(uint64)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_uint64_le(io.binary_input_stream::in,
|
|
maybe_incomplete_result(uint64)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_uint64_be(maybe_incomplete_result(uint64)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_binary_uint64_be(io.binary_input_stream::in,
|
|
maybe_incomplete_result(uint64)::out, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Writing values of primitive types.
|
|
%
|
|
|
|
% Writes a character to the current output stream
|
|
% or to the specified output stream.
|
|
%
|
|
:- pred write_char(char::in, io::di, io::uo) is det.
|
|
:- pred write_char(io.text_output_stream::in, char::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Writes a signed or unsigned integer to the current output stream
|
|
% or to the specified output stream.
|
|
%
|
|
:- pred write_int(int::in, io::di, io::uo) is det.
|
|
:- pred write_int(io.text_output_stream::in, int::in, io::di, io::uo) is det.
|
|
:- pred write_uint(uint::in, io::di, io::uo) is det.
|
|
:- pred write_uint(io.text_output_stream::in, uint::in, io::di, io::uo) is det.
|
|
|
|
% Write a signed or unsigned 8-bit integer to the current output stream
|
|
% or to the specified output stream.
|
|
%
|
|
:- pred write_int8(int8::in, io::di, io::uo) is det.
|
|
:- pred write_int8(io.text_output_stream::in, int8::in, io::di, io::uo) is det.
|
|
:- pred write_uint8(uint8::in, io::di, io::uo) is det.
|
|
:- pred write_uint8(io.text_output_stream::in, uint8::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Write a signed or unsigned 16-bit integer to the current output stream
|
|
% or to the specified output stream.
|
|
%
|
|
:- pred write_int16(int16::in, io::di, io::uo) is det.
|
|
:- pred write_int16(io.text_output_stream::in, int16::in, io::di, io::uo)
|
|
is det.
|
|
:- pred write_uint16(uint16::in, io::di, io::uo) is det.
|
|
:- pred write_uint16(io.text_output_stream::in, uint16::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Write a signed or unsigned 32-bit integer to the current output stream
|
|
% or to the specified output stream.
|
|
%
|
|
:- pred write_int32(int32::in, io::di, io::uo) is det.
|
|
:- pred write_int32(io.text_output_stream::in, int32::in, io::di, io::uo)
|
|
is det.
|
|
:- pred write_uint32(uint32::in, io::di, io::uo) is det.
|
|
:- pred write_uint32(io.text_output_stream::in, uint32::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Write a signed or unsigned 64-bit integer to the current output stream
|
|
% or to the specified output stream.
|
|
%
|
|
:- pred write_int64(int64::in, io::di, io::uo) is det.
|
|
:- pred write_int64(io.text_output_stream::in, int64::in, io::di, io::uo)
|
|
is det.
|
|
:- pred write_uint64(uint64::in, io::di, io::uo) is det.
|
|
:- pred write_uint64(io.text_output_stream::in, uint64::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Writes a floating point number to the current output stream
|
|
% or to the specified output stream.
|
|
%
|
|
:- pred write_float(float::in, io::di, io::uo) is det.
|
|
:- pred write_float(io.text_output_stream::in, float::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Writes a string to the current output stream or to the
|
|
% specified output stream.
|
|
%
|
|
:- pred write_string(string::in, io::di, io::uo) is det.
|
|
:- pred write_string(io.text_output_stream::in, string::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Writes a newline character to the current output stream
|
|
% or to the specified stream.
|
|
%
|
|
:- pred nl(io::di, io::uo) is det.
|
|
:- pred nl(io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Writes a single byte to the current binary output stream
|
|
% or to the specified binary output stream. The byte is taken from
|
|
% the bottom 8 bits of the specified int.
|
|
%
|
|
:- pred write_byte(int::in, io::di, io::uo) is det.
|
|
:- pred write_byte(io.binary_output_stream::in, int::in, io::di, io::uo)
|
|
is det.
|
|
|
|
% Writes a signed or unsigned 8-bit integer to the current binary
|
|
% output stream or to the specified binary output stream.
|
|
%
|
|
:- pred write_binary_int8(int8::in, io::di, io::uo) is det.
|
|
:- pred write_binary_int8(io.binary_output_stream::in, int8::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_uint8(uint8::in, io::di, io::uo) is det.
|
|
:- pred write_binary_uint8(io.binary_output_stream::in, uint8::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% The following predicates write multibyte integer values, either to the
|
|
% current binary output stream, or to the specified binary output stream.
|
|
%
|
|
% These names of these predicates have the form:
|
|
%
|
|
% write_binary_<TYPE><SUFFIX>
|
|
%
|
|
% where <TYPE> is the name of one of the Mercury multibyte fixed size
|
|
% integer types. The optional <SUFFIX> specifies the order in which
|
|
% the bytes that make up the multibyte integer are written to the stream.
|
|
% The suffix may be one of:
|
|
%
|
|
% "_le": the bytes are in little endian byte order.
|
|
% "_be": the bytes are in big endian byte order.
|
|
% none: the bytes are in the byte order of the underlying platform.
|
|
|
|
:- pred write_binary_int16(int16::in, io::di, io::uo) is det.
|
|
:- pred write_binary_int16(io.binary_output_stream::in, int16::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_uint16(uint16::in, io::di, io::uo) is det.
|
|
:- pred write_binary_uint16(io.binary_output_stream::in, uint16::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_int16_le(int16::in, io::di, io::uo) is det.
|
|
:- pred write_binary_int16_le(io.binary_output_stream::in, int16::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_uint16_le(uint16::in, io::di, io::uo) is det.
|
|
:- pred write_binary_uint16_le(io.binary_output_stream::in, uint16::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_int16_be(int16::in, io::di, io::uo) is det.
|
|
:- pred write_binary_int16_be(io.binary_output_stream::in, int16::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_uint16_be(uint16::in, io::di, io::uo) is det.
|
|
:- pred write_binary_uint16_be(io.binary_output_stream::in, uint16::in,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pred write_binary_int32(int32::in, io::di, io::uo) is det.
|
|
:- pred write_binary_int32(io.binary_output_stream::in, int32::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_uint32(uint32::in, io::di, io::uo) is det.
|
|
:- pred write_binary_uint32(io.binary_output_stream::in, uint32::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_int32_le(int32::in, io::di, io::uo) is det.
|
|
:- pred write_binary_int32_le(io.binary_output_stream::in, int32::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_uint32_le(uint32::in, io::di, io::uo) is det.
|
|
:- pred write_binary_uint32_le(io.binary_output_stream::in, uint32::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_int32_be(int32::in, io::di, io::uo) is det.
|
|
:- pred write_binary_int32_be(io.binary_output_stream::in, int32::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_uint32_be(uint32::in, io::di, io::uo) is det.
|
|
:- pred write_binary_uint32_be(io.binary_output_stream::in, uint32::in,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pred write_binary_int64(int64::in, io::di, io::uo) is det.
|
|
:- pred write_binary_int64(io.binary_output_stream::in, int64::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_uint64(uint64::in, io::di, io::uo) is det.
|
|
:- pred write_binary_uint64(io.binary_output_stream::in, uint64::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_int64_le(int64::in, io::di, io::uo) is det.
|
|
:- pred write_binary_int64_le(io.binary_output_stream::in, int64::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_uint64_le(uint64::in, io::di, io::uo) is det.
|
|
:- pred write_binary_uint64_le(io.binary_output_stream::in, uint64::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_int64_be(int64::in, io::di, io::uo) is det.
|
|
:- pred write_binary_int64_be(io.binary_output_stream::in, int64::in,
|
|
io::di, io::uo) is det.
|
|
:- pred write_binary_uint64_be(uint64::in, io::di, io::uo) is det.
|
|
:- pred write_binary_uint64_be(io.binary_output_stream::in, uint64::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Text input predicates.
|
|
%
|
|
|
|
% Read a whitespace delimited word from the current input stream
|
|
% or from the specified stream.
|
|
%
|
|
% See `char.is_whitespace' for the definition of whitespace characters
|
|
% used by this predicate.
|
|
%
|
|
:- pred read_word(io.result(list(char))::out, io::di, io::uo) is det.
|
|
:- pred read_word(io.text_input_stream::in, io.result(list(char))::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Read a line from the current input stream or from the specified
|
|
% stream, returning the result as a list of characters (code points).
|
|
%
|
|
% See the documentation for `string.line' for the definition of a line.
|
|
%
|
|
:- pred read_line(io.result(list(char))::out, io::di, io::uo) is det.
|
|
:- pred read_line(io.text_input_stream::in, io.result(list(char))::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Read a line from the current input stream or from the specified
|
|
% stream, returning the result as a string.
|
|
%
|
|
% See the documentation for `string.line' for the definition of a line.
|
|
%
|
|
% WARNING: the returned string is NOT guaranteed to be valid UTF-8
|
|
% or UTF-16.
|
|
%
|
|
:- pred read_line_as_string(io.result(string)::out, io::di, io::uo) is det.
|
|
:- pred read_line_as_string(io.text_input_stream::in, io.result(string)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Discards all the whitespace characters satisfying `char.is_whitespace'
|
|
% from the current stream or from the specified stream.
|
|
%
|
|
:- pred ignore_whitespace(io.result::out, io::di, io::uo) is det.
|
|
:- pred ignore_whitespace(io.text_input_stream::in, io.result::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Bitmap input and output predicates.
|
|
%
|
|
|
|
% Fill a bitmap from the current binary input stream
|
|
% or from the specified binary input stream.
|
|
% Return the number of bytes read. On end-of-file, the number of
|
|
% bytes read will be less than the size of the bitmap, and
|
|
% the result will be `ok'.
|
|
% Throws an exception if the bitmap has a partial final byte.
|
|
%
|
|
:- pred read_bitmap(bitmap::bitmap_di, bitmap::bitmap_uo,
|
|
int::out, io.res::out, io::di, io::uo) is det.
|
|
:- pred read_bitmap(io.binary_input_stream::in,
|
|
bitmap::bitmap_di, bitmap::bitmap_uo,
|
|
int::out, io.res::out, io::di, io::uo) is det.
|
|
|
|
% read_bitmap(StartByte, NumBytes, !Bitmap, BytesRead, Result, !IO)
|
|
%
|
|
% Read NumBytes bytes into a bitmap starting at StartByte from the
|
|
% current binary input stream, or from the specified binary input stream.
|
|
% Return the number of bytes read. On end-of-file, the number of
|
|
% bytes read will be less than NumBytes, and the result will be `ok'.
|
|
%
|
|
:- pred read_bitmap(byte_index::in, num_bytes::in,
|
|
bitmap::bitmap_di, bitmap::bitmap_uo, num_bytes::out, io.res::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_bitmap(io.binary_input_stream::in, byte_index::in, num_bytes::in,
|
|
bitmap::bitmap_di, bitmap::bitmap_uo, num_bytes::out, io.res::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Write a bitmap to the current binary output stream
|
|
% or to the specified binary output stream. The bitmap must not contain
|
|
% a partial final byte.
|
|
%
|
|
:- pred write_bitmap(bitmap, io, io).
|
|
%:- mode write_bitmap(bitmap_ui, di, uo) is det.
|
|
:- mode write_bitmap(in, di, uo) is det.
|
|
:- pred write_bitmap(io.binary_output_stream, bitmap, io, io).
|
|
%:- mode write_bitmap(in, bitmap_ui, di, uo) is det.
|
|
:- mode write_bitmap(in, in, di, uo) is det.
|
|
|
|
% write_bitmap(BM, StartByte, NumBytes, !IO):
|
|
% write_bitmap(Stream, BM, StartByte, NumBytes, !IO):
|
|
%
|
|
% Write part of a bitmap to the current binary output stream
|
|
% or to the specified binary output stream.
|
|
%
|
|
:- pred write_bitmap(bitmap, int, int, io, io).
|
|
%:- mode write_bitmap(bitmap_ui, in, in, di, uo) is det.
|
|
:- mode write_bitmap(in, in, in, di, uo) is det.
|
|
:- pred write_bitmap(io.binary_output_stream, bitmap, int, int, io, io).
|
|
%:- mode write_bitmap(in, bitmap_ui, in, in, di, uo) is det.
|
|
:- mode write_bitmap(in, in, in, in, di, uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Reading values of arbitrary types.
|
|
%
|
|
|
|
% Read a ground term of any type, written using standard Mercury syntax,
|
|
% from the current stream or from the specified input stream.
|
|
% The type of the term read is determined by the context from which
|
|
% `io.read' is called.
|
|
%
|
|
% This predicate reads the input stream until reaching one of
|
|
% an end-of-term token, end-of-file, or I/O error.
|
|
%
|
|
% - If it finds no non-whitespace characters before the end-of-file,
|
|
% then it returns `eof'.
|
|
%
|
|
% - If it finds a sequence of tokens ending with an end-of-term token,
|
|
% which is a `.' followed by whitespace, then it leaves the trailing
|
|
% whitespace in the input stream, and decides what to do based on
|
|
% the contents of the token sequence before the end-of-term token.
|
|
%
|
|
% - If the tokens form a syntactically correct ground term of the
|
|
% expected type, then it returns `ok(Term)'.
|
|
%
|
|
% - If tokens do not form a syntactically correct term, or if the term
|
|
% they form is not ground, or if the term is not a valid term of the
|
|
% expected type, then it returns `error(Message, LineNumber)'.
|
|
%
|
|
% - If it encounters an I/O error, then it also returns
|
|
% `error(Message, LineNumber)'.
|
|
%
|
|
% See `char.is_whitespace' for the definition of whitespace characters
|
|
% used by this predicate.
|
|
%
|
|
:- pred read(io.read_result(T)::out, io::di, io::uo) is det.
|
|
:- pred read(io.text_input_stream::in, io.read_result(T)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% The type `posn' represents a position within a string.
|
|
%
|
|
:- type posn
|
|
---> posn(
|
|
% The first two fields are used only for computing
|
|
% term contexts, for use e.g. in error messages.
|
|
%
|
|
% Line numbers start at 1; offsets start at zero.
|
|
% So the usual posn at the start of a file is posn(1, 0, 0).
|
|
posn_current_line_number :: int,
|
|
posn_offset_of_start_of_line :: int,
|
|
posn_current_offset :: int
|
|
).
|
|
|
|
% read_from_string(FileName, String, MaxPos, Result, Posn0, Posn):
|
|
%
|
|
% Does the same job as read/4, but reads from a string, not from a stream.
|
|
%
|
|
% FileName is the name of the source (for use in error messages).
|
|
% String is the string to be parsed.
|
|
% Posn0 is the position to start parsing from.
|
|
% Posn is the position one past where the term read in ends.
|
|
% MaxPos is the offset in the string which should be considered the
|
|
% end-of-stream -- this is the upper bound for Posn.
|
|
% (In the usual case, MaxPos is just the length of the String.)
|
|
% WARNING: if MaxPos > length of String, then the behaviour is UNDEFINED.
|
|
%
|
|
:- pred read_from_string(string::in, string::in, int::in, read_result(T)::out,
|
|
posn::in, posn::out) is det.
|
|
|
|
% Reads a binary representation of a term of type T from the current
|
|
% binary input stream or from the specified binary input stream.
|
|
%
|
|
% Note: if you attempt to read a binary representation written by
|
|
% a different program, or a different version of the same program,
|
|
% then the results are not guaranteed to be meaningful. Another caveat
|
|
% is that higher-order types cannot be read. (If you try, you will get
|
|
% a runtime error.)
|
|
%
|
|
% XXX Note also that in the current implementation, read_binary
|
|
% will not work on the Java back-end.
|
|
%
|
|
:- pred read_binary(io.result(T)::out, io::di, io::uo) is det.
|
|
:- pred read_binary(io.binary_input_stream::in, io.result(T)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Writing values of arbitrary types.
|
|
%
|
|
|
|
% These will all throw an io.error exception if an I/O error occurs.
|
|
|
|
% print/3 writes its argument to the standard output stream.
|
|
% print/4 writes its second argument to the output stream specified in
|
|
% its first argument. In all cases, the argument to output can be of any
|
|
% type. It is output in a format that is intended to be human readable.
|
|
%
|
|
% If the argument is just a single string or character, it will be printed
|
|
% out exactly as is (unquoted). If the argument is of type integer (i.e.
|
|
% an arbitrary precision integer), then its decimal representation will be
|
|
% printed. If the argument is of type univ, then the value stored in the
|
|
% the univ will be printed out, but not the type. If the argument is of
|
|
% type date_time, it will be printed out in the same form as the string
|
|
% returned by the function date_to_string/1. If the argument is of type
|
|
% duration, it will be printed out in the same form as the string
|
|
% returned by the function duration_to_string/1.
|
|
%
|
|
% print/5 is the same as print/4 except that it allows the caller to
|
|
% specify how non-canonical types should be handled. print/3 and
|
|
% print/4 implicitly specify `canonicalize' as the method for handling
|
|
% non-canonical types. This means that for higher-order types, or types
|
|
% with user-defined equality axioms, or types defined using the foreign
|
|
% language interface (i.e. pragma foreign_type), the text output will only
|
|
% describe the type that is being printed, not the value.
|
|
%
|
|
% print_cc/3 is the same as print/3 except that it specifies
|
|
% `include_details_cc' rather than `canonicalize'. This means that it will
|
|
% print the details of non-canonical types. However, it has determinism
|
|
% `cc_multi'.
|
|
%
|
|
% Note that even if `include_details_cc' is specified, some implementations
|
|
% may not be able to print all the details for higher-order types or types
|
|
% defined using the foreign language interface.
|
|
%
|
|
:- pred print(T::in, io::di, io::uo) is det.
|
|
:- pred print(io.text_output_stream::in, T::in, io::di, io::uo) is det.
|
|
|
|
:- pred print(io.text_output_stream, deconstruct.noncanon_handling, T, io, io).
|
|
:- mode print(in, in(do_not_allow), in, di, uo) is det.
|
|
:- mode print(in, in(canonicalize), in, di, uo) is det.
|
|
:- mode print(in, in(include_details_cc), in, di, uo) is cc_multi.
|
|
:- mode print(in, in, in, di, uo) is cc_multi.
|
|
|
|
:- pred print_cc(T::in, io::di, io::uo) is cc_multi.
|
|
|
|
% print_line calls print and then writes a newline character.
|
|
%
|
|
:- pred print_line(T::in, io::di, io::uo) is det.
|
|
:- pred print_line(io.text_output_stream::in, T::in, io::di, io::uo) is det.
|
|
|
|
:- pred print_line(io.text_output_stream, deconstruct.noncanon_handling,
|
|
T, io, io).
|
|
:- mode print_line(in, in(do_not_allow), in, di, uo) is det.
|
|
:- mode print_line(in, in(canonicalize), in, di, uo) is det.
|
|
:- mode print_line(in, in(include_details_cc), in, di, uo) is cc_multi.
|
|
:- mode print_line(in, in, in, di, uo) is cc_multi.
|
|
|
|
:- pred print_line_cc(T::in, io::di, io::uo) is cc_multi.
|
|
|
|
% write/3 writes its argument to the current output stream.
|
|
% write/4 writes its second argument to the output stream specified
|
|
% in its first argument. In all cases, the argument to output may be
|
|
% of any type. The argument is written in a format that is intended to
|
|
% be valid Mercury syntax whenever possible.
|
|
%
|
|
% Strings and characters are always printed out in quotes, using backslash
|
|
% escapes if necessary and backslash or octal escapes for all characters
|
|
% for which char.is_control/1 is true. For higher-order types, or for types
|
|
% defined using the foreign language interface (pragma foreign_type), the
|
|
% text output will only describe the type that is being printed, not the
|
|
% value, and the result may not be parsable by `read'. For the types
|
|
% containing existential quantifiers, the type `type_desc' and closure
|
|
% types, the result may not be parsable by `read', either. But in all other
|
|
% cases the format used is standard Mercury syntax, and if you append a
|
|
% period and newline (".\n"), then the results can be read in again using
|
|
% `read'.
|
|
%
|
|
% write/5 is the same as write/4 except that it allows the caller
|
|
% to specify how non-canonical types should be handled. write_cc/3
|
|
% is the same as write/3 except that it specifies `include_details_cc'
|
|
% rather than `canonicalize'.
|
|
%
|
|
:- pred write(T::in, io::di, io::uo) is det.
|
|
:- pred write(io.text_output_stream::in, T::in, io::di, io::uo) is det.
|
|
|
|
:- pred write(io.text_output_stream, deconstruct.noncanon_handling, T, io, io).
|
|
:- mode write(in, in(do_not_allow), in, di, uo) is det.
|
|
:- mode write(in, in(canonicalize), in, di, uo) is det.
|
|
:- mode write(in, in(include_details_cc), in, di, uo) is cc_multi.
|
|
:- mode write(in, in, in, di, uo) is cc_multi.
|
|
|
|
:- pred write_cc(T::in, io::di, io::uo) is cc_multi.
|
|
:- pred write_cc(io.text_output_stream::in, T::in, io::di, io::uo) is cc_multi.
|
|
|
|
% write_line calls write and then writes a newline character.
|
|
%
|
|
:- pred write_line(T::in, io::di, io::uo) is det.
|
|
:- pred write_line(io.text_output_stream::in, T::in, io::di, io::uo) is det.
|
|
|
|
:- pred write_line(io.text_output_stream, deconstruct.noncanon_handling, T,
|
|
io, io).
|
|
:- mode write_line(in, in(do_not_allow), in, di, uo) is det.
|
|
:- mode write_line(in, in(canonicalize), in, di, uo) is det.
|
|
:- mode write_line(in, in(include_details_cc), in, di, uo) is cc_multi.
|
|
:- mode write_line(in, in, in, di, uo) is cc_multi.
|
|
|
|
:- pred write_line_cc(T::in, io::di, io::uo) is cc_multi.
|
|
:- pred write_line_cc(io.text_output_stream::in, T::in, io::di, io::uo)
|
|
is cc_multi.
|
|
|
|
% Writes a binary representation of a term to the current binary output
|
|
% stream or to the specified stream, in a format suitable for reading in
|
|
% again with read_binary.
|
|
%
|
|
:- pred write_binary(T::in, io::di, io::uo) is det.
|
|
:- pred write_binary(io.binary_output_stream::in, T::in, io::di, io::uo)
|
|
is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Formatted output.
|
|
%
|
|
|
|
% Formats the specified arguments according to the format string,
|
|
% using string.format, and then writes the result to the current
|
|
% output stream or to the specified output stream.
|
|
% (See the documentation of string.format for details.)
|
|
%
|
|
:- pred format(string::in, list(poly_type)::in, io::di, io::uo) is det.
|
|
:- pred format(io.text_output_stream::in, string::in, list(poly_type)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Writing out several values.
|
|
%
|
|
|
|
% Writes a list of strings to the current output stream
|
|
% or to the specified output stream.
|
|
%
|
|
:- pred write_strings(list(string)::in, io::di, io::uo) is det.
|
|
:- pred write_strings(io.text_output_stream::in, list(string)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
% Writes the specified arguments to the current output stream
|
|
% or to the specified output stream.
|
|
%
|
|
:- pred write_many(list(poly_type)::in, io::di, io::uo) is det.
|
|
:- pred write_many(io.text_output_stream::in, list(poly_type)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
% write_list(List, Separator, OutputPred, !IO):
|
|
% write_list(Stream, List, Separator, OutputPred, !IO):
|
|
%
|
|
% Applies OutputPred to each element of List, printing Separator
|
|
% (to the current output stream or to Stream) between each element.
|
|
%
|
|
:- pred write_list(list(T), string, pred(T, io, io), io, io).
|
|
:- mode write_list(in, in, pred(in, di, uo) is det, di, uo) is det.
|
|
:- mode write_list(in, in, pred(in, di, uo) is cc_multi, di, uo)
|
|
is cc_multi.
|
|
|
|
% write_list(Stream, List, Separator, OutputPred, !IO):
|
|
% Sets the current output stream to Stream, then applies OutputPred to
|
|
% each element of List, printing Separator between each element.
|
|
% The original output stream is restored whether returning normally
|
|
% or if an exception is thrown.
|
|
%
|
|
:- pred write_list(io.text_output_stream, list(T), string,
|
|
pred(T, io, io), io, io).
|
|
:- mode write_list(in, in, in, pred(in, di, uo) is det, di, uo) is det.
|
|
:- mode write_list(in, in, in, pred(in, di, uo) is cc_multi, di, uo)
|
|
is cc_multi.
|
|
|
|
% write_array(Array, Separator, OutputPred, !IO):
|
|
% Applies OutputPred to each element of Array, printing Separator
|
|
% to the current output stream between each element.
|
|
%
|
|
:- pred write_array(array(T), string, pred(T, io, io), io, io).
|
|
:- mode write_array(in, in, pred(in, di, uo) is det, di, uo) is det.
|
|
%:- mode write_array(array_ui, in, pred(in, di, uo) is det, di uo) is det.
|
|
:- mode write_array(in, in, pred(in, di, uo) is cc_multi, di, uo) is cc_multi.
|
|
%:- mode write_array(array_ui, in, pred(in, di, uo) is cc_multi, di uo)
|
|
% is cc_multi.
|
|
|
|
% write_array(Stream, Array, Separator, OutputPred, !IO):
|
|
% Sets the current output stream to Stream, then applies OutputPred to
|
|
% each element of Array, printing Separator between each element.
|
|
% The original output stream is restored whether returning normally
|
|
% or if an exception is thrown.
|
|
%
|
|
:- pred write_array(io.text_output_stream, array(T), string, pred(T, io, io),
|
|
io, io).
|
|
:- mode write_array(in, in, in, pred(in, di, uo) is det, di, uo) is det.
|
|
%:- mode write_array(in, array_ui, in, pred(in, di, uo) is det, di uo) is det.
|
|
:- mode write_array(in, in, in, pred(in, di, uo) is cc_multi, di, uo)
|
|
is cc_multi.
|
|
%:- mode write_array(in, array_ui, in, pred(in, di, uo) is cc_multi, di uo)
|
|
% is cc_multi.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Flushing output to the operating system.
|
|
%
|
|
|
|
% Flush the output buffer of the current output stream
|
|
% or to the specified output stream.
|
|
%
|
|
:- pred flush_output(io::di, io::uo) is det.
|
|
:- pred flush_output(io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
% Flush the output buffer of the current binary output stream.
|
|
% or of the specified binary output stream.
|
|
%
|
|
:- pred flush_binary_output(io::di, io::uo) is det.
|
|
:- pred flush_binary_output(io.binary_output_stream::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Whole file input predicates.
|
|
%
|
|
|
|
% Read all the characters (code points) from the current input stream
|
|
% or from the specified stream, until eof or error.
|
|
%
|
|
:- pred read_file(io.maybe_partial_res(list(char))::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_file(io.text_input_stream::in,
|
|
io.maybe_partial_res(list(char))::out, io::di, io::uo) is det.
|
|
|
|
% Read all the characters (code points) from the current input stream
|
|
% or from the specified stream, until eof or error. Returns the result
|
|
% as a string rather than as a list of char.
|
|
%
|
|
% Returns an error if the file contains a null character, because
|
|
% null characters are not allowed in Mercury strings.
|
|
%
|
|
% WARNING: the returned string is NOT guaranteed to be valid UTF-8
|
|
% or UTF-16.
|
|
%
|
|
:- pred read_file_as_string(io.maybe_partial_res(string)::out,
|
|
io::di, io::uo) is det.
|
|
:- pred read_file_as_string(io.text_input_stream::in,
|
|
io.maybe_partial_res(string)::out, io::di, io::uo) is det.
|
|
|
|
% The same as read_file_as_string, but returns not only a string,
|
|
% but also the number of code units in that string.
|
|
%
|
|
% WARNING: the returned string is NOT guaranteed to be valid UTF-8
|
|
% or UTF-16.
|
|
%
|
|
:- pred read_file_as_string_and_num_code_units(
|
|
io.maybe_partial_res_2(string, int)::out, io::di, io::uo) is det.
|
|
:- pred read_file_as_string_and_num_code_units(io.text_input_stream::in,
|
|
io.maybe_partial_res_2(string, int)::out, io::di, io::uo) is det.
|
|
|
|
% Reads all the bytes until eof or error from the current binary input
|
|
% stream or from the specified binary input stream.
|
|
%
|
|
:- pred read_binary_file(
|
|
io.result(list(int))::out, io::di, io::uo) is det.
|
|
:- pred read_binary_file(io.binary_input_stream::in,
|
|
io.result(list(int))::out, io::di, io::uo) is det.
|
|
|
|
% Reads all the bytes until eof or error from the current binary input
|
|
% stream or from the specified binary input stream into a bitmap.
|
|
%
|
|
:- pred read_binary_file_as_bitmap(
|
|
io.res(bitmap)::out, io::di, io::uo) is det.
|
|
:- pred read_binary_file_as_bitmap(io.binary_input_stream::in,
|
|
io.res(bitmap)::out, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Processing the contents of a whole file.
|
|
%
|
|
|
|
% Applies the given closure to each character (code point) read from
|
|
% the input stream in turn, until eof or error.
|
|
%
|
|
:- pred input_stream_foldl(pred(char, T, T), T, io.maybe_partial_res(T),
|
|
io, io).
|
|
:- mode input_stream_foldl((pred(in, in, out) is det), in, out,
|
|
di, uo) is det.
|
|
:- mode input_stream_foldl((pred(in, in, out) is cc_multi), in, out,
|
|
di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each character (code point) read from the
|
|
% input stream in turn, until eof or error.
|
|
%
|
|
:- pred input_stream_foldl(io.text_input_stream, pred(char, T, T),
|
|
T, io.maybe_partial_res(T), io, io).
|
|
:- mode input_stream_foldl(in, in(pred(in, in, out) is det),
|
|
in, out, di, uo) is det.
|
|
:- mode input_stream_foldl(in, in(pred(in, in, out) is cc_multi),
|
|
in, out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each character (code point) read from
|
|
% the input stream in turn, until eof or error.
|
|
%
|
|
:- pred input_stream_foldl_io(pred(char, io, io), io.res, io, io).
|
|
:- mode input_stream_foldl_io((pred(in, di, uo) is det), out, di, uo)
|
|
is det.
|
|
:- mode input_stream_foldl_io((pred(in, di, uo) is cc_multi), out, di, uo)
|
|
is cc_multi.
|
|
|
|
% Applies the given closure to each character (code point) read from the
|
|
% input stream in turn, until eof or error.
|
|
%
|
|
:- pred input_stream_foldl_io(io.text_input_stream, pred(char, io, io),
|
|
io.res, io, io).
|
|
:- mode input_stream_foldl_io(in, in(pred(in, di, uo) is det),
|
|
out, di, uo) is det.
|
|
:- mode input_stream_foldl_io(in, in(pred(in, di, uo) is cc_multi),
|
|
out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each character (code point) read from
|
|
% the input stream in turn, until eof or error.
|
|
%
|
|
:- pred input_stream_foldl2_io(pred(char, T, T, io, io),
|
|
T, io.maybe_partial_res(T), io, io).
|
|
:- mode input_stream_foldl2_io((pred(in, in, out, di, uo) is det),
|
|
in, out, di, uo) is det.
|
|
:- mode input_stream_foldl2_io((pred(in, in, out, di, uo) is cc_multi),
|
|
in, out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each character (code point) read from the
|
|
% input stream in turn, until eof or error.
|
|
%
|
|
:- pred input_stream_foldl2_io(io.text_input_stream,
|
|
pred(char, T, T, io, io),
|
|
T, maybe_partial_res(T), io, io).
|
|
:- mode input_stream_foldl2_io(in,
|
|
in(pred(in, in, out, di, uo) is det),
|
|
in, out, di, uo) is det.
|
|
:- mode input_stream_foldl2_io(in,
|
|
in(pred(in, in, out, di, uo) is cc_multi),
|
|
in, out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each character (code point) read from the
|
|
% input stream in turn, until eof or error, or the closure returns `no' as
|
|
% its second argument.
|
|
%
|
|
:- pred input_stream_foldl2_io_maybe_stop(
|
|
pred(char, bool, T, T, io, io),
|
|
T, io.maybe_partial_res(T), io, io).
|
|
:- mode input_stream_foldl2_io_maybe_stop(
|
|
(pred(in, out, in, out, di, uo) is det),
|
|
in, out, di, uo) is det.
|
|
:- mode input_stream_foldl2_io_maybe_stop(
|
|
(pred(in, out, in, out, di, uo) is cc_multi),
|
|
in, out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each character (code point) read from the
|
|
% input stream in turn, until eof or error, or the closure returns `no' as
|
|
% its second argument.
|
|
%
|
|
:- pred input_stream_foldl2_io_maybe_stop(io.text_input_stream,
|
|
pred(char, bool, T, T, io, io),
|
|
T, maybe_partial_res(T), io, io).
|
|
:- mode input_stream_foldl2_io_maybe_stop(in,
|
|
(pred(in, out, in, out, di, uo) is det),
|
|
in, out, di, uo) is det.
|
|
:- mode input_stream_foldl2_io_maybe_stop(in,
|
|
(pred(in, out, in, out, di, uo) is cc_multi),
|
|
in, out, di, uo) is cc_multi.
|
|
|
|
%---------------------%
|
|
|
|
% Applies the given closure to each byte read from the current binary
|
|
% input stream in turn, until eof or error.
|
|
%
|
|
:- pred binary_input_stream_foldl(pred(int, T, T),
|
|
T, maybe_partial_res(T), io, io).
|
|
:- mode binary_input_stream_foldl((pred(in, in, out) is det),
|
|
in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl((pred(in, in, out) is cc_multi),
|
|
in, out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each byte read from the given binary
|
|
% input stream in turn, until eof or error.
|
|
%
|
|
:- pred binary_input_stream_foldl(io.binary_input_stream,
|
|
pred(int, T, T), T, maybe_partial_res(T), io, io).
|
|
:- mode binary_input_stream_foldl(in, in(pred(in, in, out) is det),
|
|
in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl(in, in(pred(in, in, out) is cc_multi),
|
|
in, out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each byte read from the current binary
|
|
% input stream in turn, until eof or error.
|
|
%
|
|
:- pred binary_input_stream_foldl_io(pred(int, io, io),
|
|
io.res, io, io).
|
|
:- mode binary_input_stream_foldl_io((pred(in, di, uo) is det),
|
|
out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl_io((pred(in, di, uo) is cc_multi),
|
|
out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each byte read from the given binary
|
|
% input stream in turn, until eof or error.
|
|
%
|
|
:- pred binary_input_stream_foldl_io(io.binary_input_stream,
|
|
pred(int, io, io), io.res, io, io).
|
|
:- mode binary_input_stream_foldl_io(in, in(pred(in, di, uo) is det),
|
|
out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl_io(in, in(pred(in, di, uo) is cc_multi),
|
|
out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each byte read from the current binary
|
|
% input stream in turn, until eof or error.
|
|
%
|
|
:- pred binary_input_stream_foldl2_io(
|
|
pred(int, T, T, io, io), T, maybe_partial_res(T), io, io).
|
|
:- mode binary_input_stream_foldl2_io(
|
|
in(pred(in, in, out, di, uo) is det), in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl2_io(
|
|
in(pred(in, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each byte read from the given binary
|
|
% input stream in turn, until eof or error.
|
|
%
|
|
:- pred binary_input_stream_foldl2_io(io.binary_input_stream,
|
|
pred(int, T, T, io, io), T, maybe_partial_res(T), io, io).
|
|
:- mode binary_input_stream_foldl2_io(in,
|
|
(pred(in, in, out, di, uo) is det), in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl2_io(in,
|
|
(pred(in, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each byte read from the current binary
|
|
% input stream in turn, until eof or error, or the closure returns `no'
|
|
% as its second argument.
|
|
%
|
|
:- pred binary_input_stream_foldl2_io_maybe_stop(
|
|
pred(int, bool, T, T, io, io), T, maybe_partial_res(T), io, io).
|
|
:- mode binary_input_stream_foldl2_io_maybe_stop(
|
|
(pred(in, out, in, out, di, uo) is det), in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl2_io_maybe_stop(
|
|
(pred(in, out, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
|
|
|
|
% Applies the given closure to each byte read from the given binary input
|
|
% stream in turn, until eof or error, or the closure returns `no' as its
|
|
% second argument.
|
|
%
|
|
:- pred binary_input_stream_foldl2_io_maybe_stop(io.binary_input_stream,
|
|
pred(int, bool, T, T, io, io), T, maybe_partial_res(T), io, io).
|
|
:- mode binary_input_stream_foldl2_io_maybe_stop(in,
|
|
(pred(in, out, in, out, di, uo) is det), in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl2_io_maybe_stop(in,
|
|
(pred(in, out, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File handling predicates.
|
|
%
|
|
|
|
% remove_file(FileName, Result, !IO) attempts to remove the file
|
|
% `FileName', binding Result to ok/0 if it succeeds, or error/1 if it
|
|
% fails. If `FileName' names a file that is currently open, the behaviour
|
|
% is implementation-dependent.
|
|
%
|
|
:- pred remove_file(string::in, io.res::out, io::di, io::uo) is det.
|
|
|
|
% remove_file_recursively(FileName, Result, !IO) attempts to remove
|
|
% the file `FileName', binding Result to ok/0 if it succeeds, or error/1
|
|
% if it fails. If `FileName' names a file that is currently open, the
|
|
% behaviour is implementation-dependent.
|
|
%
|
|
% Unlike `remove_file', this predicate will attempt to remove non-empty
|
|
% directories (recursively). If it fails, some of the directory elements
|
|
% may already have been removed.
|
|
%
|
|
:- pred remove_file_recursively(string::in, io.res::out, io::di, io::uo)
|
|
is det.
|
|
|
|
% rename_file(OldFileName, NewFileName, Result, !IO).
|
|
%
|
|
% Attempts to rename the file `OldFileName' as `NewFileName', binding
|
|
% Result to ok/0 if it succeeds, or error/1 if it fails. If `OldFileName'
|
|
% names a file that is currently open, the behaviour is
|
|
% implementation-dependent. If `NewFileName' names a file that already
|
|
% exists the behaviour is also implementation-dependent; on some systems,
|
|
% the file previously named `NewFileName' will be deleted and replaced
|
|
% with the file previously named `OldFileName'.
|
|
%
|
|
:- pred rename_file(string::in, string::in, io.res::out, io::di, io::uo)
|
|
is det.
|
|
|
|
%---------------------%
|
|
|
|
% Succeeds if this platform can read and create symbolic links.
|
|
%
|
|
:- pred have_symlinks is semidet.
|
|
|
|
% make_symlink(FileName, LinkFileName, Result, !IO).
|
|
%
|
|
% Attempts to make `LinkFileName' be a symbolic link to `FileName'.
|
|
% If `FileName' is a relative path, it is interpreted relative
|
|
% to the directory containing `LinkFileName'.
|
|
%
|
|
:- pred make_symlink(string::in, string::in, io.res::out, io::di, io::uo)
|
|
is det.
|
|
|
|
% read_symlink(FileName, Result, !IO) returns `ok(LinkTarget)'
|
|
% if `FileName' is a symbolic link pointing to `LinkTarget', and
|
|
% `error(Error)' otherwise. If `LinkTarget' is a relative path,
|
|
% it should be interpreted relative the directory containing `FileName',
|
|
% not the current directory.
|
|
%
|
|
:- pred read_symlink(string::in, io.res(string)::out, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
:- type access_type
|
|
---> read
|
|
; write
|
|
; execute.
|
|
|
|
% check_file_accessibility(FileName, AccessTypes, Result):
|
|
%
|
|
% Check whether the current process can perform the operations given
|
|
% in `AccessTypes' on `FileName'.
|
|
% XXX When using the .NET CLI, this predicate will sometimes report
|
|
% that a directory is writable when in fact it is not.
|
|
%
|
|
:- pred check_file_accessibility(string::in, list(access_type)::in,
|
|
io.res::out, io::di, io::uo) is det.
|
|
|
|
:- type file_type
|
|
---> regular_file
|
|
; directory
|
|
; symbolic_link
|
|
; named_pipe
|
|
; socket
|
|
; character_device
|
|
; block_device
|
|
; message_queue
|
|
; semaphore
|
|
; shared_memory
|
|
; unknown.
|
|
|
|
% file_type(FollowSymLinks, FileName, TypeResult)
|
|
% finds the type of the given file.
|
|
%
|
|
:- pred file_type(bool::in, string::in, io.res(file_type)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% file_modification_time(FileName, TimeResult)
|
|
% finds the last modification time of the given file.
|
|
%
|
|
:- pred file_modification_time(string::in, io.res(time_t)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Predicates for handling temporary files.
|
|
%
|
|
|
|
% make_temp_file(Result, !IO) creates an empty file whose name is different
|
|
% to the name of any existing file. If successful Result returns the name
|
|
% of the file. It is the responsibility of the caller to delete the file
|
|
% when it is no longer required.
|
|
%
|
|
% The file is placed in the directory returned by get_temp_directory/3.
|
|
%
|
|
% On the Java backend, this does not attempt to create the file
|
|
% with restrictive permissions (600 on Unix-like systems) and therefore
|
|
% should not be used when security is required.
|
|
%
|
|
:- pred make_temp_file(io.res(string)::out, io::di, io::uo) is det.
|
|
|
|
% make_temp_file(Dir, Prefix, Suffix, Result, !IO) creates an empty file
|
|
% whose name is different to the name of any existing file. The file will
|
|
% reside in the directory specified by Dir and will have a prefix using up
|
|
% to the first 5 code units of Prefix. If successful, Result returns the
|
|
% name of the file. It is the responsibility of the caller to delete the
|
|
% file when it is no longer required.
|
|
%
|
|
% The reason for truncating Prefix is historical; in future the behaviour
|
|
% may be changed. Note that the truncation is performed without regard for
|
|
% code point boundaries. It is recommended to use only (printable) ASCII
|
|
% characters in the prefix string.
|
|
%
|
|
% The C backend has the following limitations:
|
|
% - Suffix may be ignored.
|
|
%
|
|
% The C# backend has the following limitations:
|
|
% - Dir is ignored.
|
|
% - Prefix is ignored.
|
|
% - Suffix is ignored.
|
|
%
|
|
% On the Java backend, this does not attempt to create the file
|
|
% with restrictive permissions (600 on Unix-like systems) and therefore
|
|
% should not be used when security is required.
|
|
%
|
|
:- pred make_temp_file(string::in, string::in, string::in, io.res(string)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% make_temp_directory(Result, !IO) creates an empty directory whose name
|
|
% is different from the name of any existing directory.
|
|
%
|
|
% On the Java backend this is insecure as the file permissions are not set.
|
|
%
|
|
:- pred make_temp_directory(io.res(string)::out, io::di, io::uo) is det.
|
|
|
|
% make_temp_directory(Dir, Prefix, Suffix, Result, !IO) creates an empty
|
|
% directory whose name is different from the name of any existing
|
|
% directory. The new directory will reside in the existing directory
|
|
% specified by Dir and will have a prefix using up to the first 5
|
|
% characters of Prefix and a Suffix. Result returns the name of the
|
|
% new directory. It is the responsibility of the program to delete the
|
|
% directory when it is no longer needed.
|
|
%
|
|
% The C backend has the following limitations:
|
|
% - Suffix is ignored.
|
|
%
|
|
% The C# backend has the following limitations:
|
|
% - Prefix is ignored.
|
|
% - Suffix is ignored.
|
|
%
|
|
% On the Java backend this is insecure as the file permissions are not set.
|
|
%
|
|
:- pred make_temp_directory(string::in, string::in, string::in,
|
|
io.res(string)::out, io::di, io::uo) is det.
|
|
|
|
% Test if the make_temp_directory predicates are available.
|
|
% This is false for C backends without support for mkdtemp(3).
|
|
%
|
|
:- pred have_make_temp_directory is semidet.
|
|
|
|
% get_temp_directory(DirName, !IO)
|
|
%
|
|
% DirName is the name of a directory where applications should put
|
|
% temporary files.
|
|
%
|
|
% This is implementation-dependent. For current Mercury implementations,
|
|
% it is determined as follows:
|
|
% 1. For the non-Java back-ends:
|
|
% - On Microsoft Windows systems, the file will reside in
|
|
% the current directory if the TMP environment variable
|
|
% is not set, or in the directory specified by TMP if it is set.
|
|
% - On Unix systems, the file will reside in /tmp if the TMPDIR
|
|
% environment variable is not set, or in the directory specified
|
|
% by TMPDIR if it is set.
|
|
% 2. For the Java back-end, the system-dependent default
|
|
% temporary-file directory will be used, specified by the Java
|
|
% system property java.io.tmpdir. On UNIX systems the default
|
|
% value of this property is typically "/tmp" or "/var/tmp";
|
|
% on Microsoft Windows systems it is typically "c:\\temp".
|
|
%
|
|
:- pred get_temp_directory(string::out, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Global state predicates.
|
|
%
|
|
|
|
% progname(DefaultProgname, Progname).
|
|
%
|
|
% Returns the name that the program was invoked with, if available,
|
|
% or DefaultProgname if the name is not available.
|
|
% Does not modify the I/O state.
|
|
%
|
|
:- pred progname(string::in, string::out, io::di, io::uo) is det.
|
|
|
|
% progname_base(DefaultProgname, Progname).
|
|
%
|
|
% Like `progname', except that it strips off any path name
|
|
% preceding the program name. Useful for error messages.
|
|
%
|
|
:- pred progname_base(string::in, string::out, io::di, io::uo) is det.
|
|
|
|
% Returns the arguments that the program was invoked with,
|
|
% if available, otherwise an empty list. Does not modify the I/O state.
|
|
%
|
|
:- pred command_line_arguments(list(string)::out, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% The I/O state contains an integer used to record the program's exit
|
|
% status. When the program finishes, it will return this exit status
|
|
% to the operating system. The following predicates can be used to get
|
|
% and set the exit status.
|
|
%
|
|
:- pred get_exit_status(int::out, io::di, io::uo) is det.
|
|
:- pred set_exit_status(int::in, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
|
|
% The following predicates provide an interface to the environment list.
|
|
% Do not attempt to put spaces or '=' signs in the names of environment
|
|
% variables, or bad things may result!
|
|
%
|
|
% First argument is the name of the environment variable. Returns
|
|
% yes(Value) if the variable was set (Value will be set to the value
|
|
% of the variable) and no if the variable was not set.
|
|
%
|
|
:- pred get_environment_var(string::in, maybe(string)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% First argument is the name of the environment variable, second argument
|
|
% is the value to be assigned to that variable. Res is 'ok' on success or
|
|
% 'error(ErrorCode)' if the system runs out of environment space or if
|
|
% the environment cannot be modified.
|
|
%
|
|
% Note that the environment cannot be modified on Java.
|
|
%
|
|
:- pred set_environment_var(string::in, string::in, io.res::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Same as set_environment_var/5, but throws an exception if an error
|
|
% occurs.
|
|
%
|
|
:- pred set_environment_var(string::in, string::in, io::di, io::uo) is det.
|
|
|
|
% Test if the set_environment_var/{4,5} predicates are available.
|
|
% This is false for Java backends.
|
|
%
|
|
:- pred have_set_environment_var is semidet.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% System access predicates.
|
|
%
|
|
|
|
% Invokes the operating system shell with the specified Command.
|
|
% Result is either `ok(ExitStatus)', if it was possible to invoke
|
|
% the command, or `error(ErrorCode)' if not. The ExitStatus will be 0
|
|
% if the command completed successfully or the return value of the system
|
|
% call. If a signal kills the system call, then Result will be an error
|
|
% indicating which signal occurred.
|
|
%
|
|
:- pred call_system(string::in, io.res(int)::out, io::di, io::uo) is det.
|
|
|
|
:- type system_result
|
|
---> exited(int)
|
|
; signalled(int).
|
|
|
|
% call_system_return_signal(Command, Result, !IO):
|
|
%
|
|
% Invokes the operating system shell with the specified Command.
|
|
% Result is either `ok(ExitStatus)' if it was possible to invoke
|
|
% the command or `error(Error)' if the command could not be executed.
|
|
% If the command could be executed then ExitStatus is either
|
|
% `exited(ExitCode)' if the command ran to completion or
|
|
% `signalled(SignalNum)' if the command was killed by a signal.
|
|
% If the command ran to completion then ExitCode will be 0 if the command
|
|
% ran successfully and the return value of the command otherwise.
|
|
%
|
|
:- pred call_system_return_signal(string::in,
|
|
io.res(system_result)::out, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Managing the globals structure that Mercury attaches to the I/O state.
|
|
%
|
|
|
|
% The I/O state includes a `globals' field which is not used by the
|
|
% standard library, but can be used by the application. The globals field
|
|
% is of type `univ' so that the application can store any data it wants
|
|
% there. The following predicates can be used to access this global state.
|
|
%
|
|
% Does not modify the I/O state.
|
|
%
|
|
:- pred get_globals(univ::out, io::di, io::uo) is det.
|
|
:- pred set_globals(univ::in, io::di, io::uo) is det.
|
|
|
|
% update_globals(UpdatePred, !IO).
|
|
% Update the `globals' field in the I/O state based upon its current value.
|
|
% This is equivalent to the following:
|
|
%
|
|
% get_globals(Globals0, !IO),
|
|
% UpdatePred(Globals0, Globals),
|
|
% set_globals(Globals, !IO)
|
|
%
|
|
% In parallel grades calls to update_globals/3 are atomic.
|
|
% If `UpdatePred' throws an exception then the `globals' field is
|
|
% left unchanged.
|
|
%
|
|
:- pred update_globals(pred(univ, univ)::in(pred(in, out) is det),
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Predicates that report statistics about the current program execution.
|
|
%
|
|
|
|
% Write memory/time usage statistics to stderr.
|
|
%
|
|
:- pred report_stats(io::di, io::uo) is det.
|
|
|
|
% Write statistics to stderr; what statistics will be written
|
|
% is controlled by the first argument, which acts a selector.
|
|
% What selector values cause what statistics to be printed
|
|
% is implementation defined.
|
|
%
|
|
% The Melbourne implementation supports the following selectors:
|
|
%
|
|
% "standard"
|
|
% Writes memory/time usage statistics.
|
|
%
|
|
% "full_memory_stats"
|
|
% Writes complete memory usage statistics, including information
|
|
% about all procedures and types. Requires compilation with memory
|
|
% profiling enabled.
|
|
%
|
|
% "tabling"
|
|
% Writes statistics about the internals of the tabling system.
|
|
% Requires the runtime to have been compiled with the macro
|
|
% MR_TABLE_STATISTICS defined.
|
|
%
|
|
:- pred report_stats(string::in, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Interpreting I/O error messages.
|
|
%
|
|
|
|
% Construct an error code including the specified error message.
|
|
%
|
|
:- func make_io_error(string) = io.error.
|
|
|
|
% Look up the error message corresponding to a particular error code.
|
|
%
|
|
:- func error_message(io.error) = string.
|
|
:- pred error_message(io.error::in, string::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Instances of the stream typeclasses.
|
|
%
|
|
|
|
:- instance stream.error(io.error).
|
|
|
|
:- instance stream.stream(text_output_stream, io).
|
|
:- instance stream.output(text_output_stream, io).
|
|
:- instance stream.writer(text_output_stream, char, io).
|
|
:- instance stream.writer(text_output_stream, float, io).
|
|
:- instance stream.writer(text_output_stream, int, io).
|
|
:- instance stream.writer(text_output_stream, int8, io).
|
|
:- instance stream.writer(text_output_stream, int16, io).
|
|
:- instance stream.writer(text_output_stream, int32, io).
|
|
:- instance stream.writer(text_output_stream, uint, io).
|
|
:- instance stream.writer(text_output_stream, uint8, io).
|
|
:- instance stream.writer(text_output_stream, uint16, io).
|
|
:- instance stream.writer(text_output_stream, uint8, io).
|
|
:- instance stream.writer(text_output_stream, string, io).
|
|
:- instance stream.writer(text_output_stream, univ, io).
|
|
:- instance stream.line_oriented(text_output_stream, io).
|
|
|
|
:- instance stream.stream(text_input_stream, io).
|
|
:- instance stream.input(text_input_stream, io).
|
|
:- instance stream.reader(text_input_stream, char, io, io.error).
|
|
:- instance stream.unboxed_reader(text_input_stream, char, io, io.error).
|
|
:- instance stream.reader(text_input_stream, line, io, io.error).
|
|
:- instance stream.reader(text_input_stream, text_file, io, io.error).
|
|
|
|
:- instance stream.line_oriented(text_input_stream, io).
|
|
:- instance stream.putback(text_input_stream, char, io, io.error).
|
|
|
|
:- instance stream.stream(binary_output_stream, io).
|
|
:- instance stream.output(binary_output_stream, io).
|
|
:- instance stream.writer(binary_output_stream, byte, io).
|
|
:- instance stream.writer(binary_output_stream, int8, io).
|
|
:- instance stream.writer(binary_output_stream, uint8, io).
|
|
:- instance stream.writer(binary_output_stream, bitmap.slice, io).
|
|
:- instance stream.seekable(binary_output_stream, io).
|
|
|
|
:- instance stream.stream(binary_input_stream, io).
|
|
:- instance stream.input(binary_input_stream, io).
|
|
:- instance stream.reader(binary_input_stream, int, io, io.error).
|
|
:- instance stream.reader(binary_input_stream, int8, io, io.error).
|
|
:- instance stream.reader(binary_input_stream, uint8, io, io.error).
|
|
:- instance stream.bulk_reader(binary_input_stream, int, bitmap, io, io.error).
|
|
:- instance stream.putback(binary_input_stream, int, io, io.error).
|
|
:- instance stream.putback(binary_input_stream, int8, io, io.error).
|
|
:- instance stream.putback(binary_input_stream, uint8, io, io.error).
|
|
:- instance stream.seekable(binary_input_stream, io).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
% Everything below here is not intended to be part of the public interface,
|
|
% and will not be included in the Mercury library reference manual.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- interface.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% For use by library.m.
|
|
%
|
|
|
|
:- pred init_state(io::di, io::uo) is det.
|
|
:- pred finalize_state(io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
%
|
|
% For use by dir.m.
|
|
%
|
|
|
|
% Succeeds iff the Win32 API is available.
|
|
%
|
|
:- pred have_win32 is semidet.
|
|
|
|
% Succeeds iff the current process was compiled against the Cygwin library.
|
|
%
|
|
:- pred have_cygwin is semidet.
|
|
|
|
% Succeeds iff the .NET class library is available.
|
|
%
|
|
:- pred have_dotnet is semidet.
|
|
|
|
% A system-dependent error indication.
|
|
% For C, this is 0 for success or the value of errno.
|
|
% (In a few cases, we pass a Win32 error as a system_error.)
|
|
% For Java, this is null for success or an exception object.
|
|
% For C#, this is null for success or an exception object.
|
|
%
|
|
:- type system_error.
|
|
:- pragma foreign_type(c, system_error, "MR_Integer").
|
|
:- pragma foreign_type("C#", system_error, "System.Exception").
|
|
:- pragma foreign_type(java, system_error, "java.lang.Exception").
|
|
|
|
% is_error(Error, MessagePrefix, MaybeIOError, !IO):
|
|
% Returns `yes(IOError)' if `Error' indicates an error (not success).
|
|
% `IOError' contains an error message obtained by looking up the message
|
|
% for the given errno value and prepending `MessagePrefix'.
|
|
%
|
|
:- pred is_error(system_error::in, string::in, maybe(io.error)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% is_maybe_win32_error(Error, MessagePrefix, MaybeIOError, !IO):
|
|
% Same as is_error except that `Error' is a Win32 error value on Windows.
|
|
%
|
|
:- pred is_maybe_win32_error(system_error::in, string::in,
|
|
maybe(io.error)::out, io::di, io::uo) is det.
|
|
|
|
% make_err_msg(Error, MessagePrefix, Message, !IO):
|
|
% `Message' is an error message obtained by looking up the message for the
|
|
% given errno value and prepending `MessagePrefix'.
|
|
%
|
|
:- pred make_err_msg(system_error::in, string::in, string::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% make_maybe_win32_err_msg(Error, MessagePrefix, Message, !IO):
|
|
%
|
|
% `Message' is an error message obtained by looking up the error message
|
|
% for `Error' and prepending `MessagePrefix'.
|
|
% On Win32 systems, `Error' is obtained by calling GetLastError.
|
|
% On other systems `Error' is obtained by reading errno.
|
|
%
|
|
:- pred make_maybe_win32_err_msg(system_error::in, string::in, string::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Return a unique identifier for the given file (after following
|
|
% symlinks in FileName).
|
|
% XXX On Cygwin sometimes two files will have the same file_id.
|
|
% This is because MS-Windows does not use inodes, so Cygwin hashes
|
|
% the absolute file name. On Windows without Cygwin this will always
|
|
% return error(_). That doesn't matter, because this function is only used
|
|
% for checking for symlink loops in dir.foldl2, but plain Windows
|
|
% doesn't support symlinks.
|
|
%
|
|
:- type file_id.
|
|
:- pred file_id(string::in, io.res(file_id)::out, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
%
|
|
% For use by term_io.m.
|
|
%
|
|
|
|
:- import_module ops.
|
|
|
|
:- pred get_op_table(ops.table::out, io::di, io::uo) is det.
|
|
:- pred set_op_table(ops.table::di, io::di, io::uo) is det.
|
|
|
|
%---------------------%
|
|
%
|
|
% For use by browser/browse.m.
|
|
%
|
|
|
|
% Types and predicates for managing the stream info database.
|
|
|
|
:- type stream_db == map(stream_id, stream_info).
|
|
|
|
:- type stream_info
|
|
---> stream(
|
|
stream_id :: int,
|
|
stream_mode :: stream_mode,
|
|
stream_content :: stream_content,
|
|
stream_source :: stream_source
|
|
).
|
|
|
|
:- type maybe_stream_info
|
|
---> stream(
|
|
maybe_stream_id :: int,
|
|
maybe_stream_mode :: stream_mode,
|
|
maybe_stream_content :: stream_content,
|
|
maybe_stream_source :: stream_source
|
|
)
|
|
; unknown_stream.
|
|
|
|
:- type stream_mode
|
|
---> input
|
|
; output
|
|
; append.
|
|
|
|
:- type stream_content
|
|
---> text
|
|
; binary
|
|
; preopen.
|
|
|
|
:- type stream_source
|
|
---> file(string) % the file name
|
|
; stdin
|
|
; stdout
|
|
; stderr.
|
|
|
|
% Retrieves the database mapping streams to the information we have
|
|
% about those streams.
|
|
%
|
|
:- pred get_stream_db(stream_db::out, io::di, io::uo) is det.
|
|
:- impure pred get_stream_db_with_locking(stream_db::out) is det.
|
|
|
|
% Returns the information associated with the specified input
|
|
% stream in the given stream database.
|
|
%
|
|
:- func input_stream_info(stream_db, io.text_input_stream)
|
|
= maybe_stream_info.
|
|
|
|
% Returns the information associated with the specified binary input
|
|
% stream in the given stream database.
|
|
%
|
|
:- func binary_input_stream_info(stream_db, io.binary_input_stream)
|
|
= maybe_stream_info.
|
|
|
|
% Returns the information associated with the specified output
|
|
% stream in the given stream database.
|
|
%
|
|
:- func output_stream_info(stream_db, io.text_output_stream)
|
|
= maybe_stream_info.
|
|
|
|
% Returns the information associated with the specified binary output
|
|
% stream in the given stream database.
|
|
%
|
|
:- func binary_output_stream_info(stream_db, io.binary_output_stream)
|
|
= maybe_stream_info.
|
|
|
|
% If the univ contains an I/O stream, return information about that
|
|
% stream, otherwise fail.
|
|
:- func get_io_stream_info(stream_db, T) = maybe_stream_info is semidet.
|
|
|
|
%---------------------%
|
|
%
|
|
% For use by compiler/process_util.m.
|
|
%
|
|
|
|
% Interpret the child process exit status returned by
|
|
% system() or wait().
|
|
%
|
|
:- func decode_system_command_exit_code(int) = io.res(io.system_result).
|
|
|
|
%
|
|
% For use by the compiler transformation that implements trace [io(!IO)].
|
|
% Both of these are builtins.
|
|
%
|
|
|
|
:- semipure pred unsafe_get_io_state(io::uo) is det.
|
|
:- impure pred unsafe_set_io_state(io::di) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module benchmarking.
|
|
:- import_module dir.
|
|
:- import_module exception.
|
|
:- import_module int.
|
|
:- import_module int8.
|
|
:- import_module int16.
|
|
:- import_module int32.
|
|
:- import_module int64.
|
|
:- import_module parser.
|
|
:- import_module require.
|
|
:- import_module stream.string_writer.
|
|
:- import_module term.
|
|
:- import_module term_conversion.
|
|
:- import_module term_io.
|
|
:- import_module type_desc.
|
|
:- import_module uint8.
|
|
:- import_module uint16.
|
|
:- import_module uint32.
|
|
:- import_module uint64.
|
|
|
|
:- use_module rtti_implementation.
|
|
:- use_module table_builtin.
|
|
|
|
:- pragma foreign_import_module("C", time). % For ML_construct_time_t.
|
|
:- pragma foreign_import_module("C", string).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Private type definitions.
|
|
%
|
|
|
|
% Values of type `io.state' are never really used:
|
|
% instead we store data in global variables.
|
|
% The reason this is defined as a foreign type is to prevent attempts
|
|
% to deconstruct values of the type.
|
|
:- pragma foreign_type("C", io.state, "MR_Word",
|
|
[can_pass_as_mercury_type])
|
|
where equality is io_state_equal, comparison is io_state_compare.
|
|
:- pragma foreign_type("C#", io.state, "int",
|
|
[can_pass_as_mercury_type])
|
|
where equality is io_state_equal, comparison is io_state_compare.
|
|
:- pragma foreign_type("Java", io.state, "java.lang.Object",
|
|
[can_pass_as_mercury_type])
|
|
where equality is io_state_equal, comparison is io_state_compare.
|
|
|
|
:- pred io_state_equal(io.state::in, io.state::in) is semidet.
|
|
|
|
:- pragma no_determinism_warning(io_state_equal/2).
|
|
io_state_equal(_, _) :-
|
|
error("attempt to unify two I/O states").
|
|
|
|
:- pred io_state_compare(comparison_result::uo, io.state::in, io.state::in)
|
|
is det.
|
|
|
|
:- pragma no_determinism_warning(io_state_compare/3).
|
|
io_state_compare(_, _, _) :-
|
|
error("attempt to compare two I/O states").
|
|
|
|
:- type input_stream
|
|
---> input_stream(stream).
|
|
:- type output_stream
|
|
---> output_stream(stream).
|
|
|
|
:- type binary_input_stream
|
|
---> binary_input_stream(stream).
|
|
:- type binary_output_stream
|
|
---> binary_output_stream(stream).
|
|
|
|
:- type stream
|
|
---> stream(c_pointer).
|
|
:- pragma foreign_type("C", stream, "MercuryFilePtr",
|
|
[can_pass_as_mercury_type]).
|
|
:- pragma foreign_type("C#", stream, "io.MR_MercuryFileStruct").
|
|
:- pragma foreign_type("Java", stream, "io.MR_MercuryFileStruct").
|
|
|
|
% A unique identifier for an I/O stream.
|
|
%
|
|
:- type stream_id == int.
|
|
|
|
%---------------------%
|
|
|
|
:- type result_code
|
|
---> result_code_ok
|
|
; result_code_eof
|
|
; result_code_error.
|
|
|
|
:- pragma foreign_export_enum("C", result_code/0,
|
|
[prefix("ML_"), uppercase]).
|
|
:- pragma foreign_export_enum("C#", result_code/0,
|
|
[prefix("ML_"), uppercase]).
|
|
:- pragma foreign_export_enum("Java", result_code/0,
|
|
[prefix("ML_"), uppercase]).
|
|
|
|
:- type maybe_incomplete_result_code
|
|
---> mirc_ok
|
|
; mirc_eof
|
|
; mirc_incomplete
|
|
; mirc_error.
|
|
|
|
:- pragma foreign_export_enum("C", maybe_incomplete_result_code/0,
|
|
[prefix("ML_"), uppercase]).
|
|
:- pragma foreign_export_enum("C#", maybe_incomplete_result_code/0,
|
|
[prefix("ML_"), uppercase]).
|
|
:- pragma foreign_export_enum("Java", maybe_incomplete_result_code/0,
|
|
[prefix("ML_"), uppercase]).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Instances of the stream typeclasses.
|
|
%
|
|
|
|
:- instance stream.error(error) where [
|
|
func(stream.error_message/1) is io.error_message
|
|
].
|
|
|
|
%---------------------%
|
|
%
|
|
% Text input streams.
|
|
%
|
|
|
|
:- instance stream.stream(input_stream, io) where [
|
|
pred(name/4) is input_stream_name
|
|
].
|
|
|
|
:- instance stream.input(input_stream, io) where [].
|
|
|
|
:- instance stream.reader(input_stream, char, io, io.error)
|
|
where
|
|
[
|
|
( get(Stream, Result, !IO) :-
|
|
read_char(Stream, Result0, !IO),
|
|
Result = io.result1_to_stream_result1(Result0)
|
|
)
|
|
].
|
|
|
|
:- instance stream.unboxed_reader(input_stream, char, io, io.error)
|
|
where
|
|
[
|
|
( unboxed_get(Stream, Result, Char, !IO) :-
|
|
read_char_unboxed(Stream, Result0, Char, !IO),
|
|
Result = io.result0_to_stream_result0(Result0)
|
|
)
|
|
].
|
|
|
|
:- instance stream.reader(input_stream, line, io, io.error)
|
|
where
|
|
[
|
|
( get(Stream, Result, !IO) :-
|
|
read_line_as_string(Stream, Result0, !IO),
|
|
(
|
|
Result0 = ok(String),
|
|
Result = ok(line(String))
|
|
;
|
|
Result0 = eof,
|
|
Result = eof
|
|
;
|
|
Result0 = error(Error),
|
|
Result = error(Error)
|
|
)
|
|
)
|
|
].
|
|
|
|
:- instance stream.reader(input_stream, text_file, io, io.error)
|
|
where
|
|
[
|
|
( get(Stream, Result, !IO) :-
|
|
read_file_as_string(Stream, Result0, !IO),
|
|
(
|
|
Result0 = ok(String),
|
|
Result = ok(text_file(String))
|
|
;
|
|
Result0 = error(_PartialString, Error),
|
|
Result = error(Error)
|
|
)
|
|
)
|
|
].
|
|
|
|
:- instance stream.putback(input_stream, char, io, io.error) where
|
|
[
|
|
pred(unget/4) is putback_char
|
|
].
|
|
|
|
:- instance stream.line_oriented(input_stream, io) where
|
|
[
|
|
pred(get_line/4) is io.get_line_number,
|
|
pred(set_line/4) is io.set_line_number
|
|
].
|
|
|
|
:- func result1_to_stream_result1(io.result(T)) = stream.result(T, io.error).
|
|
|
|
result1_to_stream_result1(ok(T)) = ok(T).
|
|
result1_to_stream_result1(eof) = eof.
|
|
result1_to_stream_result1(error(Error)) = error(Error).
|
|
|
|
:- func result0_to_stream_result0(io.result) = stream.result(io.error).
|
|
|
|
result0_to_stream_result0(ok) = ok.
|
|
result0_to_stream_result0(eof) = eof.
|
|
result0_to_stream_result0(error(Error)) = error(Error).
|
|
|
|
%---------------------%
|
|
%
|
|
% Text output streams.
|
|
%
|
|
|
|
:- instance stream.stream(output_stream, io) where [
|
|
pred(name/4) is output_stream_name
|
|
].
|
|
|
|
:- instance stream.output(output_stream, io) where [
|
|
pred(flush/3) is flush_output
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, char, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_char
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, float, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_float
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, int, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_int
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, int8, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_int8
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, int16, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_int16
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, int32, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_int32
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, uint, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_uint
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, uint8, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_uint8
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, uint16, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_uint16
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, uint32, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_uint32
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, string, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_string
|
|
].
|
|
|
|
:- instance stream.writer(output_stream, univ, io)
|
|
where
|
|
[
|
|
pred(put/4) is stream.string_writer.write_univ
|
|
].
|
|
|
|
:- instance stream.line_oriented(output_stream, io) where
|
|
[
|
|
pred(get_line/4) is get_output_line_number,
|
|
pred(set_line/4) is set_output_line_number
|
|
].
|
|
|
|
%---------------------%
|
|
%
|
|
% Binary input streams.
|
|
%
|
|
|
|
:- instance stream.stream(binary_input_stream, io)
|
|
where
|
|
[
|
|
pred(name/4) is binary_input_stream_name
|
|
].
|
|
|
|
:- instance stream.input(binary_input_stream, io)
|
|
where [].
|
|
|
|
:- instance stream.reader(binary_input_stream, int, io, io.error)
|
|
where
|
|
[
|
|
( get(Stream, Result, !IO) :-
|
|
read_byte(Stream, Result0, !IO),
|
|
Result = result1_to_stream_result1(Result0)
|
|
)
|
|
].
|
|
|
|
:- instance stream.reader(binary_input_stream, int8, io, io.error)
|
|
where
|
|
[
|
|
( get(Stream, Result, !IO) :-
|
|
read_binary_int8(Stream, Result0, !IO),
|
|
Result = result1_to_stream_result1(Result0)
|
|
)
|
|
].
|
|
|
|
:- instance stream.reader(binary_input_stream, uint8, io, io.error)
|
|
where
|
|
[
|
|
( get(Stream, Result, !IO) :-
|
|
read_binary_uint8(Stream, Result0, !IO),
|
|
Result = result1_to_stream_result1(Result0)
|
|
)
|
|
].
|
|
|
|
:- instance stream.bulk_reader(binary_input_stream, int,
|
|
bitmap, io, io.error)
|
|
where
|
|
[
|
|
( bulk_get(Stream, Index, Int, !Store, NumRead, Result, !State) :-
|
|
read_bitmap(Stream, Index, Int, !Store, NumRead,
|
|
Result0, !State),
|
|
Result = res_to_stream_res(Result0)
|
|
)
|
|
].
|
|
|
|
:- instance stream.putback(binary_input_stream, int, io, io.error)
|
|
where
|
|
[
|
|
pred(unget/4) is putback_byte
|
|
].
|
|
|
|
:- instance stream.putback(binary_input_stream, int8, io, io.error)
|
|
where
|
|
[
|
|
pred(unget/4) is putback_int8
|
|
].
|
|
|
|
:- instance stream.putback(binary_input_stream, uint8, io, io.error)
|
|
where
|
|
[
|
|
pred(unget/4) is putback_uint8
|
|
].
|
|
|
|
:- instance stream.seekable(binary_input_stream, io)
|
|
where
|
|
[
|
|
( seek(Stream, Whence0, OffSet, !IO) :-
|
|
Whence = stream_whence_to_io_whence(Whence0),
|
|
seek_binary_input(Stream, Whence, OffSet, !IO)
|
|
),
|
|
( seek64(Stream, Whence0, OffSet, !IO) :-
|
|
Whence = stream_whence_to_io_whence(Whence0),
|
|
seek_binary_input64(Stream, Whence, OffSet, !IO)
|
|
)
|
|
].
|
|
|
|
:- func stream_whence_to_io_whence(stream.whence) = io.whence.
|
|
|
|
stream_whence_to_io_whence(set) = set.
|
|
stream_whence_to_io_whence(cur) = cur.
|
|
stream_whence_to_io_whence(end) = end.
|
|
|
|
:- func io.res_to_stream_res(io.res) = stream.res(io.error).
|
|
|
|
res_to_stream_res(ok) = ok.
|
|
res_to_stream_res(error(E)) = error(E).
|
|
|
|
%---------------------%
|
|
%
|
|
% Binary output streams.
|
|
%
|
|
|
|
:- instance stream.stream(binary_output_stream, io)
|
|
where
|
|
[
|
|
pred(name/4) is binary_output_stream_name
|
|
].
|
|
|
|
:- instance stream.output(binary_output_stream, io)
|
|
where
|
|
[
|
|
pred(flush/3) is flush_binary_output
|
|
].
|
|
|
|
:- instance stream.writer(binary_output_stream, byte, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_byte
|
|
].
|
|
|
|
:- instance stream.writer(binary_output_stream, int8, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_binary_int8
|
|
].
|
|
|
|
:- instance stream.writer(binary_output_stream, uint8, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_binary_uint8
|
|
].
|
|
|
|
:- instance stream.writer(binary_output_stream, bitmap, io)
|
|
where
|
|
[
|
|
pred(put/4) is write_bitmap
|
|
].
|
|
|
|
:- instance stream.writer(binary_output_stream, bitmap.slice, io)
|
|
where
|
|
[
|
|
( put(Stream, Slice, !IO) :-
|
|
write_bitmap(Stream, Slice ^ slice_bitmap,
|
|
Slice ^ slice_start_byte_index, Slice ^ slice_num_bytes, !IO)
|
|
)
|
|
].
|
|
|
|
:- instance stream.seekable(binary_output_stream, io)
|
|
where
|
|
[
|
|
( seek(Stream, Whence0, OffSet, !IO) :-
|
|
Whence = stream_whence_to_io_whence(Whence0),
|
|
seek_binary_output(Stream, Whence, OffSet, !IO)
|
|
),
|
|
( seek64(Stream, Whence0, Offset, !IO) :-
|
|
Whence = stream_whence_to_io_whence(Whence0),
|
|
seek_binary_output64(Stream, Whence, Offset, !IO)
|
|
)
|
|
].
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma foreign_decl("C", "
|
|
#ifdef MR_HAVE_UNISTD_H
|
|
#include <unistd.h>
|
|
#endif
|
|
#ifdef MR_HAVE_SYS_STAT_H
|
|
#include <sys/stat.h>
|
|
#endif
|
|
#include ""mercury_types.h"" // for MR_Integer
|
|
#include ""mercury_library_types.h"" // for MercuryFilePtr
|
|
#include ""mercury_int.h"" // for MR_*_reverse_bytes
|
|
").
|
|
|
|
:- pragma foreign_decl("C", "
|
|
#include ""mercury_init.h""
|
|
#include ""mercury_wrapper.h""
|
|
#include ""mercury_type_info.h""
|
|
#include ""mercury_library_types.h""
|
|
#include ""mercury_file.h""
|
|
#include ""mercury_heap.h""
|
|
#include ""mercury_misc.h""
|
|
#include ""mercury_runtime_util.h""
|
|
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <stdarg.h>
|
|
#include <string.h>
|
|
#include <errno.h>
|
|
#include <inttypes.h>
|
|
#include <limits.h>
|
|
|
|
#ifdef MR_HAVE_SYS_WAIT_H
|
|
#include <sys/wait.h> // for WIFEXITED, WEXITSTATUS, etc.
|
|
#endif
|
|
|
|
#ifdef MR_WIN32
|
|
#include ""mercury_windows.h""
|
|
#endif
|
|
|
|
#if defined(MR_MSVC)
|
|
typedef SSIZE_T ML_ssize_t;
|
|
#else
|
|
typedef ssize_t ML_ssize_t;
|
|
#endif
|
|
|
|
extern MercuryFile mercury_stdin;
|
|
extern MercuryFile mercury_stdout;
|
|
extern MercuryFile mercury_stderr;
|
|
extern MercuryFile mercury_stdin_binary;
|
|
extern MercuryFile mercury_stdout_binary;
|
|
extern MR_Unsigned mercury_current_text_input_index;
|
|
extern MR_Unsigned mercury_current_text_output_index;
|
|
extern MR_Unsigned mercury_current_binary_input_index;
|
|
extern MR_Unsigned mercury_current_binary_output_index;
|
|
|
|
#define MR_initial_io_state() 0 // some random number
|
|
#define MR_final_io_state(r) ((void) 0)
|
|
|
|
void mercury_init_io(void);
|
|
MercuryFilePtr mercury_current_text_input(void);
|
|
MercuryFilePtr mercury_current_text_output(void);
|
|
MercuryFilePtr mercury_current_binary_input(void);
|
|
MercuryFilePtr mercury_current_binary_output(void);
|
|
int mercury_next_stream_id(void);
|
|
MercuryFilePtr mercury_open(const char *filename, const char *openmode,
|
|
MR_AllocSiteInfoPtr alloc_id);
|
|
int mercury_get_byte(MercuryFilePtr mf);
|
|
int mercury_close(MercuryFilePtr mf);
|
|
int ML_fprintf(MercuryFilePtr mf, const char *format, ...);
|
|
|
|
#ifdef MR_WIN32
|
|
wchar_t *ML_utf8_to_wide(const char *s);
|
|
char *ML_wide_to_utf8(const wchar_t *ws,
|
|
MR_AllocSiteInfoPtr alloc_id);
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_decl("C", "
|
|
extern MR_Word ML_io_stream_db;
|
|
extern MR_Word ML_io_user_globals;
|
|
|
|
extern int ML_next_stream_id;
|
|
#if 0
|
|
extern MR_Word ML_io_ops_table;
|
|
#endif
|
|
|
|
#ifdef MR_THREAD_SAFE
|
|
extern MercuryLock ML_io_stream_db_lock;
|
|
extern MercuryLock ML_io_user_globals_lock;
|
|
extern MercuryLock ML_io_next_stream_id_lock;
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_code("C", "
|
|
MR_Word ML_io_stream_db;
|
|
MR_Word ML_io_user_globals;
|
|
|
|
// A counter used to generate unique stream ids.
|
|
int ML_next_stream_id;
|
|
#if 0
|
|
MR_Word ML_io_ops_table;
|
|
#endif
|
|
|
|
#ifdef MR_THREAD_SAFE
|
|
MercuryLock ML_io_stream_db_lock;
|
|
MercuryLock ML_io_user_globals_lock;
|
|
MercuryLock ML_io_next_stream_id_lock;
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_code("C", "
|
|
MercuryFile mercury_stdin;
|
|
MercuryFile mercury_stdout;
|
|
MercuryFile mercury_stderr;
|
|
MercuryFile mercury_stdin_binary;
|
|
MercuryFile mercury_stdout_binary;
|
|
|
|
MR_Unsigned mercury_current_text_input_index;
|
|
MR_Unsigned mercury_current_text_output_index;
|
|
MR_Unsigned mercury_current_binary_input_index;
|
|
MR_Unsigned mercury_current_binary_output_index;
|
|
|
|
static void
|
|
mercury_set_binary_mode(FILE *f)
|
|
{
|
|
#if defined(MR_MSVC) || defined(MR_MINGW)
|
|
// Calling fdopen with 'b' in the mode string does not necessarily put the
|
|
// standard input or standard output file into binary translation mode on
|
|
// Windows. This is the case with MinGW and MSVC. The cause is likely the
|
|
// MSVC CRT. The solution is to change the mode on the file after opening.
|
|
_setmode(_fileno(f), _O_BINARY);
|
|
#endif
|
|
}
|
|
|
|
void
|
|
mercury_init_io(void)
|
|
{
|
|
MR_mercuryfile_init(stdin, 1, &mercury_stdin);
|
|
MR_mercuryfile_init(stdout, 1, &mercury_stdout);
|
|
MR_mercuryfile_init(stderr, 1, &mercury_stderr);
|
|
|
|
MR_mercuryfile_init(NULL, 1, &mercury_stdin_binary);
|
|
MR_mercuryfile_init(NULL, 1, &mercury_stdout_binary);
|
|
|
|
mercury_current_text_input_index = MR_new_thread_local_mutable_index();
|
|
mercury_current_text_output_index = MR_new_thread_local_mutable_index();
|
|
mercury_current_binary_input_index = MR_new_thread_local_mutable_index();
|
|
mercury_current_binary_output_index = MR_new_thread_local_mutable_index();
|
|
|
|
#if defined(MR_HAVE_FDOPEN) && (defined(MR_HAVE_FILENO) || defined(fileno)) \
|
|
&& defined(MR_HAVE_DUP)
|
|
MR_file(mercury_stdin_binary) = fdopen(dup(fileno(stdin)), ""rb"");
|
|
if (MR_file(mercury_stdin_binary) != NULL) {
|
|
mercury_set_binary_mode(MR_file(mercury_stdin_binary));
|
|
} else {
|
|
// The call to fdopen() may fail if stdin is not available.
|
|
// We don't abort since we still want Mercury programs to be runnable
|
|
// in such a circumstance (aside from those that use stdin).
|
|
// For the same reason we treat binary stdout identically below.
|
|
//
|
|
// NOTE: some versions of nohup may also cause the above call to
|
|
// fdopen() to fail because they redirect stdin to /dev/null
|
|
// in *write* mode. Setting binary stdin to stdin in such
|
|
// a case also ensures that we work with those versions of
|
|
// nohup.
|
|
MR_file(mercury_stdin_binary) = stdin;
|
|
}
|
|
|
|
MR_file(mercury_stdout_binary) = fdopen(dup(fileno(stdout)), ""wb"");
|
|
if (MR_file(mercury_stdout_binary) != NULL) {
|
|
mercury_set_binary_mode(MR_file(mercury_stdout_binary));
|
|
} else {
|
|
MR_file(mercury_stdout_binary) = stdout;
|
|
}
|
|
#else
|
|
// XXX Standard ANSI/ISO C provides no way to set stdin/stdout
|
|
// to binary mode. I guess we just have to punt...
|
|
MR_file(mercury_stdin_binary) = stdin;
|
|
MR_file(mercury_stdout_binary) = stdout;
|
|
#endif
|
|
|
|
#ifdef MR_THREAD_SAFE
|
|
pthread_mutex_init(&ML_io_stream_db_lock, MR_MUTEX_ATTR);
|
|
pthread_mutex_init(&ML_io_user_globals_lock, MR_MUTEX_ATTR);
|
|
pthread_mutex_init(&ML_io_next_stream_id_lock, MR_MUTEX_ATTR);
|
|
#endif
|
|
}
|
|
|
|
MercuryFilePtr
|
|
mercury_current_text_input(void)
|
|
{
|
|
MercuryFilePtr stream;
|
|
MR_get_thread_local_mutable(MercuryFilePtr, stream,
|
|
mercury_current_text_input_index);
|
|
return stream;
|
|
}
|
|
|
|
MercuryFilePtr
|
|
mercury_current_text_output(void)
|
|
{
|
|
MercuryFilePtr stream;
|
|
MR_get_thread_local_mutable(MercuryFilePtr, stream,
|
|
mercury_current_text_output_index);
|
|
return stream;
|
|
}
|
|
|
|
MercuryFilePtr
|
|
mercury_current_binary_input(void)
|
|
{
|
|
MercuryFilePtr stream;
|
|
MR_get_thread_local_mutable(MercuryFilePtr, stream,
|
|
mercury_current_binary_input_index);
|
|
return stream;
|
|
}
|
|
|
|
MercuryFilePtr
|
|
mercury_current_binary_output(void)
|
|
{
|
|
MercuryFilePtr stream;
|
|
MR_get_thread_local_mutable(MercuryFilePtr, stream,
|
|
mercury_current_binary_output_index);
|
|
return stream;
|
|
}
|
|
|
|
int
|
|
mercury_next_stream_id(void)
|
|
{
|
|
int id;
|
|
MR_LOCK(&ML_io_next_stream_id_lock, ""io.do_open_text"");
|
|
id = ML_next_stream_id++;
|
|
MR_UNLOCK(&ML_io_next_stream_id_lock, ""io.do_open_text"");
|
|
return id;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_code("C", "
|
|
MercuryFilePtr
|
|
mercury_open(const char *filename, const char *openmode,
|
|
MR_AllocSiteInfoPtr alloc_id)
|
|
{
|
|
MercuryFilePtr mf;
|
|
FILE *f;
|
|
|
|
#ifdef MR_WIN32
|
|
f = _wfopen(ML_utf8_to_wide(filename), ML_utf8_to_wide(openmode));
|
|
#else
|
|
f = fopen(filename, openmode);
|
|
#endif
|
|
|
|
if (f == NULL) {
|
|
return NULL;
|
|
}
|
|
|
|
// Check if the opened file is actually a directory.
|
|
// If fileno or fstat are not available then we assume the OS would not
|
|
// let us open a directory as a file anyway.
|
|
#if defined(MR_HAVE_FSTAT) && \
|
|
(defined(MR_HAVE_FILENO) || defined(fileno)) && defined(S_ISDIR)
|
|
{
|
|
struct stat stat_info;
|
|
int stat_errno;
|
|
|
|
if (0 != fstat(fileno(f), &stat_info)) {
|
|
stat_errno = errno;
|
|
fclose(f);
|
|
errno = stat_errno;
|
|
return NULL;
|
|
}
|
|
if (S_ISDIR(stat_info.st_mode)) {
|
|
fclose(f);
|
|
errno = EISDIR;
|
|
return NULL;
|
|
}
|
|
}
|
|
#endif
|
|
|
|
mf = MR_GC_NEW_ATTRIB(MercuryFile, alloc_id);
|
|
MR_mercuryfile_init(f, 1, mf);
|
|
return mf;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_code("C", "
|
|
int
|
|
mercury_get_byte(MercuryFilePtr mf)
|
|
{
|
|
int c = MR_GETCH(*mf);
|
|
if (c == '\\n') {
|
|
MR_line_number(*mf)++;
|
|
}
|
|
return c;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_code("C", "
|
|
#include <errno.h>
|
|
|
|
#ifdef EBADF
|
|
#define MR_CLOSED_FILE_ERROR EBADF
|
|
#else
|
|
// ANSI/ISO C guarantees that EDOM will exist.
|
|
#define MR_CLOSED_FILE_ERROR EDOM
|
|
#endif
|
|
|
|
#ifdef MR_NEW_MERCURYFILE_STRUCT
|
|
|
|
static int
|
|
ME_closed_stream_close(MR_StreamInfo *info)
|
|
{
|
|
errno = MR_CLOSED_FILE_ERROR;
|
|
return EOF;
|
|
}
|
|
|
|
static int
|
|
ME_closed_stream_read(MR_StreamInfo *info, void *buffer, size_t size)
|
|
{
|
|
errno = MR_CLOSED_FILE_ERROR;
|
|
return -1; // XXX should this be 0?
|
|
}
|
|
|
|
static int
|
|
ME_closed_stream_write(MR_StreamInfo *info, const void *buffer, size_t size)
|
|
{
|
|
errno = MR_CLOSED_FILE_ERROR;
|
|
return -1; // XXX should this be 0?
|
|
}
|
|
|
|
static int
|
|
ME_closed_stream_flush(MR_StreamInfo *info)
|
|
{
|
|
errno = MR_CLOSED_FILE_ERROR;
|
|
return EOF;
|
|
}
|
|
|
|
static int
|
|
ME_closed_stream_ungetch(MR_StreamInfo *info, int ch)
|
|
{
|
|
errno = MR_CLOSED_FILE_ERROR;
|
|
return EOF;
|
|
}
|
|
|
|
static int
|
|
ME_closed_stream_getch(MR_StreamInfo *info)
|
|
{
|
|
errno = MR_CLOSED_FILE_ERROR;
|
|
return EOF;
|
|
}
|
|
|
|
static int
|
|
ME_closed_stream_vfprintf(MR_StreamInfo *info, const char *format, va_list ap)
|
|
{
|
|
errno = MR_CLOSED_FILE_ERROR;
|
|
return EOF;
|
|
}
|
|
|
|
static int
|
|
ME_closed_stream_putch(MR_StreamInfo *info, int ch)
|
|
{
|
|
errno = MR_CLOSED_FILE_ERROR;
|
|
return EOF;
|
|
}
|
|
|
|
static int
|
|
ME_closed_stream_ferror(MR_StreamInfo *info)
|
|
{
|
|
return 0;
|
|
}
|
|
|
|
static const MercuryFile MR_closed_stream = {
|
|
/* stream_type = */ MR_USER_STREAM,
|
|
/* stream_info = */ { NULL },
|
|
/* line_number = */ 0,
|
|
|
|
/* close = */ ME_closed_stream_close,
|
|
/* read = */ ME_closed_stream_read,
|
|
/* write = */ ME_closed_stream_write,
|
|
|
|
/* flush = */ ME_closed_stream_flush,
|
|
/* ungetc = */ ME_closed_stream_ungetch,
|
|
/* getc = */ ME_closed_stream_getch,
|
|
/* vprintf = */ ME_closed_stream_vfprintf,
|
|
/* putc = */ ME_closed_stream_putch,
|
|
/* ferror = */ ME_closed_stream_ferror
|
|
};
|
|
|
|
#endif // MR_NEW_MERCURYFILE_STRUCT
|
|
|
|
int
|
|
mercury_close(MercuryFilePtr mf)
|
|
{
|
|
// On some systems, attempting to close a file stream that has been
|
|
// previously closed will lead to a segmentation fault. We check
|
|
// that we have not previously closed the file stream here so we
|
|
// can give the user some idea about what has happened.
|
|
if (MR_file(*mf) == NULL) {
|
|
errno = MR_CLOSED_FILE_ERROR;
|
|
return EOF;
|
|
}
|
|
|
|
if (MR_CLOSE(*mf) < 0) {
|
|
return EOF;
|
|
}
|
|
|
|
#ifdef MR_NEW_MERCURYFILE_STRUCT
|
|
|
|
// MR_closed_stream is a dummy stream object containing pointers to
|
|
// functions that always return an error indication. Doing this ensures
|
|
// that future accesses to the file will fail nicely.
|
|
|
|
// gcc 2.95.2 barfs on `*mf = MR_closed_stream;'
|
|
// so we use MR_memcpy() instead.
|
|
MR_memcpy(mf, &MR_closed_stream, sizeof(*mf));
|
|
|
|
// XXX It would be nice to have an autoconf check for the GNU libc
|
|
// function fopencookie(); we could use that to do a similar thing to what
|
|
// we do in the MR_NEW_MERCURYFILE_STRUCT case.
|
|
|
|
/****
|
|
#elif defined(HAVE_FOPENCOOKIE)
|
|
MR_file(*mf) = MR_closed_file;
|
|
****/
|
|
|
|
#else
|
|
|
|
// We want future accesses to the file to fail nicely. Ideally they would
|
|
// throw an exception, but that would require a check at every I/O
|
|
// operation, and for simple operations like putchar() or getchar(),
|
|
// that would be too expensive. Instead we just set the file pointer
|
|
// to NULL; on systems which trap null pointer dereferences, or if
|
|
// library/io.m is compiled with MR_assert assertions enabled
|
|
// (i.e. -DMR_LOWLEVEL_DEBUG), this will ensure that accessing closed files
|
|
// traps immediately rather than causing problems at some later point.
|
|
MR_mercuryfile_init(NULL, 0, mf);
|
|
|
|
#endif // ! MR_NEW_MERCURYFILE_STRUCT
|
|
|
|
#ifndef MR_CONSERVATIVE_GC
|
|
if (mf == &mercury_stdin ||
|
|
mf == &mercury_stdout ||
|
|
mf == &mercury_stderr ||
|
|
mf == &mercury_stdin_binary ||
|
|
mf == &mercury_stdout_binary)
|
|
{
|
|
// The memory for these streams is allocated statically,
|
|
// so there is nothing to free.
|
|
} else {
|
|
// For the accurate GC or no GC cases, we need to explicitly deallocate
|
|
// the memory here, to avoid a memory leak. Note that the accurate
|
|
// collector won't reclaim io_streams, since the io.stream type
|
|
// is defined as a foreign_type.
|
|
MR_GC_free(mf);
|
|
}
|
|
#endif // !MR_CONSERVATIVE_GC
|
|
|
|
return 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_code("C", "
|
|
int
|
|
ML_fprintf(MercuryFilePtr mf, const char *format, ...)
|
|
{
|
|
int rc;
|
|
va_list args;
|
|
|
|
va_start(args, format);
|
|
rc = MR_VFPRINTF(*mf, format, args);
|
|
va_end(args);
|
|
|
|
return rc;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_code("C", "
|
|
#ifdef MR_WIN32
|
|
|
|
// Accessing Unicode file names on Windows requires that we use the functions
|
|
// taking wide character strings.
|
|
wchar_t *
|
|
ML_utf8_to_wide(const char *s)
|
|
{
|
|
int wslen;
|
|
wchar_t *ws;
|
|
|
|
wslen = MultiByteToWideChar(CP_UTF8, 0, s, -1, NULL, 0);
|
|
if (wslen == 0) {
|
|
MR_fatal_error(""ML_utf8_to_wide: MultiByteToWideChar failed"");
|
|
}
|
|
ws = MR_GC_NEW_ARRAY(wchar_t, wslen);
|
|
if (0 == MultiByteToWideChar(CP_UTF8, 0, s, -1, ws, wslen)) {
|
|
MR_fatal_error(""ML_utf8_to_wide: MultiByteToWideChar failed"");
|
|
}
|
|
return ws;
|
|
}
|
|
|
|
char *
|
|
ML_wide_to_utf8(const wchar_t *ws, MR_AllocSiteInfoPtr alloc_id)
|
|
{
|
|
char *s;
|
|
int bytes;
|
|
|
|
bytes = WideCharToMultiByte(CP_UTF8, 0, ws, -1, NULL, 0, NULL, NULL);
|
|
if (bytes == 0) {
|
|
MR_fatal_error(""ML_wide_to_utf8: WideCharToMultiByte failed"");
|
|
}
|
|
MR_allocate_aligned_string_msg(s, bytes, alloc_id);
|
|
if (0 == WideCharToMultiByte(CP_UTF8, 0, ws, -1, s, bytes, NULL, NULL)) {
|
|
MR_fatal_error(""ML_wide_to_utf8: WideCharToMultiByte failed"");
|
|
}
|
|
return s;
|
|
}
|
|
|
|
#endif // MR_WIN32
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_code("Java", "
|
|
public static tree234.Tree234_2<Integer, Stream_info_0> ML_io_stream_db
|
|
= new tree234.Tree234_2.Empty_0<Integer, Stream_info_0>();
|
|
public static univ.Univ_0 ML_io_user_globals = null;
|
|
").
|
|
|
|
:- pragma foreign_code("Java", "
|
|
// While strings are stored internally as UTF-16, all text file I/O
|
|
// (including stdin/stdout/stderr) is run through stream readers/writers
|
|
// that use UTF-8 encoding.
|
|
// Binary files are opened via RandomAccessFile, which supports seek,
|
|
// but not character encoding/decoding or buffering.
|
|
// Binary stdin and stdout are a special case. They are opened via
|
|
// FileInput/OutputStreams and seeking is controlled through use of
|
|
// FileChannels.
|
|
//
|
|
// The use of the methods in this implementation is not very flexible.
|
|
// You may not perform text mode operations on a binary file or vice versa.
|
|
// XXX This causes problems for io.read_binary and io.write_binary,
|
|
// for which the current implementations attempt to access binary
|
|
// streams using text mode operations (and so will definitely break.)
|
|
|
|
public abstract static class MR_MercuryFileStruct {
|
|
public static int ML_next_stream_id = 0;
|
|
public int id;
|
|
|
|
protected MR_MercuryFileStruct() {
|
|
assign_id();
|
|
}
|
|
|
|
private synchronized void assign_id() {
|
|
id = ML_next_stream_id++;
|
|
}
|
|
|
|
abstract public void close() throws java.io.IOException;
|
|
}
|
|
|
|
public static class MR_TextInputFile
|
|
extends MR_MercuryFileStruct
|
|
{
|
|
private java.io.InputStreamReader input = null;
|
|
private char[] buf = new char[1024];
|
|
private int buf_pos = 0;
|
|
private int buf_end = 0;
|
|
public int line_number = 1;
|
|
|
|
public MR_TextInputFile(java.io.InputStream stream) {
|
|
try {
|
|
input = new java.io.InputStreamReader(stream, ""UTF-8"");
|
|
} catch (java.io.UnsupportedEncodingException e) {
|
|
// This will never happen.
|
|
throw new Error(e.toString());
|
|
}
|
|
}
|
|
|
|
// refill_buffer():
|
|
// Returns true if the end of the stream has not been reached.
|
|
private boolean refill_buffer()
|
|
throws java.io.IOException
|
|
{
|
|
if (buf_end == buf_pos) {
|
|
int n = input.read(buf, 0, buf.length);
|
|
if (n == -1) {
|
|
return false;
|
|
}
|
|
buf_end = n;
|
|
buf_pos = 0;
|
|
}
|
|
return true;
|
|
}
|
|
|
|
private int read_code_unit()
|
|
throws java.io.IOException
|
|
{
|
|
if (!refill_buffer()) {
|
|
return -1;
|
|
}
|
|
|
|
char c = buf[buf_pos];
|
|
buf_pos++;
|
|
return (int) c;
|
|
}
|
|
|
|
// read_char(): [Java]
|
|
//
|
|
// Reads one character in from a text input file using the default
|
|
// charset decoding. Returns -1 at end of file.
|
|
public int read_char()
|
|
throws java.io.IOException
|
|
{
|
|
final int c1 = read_code_unit();
|
|
if (c1 == -1) {
|
|
return -1;
|
|
}
|
|
if (c1 == '\\n') {
|
|
line_number++;
|
|
}
|
|
if (!Character.isHighSurrogate((char) c1)) {
|
|
return c1;
|
|
}
|
|
final int c2 = read_code_unit();
|
|
if (c2 != -1 && !Character.isLowSurrogate((char) c2)) {
|
|
// Return replacement character.
|
|
return 0xfffd;
|
|
}
|
|
return Character.toCodePoint((char) c1, (char) c2);
|
|
}
|
|
|
|
// read_line(): [Java]
|
|
//
|
|
// Reads in a line of a text input file using the default
|
|
// charset decoding. Returns null at end of file.
|
|
public String read_line()
|
|
throws java.io.IOException
|
|
{
|
|
if (!refill_buffer()) {
|
|
return null;
|
|
}
|
|
|
|
// Commonly, the buffer already contains a complete line.
|
|
for (int i = buf_pos; i < buf_end; i++) {
|
|
if (buf[i] == '\\n') {
|
|
String s = new String(buf, buf_pos, i - buf_pos + 1);
|
|
buf_pos = i + 1;
|
|
line_number++;
|
|
return s;
|
|
}
|
|
}
|
|
|
|
// The buffer doesn't contain a complete line.
|
|
StringBuilder sb = new StringBuilder();
|
|
|
|
sb.append(buf, buf_pos, buf_end - buf_pos);
|
|
buf_pos = buf_end;
|
|
|
|
while (refill_buffer()) {
|
|
for (int i = buf_pos; i < buf_end; i++) {
|
|
if (buf[i] == '\\n') {
|
|
sb.append(buf, buf_pos, i - buf_pos + 1);
|
|
buf_pos = i + 1;
|
|
line_number++;
|
|
return sb.toString();
|
|
}
|
|
}
|
|
|
|
sb.append(buf, buf_pos, buf_end - buf_pos);
|
|
buf_pos = buf_end;
|
|
}
|
|
|
|
return sb.toString();
|
|
}
|
|
|
|
// read_file(): [Java]
|
|
//
|
|
// Reads in the rest of a text input file using the default
|
|
// charset decoding.
|
|
public void read_file(StringBuilder sb)
|
|
throws java.io.IOException
|
|
{
|
|
int n;
|
|
|
|
sb.append(buf, buf_pos, buf_end - buf_pos);
|
|
buf_pos = buf_end;
|
|
|
|
while ((n = input.read(buf)) > -1) {
|
|
for (int i = 0; i < n; i++) {
|
|
if (buf[i] == '\\n') {
|
|
line_number++;
|
|
}
|
|
}
|
|
sb.append(buf, 0, n);
|
|
}
|
|
}
|
|
|
|
private void unget_code_unit(char c) {
|
|
// If necessary, shift the unread characters in the input buffer
|
|
// to make room at the front of the buffer. If the buffer is full
|
|
// then allocate a bigger buffer.
|
|
if (buf_pos == 0) {
|
|
if (buf_end < buf.length) {
|
|
int offset = buf.length - buf_end;
|
|
System.arraycopy(buf, 0, buf, offset, buf_end);
|
|
buf_pos = offset;
|
|
buf_end = buf.length;
|
|
} else {
|
|
char[] new_buf = new char[buf.length * 2];
|
|
int offset = new_buf.length - buf_end;
|
|
System.arraycopy(buf, 0, new_buf, offset, buf_end);
|
|
buf = new_buf;
|
|
buf_pos = offset;
|
|
buf_end = new_buf.length;
|
|
}
|
|
}
|
|
|
|
buf[--buf_pos] = c;
|
|
}
|
|
|
|
public void ungetc(int c) {
|
|
if (Character.charCount(c) == 1) {
|
|
unget_code_unit((char) c);
|
|
if (c == '\\n') {
|
|
line_number--;
|
|
}
|
|
} else {
|
|
char[] units = Character.toChars(c);
|
|
unget_code_unit(units[1]);
|
|
unget_code_unit(units[0]);
|
|
}
|
|
}
|
|
|
|
@Override
|
|
public void close()
|
|
throws java.io.IOException
|
|
{
|
|
input.close();
|
|
}
|
|
} // class MR_TextInputFile
|
|
|
|
public static class MR_TextOutputFile
|
|
extends MR_MercuryFileStruct
|
|
{
|
|
private java.io.BufferedWriter output = null;
|
|
public int line_number = 1;
|
|
|
|
public MR_TextOutputFile(java.io.OutputStream stream) {
|
|
try {
|
|
output = new java.io.BufferedWriter(
|
|
new java.io.OutputStreamWriter(stream, ""UTF-8""));
|
|
}
|
|
catch (java.io.UnsupportedEncodingException e) {
|
|
// This will never happen.
|
|
throw new Error(e.toString());
|
|
}
|
|
}
|
|
|
|
public void put(char c)
|
|
throws java.io.IOException
|
|
{
|
|
output.write(c);
|
|
if (c == '\\n') {
|
|
output.flush();
|
|
line_number++;
|
|
}
|
|
}
|
|
|
|
public void write(java.lang.String s)
|
|
throws java.io.IOException
|
|
{
|
|
output.write(s);
|
|
|
|
int old_line_number = line_number;
|
|
for (int i = 0; i < s.length(); i++) {
|
|
if (s.charAt(i) == '\\n') {
|
|
line_number++;
|
|
}
|
|
}
|
|
|
|
// Flush if we saw a newline.
|
|
if (old_line_number != line_number) {
|
|
output.flush();
|
|
}
|
|
}
|
|
|
|
public void flush()
|
|
throws java.io.IOException
|
|
{
|
|
output.flush();
|
|
}
|
|
|
|
@Override
|
|
public void close()
|
|
throws java.io.IOException
|
|
{
|
|
output.close();
|
|
}
|
|
} // class MR_TextOutputFile
|
|
|
|
public abstract static class MR_BinaryFile
|
|
extends MR_MercuryFileStruct
|
|
{
|
|
// These must match whence_to_int.
|
|
protected static final int SEEK_SET = 0;
|
|
protected static final int SEEK_CUR = 1;
|
|
protected static final int SEEK_END = 2;
|
|
|
|
// channel is used for positioning the stream. Read/write operations
|
|
// use randomaccess, binary_input, binary_output instead.
|
|
protected java.nio.channels.FileChannel channel = null;
|
|
|
|
// size(): [Java]
|
|
//
|
|
// Returns the length of a file.
|
|
public long size()
|
|
throws java.io.IOException
|
|
{
|
|
return channel.size();
|
|
}
|
|
|
|
// getOffset():
|
|
//
|
|
// Returns the current position in a binary file.
|
|
abstract public long getOffset() throws java.io.IOException;
|
|
|
|
// seek(): [Java]
|
|
//
|
|
// Seek relative to start, current position or end depending on the
|
|
// flag.
|
|
public void seek_binary(int flag, long offset)
|
|
throws java.io.IOException
|
|
{
|
|
long position;
|
|
|
|
switch (flag) {
|
|
case SEEK_SET:
|
|
position = offset;
|
|
break;
|
|
case SEEK_CUR:
|
|
position = getOffset() + offset;
|
|
break;
|
|
case SEEK_END:
|
|
position = size() + offset;
|
|
break;
|
|
default:
|
|
throw new java.lang.
|
|
RuntimeException(""Invalid seek flag"");
|
|
}
|
|
|
|
channel.position(position);
|
|
}
|
|
}
|
|
|
|
public static class MR_BinaryInputFile
|
|
extends MR_BinaryFile
|
|
{
|
|
private java.io.FileInputStream binary_input = null;
|
|
protected java.util.Stack<Byte> pushback
|
|
= new java.util.Stack<Byte>();
|
|
|
|
public MR_BinaryInputFile(java.io.FileInputStream in) {
|
|
this.binary_input = in;
|
|
this.channel = in.getChannel();
|
|
}
|
|
|
|
// read_byte(): [Java]
|
|
//
|
|
// Reads one byte in from a binary file. Returns -1 at end of file.
|
|
public int read_byte()
|
|
throws java.io.IOException
|
|
{
|
|
int c;
|
|
if (pushback.empty()) {
|
|
c = binary_input.read();
|
|
} else {
|
|
c = pushback.pop() & 0xff; // make unsigned
|
|
}
|
|
return c;
|
|
}
|
|
|
|
public void ungetc(byte b) {
|
|
pushback.push(b);
|
|
}
|
|
|
|
public int read_pushback(byte[] b, int start, int len)
|
|
{
|
|
final int end = start + len;
|
|
int cur = start;
|
|
while (cur < end && !pushback.empty()) {
|
|
b[cur] = pushback.pop();
|
|
cur++;
|
|
}
|
|
return cur - start;
|
|
}
|
|
|
|
public int read_non_pushback(byte[] b, int start, int len)
|
|
throws java.io.IOException
|
|
{
|
|
int n = binary_input.read(b, start, len);
|
|
if (n < 0) {
|
|
return 0;
|
|
}
|
|
return n;
|
|
}
|
|
|
|
@Override
|
|
public long getOffset()
|
|
throws java.io.IOException
|
|
{
|
|
return channel.position() - pushback.size();
|
|
}
|
|
|
|
@Override
|
|
public void seek_binary(int flag, long offset)
|
|
throws java.io.IOException
|
|
{
|
|
super.seek_binary(flag, offset);
|
|
|
|
pushback = new java.util.Stack<Byte>();
|
|
}
|
|
|
|
@Override
|
|
public void close()
|
|
throws java.io.IOException
|
|
{
|
|
binary_input.close();
|
|
}
|
|
}
|
|
|
|
public static class MR_BinaryOutputFile
|
|
extends MR_BinaryFile
|
|
{
|
|
private java.io.FileOutputStream binary_output = null;
|
|
|
|
public MR_BinaryOutputFile(java.io.FileOutputStream out) {
|
|
this.binary_output = out;
|
|
this.channel = out.getChannel();
|
|
}
|
|
|
|
public void put(byte b)
|
|
throws java.io.IOException
|
|
{
|
|
binary_output.write(b);
|
|
}
|
|
|
|
// Obsolete.
|
|
public void write(java.lang.String s)
|
|
throws java.io.IOException
|
|
{
|
|
for (int i = 0; i < s.length(); i++) {
|
|
// lower 8 bits of each
|
|
put((byte) s.charAt(i));
|
|
}
|
|
}
|
|
|
|
public void write(byte[] bs, int start, int length)
|
|
throws java.io.IOException
|
|
{
|
|
binary_output.write(bs, start, length);
|
|
}
|
|
|
|
public void flush()
|
|
throws java.io.IOException
|
|
{
|
|
binary_output.flush();
|
|
}
|
|
|
|
@Override
|
|
public long getOffset()
|
|
throws java.io.IOException
|
|
{
|
|
return (int) channel.position();
|
|
}
|
|
|
|
@Override
|
|
public void close()
|
|
throws java.io.IOException
|
|
{
|
|
binary_output.close();
|
|
}
|
|
}
|
|
|
|
// StreamPipe is a mechanism for connecting streams to those of a
|
|
// Runtime.exec() Process.
|
|
|
|
private static class StreamPipe extends java.lang.Thread {
|
|
MR_TextInputFile in;
|
|
MR_TextOutputFile out;
|
|
boolean closeOutput = false;
|
|
java.lang.Exception exception = null;
|
|
|
|
StreamPipe(java.io.InputStream in, MR_TextOutputFile out) {
|
|
this.in = new MR_TextInputFile(in);
|
|
this.out = out;
|
|
}
|
|
|
|
StreamPipe(MR_TextInputFile in, java.io.OutputStream out) {
|
|
this.in = in;
|
|
this.out = new MR_TextOutputFile(out);
|
|
closeOutput = true;
|
|
}
|
|
|
|
public void run() {
|
|
try {
|
|
while (true) {
|
|
int c = in.read_char();
|
|
if (c == -1 || interrupted()) {
|
|
break;
|
|
}
|
|
out.put((char) c);
|
|
}
|
|
out.flush();
|
|
if (closeOutput) {
|
|
out.close();
|
|
}
|
|
}
|
|
catch (java.lang.Exception e) {
|
|
exception = e;
|
|
}
|
|
}
|
|
} // class StreamPipe
|
|
").
|
|
|
|
:- pragma foreign_code("Java", "
|
|
public static MR_TextInputFile mercury_stdin =
|
|
new MR_TextInputFile(java.lang.System.in);
|
|
|
|
public static MR_TextOutputFile mercury_stdout =
|
|
new MR_TextOutputFile(java.lang.System.out);
|
|
|
|
public static MR_TextOutputFile mercury_stderr =
|
|
new MR_TextOutputFile(java.lang.System.err);
|
|
|
|
// We initialize mercury_stdin_binary and mercury_stdout_binary
|
|
// only when they are needed, because the initialization code
|
|
// does not work on Google's App Engine.
|
|
|
|
private static MR_BinaryInputFile mercury_stdin_binary = null;
|
|
|
|
private static MR_BinaryOutputFile mercury_stdout_binary = null;
|
|
|
|
private static void ensure_init_mercury_stdin_binary() {
|
|
if (mercury_stdin_binary == null) {
|
|
mercury_stdin_binary = new MR_BinaryInputFile(
|
|
new java.io.FileInputStream(java.io.FileDescriptor.in));
|
|
}
|
|
}
|
|
|
|
private static void ensure_init_mercury_stdout_binary() {
|
|
if (mercury_stdout_binary == null) {
|
|
mercury_stdout_binary = new MR_BinaryOutputFile(
|
|
new java.io.FileOutputStream(java.io.FileDescriptor.out));
|
|
}
|
|
}
|
|
|
|
// Note: these are also set in io.init_state.
|
|
|
|
public static ThreadLocal<MR_TextInputFile> mercury_current_text_input =
|
|
new InheritableThreadLocal<MR_TextInputFile>() {
|
|
protected MR_TextInputFile initialValue() {
|
|
return mercury_stdin;
|
|
}
|
|
};
|
|
|
|
public static ThreadLocal<MR_TextOutputFile> mercury_current_text_output =
|
|
new InheritableThreadLocal<MR_TextOutputFile>() {
|
|
protected MR_TextOutputFile initialValue() {
|
|
return mercury_stdout;
|
|
}
|
|
};
|
|
|
|
public static ThreadLocal<MR_BinaryInputFile> mercury_current_binary_input =
|
|
new InheritableThreadLocal<MR_BinaryInputFile>() {
|
|
protected MR_BinaryInputFile initialValue() {
|
|
ensure_init_mercury_stdin_binary();
|
|
return mercury_stdin_binary;
|
|
}
|
|
};
|
|
|
|
public static ThreadLocal<MR_BinaryOutputFile> mercury_current_binary_output =
|
|
new InheritableThreadLocal<MR_BinaryOutputFile>() {
|
|
protected MR_BinaryOutputFile initialValue() {
|
|
ensure_init_mercury_stdout_binary();
|
|
return mercury_stdout_binary;
|
|
}
|
|
};
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_decl("C#", "
|
|
using System;
|
|
using System.IO;
|
|
using System.Runtime.InteropServices;
|
|
using System.Security.AccessControl;
|
|
using System.Security.Principal;
|
|
").
|
|
|
|
:- pragma foreign_code("C#", "
|
|
// The ML_ prefixes here are not really needed,
|
|
// since the C# code all gets generated inside a class,
|
|
// but we keep them for consistency with the C code.
|
|
|
|
public static tree234.Tree234_2 ML_io_stream_db =
|
|
new tree234.Tree234_2.Empty_0();
|
|
public static univ.Univ_0 ML_io_user_globals;
|
|
|
|
// a counter used to generate unique stream ids
|
|
static int ML_next_stream_id;
|
|
|
|
// This specifies the default encoding used for text files.
|
|
// It must be either ML_OS_text_encoding or ML_Unix_text_encoding.
|
|
//
|
|
// XXX The initial setting for this should be controlled
|
|
// by an environment variable. (This might require moving
|
|
// the code which initializes mercury_stdin, etc.)
|
|
//
|
|
static readonly ML_line_ending_kind ML_default_line_ending =
|
|
ML_line_ending_kind.ML_OS_line_ending;
|
|
|
|
// Assume UTF-8 encoding on files. When writing a file, don't emit
|
|
// a byte order mark.
|
|
static readonly System.Text.Encoding text_encoding =
|
|
new System.Text.UTF8Encoding(false);
|
|
|
|
#if __MonoCS__
|
|
// int chmod(const char *path, mode_t mode);
|
|
[DllImport(""libc"", SetLastError=true, EntryPoint=""mkdir"",
|
|
CallingConvention=CallingConvention.Cdecl)]
|
|
static extern int ML_sys_mkdir (string path, uint mode);
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_code("C#", "
|
|
public enum ML_line_ending_kind {
|
|
ML_OS_line_ending, // file uses the usual line-ending convention
|
|
// for the OS (e.g. CR-LF for DOS/Windows).
|
|
|
|
ML_Unix_line_ending, // file uses the Unix line-encoding convention.
|
|
|
|
ML_raw_binary // file stores bytes
|
|
};
|
|
|
|
public class MR_MercuryFileStruct {
|
|
// Note that stream reader and writer are initialized lazily;
|
|
// that is, if the stream has not yet been used for reading,
|
|
// the `reader' field may be null. Any code which accesses that
|
|
// field must check for null and initialize it if needed.
|
|
// Likewise for the `writer' field.
|
|
|
|
public System.IO.Stream stream; // The stream itself
|
|
public System.IO.TextReader reader; // The stream reader for it
|
|
public System.IO.TextWriter writer; // The stream writer for it
|
|
public int putback;
|
|
// the next character or byte to read,
|
|
// or -1 if no putback char/byte is stored
|
|
|
|
public ML_line_ending_kind line_ending;
|
|
// DOS, Unix, or raw binary
|
|
|
|
public int line_number;
|
|
public int id;
|
|
};
|
|
").
|
|
|
|
:- pragma foreign_code("C#", "
|
|
static MR_MercuryFileStruct
|
|
mercury_file_init(System.IO.Stream stream,
|
|
System.IO.TextReader reader, System.IO.TextWriter writer,
|
|
ML_line_ending_kind line_ending)
|
|
{
|
|
MR_MercuryFileStruct mf = new MR_MercuryFileStruct();
|
|
mf.stream = stream;
|
|
mf.reader = reader;
|
|
mf.putback = -1;
|
|
mf.writer = writer;
|
|
mf.line_ending = line_ending;
|
|
mf.line_number = 1;
|
|
mf.id = ML_next_stream_id++;
|
|
return mf;
|
|
}
|
|
|
|
// Note: for Windows GUI programs, the Console is set to the equivalent
|
|
// of /dev/null. This could perhaps be considered a problem. But if so,
|
|
// it is a problem in Windows, not in Mercury -- I don't think it is one
|
|
// that the Mercury implementation should try to solve.
|
|
|
|
public static MR_MercuryFileStruct mercury_stdin =
|
|
mercury_file_init(System.Console.OpenStandardInput(),
|
|
System.Console.In, null, ML_default_line_ending);
|
|
public static MR_MercuryFileStruct mercury_stdout =
|
|
mercury_file_init(System.Console.OpenStandardOutput(),
|
|
null, System.Console.Out, ML_default_line_ending);
|
|
public static MR_MercuryFileStruct mercury_stderr =
|
|
mercury_file_init(System.Console.OpenStandardError(),
|
|
null, System.Console.Error, ML_default_line_ending);
|
|
|
|
// XXX should we use BufferedStreams here?
|
|
public static MR_MercuryFileStruct mercury_stdin_binary =
|
|
mercury_file_init(System.Console.OpenStandardInput(),
|
|
System.Console.In, null, ML_line_ending_kind.ML_raw_binary);
|
|
public static MR_MercuryFileStruct mercury_stdout_binary =
|
|
mercury_file_init(System.Console.OpenStandardOutput(),
|
|
null, System.Console.Out, ML_line_ending_kind.ML_raw_binary);
|
|
|
|
// Note: these are set again in io.init_state.
|
|
public static MR_MercuryFileStruct mercury_current_text_input =
|
|
mercury_stdin;
|
|
public static MR_MercuryFileStruct mercury_current_text_output =
|
|
mercury_stdout;
|
|
public static MR_MercuryFileStruct mercury_current_binary_input =
|
|
mercury_stdin_binary;
|
|
public static MR_MercuryFileStruct mercury_current_binary_output =
|
|
mercury_stdout_binary;
|
|
|
|
").
|
|
|
|
:- pragma foreign_code("C#", "
|
|
public static
|
|
MR_MercuryFileStruct mercury_open(string filename, string openmode,
|
|
ML_line_ending_kind line_ending)
|
|
{
|
|
System.IO.FileMode mode;
|
|
System.IO.FileAccess access;
|
|
System.IO.FileShare share;
|
|
System.IO.Stream stream = null;
|
|
|
|
if (openmode == ""r"" || openmode == ""rb"") {
|
|
// Like '<' in Bourne shell.
|
|
// Read a file. The file must exist already.
|
|
mode = System.IO.FileMode.Open;
|
|
access = System.IO.FileAccess.Read;
|
|
} else if (openmode == ""w"" || openmode == ""wb"") {
|
|
// Like '>' in Bourne shell.
|
|
// Overwrite an existing file, or create a new file.
|
|
mode = System.IO.FileMode.Create;
|
|
access = System.IO.FileAccess.Write;
|
|
} else if (openmode == ""a"" || openmode == ""ab"") {
|
|
// Like '>>' in Bourne shell.
|
|
// Append to an existing file, or create a new file.
|
|
mode = System.IO.FileMode.Append;
|
|
access = System.IO.FileAccess.Write;
|
|
} else {
|
|
runtime.Errors.SORRY(System.String.Concat(
|
|
""foreign code for this function, open mode:"",
|
|
openmode));
|
|
// Needed to convince the C# compiler that mode and
|
|
// access are always initialized.
|
|
throw new System.Exception();
|
|
}
|
|
|
|
// For Unix compatibility, we allow files
|
|
// to be read or written by multiple processes
|
|
// simultaneously. XXX Is this a good idea?
|
|
share = System.IO.FileShare.ReadWrite;
|
|
|
|
stream = System.IO.File.Open(filename, mode, access, share);
|
|
|
|
// We initialize the `reader' and `writer' fields to null;
|
|
// they will be filled in later if they are needed.
|
|
return mercury_file_init(new System.IO.BufferedStream(stream),
|
|
null, null, line_ending);
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_code("C#", "
|
|
// Any changes here should also be reflected in the code for
|
|
// io.write_char, which (for efficiency) uses its own inline
|
|
// code, rather than calling this function.
|
|
public static void
|
|
mercury_print_string(MR_MercuryFileStruct mf, string s)
|
|
{
|
|
if (mf.writer == null) {
|
|
mf.writer = new System.IO.StreamWriter(mf.stream, text_encoding);
|
|
}
|
|
|
|
switch (mf.line_ending) {
|
|
case ML_line_ending_kind.ML_raw_binary:
|
|
case ML_line_ending_kind.ML_Unix_line_ending:
|
|
mf.writer.Write(s);
|
|
for (int i = 0; i < s.Length; i++) {
|
|
if (s[i] == '\\n') {
|
|
mf.line_number++;
|
|
}
|
|
}
|
|
break;
|
|
case ML_line_ending_kind.ML_OS_line_ending:
|
|
// We can't just use the System.TextWriter.Write(String) method,
|
|
// since that method doesn't convert newline characters to the
|
|
// system's newline convention (e.g. CR-LF on Windows).
|
|
// Only the WriteLine(...) method handles those properly.
|
|
// So we have to output each character separately.
|
|
|
|
for (int i = 0; i < s.Length; i++) {
|
|
if (System.Char.IsSurrogate(s[i])) {
|
|
mf.writer.Write(s.Substring(i, 2));
|
|
i++;
|
|
} else if (s[i] == '\\n') {
|
|
mf.line_number++;
|
|
mf.writer.WriteLine("""");
|
|
} else {
|
|
mf.writer.Write(s[i]);
|
|
}
|
|
}
|
|
break;
|
|
}
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_code("C#", "
|
|
// Read in a character. This means reading in one or more bytes,
|
|
// converting the bytes from the system's default encoding to Unicode,
|
|
// and possibly converting CR-LF to newline. Returns -1 on EOF, and
|
|
// throws an exception on error.
|
|
|
|
private static readonly string NewLine = System.Environment.NewLine;
|
|
|
|
public static int
|
|
mercury_getc(MR_MercuryFileStruct mf)
|
|
{
|
|
int c;
|
|
|
|
if (mf.putback != -1) {
|
|
c = mf.putback;
|
|
mf.putback = -1;
|
|
if (c == '\\n') {
|
|
mf.line_number++;
|
|
}
|
|
return c;
|
|
}
|
|
|
|
if (mf.reader == null) {
|
|
mf.reader = new System.IO.StreamReader(mf.stream, text_encoding);
|
|
}
|
|
|
|
c = mf.reader.Read();
|
|
switch (mf.line_ending) {
|
|
case ML_line_ending_kind.ML_raw_binary:
|
|
case ML_line_ending_kind.ML_Unix_line_ending:
|
|
if (c == '\\n') {
|
|
mf.line_number++;
|
|
}
|
|
break;
|
|
case ML_line_ending_kind.ML_OS_line_ending:
|
|
// First, check if the character we've read matches
|
|
// System.Environment.NewLine.
|
|
// We assume that System.Environment.NewLine is non-null
|
|
// and that System.Environment.NewLine.Length > 0.
|
|
if (c != io.NewLine[0]) {
|
|
if (c == '\\n') {
|
|
// the input file was ill-formed, e.g. it contained only raw
|
|
// LFs rather than CR-LF. Perhaps we should throw an exception?
|
|
// If not, we still need to treat this as a newline, and thus
|
|
// increment the line counter.
|
|
mf.line_number++;
|
|
} else if (System.Char.IsSurrogate((char) c)) {
|
|
int c2 = mf.reader.Read();
|
|
c = System.Char.ConvertToUtf32((char) c, (char) c2);
|
|
}
|
|
} else /* c == NewLine[0] */ {
|
|
switch (io.NewLine.Length) {
|
|
case 1:
|
|
mf.line_number++;
|
|
c = '\\n';
|
|
break;
|
|
case 2:
|
|
if (mf.reader.Peek() == io.NewLine[1]) {
|
|
mf.reader.Read();
|
|
mf.line_number++;
|
|
c = '\\n';
|
|
} else if (c == '\\n') {
|
|
// the input file was ill-formed, e.g. it contained only
|
|
// raw CRs rather than CR-LF. Perhaps we should throw an
|
|
// exception? If not, we still need to treat this
|
|
// as a newline, and thus increment the line counter.
|
|
mf.line_number++;
|
|
}
|
|
break;
|
|
default:
|
|
runtime.Errors.SORRY(
|
|
""mercury_getc: Environment.NewLine.Length"" +
|
|
""is neither 1 nor 2"");
|
|
break;
|
|
}
|
|
}
|
|
break;
|
|
}
|
|
return c;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_code("C#", "
|
|
public static void
|
|
mercury_write_codepoint(System.IO.TextWriter w, int c)
|
|
{
|
|
if (c <= 0xffff) {
|
|
w.Write((char) c);
|
|
} else {
|
|
w.Write(System.Char.ConvertFromUtf32(c));
|
|
}
|
|
}
|
|
|
|
public static void
|
|
mercury_close(MR_MercuryFileStruct mf)
|
|
{
|
|
if (mf.reader != null) {
|
|
mf.reader.Close();
|
|
mf.reader = null;
|
|
}
|
|
if (mf.writer != null) {
|
|
mf.writer.Close();
|
|
mf.writer = null;
|
|
}
|
|
mf.stream.Close();
|
|
mf.stream = null;
|
|
}
|
|
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Opening and closing streams, both text and binary.
|
|
%
|
|
|
|
open_input(FileName, Result, !IO) :-
|
|
do_open_text(FileName, "r", OpenCount, NewStream, Error, !IO),
|
|
is_error(Error, "can't open input file: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(input_stream(NewStream)),
|
|
insert_stream_info(NewStream,
|
|
stream(OpenCount, input, text, file(FileName)), !IO)
|
|
).
|
|
|
|
open_binary_input(FileName, Result, !IO) :-
|
|
do_open_binary(FileName, "rb", OpenCount, NewStream, Error, !IO),
|
|
is_error(Error, "can't open input file: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(binary_input_stream(NewStream)),
|
|
insert_stream_info(NewStream,
|
|
stream(OpenCount, input, binary, file(FileName)), !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
open_output(FileName, Result, !IO) :-
|
|
do_open_text(FileName, "w", OpenCount, NewStream, Error, !IO),
|
|
is_error(Error, "can't open output file: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(output_stream(NewStream)),
|
|
insert_stream_info(NewStream,
|
|
stream(OpenCount, output, text, file(FileName)), !IO)
|
|
).
|
|
|
|
open_binary_output(FileName, Result, !IO) :-
|
|
do_open_binary(FileName, "wb", OpenCount, NewStream, Error, !IO),
|
|
is_error(Error, "can't open output file: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(binary_output_stream(NewStream)),
|
|
insert_stream_info(NewStream,
|
|
stream(OpenCount, output, binary, file(FileName)), !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
open_append(FileName, Result, !IO) :-
|
|
do_open_text(FileName, "a", OpenCount, NewStream, Error, !IO),
|
|
is_error(Error, "can't append to file: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(output_stream(NewStream)),
|
|
insert_stream_info(NewStream,
|
|
stream(OpenCount, append, text, file(FileName)), !IO)
|
|
).
|
|
|
|
open_binary_append(FileName, Result, !IO) :-
|
|
do_open_binary(FileName, "ab", OpenCount, NewStream, Error, !IO),
|
|
is_error(Error, "can't append to file: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(binary_output_stream(NewStream)),
|
|
insert_stream_info(NewStream,
|
|
stream(OpenCount, append, binary, file(FileName)), !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
% do_open_binary(File, Mode, StreamId, Stream, Error, !IO):
|
|
% do_open_text(File, Mode, StreamId, Stream, Error, !IO):
|
|
%
|
|
% Attempts to open a file in the specified mode.
|
|
% The Mode is a string suitable for passing to fopen().
|
|
% StreamId is a unique integer identifying the open.
|
|
% StreamId and Stream are valid only if Error indicates an error occurred.
|
|
%
|
|
:- pred do_open_text(string::in, string::in, int::out, stream::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_open_text(FileName::in, Mode::in, StreamId::out, Stream::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
Stream = mercury_open(FileName, Mode, MR_ALLOC_ID);
|
|
if (Stream != NULL) {
|
|
StreamId = mercury_next_stream_id();
|
|
Error = 0;
|
|
} else {
|
|
StreamId = -1;
|
|
Error = errno;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_open_text(FileName::in, Mode::in, StreamId::out, Stream::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
Stream = io.mercury_open(FileName, Mode, io.ML_default_line_ending);
|
|
StreamId = Stream.id;
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
StreamId = -1;
|
|
Stream = null;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_open_text(FileName::in, Mode::in, StreamId::out, Stream::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
try {
|
|
switch (Mode.charAt(0)) {
|
|
case 'r':
|
|
Stream = new MR_TextInputFile(
|
|
new java.io.FileInputStream(FileName));
|
|
break;
|
|
case 'w':
|
|
Stream = new MR_TextOutputFile(
|
|
new java.io.FileOutputStream(FileName));
|
|
break;
|
|
case 'a':
|
|
Stream = new MR_TextOutputFile(
|
|
new java.io.FileOutputStream(FileName, true));
|
|
break;
|
|
default:
|
|
throw new RuntimeException(""Invalid file opening mode: "" +
|
|
Mode);
|
|
}
|
|
StreamId = Stream.id;
|
|
Error = null;
|
|
} catch (java.lang.Exception e) {
|
|
Stream = null;
|
|
StreamId = -1;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_open_binary(string::in, string::in, int::out, stream::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_open_binary(FileName::in, Mode::in, StreamId::out, Stream::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
Stream = mercury_open(FileName, Mode, MR_ALLOC_ID);
|
|
if (Stream != NULL) {
|
|
StreamId = mercury_next_stream_id();
|
|
Error = 0;
|
|
} else {
|
|
StreamId = -1;
|
|
Error = errno;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_open_binary(FileName::in, Mode::in, StreamId::out, Stream::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
Stream = io.mercury_open(FileName, Mode,
|
|
io.ML_line_ending_kind.ML_raw_binary);
|
|
StreamId = Stream.id;
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
StreamId = -1;
|
|
Stream = null;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_open_binary(FileName::in, Mode::in, StreamId::out, Stream::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
try {
|
|
switch (Mode.charAt(0)) {
|
|
case 'r':
|
|
Stream = new io.MR_BinaryInputFile(
|
|
new java.io.FileInputStream(FileName));
|
|
break;
|
|
case 'w':
|
|
Stream = new io.MR_BinaryOutputFile(
|
|
new java.io.FileOutputStream(FileName));
|
|
break;
|
|
case 'a':
|
|
Stream = new io.MR_BinaryOutputFile(
|
|
new java.io.FileOutputStream(FileName, true));
|
|
break;
|
|
default:
|
|
throw new RuntimeException(""Invalid file opening mode: "" +
|
|
Mode);
|
|
}
|
|
StreamId = Stream.id;
|
|
Error = null;
|
|
} catch (java.lang.Exception e) {
|
|
Stream = null;
|
|
StreamId = -1;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
close_input(input_stream(Stream), !IO) :-
|
|
maybe_delete_stream_info(Stream, !IO),
|
|
close_stream(Stream, Error, !IO),
|
|
throw_on_close_error(Error, !IO).
|
|
|
|
close_binary_input(binary_input_stream(Stream), !IO) :-
|
|
maybe_delete_stream_info(Stream, !IO),
|
|
close_stream(Stream, Error, !IO),
|
|
throw_on_close_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
close_output(output_stream(Stream), !IO) :-
|
|
maybe_delete_stream_info(Stream, !IO),
|
|
close_stream(Stream, Error, !IO),
|
|
throw_on_close_error(Error, !IO).
|
|
|
|
close_binary_output(binary_output_stream(Stream), !IO) :-
|
|
maybe_delete_stream_info(Stream, !IO),
|
|
close_stream(Stream, Error, !IO),
|
|
throw_on_close_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred close_stream(stream::in, system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
close_stream(Stream::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (mercury_close(Stream) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
close_stream(Stream::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
io.mercury_close(Stream);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
close_stream(Stream::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
try {
|
|
Stream.close();
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Switching streams.
|
|
%
|
|
|
|
set_input_stream(input_stream(NewStream), input_stream(OutStream), !IO) :-
|
|
set_input_stream_2(NewStream, OutStream, !IO).
|
|
|
|
:- pred set_input_stream_2(stream::in, stream::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
set_input_stream_2(NewStream::in, OutStream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
OutStream = mercury_current_text_input();
|
|
MR_set_thread_local_mutable(MercuryFilePtr, NewStream,
|
|
mercury_current_text_input_index);
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
set_input_stream_2(NewStream::in, OutStream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
OutStream = io.mercury_current_text_input;
|
|
io.mercury_current_text_input = NewStream;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
set_input_stream_2(NewStream::in, OutStream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
OutStream = io.mercury_current_text_input.get();
|
|
io.mercury_current_text_input.set((io.MR_TextInputFile) NewStream);
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
set_binary_input_stream(binary_input_stream(NewStream),
|
|
binary_input_stream(OutStream), !IO) :-
|
|
set_binary_input_stream_2(NewStream, OutStream, !IO).
|
|
|
|
:- pred set_binary_input_stream_2(stream::in, stream::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
set_binary_input_stream_2(NewStream::in, OutStream::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
OutStream = mercury_current_binary_input();
|
|
MR_set_thread_local_mutable(MercuryFilePtr, NewStream,
|
|
mercury_current_binary_input_index);
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
set_binary_input_stream_2(NewStream::in, OutStream::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
OutStream = io.mercury_current_binary_input;
|
|
io.mercury_current_binary_input = NewStream;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
set_binary_input_stream_2(NewStream::in, OutStream::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
OutStream = io.mercury_current_binary_input.get();
|
|
io.mercury_current_binary_input.set((io.MR_BinaryInputFile) NewStream);
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
set_output_stream(output_stream(NewStream), output_stream(OutStream), !IO) :-
|
|
set_output_stream_2(NewStream, OutStream, !IO).
|
|
|
|
:- pred set_output_stream_2(stream::in, stream::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
set_output_stream_2(NewStream::in, OutStream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
OutStream = mercury_current_text_output();
|
|
MR_set_thread_local_mutable(MercuryFilePtr, NewStream,
|
|
mercury_current_text_output_index);
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
set_output_stream_2(NewStream::in, OutStream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
OutStream = io.mercury_current_text_output;
|
|
io.mercury_current_text_output = NewStream;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
set_output_stream_2(NewStream::in, OutStream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
OutStream = io.mercury_current_text_output.get();
|
|
io.mercury_current_text_output.set((io.MR_TextOutputFile) NewStream);
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
set_binary_output_stream(binary_output_stream(NewStream),
|
|
binary_output_stream(OutStream), !IO) :-
|
|
set_binary_output_stream_2(NewStream, OutStream, !IO).
|
|
|
|
:- pred set_binary_output_stream_2(stream::in, stream::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
set_binary_output_stream_2(NewStream::in, OutStream::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
OutStream = mercury_current_binary_output();
|
|
MR_set_thread_local_mutable(MercuryFilePtr, NewStream,
|
|
mercury_current_binary_output_index);
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
set_binary_output_stream_2(NewStream::in, OutStream::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
OutStream = io.mercury_current_binary_output;
|
|
io.mercury_current_binary_output = NewStream;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
set_binary_output_stream_2(NewStream::in, OutStream::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
OutStream = io.mercury_current_binary_output.get();
|
|
io.mercury_current_binary_output.set((io.MR_BinaryOutputFile) NewStream);
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Prolog style predicates for opening and switching streams.
|
|
%
|
|
|
|
see(File, Result, !IO) :-
|
|
io.open_input(File, Result0, !IO),
|
|
(
|
|
Result0 = ok(Stream),
|
|
io.set_input_stream(Stream, _, !IO),
|
|
Result = ok
|
|
;
|
|
Result0 = error(Error),
|
|
Result = error(Error)
|
|
).
|
|
|
|
see_binary(File, Result, !IO) :-
|
|
io.open_binary_input(File, Result0, !IO),
|
|
(
|
|
Result0 = ok(Stream),
|
|
io.set_binary_input_stream(Stream, _, !IO),
|
|
Result = ok
|
|
;
|
|
Result0 = error(Error),
|
|
Result = error(Error)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
seen(!IO) :-
|
|
io.stdin_stream(Stdin, !IO),
|
|
io.set_input_stream(Stdin, OldStream, !IO),
|
|
io.close_input(OldStream, !IO).
|
|
|
|
seen_binary(!IO) :-
|
|
io.stdin_binary_stream(Stdin, !IO),
|
|
io.set_binary_input_stream(Stdin, OldStream, !IO),
|
|
io.close_binary_input(OldStream, !IO).
|
|
|
|
%---------------------%
|
|
|
|
tell(File, Result, !IO) :-
|
|
io.open_output(File, Result0, !IO),
|
|
(
|
|
Result0 = ok(Stream),
|
|
io.set_output_stream(Stream, _, !IO),
|
|
Result = ok
|
|
;
|
|
Result0 = error(Msg),
|
|
Result = error(Msg)
|
|
).
|
|
|
|
tell_binary(File, Result, !IO) :-
|
|
io.open_binary_output(File, Result0, !IO),
|
|
(
|
|
Result0 = ok(Stream),
|
|
io.set_binary_output_stream(Stream, _, !IO),
|
|
Result = ok
|
|
;
|
|
Result0 = error(Msg),
|
|
Result = error(Msg)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
told(!IO) :-
|
|
io.stdout_stream(Stdout, !IO),
|
|
io.set_output_stream(Stdout, OldStream, !IO),
|
|
io.close_output(OldStream, !IO).
|
|
|
|
told_binary(!IO) :-
|
|
io.stdout_binary_stream(Stdout, !IO),
|
|
io.set_binary_output_stream(Stdout, OldStream, !IO),
|
|
io.close_binary_output(OldStream, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Seeking on binary streams.
|
|
%
|
|
|
|
seek_binary_input(binary_input_stream(Stream), Whence, Offset, !IO) :-
|
|
whence_to_int(Whence, Flag),
|
|
seek_binary_2(Stream, Flag, int64.from_int(Offset), Error, !IO),
|
|
throw_on_error(Error, "error seeking in file: ", !IO).
|
|
|
|
seek_binary_input64(binary_input_stream(Stream), Whence, Offset, !IO) :-
|
|
whence_to_int(Whence, Flag),
|
|
seek_binary_2(Stream, Flag, Offset, Error, !IO),
|
|
throw_on_error(Error, "error seeking in file: ", !IO).
|
|
|
|
%---------------------%
|
|
|
|
seek_binary_output(binary_output_stream(Stream), Whence, Offset, !IO) :-
|
|
whence_to_int(Whence, Flag),
|
|
seek_binary_2(Stream, Flag, int64.from_int(Offset), Error, !IO),
|
|
throw_on_error(Error, "error seeking in file: ", !IO).
|
|
|
|
seek_binary_output64(binary_output_stream(Stream), Whence, Offset, !IO) :-
|
|
whence_to_int(Whence, Flag),
|
|
seek_binary_2(Stream, Flag, Offset, Error, !IO),
|
|
throw_on_error(Error, "error seeking in file: ", !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred whence_to_int(io.whence::in, int::out) is det.
|
|
|
|
whence_to_int(set, 0).
|
|
whence_to_int(cur, 1).
|
|
whence_to_int(end, 2).
|
|
|
|
:- pred seek_binary_2(stream::in, int::in, int64::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
seek_binary_2(Stream::in, Flag::in, Off::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
static const int seek_flags[] = { SEEK_SET, SEEK_CUR, SEEK_END };
|
|
|
|
// XXX check if the stream is seekable.
|
|
if (MR_IS_FILE_STREAM(*Stream)) {
|
|
if (MR_fseek(MR_file(*Stream), Off, seek_flags[Flag]) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
} else {
|
|
Error = EINVAL;
|
|
}
|
|
").
|
|
|
|
% MISSING C# seek_binary_2
|
|
|
|
:- pragma foreign_proc("Java",
|
|
seek_binary_2(Stream::in, Flag::in, Off::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
((io.MR_BinaryFile) Stream).seek_binary(Flag, Off);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
binary_input_stream_offset(binary_input_stream(Stream), Offset, !IO) :-
|
|
binary_stream_offset_2(Stream, Offset64, Error, !IO),
|
|
throw_on_error(Error, "error getting file offset: ", !IO),
|
|
( if int64.to_int(Offset64, OffsetPrime) then
|
|
Offset = OffsetPrime
|
|
else
|
|
error("io.binary_input_stream_offset: offset exceeds range of an int")
|
|
).
|
|
|
|
binary_input_stream_offset64(binary_input_stream(Stream), Offset, !IO) :-
|
|
binary_stream_offset_2(Stream, Offset, Error, !IO),
|
|
throw_on_error(Error, "error getting file offset: ", !IO).
|
|
|
|
%---------------------%
|
|
|
|
binary_output_stream_offset(binary_output_stream(Stream), Offset, !IO) :-
|
|
binary_stream_offset_2(Stream, Offset64, Error, !IO),
|
|
throw_on_error(Error, "error getting file offset: ", !IO),
|
|
( if int64.to_int(Offset64, OffsetPrime) then
|
|
Offset = OffsetPrime
|
|
else
|
|
error("io.binary_output_stream_offset: offset exceeds range of an int")
|
|
).
|
|
|
|
binary_output_stream_offset64(binary_output_stream(Stream), Offset, !IO) :-
|
|
binary_stream_offset_2(Stream, Offset, Error, !IO),
|
|
throw_on_error(Error, "error getting file offset: ", !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred binary_stream_offset_2(stream::in, int64::out, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
binary_stream_offset_2(Stream::in, Offset::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
// XXX should check if the stream is tellable
|
|
if (MR_IS_FILE_STREAM(*Stream)) {
|
|
Offset = MR_ftell(MR_file(*Stream));
|
|
if (Offset < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
} else {
|
|
Error = EINVAL;
|
|
}
|
|
").
|
|
|
|
% MISSING C# binary_stream_offset_2
|
|
|
|
:- pragma foreign_proc("Java",
|
|
binary_stream_offset_2(Stream::in, Offset::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
Offset = ((io.MR_BinaryFile) Stream).getOffset();
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Offset = -1;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Standard stream id predicates.
|
|
%
|
|
|
|
:- pragma foreign_export("C", stdin_stream_2(out, di, uo),
|
|
"ML_io_stdin_stream").
|
|
:- pragma foreign_export("C", stdout_stream_2(out, di, uo),
|
|
"ML_io_stdout_stream").
|
|
:- pragma foreign_export("C", stderr_stream_2(out, di, uo),
|
|
"ML_io_stderr_stream").
|
|
|
|
%---------------------%
|
|
|
|
stdin_stream = input_stream(stdin_stream_2).
|
|
|
|
:- func stdin_stream_2 = stream.
|
|
|
|
:- pragma foreign_proc("C",
|
|
stdin_stream_2 = (Stream::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = &mercury_stdin;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
stdin_stream_2 = (Stream::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness],
|
|
"
|
|
Stream = io.mercury_stdin;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
stdin_stream_2 = (Stream::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness],
|
|
"
|
|
Stream = io.mercury_stdin;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
stdin_stream(input_stream(Stream), !IO) :-
|
|
stdin_stream_2(Stream, !IO).
|
|
|
|
:- pred stdin_stream_2(stream::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
stdin_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = &mercury_stdin;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
stdin_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_stdin;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
stdin_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_stdin;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
stdin_binary_stream(binary_input_stream(Stream), !IO) :-
|
|
stdin_binary_stream_2(Stream, !IO).
|
|
|
|
:- pred stdin_binary_stream_2(stream::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
stdin_binary_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = &mercury_stdin_binary;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
stdin_binary_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_stdin_binary;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
stdin_binary_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
may_not_duplicate],
|
|
"
|
|
io.ensure_init_mercury_stdin_binary();
|
|
Stream = io.mercury_stdin_binary;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
stdout_stream = output_stream(io.stdout_stream_2).
|
|
|
|
:- func stdout_stream_2 = stream.
|
|
|
|
:- pragma foreign_proc("C",
|
|
stdout_stream_2 = (Stream::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = &mercury_stdout;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
stdout_stream_2 = (Stream::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness],
|
|
"
|
|
Stream = io.mercury_stdout;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
stdout_stream_2 = (Stream::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness],
|
|
"
|
|
Stream = io.mercury_stdout;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
stdout_stream(output_stream(Stream), !IO) :-
|
|
stdout_stream_2(Stream, !IO).
|
|
|
|
:- pred stdout_stream_2(stream::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
stdout_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = &mercury_stdout;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
stdout_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_stdout;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
stdout_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_stdout;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
stdout_binary_stream(binary_output_stream(Stream), !IO) :-
|
|
stdout_binary_stream_2(Stream, !IO).
|
|
|
|
:- pred stdout_binary_stream_2(stream::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
stdout_binary_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = &mercury_stdout_binary;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
stdout_binary_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_stdout_binary;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
stdout_binary_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
may_not_duplicate],
|
|
"
|
|
io.ensure_init_mercury_stdout_binary();
|
|
Stream = io.mercury_stdout_binary;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
stderr_stream = output_stream(stderr_stream_2).
|
|
|
|
:- func stderr_stream_2 = stream.
|
|
|
|
:- pragma foreign_proc("C",
|
|
stderr_stream_2 = (Stream::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = &mercury_stderr;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
stderr_stream_2 = (Stream::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness],
|
|
"
|
|
Stream = io.mercury_stderr;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
stderr_stream_2 = (Stream::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness],
|
|
"
|
|
Stream = io.mercury_stderr;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
stderr_stream(output_stream(Stream), !IO) :-
|
|
stderr_stream_2(Stream, !IO).
|
|
|
|
:- pred stderr_stream_2(stream::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
stderr_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = &mercury_stderr;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
stderr_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_stderr;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
stderr_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_stderr;
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Current stream id predicates.
|
|
%
|
|
|
|
input_stream(input_stream(Stream), !IO) :-
|
|
input_stream_2(Stream, !IO).
|
|
|
|
:- pred input_stream_2(stream::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
input_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = mercury_current_text_input();
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
input_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_current_text_input;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
input_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
may_not_duplicate],
|
|
"
|
|
Stream = io.mercury_current_text_input.get();
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
binary_input_stream(binary_input_stream(Stream), !IO) :-
|
|
binary_input_stream_2(Stream, !IO).
|
|
|
|
:- pred binary_input_stream_2(stream::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
binary_input_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = mercury_current_binary_input();
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
binary_input_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_current_binary_input;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
binary_input_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
may_not_duplicate],
|
|
"
|
|
Stream = io.mercury_current_binary_input.get();
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
output_stream(output_stream(Stream), !IO) :-
|
|
output_stream_2(Stream, !IO).
|
|
|
|
:- pred output_stream_2(stream::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
output_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = mercury_current_text_output();
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
output_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_current_text_output;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
output_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
may_not_duplicate],
|
|
"
|
|
Stream = io.mercury_current_text_output.get();
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
binary_output_stream(binary_output_stream(Stream), !IO) :-
|
|
binary_output_stream_2(Stream, !IO).
|
|
|
|
:- pred binary_output_stream_2(stream::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
binary_output_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
% no_sharing is okay as io.stream is a foreign type so can't be reused.
|
|
"
|
|
Stream = mercury_current_binary_output();
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
binary_output_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
Stream = io.mercury_current_binary_output;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
binary_output_stream_2(Stream::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
may_not_duplicate],
|
|
"
|
|
Stream = io.mercury_current_binary_output.get();
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Getting and setting stream properties.
|
|
%
|
|
|
|
input_stream_name(Name, !IO) :-
|
|
input_stream(input_stream(Stream), !IO),
|
|
stream_name(Stream, Name, !IO).
|
|
|
|
input_stream_name(input_stream(Stream), Name, !IO) :-
|
|
stream_name(Stream, Name, !IO).
|
|
|
|
binary_input_stream_name(Name, !IO) :-
|
|
binary_input_stream(binary_input_stream(Stream), !IO),
|
|
stream_name(Stream, Name, !IO).
|
|
|
|
binary_input_stream_name(binary_input_stream(Stream), Name, !IO) :-
|
|
stream_name(Stream, Name, !IO).
|
|
|
|
%---------------------%
|
|
|
|
output_stream_name(Name, !IO) :-
|
|
output_stream(output_stream(Stream), !IO),
|
|
stream_name(Stream, Name, !IO).
|
|
|
|
output_stream_name(output_stream(Stream), Name, !IO) :-
|
|
stream_name(Stream, Name, !IO).
|
|
|
|
binary_output_stream_name(Name, !IO) :-
|
|
binary_output_stream(binary_output_stream(Stream), !IO),
|
|
stream_name(Stream, Name, !IO).
|
|
|
|
binary_output_stream_name(binary_output_stream(Stream), Name, !IO) :-
|
|
stream_name(Stream, Name, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred insert_stream_info(stream::in, stream_info::in,
|
|
io::di, io::uo) is det.
|
|
|
|
insert_stream_info(Stream, Name, !IO) :-
|
|
lock_stream_db(!IO),
|
|
get_stream_db(StreamDb0, !IO),
|
|
map.set(get_stream_id(Stream), Name, StreamDb0, StreamDb),
|
|
set_stream_db(StreamDb, !IO),
|
|
unlock_stream_db(!IO).
|
|
|
|
:- pred maybe_delete_stream_info(io.stream::in, io::di, io::uo) is det.
|
|
|
|
maybe_delete_stream_info(Stream, !IO) :-
|
|
may_delete_stream_info(MayDeleteStreamInfo, !IO),
|
|
( if MayDeleteStreamInfo = 0 then
|
|
true
|
|
else
|
|
lock_stream_db(!IO),
|
|
get_stream_db(StreamDb0, !IO),
|
|
map.delete(get_stream_id(Stream), StreamDb0, StreamDb),
|
|
set_stream_db(StreamDb, !IO),
|
|
unlock_stream_db(!IO)
|
|
).
|
|
|
|
% Return an integer that is nonzero if and only if we should delete
|
|
% the information we have about stream when that stream is closed.
|
|
% The debugger may need this information in order to display the stream id
|
|
% in a user-friendly manner even after the stream is closed (e.g. after
|
|
% performing a retry after the close), so if debugging is enabled, we
|
|
% hang on to the stream info until the end of the execution. This is a
|
|
% space leak, but one that is acceptable in a program being debugged.
|
|
%
|
|
:- pred may_delete_stream_info(int::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
may_delete_stream_info(MayDelete::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
MayDelete = !MR_debug_ever_enabled;
|
|
").
|
|
|
|
may_delete_stream_info(1, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_line_number(LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
LineNum = MR_line_number(*mercury_current_text_input());
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
get_line_number(LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
LineNum = io.mercury_current_text_input.line_number;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
get_line_number(LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
LineNum = io.mercury_current_text_input.get().line_number;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
get_line_number(input_stream(Stream), LineNum, !IO) :-
|
|
get_line_number_2(Stream, LineNum, !IO).
|
|
|
|
:- pred get_line_number_2(stream::in, int::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_line_number_2(Stream::in, LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
LineNum = MR_line_number(*Stream);
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
get_line_number_2(Stream::in, LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
LineNum = Stream.line_number;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
get_line_number_2(Stream::in, LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
LineNum = ((io.MR_TextInputFile) Stream).line_number;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
set_line_number(LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
MR_line_number(*mercury_current_text_input()) = LineNum;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
set_line_number(LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
io.mercury_current_text_input.line_number = LineNum;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
set_line_number(LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
io.mercury_current_text_input.get().line_number = LineNum;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
set_line_number(input_stream(Stream), LineNum, !IO) :-
|
|
set_line_number_2(Stream, LineNum,!IO).
|
|
|
|
:- pred set_line_number_2(stream::in, int::in, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
set_line_number_2(Stream::in, LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
MR_line_number(*Stream) = LineNum;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
set_line_number_2(Stream::in, LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"{
|
|
Stream.line_number = LineNum;
|
|
}").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
set_line_number_2(Stream::in, LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
((io.MR_TextInputFile) Stream).line_number = LineNum;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_output_line_number(LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
LineNum = MR_line_number(*mercury_current_text_output());
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
get_output_line_number(LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
LineNum = io.mercury_current_text_output.line_number;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
get_output_line_number(LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
LineNum = io.mercury_current_text_output.get().line_number;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
get_output_line_number(output_stream(Stream), LineNum, !IO) :-
|
|
get_output_line_number_2(Stream, LineNum, !IO).
|
|
|
|
:- pred get_output_line_number_2(stream::in, int::out, io::di, io::uo)
|
|
is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_output_line_number_2(Stream::in, LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
LineNum = MR_line_number(*Stream);
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
get_output_line_number_2(Stream::in, LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"{
|
|
LineNum = Stream.line_number;
|
|
}").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
get_output_line_number_2(Stream::in, LineNum::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
LineNum = ((io.MR_TextOutputFile) Stream).line_number;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
set_output_line_number(LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
MR_line_number(*mercury_current_text_output()) = LineNum;
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
set_output_line_number(LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
io.mercury_current_text_output.line_number = LineNum;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
set_output_line_number(LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
io.mercury_current_text_output.get().line_number = LineNum;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
set_output_line_number(output_stream(Stream), LineNum, !IO) :-
|
|
set_output_line_number_2(Stream, LineNum, !IO).
|
|
|
|
:- pred set_output_line_number_2(stream::in, int::in, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
set_output_line_number_2(Stream::in, LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
MR_line_number(*Stream) = LineNum;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
set_output_line_number_2(Stream::in, LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"{
|
|
Stream.line_number = LineNum;
|
|
}").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
set_output_line_number_2(Stream::in, LineNum::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
((io.MR_TextOutputFile) Stream).line_number = LineNum;
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Reading values of primitive types.
|
|
%
|
|
|
|
:- pragma inline(read_char/3). % Inline to allow deforestation.
|
|
read_char(Result, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
read_char(Stream, Result, !IO).
|
|
|
|
:- pragma inline(read_char/4). % Inline to allow deforestation.
|
|
read_char(Stream, Result, !IO) :-
|
|
read_char_code(Stream, ResultCode, Char, Error, !IO),
|
|
(
|
|
ResultCode = result_code_ok,
|
|
Result = ok(Char)
|
|
;
|
|
ResultCode = result_code_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = result_code_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
:- pragma inline(read_char_unboxed/5). % Inline to allow deforestation.
|
|
read_char_unboxed(Stream, Result, Char, !IO) :-
|
|
read_char_code(Stream, ResultCode, Char, Error, !IO),
|
|
(
|
|
ResultCode = result_code_ok,
|
|
Result = ok
|
|
;
|
|
ResultCode = result_code_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = result_code_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
% We communicate results from foreign_procs as separate simple arguments
|
|
% so the C/Java/etc code does not depend on how Mercury stores its
|
|
% discriminated union data types. It also avoids memory allocation in
|
|
% inner loops.
|
|
|
|
% Reads a character (code point) from specified stream. This may
|
|
% involve converting external character encodings into Mercury's internal
|
|
% character representation and (for text streams) converting OS line
|
|
% indicators, e.g. CR-LF for Windows, to '\n' characters.
|
|
%
|
|
:- pred read_char_code(input_stream::in, result_code::out, char::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
read_char_code(input_stream(Stream), ResultCode, Char, Error, !IO) :-
|
|
read_char_code_2(Stream, ResultCode, Char, Error, !IO).
|
|
|
|
:- pred read_char_code_2(stream::in, result_code::out, char::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
read_char_code_2(Stream::in, ResultCode::out, Char::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing, may_not_duplicate],
|
|
"
|
|
char buf[5];
|
|
int nbytes;
|
|
int i;
|
|
int c;
|
|
unsigned int uc;
|
|
|
|
c = mercury_get_byte(Stream);
|
|
uc = c;
|
|
if (uc <= 0x7f) {
|
|
ResultCode = ML_RESULT_CODE_OK;
|
|
Char = uc;
|
|
Error = 0;
|
|
} else if (c == EOF) {
|
|
if (MR_FERROR(*Stream)) {
|
|
ResultCode = ML_RESULT_CODE_ERROR;
|
|
Error = errno;
|
|
Char = 0;
|
|
} else {
|
|
ResultCode = ML_RESULT_CODE_EOF;
|
|
Error = 0;
|
|
Char = 0;
|
|
}
|
|
} else {
|
|
if ((uc & 0xE0) == 0xC0) {
|
|
nbytes = 2;
|
|
} else if ((uc & 0xF0) == 0xE0) {
|
|
nbytes = 3;
|
|
} else if ((uc & 0xF8) == 0xF0) {
|
|
nbytes = 4;
|
|
} else {
|
|
nbytes = 0;
|
|
}
|
|
if (nbytes > 0) {
|
|
buf[0] = (char) uc;
|
|
for (i = 1; i < nbytes; i++) {
|
|
c = mercury_get_byte(Stream);
|
|
uc = c;
|
|
if (c == EOF) {
|
|
// Illegal byte sequence whether EOF or I/O error.
|
|
ResultCode = ML_RESULT_CODE_ERROR;
|
|
Error = MR_FERROR(*Stream) ? errno : EILSEQ;
|
|
Char = 0;
|
|
break;
|
|
}
|
|
buf[i] = uc;
|
|
}
|
|
if (i == nbytes) {
|
|
buf[i] = '\\0';
|
|
c = MR_utf8_get(buf, 0);
|
|
if (c < 0) {
|
|
ResultCode = ML_RESULT_CODE_ERROR;
|
|
Error = EILSEQ;
|
|
Char = 0;
|
|
} else {
|
|
ResultCode = ML_RESULT_CODE_OK;
|
|
Char = c;
|
|
Error = 0;
|
|
}
|
|
}
|
|
} else {
|
|
// Invalid lead byte.
|
|
ResultCode = ML_RESULT_CODE_ERROR;
|
|
Error = EILSEQ;
|
|
Char = 0;
|
|
}
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
read_char_code_2(File::in, ResultCode::out, Char::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
io.MR_MercuryFileStruct mf = File;
|
|
try {
|
|
int c = io.mercury_getc(mf);
|
|
if (c == -1) {
|
|
ResultCode = io.ML_RESULT_CODE_EOF;
|
|
Char = 0;
|
|
} else {
|
|
ResultCode = io.ML_RESULT_CODE_OK;
|
|
Char = c;
|
|
}
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
ResultCode = io.ML_RESULT_CODE_ERROR;
|
|
Char = 0;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
read_char_code_2(File::in, ResultCode::out, CharCode::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
int c = ((io.MR_TextInputFile) File).read_char();
|
|
if (c == -1) {
|
|
ResultCode = io.ML_RESULT_CODE_EOF;
|
|
CharCode = 0;
|
|
} else {
|
|
ResultCode = io.ML_RESULT_CODE_OK;
|
|
CharCode = c;
|
|
}
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
ResultCode = io.ML_RESULT_CODE_ERROR;
|
|
CharCode = 0;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
putback_char(Char, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
putback_char(Stream, Char, !IO).
|
|
|
|
putback_char(input_stream(Stream), Character, !IO) :-
|
|
putback_char_2(Stream, Character, Ok, !IO),
|
|
(
|
|
Ok = yes
|
|
;
|
|
Ok = no,
|
|
throw(io_error("failed to put back character"))
|
|
).
|
|
|
|
:- pred putback_char_2(stream::in, char::in, bool::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
putback_char_2(Stream::in, Character::in, Ok::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing, may_not_duplicate],
|
|
"
|
|
MercuryFilePtr mf = Stream;
|
|
Ok = MR_TRUE;
|
|
if (Character <= 0x7f) {
|
|
if (MR_UNGETCH(*mf, Character) == EOF) {
|
|
Ok = MR_FALSE;
|
|
} else {
|
|
if (Character == '\\n') {
|
|
MR_line_number(*mf)--;
|
|
}
|
|
}
|
|
} else {
|
|
// This requires multiple pushback in the underlying C library.
|
|
char buf[5];
|
|
ML_ssize_t len;
|
|
len = MR_utf8_encode(buf, Character);
|
|
// XXX ILSEQ Error if len==0
|
|
for (; len > 0; len--) {
|
|
if (MR_UNGETCH(*mf, buf[len - 1]) == EOF) {
|
|
Ok = MR_FALSE;
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
putback_char_2(File::in, Character::in, Ok::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
io.MR_MercuryFileStruct mf = File;
|
|
if (mf.putback == -1) {
|
|
mf.putback = Character;
|
|
if (Character == '\\n') {
|
|
mf.line_number--;
|
|
}
|
|
Ok = mr_bool.YES;
|
|
} else {
|
|
Ok = mr_bool.NO;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
putback_char_2(File::in, Character::in, Ok::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
((io.MR_TextInputFile) File).ungetc(Character);
|
|
Ok = bool.YES;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma inline(read_byte/3). % Inline to allow deforestation.
|
|
read_byte(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_byte(Stream, Result, !IO).
|
|
|
|
:- pragma inline(read_byte/4). % Inline to allow deforestation.
|
|
read_byte(binary_input_stream(Stream), Result, !IO) :-
|
|
read_byte_val(input_stream(Stream), ResultCode, Byte, Error, !IO),
|
|
(
|
|
ResultCode = result_code_ok,
|
|
Result = ok(Byte)
|
|
;
|
|
ResultCode = result_code_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = result_code_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
read_binary_int8(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_int8(Stream, Result, !IO).
|
|
|
|
read_binary_int8(binary_input_stream(Stream), Result, !IO) :-
|
|
read_byte_val(input_stream(Stream), ResultCode, Int, Error, !IO),
|
|
(
|
|
ResultCode = result_code_ok,
|
|
Int8 = cast_from_int(Int),
|
|
Result = ok(Int8)
|
|
;
|
|
ResultCode = result_code_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = result_code_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
read_binary_uint8(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_uint8(Stream, Result, !IO).
|
|
|
|
read_binary_uint8(binary_input_stream(Stream), Result, !IO) :-
|
|
read_byte_val(input_stream(Stream), ResultCode, Int, Error, !IO),
|
|
(
|
|
ResultCode = result_code_ok,
|
|
UInt8 = cast_from_int(Int),
|
|
Result = ok(UInt8)
|
|
;
|
|
ResultCode = result_code_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = result_code_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
% We communicate results from foreign_procs as separate simple arguments
|
|
% so the C/Java/etc code does not depend on how Mercury stores its
|
|
% discriminated union data types. It also avoids memory allocation in
|
|
% inner loops.
|
|
|
|
% Reads a byte from specified stream.
|
|
%
|
|
:- pred read_byte_val(input_stream::in, result_code::out, int::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
read_byte_val(input_stream(Stream), Result, ByteVal, Error, !IO) :-
|
|
read_byte_val_2(Stream, Result, ByteVal, Error, !IO).
|
|
|
|
:- pred read_byte_val_2(stream::in, result_code::out, int::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
read_byte_val_2(Stream::in, ResultCode::out, ByteVal::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
int b = mercury_get_byte(Stream);
|
|
if (b == EOF) {
|
|
if (MR_FERROR(*Stream)) {
|
|
ResultCode = ML_RESULT_CODE_ERROR;
|
|
Error = errno;
|
|
} else {
|
|
ResultCode = ML_RESULT_CODE_EOF;
|
|
Error = 0;
|
|
}
|
|
ByteVal = 0;
|
|
} else {
|
|
ResultCode = ML_RESULT_CODE_OK;
|
|
ByteVal = b;
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
read_byte_val_2(File::in, ResultCode::out, ByteVal::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
io.MR_MercuryFileStruct mf = File;
|
|
if (mf.putback != -1) {
|
|
ResultCode = io.ML_RESULT_CODE_OK;
|
|
ByteVal = mf.putback;
|
|
Error = null;
|
|
mf.putback = -1;
|
|
} else {
|
|
try {
|
|
int b = mf.stream.ReadByte();
|
|
if (b == -1) {
|
|
ResultCode = io.ML_RESULT_CODE_EOF;
|
|
ByteVal = 0;
|
|
} else {
|
|
ResultCode = io.ML_RESULT_CODE_OK;
|
|
ByteVal = b;
|
|
}
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
ResultCode = io.ML_RESULT_CODE_ERROR;
|
|
ByteVal = 0;
|
|
Error = e;
|
|
}
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
read_byte_val_2(File::in, ResultCode::out, ByteVal::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
int b = ((io.MR_BinaryInputFile) File).read_byte();
|
|
if (b == -1) {
|
|
ResultCode = io.ML_RESULT_CODE_EOF;
|
|
ByteVal = 0;
|
|
} else {
|
|
ResultCode = io.ML_RESULT_CODE_OK;
|
|
ByteVal = b;
|
|
}
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
ResultCode = io.ML_RESULT_CODE_ERROR;
|
|
ByteVal = 0;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
putback_byte(Char, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
putback_byte(Stream, Char, !IO).
|
|
|
|
putback_byte(binary_input_stream(Stream), Character, !IO) :-
|
|
putback_byte_2(Stream, Character, Ok, !IO),
|
|
(
|
|
Ok = yes
|
|
;
|
|
Ok = no,
|
|
throw(io_error("failed to put back byte"))
|
|
).
|
|
|
|
:- pred putback_byte_2(stream::in, int::in, bool::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
putback_byte_2(Stream::in, Character::in, Ok::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
MercuryFilePtr mf = Stream;
|
|
if (MR_UNGETCH(*mf, Character) == EOF) {
|
|
Ok = MR_FALSE;
|
|
} else {
|
|
Ok = MR_TRUE;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
putback_byte_2(File::in, Byte::in, Ok::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
io.MR_MercuryFileStruct mf = File;
|
|
if (mf.putback == -1) {
|
|
mf.putback = Byte;
|
|
Ok = mr_bool.YES;
|
|
} else {
|
|
Ok = mr_bool.NO;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
putback_byte_2(File::in, Byte::in, Ok::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
((io.MR_BinaryInputFile) File).ungetc((byte) Byte);
|
|
Ok = bool.YES;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
putback_int8(Int8, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
putback_int8(Stream, Int8, !IO).
|
|
|
|
putback_int8(binary_input_stream(Stream), Int8, !IO) :-
|
|
UInt8 = uint8.cast_from_int8(Int8),
|
|
putback_uint8_2(Stream, UInt8, Ok, !IO),
|
|
(
|
|
Ok = yes
|
|
;
|
|
Ok = no,
|
|
throw(io_error("failed to put back int8"))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
putback_uint8(UInt8, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
putback_uint8(Stream, UInt8, !IO).
|
|
|
|
putback_uint8(binary_input_stream(Stream), UInt8, !IO) :-
|
|
putback_uint8_2(Stream, UInt8, Ok, !IO),
|
|
(
|
|
Ok = yes
|
|
;
|
|
Ok = no,
|
|
throw(io_error("failed to put back uint8"))
|
|
).
|
|
|
|
:- pred putback_uint8_2(stream::in, uint8::in, bool::out, io::di, io::uo)
|
|
is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
putback_uint8_2(Stream::in, UInt8::in, Ok::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
MercuryFilePtr mf = Stream;
|
|
if (MR_UNGETCH(*mf, UInt8) == EOF) {
|
|
Ok = MR_FALSE;
|
|
} else {
|
|
Ok = MR_TRUE;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
putback_uint8_2(File::in, UInt8::in, Ok::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
io.MR_MercuryFileStruct mf = File;
|
|
if (mf.putback == -1) {
|
|
mf.putback = UInt8;
|
|
Ok = mr_bool.YES;
|
|
} else {
|
|
Ok = mr_bool.NO;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
putback_uint8_2(File::in, UInt8::in, Ok::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
((io.MR_BinaryInputFile) File).ungetc((byte) UInt8);
|
|
Ok = bool.YES;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
read_binary_int16(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_int16(Stream, Result, !IO).
|
|
|
|
read_binary_int16(Stream, Result, !IO) :-
|
|
( if native_byte_order_is_big_endian then
|
|
read_binary_int16_be(Stream, Result, !IO)
|
|
else
|
|
read_binary_int16_le(Stream, Result, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_int16_le(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_int16_le(Stream, Result, !IO).
|
|
|
|
read_binary_int16_le(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint16(Stream, little_endian, ResultCode, UInt16,
|
|
IncompleteBytes,
|
|
Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Int16 = cast_from_uint16(UInt16),
|
|
Result = ok(Int16)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_int16_be(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_int16_be(Stream, Result, !IO).
|
|
|
|
read_binary_int16_be(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint16(Stream, big_endian, ResultCode, UInt16,
|
|
IncompleteBytes, Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Int16 = cast_from_uint16(UInt16),
|
|
Result = ok(Int16)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_uint16(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_uint16(Stream, Result, !IO).
|
|
|
|
read_binary_uint16(Stream, Result, !IO) :-
|
|
( if native_byte_order_is_big_endian then
|
|
read_binary_uint16_be(Stream, Result, !IO)
|
|
else
|
|
read_binary_uint16_le(Stream, Result, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_uint16_le(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_uint16_le(Stream, Result, !IO).
|
|
|
|
read_binary_uint16_le(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint16(Stream, little_endian, ResultCode, UInt16,
|
|
IncompleteBytes, Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Result = ok(UInt16)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_uint16_be(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_uint16_be(Stream, Result, !IO).
|
|
|
|
read_binary_uint16_be(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint16(Stream, big_endian, ResultCode, UInt16,
|
|
IncompleteBytes, Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Result = ok(UInt16)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
:- pred do_read_binary_uint16(stream::in, byte_order::in,
|
|
maybe_incomplete_result_code::out, uint16::out, list(uint8)::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_read_binary_uint16(Stream::in, ByteOrder::in, ResultCode::out,
|
|
UInt16::out, IncompleteBytes::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
|
|
tabled_for_io],
|
|
"
|
|
ML_do_read_binary_uintN(2, 16, Stream, ByteOrder, ResultCode, UInt16,
|
|
IncompleteBytes, Error);
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_read_binary_uint16(Stream::in, ByteOrder::in, ResultCode::out,
|
|
UInt16::out, IncompleteBytes::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
byte[] buffer = new byte[2];
|
|
io.MR_MercuryFileStruct mf = Stream;
|
|
UInt16 = 0;
|
|
IncompleteBytes = list.empty_list();
|
|
|
|
int nread = 0;
|
|
|
|
if (mf.putback != -1) {
|
|
buffer[nread] = (byte) mf.putback;
|
|
nread++;
|
|
mf.putback = -1;
|
|
}
|
|
|
|
try {
|
|
for ( ; nread < 2; nread++) {
|
|
int b = mf.stream.ReadByte();
|
|
if (b == -1) {
|
|
break;
|
|
}
|
|
buffer[nread] = (byte) b;
|
|
}
|
|
if (nread < 2) {
|
|
if (nread > 0) {
|
|
ResultCode = io.ML_MIRC_INCOMPLETE;
|
|
IncompleteBytes = list.cons(buffer[0], IncompleteBytes);
|
|
} else {
|
|
ResultCode = io.ML_MIRC_EOF;
|
|
}
|
|
} else {
|
|
ResultCode = io.ML_MIRC_OK;
|
|
if (ByteOrder == io.ML_LITTLE_ENDIAN) {
|
|
UInt16 = (ushort) (buffer[1] << 8 | (buffer[0] & 0x00ff));
|
|
} else {
|
|
UInt16 = (ushort) (buffer[0] << 8 | (buffer[1] & 0x00ff));
|
|
}
|
|
}
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
ResultCode = io.ML_MIRC_ERROR;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_read_binary_uint16(Stream::in, ByteOrder::in, ResultCode::out,
|
|
UInt16::out, IncompleteBytes::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
byte[] buffer = new byte[2];
|
|
MR_BinaryInputFile mf = (MR_BinaryInputFile) Stream;
|
|
UInt16 = 0;
|
|
IncompleteBytes = list.empty_list();
|
|
|
|
try {
|
|
int nread;
|
|
for (nread = 0; nread < 2; nread++) {
|
|
int next = mf.read_byte();
|
|
if (next == -1) {
|
|
break;
|
|
}
|
|
buffer[nread] = (byte) next;
|
|
}
|
|
if (nread < 2) {
|
|
if (nread > 0) {
|
|
ResultCode = io.ML_MIRC_INCOMPLETE;
|
|
IncompleteBytes = list.cons(buffer[0], IncompleteBytes);
|
|
} else {
|
|
ResultCode = io.ML_MIRC_EOF;
|
|
}
|
|
} else {
|
|
ResultCode = io.ML_MIRC_OK;
|
|
if (ByteOrder == io.ML_LITTLE_ENDIAN) {
|
|
UInt16 = (short) (buffer[1] << 8 | (buffer[0] & 0x00ff));
|
|
} else {
|
|
UInt16 = (short) (buffer[0] << 8 | (buffer[1] & 0x00ff));
|
|
}
|
|
}
|
|
Error = null;
|
|
} catch (java.lang.Exception e) {
|
|
ResultCode = io.ML_MIRC_ERROR;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
read_binary_int32(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_int32(Stream, Result, !IO).
|
|
|
|
read_binary_int32(Stream, Result, !IO) :-
|
|
( if native_byte_order_is_big_endian then
|
|
read_binary_int32_be(Stream, Result, !IO)
|
|
else
|
|
read_binary_int32_le(Stream, Result, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_int32_le(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_int32_le(Stream, Result, !IO).
|
|
|
|
read_binary_int32_le(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint32(Stream, little_endian, ResultCode, UInt32,
|
|
IncompleteBytes, Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Int32 = cast_from_uint32(UInt32),
|
|
Result = ok(Int32)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_int32_be(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_int32_be(Stream, Result, !IO).
|
|
|
|
read_binary_int32_be(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint32(Stream, big_endian, ResultCode, UInt32,
|
|
IncompleteBytes, Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Int32 = cast_from_uint32(UInt32),
|
|
Result = ok(Int32)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_uint32(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_uint32(Stream, Result, !IO).
|
|
|
|
read_binary_uint32(Stream, Result, !IO) :-
|
|
( if native_byte_order_is_big_endian then
|
|
read_binary_uint32_be(Stream, Result, !IO)
|
|
else
|
|
read_binary_uint32_le(Stream, Result, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_uint32_le(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_uint32_le(Stream, Result, !IO).
|
|
|
|
read_binary_uint32_le(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint32(Stream, little_endian, ResultCode, UInt32,
|
|
IncompleteBytes, Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Result = ok(UInt32)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_uint32_be(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_uint32_be(Stream, Result, !IO).
|
|
|
|
read_binary_uint32_be(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint32(Stream, big_endian, ResultCode, UInt32,
|
|
IncompleteBytes, Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Result = ok(UInt32)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_read_binary_uint32(stream::in, byte_order::in,
|
|
maybe_incomplete_result_code::out, uint32::out, list(uint8)::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_read_binary_uint32(Stream::in, ByteOrder::in, ResultCode::out,
|
|
UInt32::out, IncompleteBytes::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
|
|
tabled_for_io],
|
|
"
|
|
ML_do_read_binary_uintN(4, 32, Stream, ByteOrder, ResultCode, UInt32,
|
|
IncompleteBytes, Error);
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_read_binary_uint32(Stream::in, ByteOrder::in, ResultCode::out,
|
|
UInt32::out, IncompleteBytes::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
byte[] buffer = new byte[4];
|
|
io.MR_MercuryFileStruct mf = Stream;
|
|
UInt32 = 0;
|
|
IncompleteBytes = list.empty_list();
|
|
|
|
int nread = 0;
|
|
|
|
if (mf.putback != -1) {
|
|
buffer[nread] = (byte) mf.putback;
|
|
nread++;
|
|
mf.putback = -1;
|
|
}
|
|
|
|
try {
|
|
for ( ; nread < 4; nread++) {
|
|
int b = mf.stream.ReadByte();
|
|
if (b == -1) {
|
|
break;
|
|
}
|
|
buffer[nread] = (byte) b;
|
|
}
|
|
if (nread < 4) {
|
|
if (nread > 0) {
|
|
ResultCode = io.ML_MIRC_INCOMPLETE;
|
|
for (int i = nread - 1; i >= 0; i--) {
|
|
IncompleteBytes = list.cons(buffer[i], IncompleteBytes);
|
|
}
|
|
} else {
|
|
ResultCode = io.ML_MIRC_EOF;
|
|
}
|
|
} else {
|
|
ResultCode = io.ML_MIRC_OK;
|
|
if (ByteOrder == io.ML_LITTLE_ENDIAN) {
|
|
UInt32 = (uint) (
|
|
buffer[3] << 24 |
|
|
buffer[2] << 16 |
|
|
buffer[1] << 8 |
|
|
buffer[0]);
|
|
} else {
|
|
UInt32 = (uint) (
|
|
buffer[0] << 24 |
|
|
buffer[1] << 16 |
|
|
buffer[2] << 8 |
|
|
buffer[3]);
|
|
}
|
|
}
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
ResultCode = io.ML_MIRC_ERROR;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_read_binary_uint32(Stream::in, ByteOrder::in, ResultCode::out,
|
|
UInt32::out, IncompleteBytes::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
byte[] buffer = new byte[4];
|
|
MR_BinaryInputFile mf = (MR_BinaryInputFile) Stream;
|
|
UInt32 = 0;
|
|
IncompleteBytes = list.empty_list();
|
|
|
|
try {
|
|
int nread;
|
|
for (nread = 0; nread < 4; nread++) {
|
|
int next = mf.read_byte();
|
|
if (next == -1) {
|
|
break;
|
|
}
|
|
buffer[nread] = (byte) next;
|
|
}
|
|
if (nread < 4) {
|
|
if (nread > 0) {
|
|
ResultCode = io.ML_MIRC_INCOMPLETE;
|
|
for (int i = nread - 1; i >= 0; i--) {
|
|
IncompleteBytes = list.cons(buffer[i], IncompleteBytes);
|
|
}
|
|
} else {
|
|
ResultCode = io.ML_MIRC_EOF;
|
|
}
|
|
} else {
|
|
ResultCode = io.ML_MIRC_OK;
|
|
if (ByteOrder == io.ML_LITTLE_ENDIAN) {
|
|
UInt32 =
|
|
(buffer[3] & 0xff) << 24 |
|
|
(buffer[2] & 0xff) << 16 |
|
|
(buffer[1] & 0xff) << 8 |
|
|
(buffer[0] & 0xff);
|
|
} else {
|
|
UInt32 =
|
|
(buffer[0] & 0xff) << 24 |
|
|
(buffer[1] & 0xff) << 16 |
|
|
(buffer[2] & 0xff) << 8 |
|
|
(buffer[3] & 0xff);
|
|
}
|
|
}
|
|
Error = null;
|
|
} catch (java.lang.Exception e) {
|
|
ResultCode = io.ML_MIRC_ERROR;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
read_binary_int64(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_int64(Stream, Result, !IO).
|
|
|
|
read_binary_int64(Stream, Result, !IO) :-
|
|
( if native_byte_order_is_big_endian then
|
|
read_binary_int64_be(Stream, Result, !IO)
|
|
else
|
|
read_binary_int64_le(Stream, Result, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_int64_le(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_int64_le(Stream, Result, !IO).
|
|
|
|
read_binary_int64_le(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint64(Stream, little_endian, ResultCode, UInt64,
|
|
IncompleteBytes, Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Int64 = cast_from_uint64(UInt64),
|
|
Result = ok(Int64)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_int64_be(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_int64_be(Stream, Result, !IO).
|
|
|
|
read_binary_int64_be(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint64(Stream, big_endian, ResultCode, UInt64,
|
|
IncompleteBytes, Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Int64 = cast_from_uint64(UInt64),
|
|
Result = ok(Int64)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_uint64(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_uint64(Stream, Result, !IO).
|
|
|
|
read_binary_uint64(Stream, Result, !IO) :-
|
|
( if native_byte_order_is_big_endian then
|
|
read_binary_uint64_be(Stream, Result, !IO)
|
|
else
|
|
read_binary_uint64_le(Stream, Result, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_uint64_le(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_uint64_le(Stream, Result, !IO).
|
|
|
|
read_binary_uint64_le(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint64(Stream, little_endian, ResultCode, UInt64,
|
|
IncompleteBytes, Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Result = ok(UInt64)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_uint64_be(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_uint64_be(Stream, Result, !IO).
|
|
|
|
read_binary_uint64_be(binary_input_stream(Stream), Result, !IO) :-
|
|
do_read_binary_uint64(Stream, big_endian, ResultCode, UInt64,
|
|
IncompleteBytes, Error, !IO),
|
|
(
|
|
ResultCode = mirc_ok,
|
|
Result = ok(UInt64)
|
|
;
|
|
ResultCode = mirc_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = mirc_incomplete,
|
|
Result = incomplete(IncompleteBytes)
|
|
;
|
|
ResultCode = mirc_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_read_binary_uint64(stream::in, byte_order::in,
|
|
maybe_incomplete_result_code::out, uint64::out, list(uint8)::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_read_binary_uint64(Stream::in, ByteOrder::in, ResultCode::out,
|
|
UInt64::out, IncompleteBytes::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
|
|
tabled_for_io],
|
|
"
|
|
ML_do_read_binary_uintN(8, 64, Stream, ByteOrder, ResultCode, UInt64,
|
|
IncompleteBytes, Error);
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_read_binary_uint64(Stream::in, ByteOrder::in, ResultCode::out,
|
|
UInt64::out, IncompleteBytes::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
byte[] buffer = new byte[8];
|
|
io.MR_MercuryFileStruct mf = Stream;
|
|
UInt64 = 0;
|
|
IncompleteBytes = list.empty_list();
|
|
|
|
int nread = 0;
|
|
|
|
if (mf.putback != -1) {
|
|
buffer[nread] = (byte) mf.putback;
|
|
nread++;
|
|
mf.putback = -1;
|
|
}
|
|
|
|
try {
|
|
for ( ; nread < 8; nread++) {
|
|
int b = mf.stream.ReadByte();
|
|
if (b == -1) {
|
|
break;
|
|
}
|
|
buffer[nread] = (byte) b;
|
|
}
|
|
if (nread < 8) {
|
|
if (nread > 0) {
|
|
ResultCode = io.ML_MIRC_INCOMPLETE;
|
|
for (int i = nread - 1; i >=0; i--) {
|
|
IncompleteBytes = list.cons(buffer[i], IncompleteBytes);
|
|
}
|
|
} else {
|
|
ResultCode = io.ML_MIRC_EOF;
|
|
}
|
|
} else {
|
|
ResultCode = io.ML_MIRC_OK;
|
|
if (ByteOrder == io.ML_LITTLE_ENDIAN) {
|
|
UInt64 = (ulong) (
|
|
(ulong) buffer[7] << 56 |
|
|
(ulong) buffer[6] << 48 |
|
|
(ulong) buffer[5] << 40 |
|
|
(ulong) buffer[4] << 32 |
|
|
(ulong) buffer[3] << 24 |
|
|
(ulong) buffer[2] << 16 |
|
|
(ulong) buffer[1] << 8 |
|
|
(ulong) buffer[0]);
|
|
} else {
|
|
UInt64 = (ulong) (
|
|
(ulong) buffer[0] << 56 |
|
|
(ulong) buffer[1] << 48 |
|
|
(ulong) buffer[2] << 40 |
|
|
(ulong) buffer[3] << 32 |
|
|
(ulong) buffer[4] << 24 |
|
|
(ulong) buffer[5] << 16 |
|
|
(ulong) buffer[6] << 8 |
|
|
(ulong) buffer[7]);
|
|
}
|
|
}
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
ResultCode = io.ML_MIRC_ERROR;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_read_binary_uint64(Stream::in, ByteOrder::in, ResultCode::out,
|
|
UInt64::out, IncompleteBytes::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
byte[] buffer = new byte[8];
|
|
MR_BinaryInputFile mf = (MR_BinaryInputFile) Stream;
|
|
UInt64 = 0;
|
|
IncompleteBytes = list.empty_list();
|
|
|
|
try {
|
|
int nread;
|
|
for (nread = 0; nread < 8; nread++) {
|
|
int next = mf.read_byte();
|
|
if (next == -1) {
|
|
break;
|
|
}
|
|
buffer[nread] = (byte) next;
|
|
}
|
|
if (nread < 8) {
|
|
if (nread > 0) {
|
|
ResultCode = io.ML_MIRC_INCOMPLETE;
|
|
for (int i = nread - 1; i >= 0; i--) {
|
|
IncompleteBytes = list.cons(buffer[i], IncompleteBytes);
|
|
}
|
|
} else {
|
|
ResultCode = io.ML_MIRC_EOF;
|
|
}
|
|
} else {
|
|
ResultCode = io.ML_MIRC_OK;
|
|
if (ByteOrder == io.ML_LITTLE_ENDIAN) {
|
|
UInt64 =
|
|
(long) (buffer[7] & 0xff) << 56 |
|
|
(long) (buffer[6] & 0xff) << 48 |
|
|
(long) (buffer[5] & 0xff) << 40 |
|
|
(long) (buffer[4] & 0xff) << 32 |
|
|
(long) (buffer[3] & 0xff) << 24 |
|
|
(long) (buffer[2] & 0xff) << 16 |
|
|
(long) (buffer[1] & 0xff) << 8 |
|
|
(long) (buffer[0] & 0xff);
|
|
} else {
|
|
UInt64 =
|
|
(long) (buffer[0] & 0xff) << 56 |
|
|
(long) (buffer[1] & 0xff) << 48 |
|
|
(long) (buffer[2] & 0xff) << 40 |
|
|
(long) (buffer[3] & 0xff) << 32 |
|
|
(long) (buffer[4] & 0xff) << 24 |
|
|
(long) (buffer[5] & 0xff) << 16 |
|
|
(long) (buffer[6] & 0xff) << 8 |
|
|
(long) (buffer[7] & 0xff);
|
|
}
|
|
}
|
|
Error = null;
|
|
} catch (java.lang.Exception e) {
|
|
ResultCode = io.ML_MIRC_ERROR;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- type byte_order
|
|
---> big_endian
|
|
; little_endian.
|
|
|
|
:- pragma foreign_export_enum("C", byte_order/0,
|
|
[prefix("ML_"), uppercase]).
|
|
:- pragma foreign_export_enum("Java", byte_order/0,
|
|
[prefix("ML_"), uppercase]).
|
|
:- pragma foreign_export_enum("C#", byte_order/0,
|
|
[prefix("ML_"), uppercase]).
|
|
|
|
:- pred native_byte_order_is_big_endian is semidet.
|
|
|
|
:- pragma foreign_proc("C",
|
|
native_byte_order_is_big_endian,
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
#if defined(MR_BIG_ENDIAN)
|
|
SUCCESS_INDICATOR = MR_TRUE;
|
|
#else
|
|
SUCCESS_INDICATOR = MR_FALSE;
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
native_byte_order_is_big_endian,
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
SUCCESS_INDICATOR = !(BitConverter.IsLittleEndian);
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
native_byte_order_is_big_endian,
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
SUCCESS_INDICATOR =
|
|
(java.nio.ByteOrder.nativeOrder() == java.nio.ByteOrder.BIG_ENDIAN);
|
|
").
|
|
|
|
%---------------------%
|
|
%
|
|
% C implementation of reading multibyte integers from binary streams.
|
|
%
|
|
|
|
:- pragma foreign_decl("C", "
|
|
// ML_N_BIT_UINT_T(n) expands to the name of an n-bit unsigned integer type
|
|
// in C, if N is 8, 16, 32 or 64.
|
|
//
|
|
#define ML_N_BIT_INT_T(n) \
|
|
MR_PASTE3(uint, n, _t)
|
|
|
|
// ML_REVERSE_BYTES_FUNC(n) expands to the name a function exported by the
|
|
// Mercury runtime that can be used to reverse the bytes in an n-bit
|
|
// unsigned integer, if N is 16, 32 or 64.
|
|
//
|
|
#define ML_REVERSE_BYTES_FUNC(n) \
|
|
MR_PASTE3(MR_uint, n, _reverse_bytes)
|
|
|
|
// ML_build_uintN(int n, MR_Word byte_order, unsigned char *buffer,
|
|
// uintN_t value):
|
|
//
|
|
// Build an n-bit unsigned integer using the bytes stored in the array
|
|
// 'buffer'. The order of the bytes in the buffer are given by 'byte_order'.
|
|
// The result is assigned to the lvalue 'value'
|
|
//
|
|
// We have two definitions of this macro, one for big-endian machines
|
|
// and one for little-endian machines.
|
|
//
|
|
#if defined(MR_BIG_ENDIAN)
|
|
#define ML_build_uintN(n, byte_order, buffer, value) \
|
|
do { \
|
|
if (byte_order == ML_LITTLE_ENDIAN) { \
|
|
value = ML_REVERSE_BYTES_FUNC(n)( \
|
|
*((ML_N_BIT_INT_T(n) *) buffer)); \
|
|
} else { \
|
|
value = *((ML_N_BIT_INT_T(n) *) buffer); \
|
|
} \
|
|
} while (0)
|
|
#else
|
|
#define ML_build_uintN(n, byte_order, buffer, value) \
|
|
do { \
|
|
if (byte_order == ML_LITTLE_ENDIAN) { \
|
|
value = *((ML_N_BIT_INT_T(n) *) buffer); \
|
|
} else { \
|
|
value = ML_REVERSE_BYTES_FUNC(n)( \
|
|
*((ML_N_BIT_INT_T(n) *) buffer)); \
|
|
} \
|
|
} while (0)
|
|
#endif
|
|
|
|
// ML_do_read_binary_uintN(int nbytes, int nbits, MR_Word stream,
|
|
// MR_Word byte_order, MR_Word result_code, MR_Word result_value,
|
|
// MR_Word result_incomplete, MR_Word result_error):
|
|
//
|
|
// This macro implements the do_read_binary_uint{16 32,64}/8 predicates.
|
|
// It expands to code for reading an 'nbits'-bit ('nbytes'-byte) unsigned
|
|
// integer from the binary stream 'stream', with the bytes in the stream
|
|
// being in 'byte_order' order.
|
|
//
|
|
// The result is returned as follows:
|
|
//
|
|
// 'result_code' is set the status code (maybe_incomplete_result_code/0)
|
|
// for the read.
|
|
// 'result_value' is the value of the integer read on a successful read
|
|
// and zero otherwise.
|
|
// 'result_incomplete' is the list of bytes read so far for an incomplete
|
|
// read, and the empty list otherwise.
|
|
// 'result_error' is the errno if an I/O error occurs, and zero otherwise.
|
|
//
|
|
#define ML_do_read_binary_uintN(nbytes, nbits, stream, byte_order, \
|
|
result_code, result_value, result_incomplete, result_error) \
|
|
do { \
|
|
unsigned char buffer[nbytes]; \
|
|
size_t nread = MR_READ(*stream, buffer, nbytes); \
|
|
result_incomplete = MR_list_empty(); \
|
|
\
|
|
if (nread < nbytes) { \
|
|
result_value = 0; \
|
|
if (MR_FERROR(*stream)) { \
|
|
result_code = ML_MIRC_ERROR, \
|
|
result_error = errno; \
|
|
} else if (nread > 0) { \
|
|
int i; \
|
|
result_code = ML_MIRC_INCOMPLETE; \
|
|
for (i = nread - 1; i >= 0; i--) { \
|
|
result_incomplete = \
|
|
MR_list_cons(buffer[i], \
|
|
result_incomplete); \
|
|
} \
|
|
result_error = 0; \
|
|
} else { \
|
|
result_code = ML_MIRC_EOF; \
|
|
result_error = 0; \
|
|
} \
|
|
} else { \
|
|
result_code = ML_MIRC_OK; \
|
|
ML_build_uintN(nbits, byte_order, buffer, result_value); \
|
|
result_error = 0; \
|
|
} \
|
|
} while (0)
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Writing values of primitive types.
|
|
%
|
|
|
|
write_char(Character, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_char(Stream, Character, !IO).
|
|
|
|
write_char(output_stream(Stream), Character, !IO) :-
|
|
do_write_char(Stream, Character, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_char(stream::in, char::in, system_error::out, io::di, io::uo)
|
|
is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_char(Stream::in, Character::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
Error = 0;
|
|
if (Character <= 0x7f) {
|
|
if (MR_PUTCH(*Stream, Character) < 0) {
|
|
Error = errno;
|
|
} else if (Character == '\\n') {
|
|
MR_line_number(*Stream)++;
|
|
}
|
|
} else {
|
|
char buf[5];
|
|
size_t len;
|
|
size_t i;
|
|
len = MR_utf8_encode(buf, Character);
|
|
// XXX ILSEQ Error if len==0
|
|
for (i = 0; i < len; i++) {
|
|
if (MR_PUTCH(*Stream, buf[i]) < 0) {
|
|
Error = errno;
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_char(Stream::in, Character::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
may_not_duplicate],
|
|
"
|
|
io.MR_MercuryFileStruct stream = Stream;
|
|
try {
|
|
// See mercury_print_string().
|
|
if (stream.writer == null) {
|
|
stream.writer = new System.IO.StreamWriter(stream.stream,
|
|
text_encoding);
|
|
}
|
|
System.IO.TextWriter w = stream.writer;
|
|
if (Character == '\\n') {
|
|
switch (stream.line_ending) {
|
|
case io.ML_line_ending_kind.ML_raw_binary:
|
|
case io.ML_line_ending_kind.ML_Unix_line_ending:
|
|
mercury_write_codepoint(w, Character);
|
|
break;
|
|
case io.ML_line_ending_kind.ML_OS_line_ending:
|
|
w.WriteLine("""");
|
|
break;
|
|
}
|
|
stream.line_number++;
|
|
} else {
|
|
mercury_write_codepoint(w, Character);
|
|
}
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_char(Stream::in, Character::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
char[] buf = java.lang.Character.toChars(Character);
|
|
for (char c : buf) {
|
|
((io.MR_TextOutputFile) Stream).put(c);
|
|
}
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_int(Val, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_int(Stream, Val, !IO).
|
|
|
|
write_int(output_stream(Stream), Val, !IO) :-
|
|
do_write_int(Stream, Val, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_int(stream::in, int::in, system_error::out, io::di, io::uo)
|
|
is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_int(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (ML_fprintf(Stream, ""%"" MR_INTEGER_LENGTH_MODIFIER ""d"", Val) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_int(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
io.mercury_print_string(Stream, Val.ToString());
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_int(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).write(String.valueOf(Val));
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_uint(Val, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_uint(Stream, Val, !IO).
|
|
|
|
write_uint(output_stream(Stream), Val, !IO) :-
|
|
do_write_uint(Stream, Val, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_uint(stream::in, uint::in, system_error::out, io::di, io::uo)
|
|
is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_uint(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (ML_fprintf(Stream, ""%"" MR_INTEGER_LENGTH_MODIFIER ""u"", Val) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_uint(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
io.mercury_print_string(Stream, Val.ToString());
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_uint(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).write(
|
|
java.lang.Long.toString(Val & 0xffffffffL));
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_int8(Val, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_int8(Stream, Val, !IO).
|
|
|
|
write_int8(output_stream(Stream), Val, !IO) :-
|
|
do_write_int8(Stream, Val, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_int8(stream::in, int8::in, system_error::out, io::di, io::uo)
|
|
is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_int8(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (ML_fprintf(Stream, ""%"" PRId8, Val) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_int8(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
io.mercury_print_string(Stream, Val.ToString());
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_int8(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).write(String.valueOf(Val));
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_uint8(Val, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_uint8(Stream, Val, !IO).
|
|
|
|
write_uint8(output_stream(Stream), Val, !IO) :-
|
|
do_write_uint8(Stream, Val, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_uint8(stream::in, uint8::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_uint8(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (ML_fprintf(Stream, ""%"" PRIu8, Val) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_uint8(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
io.mercury_print_string(Stream, Val.ToString());
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_uint8(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).write(
|
|
java.lang.Integer.toString(Val & 0xff));
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_int16(Val, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_int16(Stream, Val, !IO).
|
|
|
|
write_int16(output_stream(Stream), Val, !IO) :-
|
|
do_write_int16(Stream, Val, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_int16(stream::in, int16::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_int16(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (ML_fprintf(Stream, ""%"" PRId16, Val) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_int16(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
io.mercury_print_string(Stream, Val.ToString());
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_int16(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).write(String.valueOf(Val));
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_uint16(Val, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_uint16(Stream, Val, !IO).
|
|
|
|
write_uint16(output_stream(Stream), Val, !IO) :-
|
|
do_write_uint16(Stream, Val, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_uint16(stream::in, uint16::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_uint16(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (ML_fprintf(Stream, ""%"" PRIu16, Val) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_uint16(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
io.mercury_print_string(Stream, Val.ToString());
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_uint16(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).write(
|
|
java.lang.Integer.toString(Val & 0xffff));
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_int32(Val, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_int32(Stream, Val, !IO).
|
|
|
|
write_int32(output_stream(Stream), Val, !IO) :-
|
|
do_write_int32(Stream, Val, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_int32(stream::in, int32::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_int32(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (ML_fprintf(Stream, ""%"" PRId32, Val) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_int32(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
io.mercury_print_string(Stream, Val.ToString());
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_int32(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).write(String.valueOf(Val));
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_uint32(Val, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_uint32(Stream, Val, !IO).
|
|
|
|
write_uint32(output_stream(Stream), Val, !IO) :-
|
|
do_write_uint32(Stream, Val, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_uint32(stream::in, uint32::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_uint32(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (ML_fprintf(Stream, ""%"" PRIu32, Val) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_uint32(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
io.mercury_print_string(Stream, Val.ToString());
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_uint32(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).write(
|
|
java.lang.Long.toString(Val & 0xffffffffL));
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_int64(Val, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_int64(Stream, Val, !IO).
|
|
|
|
write_int64(output_stream(Stream), Val, !IO) :-
|
|
do_write_int64(Stream, Val, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_int64(stream::in, int64::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_int64(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (ML_fprintf(Stream, ""%"" PRId64, Val) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_int64(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
io.mercury_print_string(Stream, Val.ToString());
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_int64(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).write(String.valueOf(Val));
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_uint64(Val, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_uint64(Stream, Val, !IO).
|
|
|
|
write_uint64(output_stream(Stream), Val, !IO) :-
|
|
do_write_uint64(Stream, Val, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_uint64(stream::in, uint64::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_uint64(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (ML_fprintf(Stream, ""%"" PRIu64, Val) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_uint64(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
io.mercury_print_string(Stream, Val.ToString());
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_uint64(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).write(
|
|
java.lang.Long.toUnsignedString(Val));
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_float(Val, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_float(Stream, Val, !IO).
|
|
|
|
write_float(output_stream(Stream), Val, !IO) :-
|
|
do_write_float(Stream, Val, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_float(stream::in, float::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_float(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
char buf[MR_SPRINTF_FLOAT_BUF_SIZE];
|
|
MR_sprintf_float(buf, Val);
|
|
if (ML_fprintf(Stream, ""%s"", buf) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
% XXX MISSING C# do_write_float
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_float(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
io.MR_TextOutputFile stream = (io.MR_TextOutputFile) Stream;
|
|
|
|
try {
|
|
if (Double.isNaN(Val)) {
|
|
stream.write(""nan"");
|
|
} else if (Double.isInfinite(Val)) {
|
|
if (Val < 0.0) {
|
|
stream.write(""-infinity"");
|
|
} else {
|
|
stream.write(""infinity"");
|
|
}
|
|
} else {
|
|
stream.write(Double.toString(Val));
|
|
}
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
do_write_float(Stream, Float, Error, !IO) :-
|
|
do_write_string(Stream, string.float_to_string(Float), Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
write_string(Message, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_string(Stream, Message, !IO).
|
|
|
|
write_string(output_stream(Stream), Message, !IO) :-
|
|
do_write_string(Stream, Message, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred do_write_string(stream::in, string::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_string(Stream::in, Message::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
const char *s = Message;
|
|
if (ML_fprintf(Stream, ""%s"", s) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
while (*s) {
|
|
if (*s++ == '\\n') {
|
|
MR_line_number(*Stream)++;
|
|
}
|
|
}
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_string(Stream::in, Message::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
io.mercury_print_string(Stream, Message);
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_string(Stream::in, Message::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).write(Message);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
nl(!IO) :-
|
|
write_char('\n', !IO).
|
|
|
|
nl(Stream, !IO) :-
|
|
write_char(Stream, '\n', !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
write_byte(Byte, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_byte(Stream, Byte, !IO).
|
|
|
|
write_byte(binary_output_stream(Stream), Byte, !IO) :-
|
|
do_write_byte(Stream, Byte, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
write_binary_int8(Int8, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary_int8(Stream, Int8, !IO).
|
|
|
|
write_binary_int8(binary_output_stream(Stream), Int8, !IO) :-
|
|
UInt8 = uint8.cast_from_int8(Int8),
|
|
Int = uint8.to_int(UInt8),
|
|
do_write_byte(Stream, Int, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
write_binary_uint8(UInt8, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary_uint8(Stream, UInt8, !IO).
|
|
|
|
write_binary_uint8(binary_output_stream(Stream), UInt8, !IO) :-
|
|
Int = uint8.to_int(UInt8),
|
|
do_write_byte(Stream, Int, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_write_byte(stream::in, int::in, system_error::out, io::di, io::uo)
|
|
is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_byte(Stream::in, Byte::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
// Call putc with a strictly non-negative byte-sized integer.
|
|
if (MR_PUTCH(*Stream, (int) ((unsigned char) Byte)) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_byte(Stream::in, Byte::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
Stream.stream.WriteByte(System.Convert.ToByte(Byte));
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_byte(Stream::in, Byte::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
((io.MR_BinaryOutputFile) Stream).put((byte) Byte);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_binary_int16(Int16, !IO) :-
|
|
UInt16 = uint16.cast_from_int16(Int16),
|
|
write_binary_uint16(UInt16, !IO).
|
|
|
|
write_binary_int16(Stream, Int16, !IO) :-
|
|
UInt16 = uint16.cast_from_int16(Int16),
|
|
write_binary_uint16(Stream, UInt16, !IO).
|
|
|
|
write_binary_uint16(UInt16, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary_uint16(Stream, UInt16, !IO).
|
|
|
|
write_binary_uint16(binary_output_stream(Stream), UInt16, !IO) :-
|
|
do_write_binary_uint16(Stream, UInt16, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_write_binary_uint16(stream::in, uint16::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_binary_uint16(Stream::in, U16::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
if (MR_WRITE(*Stream, (unsigned char *)(&U16), 2) != 2) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_binary_uint16(Stream::in, U16::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
java.nio.ByteBuffer buffer = java.nio.ByteBuffer.allocate(2);
|
|
buffer.order(java.nio.ByteOrder.nativeOrder());
|
|
buffer.putShort(U16);
|
|
((io.MR_BinaryOutputFile) Stream).write(buffer.array(), 0, 2);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_binary_uint16(Stream::in, U16::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
byte[] bytes = BitConverter.GetBytes(U16);
|
|
try {
|
|
Stream.stream.Write(bytes, 0, 2);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_binary_int16_le(Int16, !IO) :-
|
|
UInt16 = uint16.cast_from_int16(Int16),
|
|
write_binary_uint16_le(UInt16, !IO).
|
|
|
|
write_binary_int16_le(Stream, Int16, !IO) :-
|
|
UInt16 = uint16.cast_from_int16(Int16),
|
|
write_binary_uint16_le(Stream, UInt16, !IO).
|
|
|
|
write_binary_uint16_le(UInt16, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary_uint16_le(Stream, UInt16, !IO).
|
|
|
|
write_binary_uint16_le(binary_output_stream(Stream), UInt16, !IO) :-
|
|
do_write_binary_uint16_le(Stream, UInt16, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_write_binary_uint16_le(stream::in, uint16::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_binary_uint16_le(Stream::in, U16::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
#if defined(MR_BIG_ENDIAN)
|
|
U16 = MR_uint16_reverse_bytes(U16);
|
|
#endif
|
|
|
|
if (MR_WRITE(*Stream, (unsigned char *)(&U16), 2) != 2) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_binary_uint16_le(Stream::in, U16::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
byte[] bytes = BitConverter.GetBytes(U16);
|
|
if (!BitConverter.IsLittleEndian) {
|
|
Array.Reverse(bytes);
|
|
}
|
|
try {
|
|
Stream.stream.Write(bytes, 0, 2);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_binary_uint16_le(Stream::in, U16::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
java.nio.ByteBuffer buffer = java.nio.ByteBuffer.allocate(2);
|
|
buffer.order(java.nio.ByteOrder.LITTLE_ENDIAN);
|
|
buffer.putShort(U16);
|
|
((io.MR_BinaryOutputFile) Stream).write(buffer.array(), 0, 2);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_binary_int16_be(Int16, !IO) :-
|
|
UInt16 = uint16.cast_from_int16(Int16),
|
|
write_binary_uint16_be(UInt16, !IO).
|
|
|
|
write_binary_int16_be(Stream, Int16, !IO) :-
|
|
UInt16 = uint16.cast_from_int16(Int16),
|
|
write_binary_uint16_be(Stream, UInt16, !IO).
|
|
|
|
write_binary_uint16_be(UInt16, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary_uint16_be(Stream, UInt16, !IO).
|
|
|
|
write_binary_uint16_be(binary_output_stream(Stream), UInt16, !IO) :-
|
|
do_write_binary_uint16_be(Stream, UInt16, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_write_binary_uint16_be(stream::in, uint16::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_binary_uint16_be(Stream::in, U16::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
#if defined(MR_LITTLE_ENDIAN)
|
|
U16 = MR_uint16_reverse_bytes(U16);
|
|
#endif
|
|
|
|
if (MR_WRITE(*Stream, (unsigned char *)(&U16), 2) != 2) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_binary_uint16_be(Stream::in, U16::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
byte[] bytes = BitConverter.GetBytes(U16);
|
|
if (BitConverter.IsLittleEndian) {
|
|
Array.Reverse(bytes);
|
|
}
|
|
try {
|
|
Stream.stream.Write(bytes, 0, 2);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_binary_uint16_be(Stream::in, U16::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
java.nio.ByteBuffer buffer = java.nio.ByteBuffer.allocate(2);
|
|
// Order in a byte buffer is big endian by default.
|
|
buffer.putShort(U16);
|
|
((io.MR_BinaryOutputFile) Stream).write(buffer.array(), 0, 2);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_binary_int32(Int32, !IO) :-
|
|
UInt32 = uint32.cast_from_int32(Int32),
|
|
write_binary_uint32(UInt32, !IO).
|
|
|
|
write_binary_int32(Stream, Int32, !IO) :-
|
|
UInt32 = uint32.cast_from_int32(Int32),
|
|
write_binary_uint32(Stream, UInt32, !IO).
|
|
|
|
write_binary_uint32(UInt32, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary_uint32(Stream, UInt32, !IO).
|
|
|
|
write_binary_uint32(binary_output_stream(Stream), UInt32, !IO) :-
|
|
do_write_binary_uint32(Stream, UInt32, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_write_binary_uint32(stream::in, uint32::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_binary_uint32(Stream::in, U32::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
if (MR_WRITE(*Stream, (unsigned char *)(&U32), 4) != 4) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_binary_uint32(Stream::in, U32::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
byte[] bytes = BitConverter.GetBytes(U32);
|
|
try {
|
|
Stream.stream.Write(bytes, 0, 4);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_binary_uint32(Stream::in, U32::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
java.nio.ByteBuffer buffer = java.nio.ByteBuffer.allocate(4);
|
|
buffer.order(java.nio.ByteOrder.nativeOrder());
|
|
buffer.putInt(U32);
|
|
((io.MR_BinaryOutputFile) Stream).write(buffer.array(), 0, 4);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_binary_int32_le(Int32, !IO) :-
|
|
UInt32 = uint32.cast_from_int32(Int32),
|
|
write_binary_uint32_le(UInt32, !IO).
|
|
|
|
write_binary_int32_le(Stream, Int32, !IO) :-
|
|
UInt32 = uint32.cast_from_int32(Int32),
|
|
write_binary_uint32_le(Stream, UInt32, !IO).
|
|
|
|
write_binary_uint32_le(UInt32, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary_uint32_le(Stream, UInt32, !IO).
|
|
|
|
write_binary_uint32_le(binary_output_stream(Stream), UInt32, !IO) :-
|
|
do_write_binary_uint32_le(Stream, UInt32, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_write_binary_uint32_le(stream::in, uint32::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_binary_uint32_le(Stream::in, U32::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
#if defined(MR_BIG_ENDIAN)
|
|
U32 = MR_uint32_reverse_bytes(U32);
|
|
#endif
|
|
|
|
if (MR_WRITE(*Stream, (unsigned char *)(&U32), 4) != 4) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_binary_uint32_le(Stream::in, U32::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
byte[] bytes = BitConverter.GetBytes(U32);
|
|
if (!BitConverter.IsLittleEndian) {
|
|
Array.Reverse(bytes);
|
|
}
|
|
try {
|
|
Stream.stream.Write(bytes, 0, 4);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_binary_uint32_le(Stream::in, U32::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
java.nio.ByteBuffer buffer = java.nio.ByteBuffer.allocate(4);
|
|
buffer.order(java.nio.ByteOrder.LITTLE_ENDIAN);
|
|
buffer.putInt(U32);
|
|
((io.MR_BinaryOutputFile) Stream).write(buffer.array(), 0, 4);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_binary_int32_be(Int32, !IO) :-
|
|
UInt32 = uint32.cast_from_int32(Int32),
|
|
write_binary_uint32_be(UInt32, !IO).
|
|
|
|
write_binary_int32_be(Stream, Int32, !IO) :-
|
|
UInt32 = uint32.cast_from_int32(Int32),
|
|
write_binary_uint32_be(Stream, UInt32, !IO).
|
|
|
|
write_binary_uint32_be(UInt32, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary_uint32_be(Stream, UInt32, !IO).
|
|
|
|
write_binary_uint32_be(binary_output_stream(Stream), UInt32, !IO) :-
|
|
do_write_binary_uint32_be(Stream, UInt32, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_write_binary_uint32_be(stream::in, uint32::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_binary_uint32_be(Stream::in, U32::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
#if defined(MR_LITTLE_ENDIAN)
|
|
U32 = MR_uint32_reverse_bytes(U32);
|
|
#endif
|
|
|
|
if (MR_WRITE(*Stream, (unsigned char *)(&U32), 4) != 4) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_binary_uint32_be(Stream::in, U32::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
byte[] bytes = BitConverter.GetBytes(U32);
|
|
if (BitConverter.IsLittleEndian) {
|
|
Array.Reverse(bytes);
|
|
}
|
|
try {
|
|
Stream.stream.Write(bytes, 0, 4);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_binary_uint32_be(Stream::in, U32::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
java.nio.ByteBuffer buffer = java.nio.ByteBuffer.allocate(4);
|
|
// Order in a byte buffer is big endian by default.
|
|
buffer.putInt(U32);
|
|
((io.MR_BinaryOutputFile) Stream).write(buffer.array(), 0, 4);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_binary_int64(Int64, !IO) :-
|
|
UInt64 = uint64.cast_from_int64(Int64),
|
|
write_binary_uint64(UInt64, !IO).
|
|
|
|
write_binary_int64(Stream, Int64, !IO) :-
|
|
UInt64 = uint64.cast_from_int64(Int64),
|
|
write_binary_uint64(Stream, UInt64, !IO).
|
|
|
|
write_binary_uint64(UInt64, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary_uint64(Stream, UInt64, !IO).
|
|
|
|
write_binary_uint64(binary_output_stream(Stream), UInt64, !IO) :-
|
|
do_write_binary_uint64(Stream, UInt64, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_write_binary_uint64(stream::in, uint64::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_binary_uint64(Stream::in, U64::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
if (MR_WRITE(*Stream, (unsigned char *)(&U64), 8) != 8) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_binary_uint64(Stream::in, U64::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
byte[] bytes = BitConverter.GetBytes(U64);
|
|
try {
|
|
Stream.stream.Write(bytes, 0, 8);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_binary_uint64(Stream::in, U64::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
java.nio.ByteBuffer buffer = java.nio.ByteBuffer.allocate(8);
|
|
buffer.order(java.nio.ByteOrder.nativeOrder());
|
|
buffer.putLong(U64);
|
|
((io.MR_BinaryOutputFile) Stream).write(buffer.array(), 0, 8);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_binary_int64_le(Int64, !IO) :-
|
|
UInt64 = uint64.cast_from_int64(Int64),
|
|
write_binary_uint64_le(UInt64, !IO).
|
|
|
|
write_binary_int64_le(Stream, Int64, !IO) :-
|
|
UInt64 = uint64.cast_from_int64(Int64),
|
|
write_binary_uint64_le(Stream, UInt64, !IO).
|
|
|
|
write_binary_uint64_le(UInt64, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary_uint64_le(Stream, UInt64, !IO).
|
|
|
|
write_binary_uint64_le(binary_output_stream(Stream), UInt64, !IO) :-
|
|
do_write_binary_uint64_le(Stream, UInt64, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_write_binary_uint64_le(stream::in, uint64::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_binary_uint64_le(Stream::in, U64::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
#if defined(MR_BIG_ENDIAN)
|
|
U64 = MR_uint64_reverse_bytes(U64);
|
|
#endif
|
|
|
|
if (MR_WRITE(*Stream, (unsigned char *)(&U64), 8) != 8) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_binary_uint64_le(Stream::in, U64::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
byte[] bytes = BitConverter.GetBytes(U64);
|
|
if (!BitConverter.IsLittleEndian) {
|
|
Array.Reverse(bytes);
|
|
}
|
|
try {
|
|
Stream.stream.Write(bytes, 0, 8);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_binary_uint64_le(Stream::in, U64::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
java.nio.ByteBuffer buffer = java.nio.ByteBuffer.allocate(8);
|
|
buffer.order(java.nio.ByteOrder.LITTLE_ENDIAN);
|
|
buffer.putLong(U64);
|
|
((io.MR_BinaryOutputFile) Stream).write(buffer.array(), 0, 8);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
write_binary_int64_be(Int64, !IO) :-
|
|
UInt64 = uint64.cast_from_int64(Int64),
|
|
write_binary_uint64_be(UInt64, !IO).
|
|
|
|
write_binary_int64_be(Stream, Int64, !IO) :-
|
|
UInt64 = uint64.cast_from_int64(Int64),
|
|
write_binary_uint64_be(Stream, UInt64, !IO).
|
|
|
|
write_binary_uint64_be(UInt64, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary_uint64_be(Stream, UInt64, !IO).
|
|
|
|
write_binary_uint64_be(binary_output_stream(Stream), UInt64, !IO) :-
|
|
do_write_binary_uint64_be(Stream, UInt64, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred do_write_binary_uint64_be(stream::in, uint64::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_binary_uint64_be(Stream::in, U64::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
#if defined(MR_LITTLE_ENDIAN)
|
|
U64 = MR_uint64_reverse_bytes(U64);
|
|
#endif
|
|
|
|
if (MR_WRITE(*Stream, (unsigned char *)(&U64), 8) != 8) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_binary_uint64_be(Stream::in, U64::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
byte[] bytes = BitConverter.GetBytes(U64);
|
|
if (BitConverter.IsLittleEndian) {
|
|
Array.Reverse(bytes);
|
|
}
|
|
try {
|
|
Stream.stream.Write(bytes, 0, 8);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_binary_uint64_be(Stream::in, U64::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
java.nio.ByteBuffer buffer = java.nio.ByteBuffer.allocate(8);
|
|
// Order in a byte buffer is big endian by default.
|
|
buffer.putLong(U64);
|
|
((io.MR_BinaryOutputFile) Stream).write(buffer.array(), 0, 8);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Text input predicates.
|
|
%
|
|
|
|
read_word(Result, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
read_word(Stream, Result, !IO).
|
|
|
|
read_word(Stream, Result, !IO) :-
|
|
io.ignore_whitespace(Stream, WSResult, !IO),
|
|
(
|
|
WSResult = error(Error),
|
|
Result = error(Error)
|
|
;
|
|
WSResult = eof,
|
|
Result = eof
|
|
;
|
|
WSResult = ok,
|
|
read_word_2(Stream, Result, !IO)
|
|
).
|
|
|
|
:- pred read_word_2(io.input_stream::in, io.result(list(char))::out,
|
|
io::di, io::uo) is det.
|
|
|
|
read_word_2(Stream, Result, !IO) :-
|
|
read_char(Stream, CharResult, !IO),
|
|
(
|
|
CharResult = error(Error),
|
|
Result = error(Error)
|
|
;
|
|
CharResult = eof,
|
|
Result = eof
|
|
;
|
|
CharResult = ok(Char),
|
|
( if char.is_whitespace(Char) then
|
|
putback_char(Stream, Char, !IO),
|
|
Result = ok([])
|
|
else
|
|
read_word_2(Stream, Result0, !IO),
|
|
(
|
|
Result0 = ok(Chars),
|
|
Result = ok([Char | Chars])
|
|
;
|
|
Result0 = error(_),
|
|
Result = Result0
|
|
;
|
|
Result0 = eof,
|
|
Result = ok([Char])
|
|
)
|
|
)
|
|
).
|
|
|
|
read_line(Result, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
read_line(Stream, Result, !IO).
|
|
|
|
read_line(Stream, Result, !IO) :-
|
|
read_line_2(Stream, ResultCode, Chars, Error, !IO),
|
|
(
|
|
ResultCode = result_code_ok,
|
|
Result = ok(Chars)
|
|
;
|
|
ResultCode = result_code_eof,
|
|
Result = eof
|
|
;
|
|
ResultCode = result_code_error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
:- pred read_line_2(input_stream::in, result_code::out, list(char)::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
read_line_2(Stream, Result, Chars, Error, !IO) :-
|
|
read_char_code(Stream, Result0, Char, Error0, !IO),
|
|
(
|
|
Result0 = result_code_ok,
|
|
( if Char = '\n' then
|
|
Result = result_code_ok,
|
|
Chars = [Char],
|
|
Error = Error0
|
|
else
|
|
read_line_2(Stream, Result, CharsTail, Error, !IO),
|
|
Chars = [Char | CharsTail] % lcmc
|
|
)
|
|
;
|
|
( Result0 = result_code_eof
|
|
; Result0 = result_code_error
|
|
),
|
|
Result = Result0,
|
|
Chars = [],
|
|
Error = Error0
|
|
).
|
|
|
|
read_line_as_string(Result, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
read_line_as_string(Stream, Result, !IO).
|
|
|
|
read_line_as_string(input_stream(Stream), Result, !IO) :-
|
|
read_line_as_string_2(Stream, yes, Res, String, Error, !IO),
|
|
(
|
|
Res = ok,
|
|
Result = ok(String)
|
|
;
|
|
Res = eof,
|
|
Result = eof
|
|
;
|
|
Res = null_char,
|
|
Result = error(io_error("null character in input"))
|
|
;
|
|
Res = error,
|
|
make_err_msg(Error, "read failed: ", Msg, !IO),
|
|
Result = error(io_error(Msg))
|
|
).
|
|
|
|
:- type read_line_as_string_result
|
|
---> ok
|
|
; eof
|
|
; null_char
|
|
; error.
|
|
|
|
:- pragma foreign_export_enum("C", read_line_as_string_result/0,
|
|
[prefix("ML_READ_LINE_AS_STRING_"), uppercase]).
|
|
:- pragma foreign_export_enum("Java", read_line_as_string_result/0,
|
|
[prefix("ML_READ_LINE_AS_STRING_"), uppercase]).
|
|
|
|
:- pred read_line_as_string_2(io.stream::in, bool::in,
|
|
read_line_as_string_result::out, string::out, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
read_line_as_string_2(Stream::in, _FirstCall::in, Res::out,
|
|
RetString::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#define ML_IO_READ_LINE_GROW(n) ((n) * 3 / 2)
|
|
#define ML_IO_BYTES_TO_WORDS(n) (((n) + sizeof(MR_Word) - 1) / sizeof(MR_Word))
|
|
#define ML_IO_READ_LINE_START 1024
|
|
|
|
char initial_read_buffer[ML_IO_READ_LINE_START];
|
|
char *read_buffer = initial_read_buffer;
|
|
size_t read_buf_size = ML_IO_READ_LINE_START;
|
|
size_t i;
|
|
int char_code = '\\0';
|
|
|
|
Res = ML_READ_LINE_AS_STRING_OK;
|
|
Error = 0;
|
|
for (i = 0; char_code != '\\n'; ) {
|
|
char_code = mercury_get_byte(Stream);
|
|
if (char_code == EOF) {
|
|
if (i == 0) {
|
|
if (MR_FERROR(*Stream)) {
|
|
Res = ML_READ_LINE_AS_STRING_ERROR;
|
|
Error = errno;
|
|
} else {
|
|
Res = ML_READ_LINE_AS_STRING_EOF;
|
|
}
|
|
}
|
|
break;
|
|
}
|
|
if (char_code == 0) {
|
|
Res = ML_READ_LINE_AS_STRING_NULL_CHAR;
|
|
break;
|
|
}
|
|
read_buffer[i++] = (char) char_code;
|
|
MR_assert(i <= read_buf_size);
|
|
if (i == read_buf_size) {
|
|
// Grow the read buffer.
|
|
read_buf_size = ML_IO_READ_LINE_GROW(read_buf_size);
|
|
if (read_buffer == initial_read_buffer) {
|
|
read_buffer = MR_NEW_ARRAY(char, read_buf_size);
|
|
MR_memcpy(read_buffer, initial_read_buffer,
|
|
ML_IO_READ_LINE_START);
|
|
} else {
|
|
read_buffer = MR_RESIZE_ARRAY(read_buffer, char,
|
|
read_buf_size);
|
|
}
|
|
}
|
|
}
|
|
if (Res == ML_READ_LINE_AS_STRING_OK) {
|
|
MR_Word ret_string_word;
|
|
MR_offset_incr_hp_atomic_msg(ret_string_word,
|
|
0, ML_IO_BYTES_TO_WORDS((i + 1) * sizeof(char)),
|
|
MR_ALLOC_ID, ""string.string/0"");
|
|
RetString = (MR_String) ret_string_word;
|
|
MR_memcpy(RetString, read_buffer, i * sizeof(char));
|
|
RetString[i] = '\\0';
|
|
} else {
|
|
RetString = MR_make_string_const("""");
|
|
}
|
|
if (read_buffer != initial_read_buffer) {
|
|
MR_free(read_buffer);
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
read_line_as_string_2(Stream::in, _FirstCall::in, Res::out,
|
|
RetString::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
try {
|
|
RetString = ((io.MR_TextInputFile) Stream).read_line();
|
|
if (RetString != null) {
|
|
Res = ML_READ_LINE_AS_STRING_OK;
|
|
} else {
|
|
Res = ML_READ_LINE_AS_STRING_EOF;
|
|
}
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Res = ML_READ_LINE_AS_STRING_ERROR;
|
|
RetString = """";
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
read_line_as_string_2(Stream, FirstCall, Res, String, Error, !IO) :-
|
|
% XXX This is terribly inefficient, a better approach would be
|
|
% to use a buffer like what is done for io.read_file_as_string.
|
|
read_char_code(input_stream(Stream), ResultCode, Char, Error0, !IO),
|
|
(
|
|
ResultCode = result_code_ok,
|
|
( if Char = '\n' then
|
|
Res = ok,
|
|
String = "\n",
|
|
Error = Error0
|
|
else if char.to_int(Char, 0) then
|
|
Res = null_char,
|
|
String = "",
|
|
Error = Error0
|
|
else
|
|
read_line_as_string_2(Stream, no, Res, String0, Error, !IO),
|
|
string.first_char(String, Char, String0)
|
|
)
|
|
;
|
|
ResultCode = result_code_eof,
|
|
(
|
|
FirstCall = yes,
|
|
Res = eof
|
|
;
|
|
FirstCall = no,
|
|
Res = ok
|
|
),
|
|
String = "",
|
|
Error = Error0
|
|
;
|
|
ResultCode = result_code_error,
|
|
Res = error,
|
|
String = "",
|
|
Error = Error0
|
|
).
|
|
|
|
ignore_whitespace(Result, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
ignore_whitespace(Stream, Result, !IO).
|
|
|
|
ignore_whitespace(Stream, Result, !IO) :-
|
|
read_char(Stream, CharResult, !IO),
|
|
(
|
|
CharResult = error(Error),
|
|
Result = error(Error)
|
|
;
|
|
CharResult = eof,
|
|
Result = eof
|
|
;
|
|
CharResult = ok(Char),
|
|
( if char.is_whitespace(Char) then
|
|
ignore_whitespace(Stream, Result, !IO)
|
|
else
|
|
putback_char(Stream, Char, !IO),
|
|
Result = ok
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Bitmap input and output predicates.
|
|
%
|
|
|
|
read_bitmap(!Bitmap, BytesRead, Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_bitmap(Stream, !Bitmap, BytesRead, Result, !IO).
|
|
|
|
read_bitmap(Stream, !Bitmap, BytesRead, Result, !IO) :-
|
|
( if NumBytes = !.Bitmap ^ num_bytes then
|
|
io.read_bitmap(Stream, 0, NumBytes, !Bitmap, BytesRead, Result, !IO)
|
|
else
|
|
error($pred, "bitmap contains partial final byte")
|
|
).
|
|
|
|
read_bitmap(StartByte, NumBytes, !Bitmap, BytesRead, Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_bitmap(Stream, StartByte, NumBytes, !Bitmap, BytesRead, Result, !IO).
|
|
|
|
read_bitmap(binary_input_stream(Stream), Start, NumBytes, !Bitmap,
|
|
BytesRead, Result, !IO) :-
|
|
( if
|
|
NumBytes > 0,
|
|
byte_in_range(!.Bitmap, Start),
|
|
byte_in_range(!.Bitmap, Start + NumBytes - 1)
|
|
then
|
|
do_read_bitmap(Stream, Start, NumBytes,
|
|
!Bitmap, 0, BytesRead, Error, !IO),
|
|
is_error(Error, "read failed: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok
|
|
)
|
|
else if
|
|
NumBytes = 0,
|
|
byte_in_range(!.Bitmap, Start)
|
|
then
|
|
Result = ok,
|
|
BytesRead = 0
|
|
else
|
|
bitmap.throw_bounds_error(!.Bitmap, "io.read_bitmap",
|
|
Start * bits_per_byte, NumBytes * bits_per_byte)
|
|
).
|
|
|
|
:- pred do_read_bitmap(stream::in, byte_index::in, num_bytes::in,
|
|
bitmap::bitmap_di, bitmap::bitmap_uo, num_bytes::in, num_bytes::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_read_bitmap(Stream::in, StartByte::in, NumBytes::in,
|
|
Bitmap0::bitmap_di, Bitmap::bitmap_uo, BytesRead0::in, BytesRead::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
size_t nread;
|
|
|
|
Bitmap = Bitmap0;
|
|
nread = MR_READ(*Stream, Bitmap->elements + StartByte, NumBytes);
|
|
BytesRead = BytesRead0 + nread;
|
|
if (nread < NumBytes && MR_FERROR(*Stream)) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_read_bitmap(Stream::in, StartByte::in, NumBytes::in,
|
|
Bitmap0::bitmap_di, Bitmap::bitmap_uo, BytesRead0::in, BytesRead::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
io.MR_MercuryFileStruct mf = Stream;
|
|
|
|
Bitmap = Bitmap0;
|
|
BytesRead = BytesRead0;
|
|
|
|
if (mf.putback != -1) {
|
|
Bitmap.elements[StartByte] = (byte) mf.putback;
|
|
BytesRead++;
|
|
StartByte++;
|
|
NumBytes--;
|
|
mf.putback = -1;
|
|
}
|
|
|
|
try {
|
|
BytesRead += mf.stream.Read(Bitmap.elements, StartByte, NumBytes);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_read_bitmap(Stream::in, StartByte::in, NumBytes::in,
|
|
Bitmap0::bitmap_di, Bitmap::bitmap_uo, BytesRead0::in, BytesRead::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
MR_BinaryInputFile mf = (MR_BinaryInputFile) Stream;
|
|
Bitmap = Bitmap0;
|
|
BytesRead = BytesRead0;
|
|
|
|
final int nread = mf.read_pushback(Bitmap.elements, StartByte, NumBytes);
|
|
BytesRead += nread;
|
|
StartByte += nread;
|
|
NumBytes -= nread;
|
|
|
|
try {
|
|
BytesRead +=
|
|
mf.read_non_pushback(Bitmap.elements, StartByte, NumBytes);
|
|
Error = null;
|
|
} catch (java.lang.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
% Default implementation.
|
|
%
|
|
do_read_bitmap(Stream, Start, NumBytes, !Bitmap, !BytesRead, Error, !IO) :-
|
|
( if NumBytes > 0 then
|
|
read_byte_val(input_stream(Stream), ResultCode, Byte, Error0, !IO),
|
|
(
|
|
ResultCode = result_code_ok,
|
|
!:Bitmap = !.Bitmap ^ unsafe_byte(Start) := Byte,
|
|
!:BytesRead = !.BytesRead + 1,
|
|
do_read_bitmap(Stream, Start + 1, NumBytes - 1,
|
|
!Bitmap, !BytesRead, Error, !IO)
|
|
;
|
|
ResultCode = result_code_eof,
|
|
Error = Error0
|
|
;
|
|
ResultCode = result_code_error,
|
|
Error = Error0
|
|
)
|
|
else
|
|
Error = no_error
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
write_bitmap(Bitmap, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_bitmap(Stream, Bitmap, !IO).
|
|
|
|
write_bitmap(binary_output_stream(Stream), Bitmap, !IO) :-
|
|
( if NumBytes = Bitmap ^ num_bytes then
|
|
do_write_bitmap(Stream, Bitmap, 0, NumBytes, Error, !IO),
|
|
throw_on_output_error(Error, !IO)
|
|
else
|
|
error($pred, "bitmap contains partial final byte")
|
|
).
|
|
|
|
write_bitmap(Bitmap, Start, NumBytes, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_bitmap(Stream, Bitmap, Start, NumBytes, !IO).
|
|
|
|
write_bitmap(binary_output_stream(Stream), Bitmap, Start, NumBytes, !IO) :-
|
|
( if NumBytes = 0 then
|
|
true
|
|
else if
|
|
NumBytes > 0,
|
|
byte_in_range(Bitmap, Start),
|
|
byte_in_range(Bitmap, Start + NumBytes - 1)
|
|
then
|
|
do_write_bitmap(Stream, Bitmap, Start, NumBytes, Error, !IO),
|
|
throw_on_output_error(Error, !IO)
|
|
else
|
|
bitmap.throw_bounds_error(Bitmap, "io.write_bitmap",
|
|
Start * bits_per_byte, NumBytes * bits_per_byte)
|
|
).
|
|
|
|
:- pred do_write_bitmap(stream, bitmap, int, int, system_error, io, io).
|
|
%:- mode do_write_bitmap(in, bitmap_ui, in, in, out, di, uo) is det.
|
|
:- mode do_write_bitmap(in, in, in, in, out, di, uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_write_bitmap(Stream::in, Bitmap::in, Start::in, Length::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
no_sharing],
|
|
"
|
|
MR_Integer bytes_written =
|
|
(MR_Integer)MR_WRITE(*Stream, Bitmap->elements + Start, Length);
|
|
if (bytes_written != Length) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_write_bitmap(Stream::in, Bitmap::in, Start::in, Length::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
no_sharing],
|
|
"
|
|
try {
|
|
Stream.stream.Write(Bitmap.elements, Start, Length);
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_write_bitmap(Stream::in, Bitmap::in, Start::in, Length::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
no_sharing],
|
|
"
|
|
try {
|
|
((MR_BinaryOutputFile) Stream).write(Bitmap.elements, Start, Length);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Reading values of arbitrary types.
|
|
%
|
|
|
|
read(Result, !IO) :-
|
|
term_io.read_term(ReadResult, !IO),
|
|
get_line_number(LineNumber, !IO),
|
|
process_read_term(ReadResult, LineNumber, Result).
|
|
|
|
read(Stream, Result, !IO) :-
|
|
% The term parser does not accept an explicit stream argument (yet)
|
|
% so we must change the current input stream.
|
|
with_input_stream(Stream, read, Result, !IO).
|
|
|
|
read_from_string(FileName, String, Len, Result, !Posn) :-
|
|
parser.read_term_from_substring(FileName, String, Len, !Posn, ReadResult),
|
|
!.Posn = posn(LineNumber, _, _),
|
|
process_read_term(ReadResult, LineNumber, Result).
|
|
|
|
:- pred process_read_term(read_term::in, int::in, io.read_result(T)::out)
|
|
is det.
|
|
|
|
process_read_term(ReadResult, LineNumber, Result) :-
|
|
(
|
|
ReadResult = term(_VarSet, Term),
|
|
( if term_to_type(Term, Type) then
|
|
Result = ok(Type)
|
|
else
|
|
( if term.is_ground(Term) then
|
|
Result = error(
|
|
"io.read: the term read did not have the right type",
|
|
LineNumber)
|
|
else
|
|
Result = error("io.read: the term read was not a ground term",
|
|
LineNumber)
|
|
)
|
|
)
|
|
;
|
|
ReadResult = eof,
|
|
Result = eof
|
|
;
|
|
ReadResult = error(String, Int),
|
|
Result = error(String, Int)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary(Result, !IO) :-
|
|
% A quick-and-dirty implementation... not very space-efficient
|
|
% (not really binary!)
|
|
% XXX This will not work for the Java back-end. See the comment at the
|
|
% top of the MR_MercuryFileStruct class definition.
|
|
binary_input_stream(binary_input_stream(Stream), !IO),
|
|
with_input_stream(input_stream(Stream),
|
|
read_binary_from_current_input_stream, Result, !IO).
|
|
|
|
read_binary(binary_input_stream(Stream), Result, !IO) :-
|
|
% We would prefer not to change the current input stream but the
|
|
% quick-and-dirty implementation of read_binary uses io.read,
|
|
% and io.read internally reads from the current text input stream.
|
|
% XXX This will not work for the Java back-end. See the comment at the
|
|
% top of the MR_MercuryFileStruct class definition.
|
|
with_input_stream(input_stream(Stream),
|
|
read_binary_from_current_input_stream, Result, !IO).
|
|
|
|
:- pred read_binary_from_current_input_stream(io.result(T)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
read_binary_from_current_input_stream(Result, !IO) :-
|
|
read(ReadResult, !IO),
|
|
(
|
|
ReadResult = ok(T),
|
|
% We've read the newline and the trailing full stop.
|
|
% Now skip the newline after the full stop.
|
|
read_char(NewLineRes, !IO),
|
|
(
|
|
NewLineRes = error(Error),
|
|
Result = error(Error)
|
|
;
|
|
NewLineRes = ok(NewLineChar),
|
|
( if NewLineChar = '\n' then
|
|
Result = ok(T)
|
|
else
|
|
Result = error(io_error("io.read_binary: missing newline"))
|
|
)
|
|
;
|
|
NewLineRes = eof,
|
|
Result = error(io_error("io.read_binary: missing newline"))
|
|
)
|
|
;
|
|
ReadResult = eof,
|
|
Result = eof
|
|
;
|
|
ReadResult = error(ErrorMsg, _Line),
|
|
Result = error(io_error(ErrorMsg))
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Writing values of arbitrary types.
|
|
%
|
|
|
|
print(Term, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
stream.string_writer.print(Stream, canonicalize, Term, !IO).
|
|
|
|
print(Stream, Term, !IO) :-
|
|
stream.string_writer.print(Stream, canonicalize, Term, !IO).
|
|
|
|
print(Stream, NonCanon, Term, !IO) :-
|
|
stream.string_writer.print(Stream, NonCanon, Term, !IO).
|
|
|
|
print_cc(Term, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
stream.string_writer.print_cc(Stream, Term, !IO).
|
|
|
|
print_line(Term, !IO) :-
|
|
io.output_stream(Stream, !IO),
|
|
print_line(Stream, Term, !IO).
|
|
|
|
print_line(Stream, Term, !IO) :-
|
|
io.print(Stream, Term, !IO),
|
|
io.nl(Stream, !IO).
|
|
|
|
print_line(Stream, NonCanon, Term, !IO) :-
|
|
io.print(Stream, NonCanon, Term, !IO),
|
|
io.nl(Stream, !IO).
|
|
|
|
print_line_cc(Term, !IO) :-
|
|
io.print_cc(Term, !IO),
|
|
io.nl(!IO).
|
|
|
|
%---------------------%
|
|
|
|
% XXX Only use this for debugging. Strictly speaking, io.print may throw an
|
|
% exception which is not allowed across the C interface.
|
|
%
|
|
:- pred print_to_stream(io.stream::in, T::in, io::di, io::uo) is det.
|
|
:- pragma foreign_export("C", io.print_to_stream(in, in, di, uo),
|
|
"ML_io_print_to_stream").
|
|
|
|
print_to_stream(Stream, Term, !IO) :-
|
|
io.print(output_stream(Stream), canonicalize, Term, !IO).
|
|
|
|
%---------------------%
|
|
|
|
write(X, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
stream.string_writer.write(Stream, canonicalize, X, !IO).
|
|
|
|
write(Stream, X, !IO) :-
|
|
stream.string_writer.write(Stream, canonicalize, X, !IO).
|
|
|
|
write(Stream, NonCanon, X, !IO) :-
|
|
stream.string_writer.write(Stream, NonCanon, X, !IO).
|
|
|
|
write_cc(X, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
io.write_cc(Stream, X, !IO).
|
|
|
|
write_cc(Stream, X, !IO) :-
|
|
stream.string_writer.write(Stream, include_details_cc, X, !IO).
|
|
|
|
write_line(X, !IO) :-
|
|
io.write(X, !IO),
|
|
io.nl(!IO).
|
|
|
|
write_line(Stream, X, !IO) :-
|
|
io.write(Stream, X, !IO),
|
|
io.nl(Stream, !IO).
|
|
|
|
write_line(Stream, NonCanon, X, !IO) :-
|
|
io.write(Stream, NonCanon, X, !IO),
|
|
io.nl(Stream, !IO).
|
|
|
|
write_line_cc(X, !IO) :-
|
|
io.write_cc(X, !IO),
|
|
io.nl(!IO).
|
|
|
|
write_line_cc(Stream, X, !IO) :-
|
|
io.write_cc(Stream, X, !IO),
|
|
io.nl(Stream, !IO).
|
|
|
|
%---------------------%
|
|
|
|
write_binary(Term, !IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
write_binary(Stream, Term, !IO).
|
|
|
|
write_binary(binary_output_stream(Stream), Term, !IO) :-
|
|
% A quick-and-dirty implementation... not very space-efficient
|
|
% (not really binary!)
|
|
% XXX This will not work for the Java back-end. See the comment at the
|
|
% top of the MR_MercuryFileStruct class definition.
|
|
io.write(output_stream(Stream), Term, !IO),
|
|
io.write_string(output_stream(Stream), ".\n", !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Formatted output.
|
|
%
|
|
|
|
format(FormatString, Arguments, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
io.format(Stream, FormatString, Arguments, !IO).
|
|
|
|
format(Stream, FormatString, Arguments, !IO) :-
|
|
string.format(FormatString, Arguments, String),
|
|
write_string(Stream, String, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Writing out several values.
|
|
%
|
|
|
|
write_strings(Strings, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_strings(Stream, Strings, !IO).
|
|
|
|
write_strings(_Stream, [], !IO).
|
|
write_strings(Stream, [S | Ss], !IO) :-
|
|
write_string(Stream, S, !IO),
|
|
write_strings(Stream, Ss, !IO).
|
|
|
|
%---------------------%
|
|
|
|
write_many(Poly_list, !IO) :-
|
|
output_stream(Stream, !IO),
|
|
write_many(Stream, Poly_list, !IO).
|
|
|
|
write_many(_Stream, [], !IO).
|
|
write_many(Stream, [c(C) | Rest], !IO) :-
|
|
write_char(Stream, C, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [i(I) | Rest], !IO) :-
|
|
write_int(Stream, I, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [i8(I) | Rest], !IO) :-
|
|
write_int8(Stream, I, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [i16(I) | Rest], !IO) :-
|
|
write_int16(Stream, I, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [i32(I) | Rest], !IO) :-
|
|
write_int32(Stream, I, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [i64(I) | Rest], !IO) :-
|
|
write_int64(Stream, I, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [u(U) | Rest], !IO) :-
|
|
write_uint(Stream, U, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [u8(U) | Rest], !IO) :-
|
|
write_uint8(Stream, U, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [u16(U) | Rest], !IO) :-
|
|
write_uint16(Stream, U, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [u32(U) | Rest], !IO) :-
|
|
write_uint32(Stream, U, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [u64(U) | Rest], !IO) :-
|
|
write_uint64(Stream, U, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [s(S) | Rest], !IO) :-
|
|
write_string(Stream, S, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
write_many(Stream, [f(F) | Rest], !IO) :-
|
|
write_float(Stream, F, !IO),
|
|
write_many(Stream, Rest, !IO).
|
|
|
|
%---------------------%
|
|
|
|
write_list([], _Separator, _OutputPred, !IO).
|
|
write_list([Head | Tail], Separator, OutputPred, !IO) :-
|
|
OutputPred(Head, !IO),
|
|
(
|
|
Tail = []
|
|
;
|
|
Tail = [TailHead | TailTail],
|
|
write_list_lag(TailHead, TailTail, Separator, OutputPred, !IO)
|
|
).
|
|
|
|
:- pred write_list_lag(T, list(T), string, pred(T, io, io), io, io).
|
|
:- mode write_list_lag(in, in, in, pred(in, di, uo) is det, di, uo) is det.
|
|
:- mode write_list_lag(in, in, in, pred(in, di, uo) is cc_multi, di, uo)
|
|
is cc_multi.
|
|
|
|
write_list_lag(Head, Tail, Separator, OutputPred, !IO) :-
|
|
write_string(Separator, !IO),
|
|
OutputPred(Head, !IO),
|
|
(
|
|
Tail = []
|
|
;
|
|
Tail = [TailHead | TailTail],
|
|
write_list_lag(TailHead, TailTail, Separator, OutputPred, !IO)
|
|
).
|
|
|
|
write_list(Stream, List, Separator, OutputPred, !IO) :-
|
|
% OutputPred expects the current output stream to be Stream.
|
|
with_output_stream(Stream,
|
|
write_list(List, Separator, OutputPred), !IO).
|
|
|
|
%---------------------%
|
|
|
|
write_array(Array, Separator, OutputPred, !IO) :-
|
|
array.bounds(Array, Lo, Hi),
|
|
( if Lo =< Hi then
|
|
array.unsafe_lookup(Array, Lo, E),
|
|
OutputPred(E, !IO),
|
|
do_write_array(Array, Separator, OutputPred, Lo + 1, Hi, !IO)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred do_write_array(array(T), string, pred(T, io, io), int, int, io, io).
|
|
:- mode do_write_array(in, in, pred(in, di, uo) is det, in, in, di, uo)
|
|
is det.
|
|
:- mode do_write_array(in, in, pred(in, di, uo) is cc_multi, in, in, di, uo)
|
|
is cc_multi.
|
|
|
|
do_write_array(Array, Separator, OutputPred, I, Hi, !IO) :-
|
|
( if I =< Hi then
|
|
write_string(Separator, !IO),
|
|
array.unsafe_lookup(Array, I, E),
|
|
OutputPred(E, !IO),
|
|
do_write_array(Array, Separator, OutputPred, I + 1, Hi, !IO)
|
|
else
|
|
true
|
|
).
|
|
|
|
write_array(Stream, Array, Separator, OutputPred, !IO) :-
|
|
% OutputPred expects the current output stream to be Stream.
|
|
with_output_stream(Stream,
|
|
write_array(Array, Separator, OutputPred), !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Flushing output to the operating system.
|
|
%
|
|
|
|
%---------------------%
|
|
|
|
flush_output(!IO) :-
|
|
output_stream(Stream, !IO),
|
|
flush_output(Stream, !IO).
|
|
|
|
flush_output(output_stream(Stream), !IO) :-
|
|
flush_output_2(Stream, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred flush_output_2(stream::in, system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
flush_output_2(Stream::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (MR_FLUSH(*Stream) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
flush_output_2(Stream::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
Stream.stream.Flush();
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
flush_output_2(Stream::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
((io.MR_TextOutputFile) Stream).flush();
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
flush_binary_output(!IO) :-
|
|
binary_output_stream(Stream, !IO),
|
|
flush_binary_output(Stream, !IO).
|
|
|
|
flush_binary_output(binary_output_stream(Stream), !IO) :-
|
|
flush_binary_output_2(Stream, Error, !IO),
|
|
throw_on_output_error(Error, !IO).
|
|
|
|
:- pred flush_binary_output_2(stream::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
flush_binary_output_2(Stream::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
if (MR_FLUSH(*Stream) < 0) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
flush_binary_output_2(Stream::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
Stream.stream.Flush();
|
|
Error = null;
|
|
} catch (System.SystemException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
flush_binary_output_2(Stream::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
((io.MR_BinaryOutputFile) Stream).flush();
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Whole file input predicates.
|
|
%
|
|
|
|
read_file(Result, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
read_file(Stream, Result, !IO).
|
|
|
|
read_file(Stream, Result, !IO) :-
|
|
read_file_2(Stream, [], Result, !IO).
|
|
|
|
:- pred read_file_2(input_stream::in, list(char)::in,
|
|
maybe_partial_res(list(char))::out, io::di, io::uo) is det.
|
|
|
|
read_file_2(Stream, Chars0, Result, !IO) :-
|
|
read_char(Stream, Result0, !IO),
|
|
(
|
|
Result0 = eof,
|
|
Result = ok(list.reverse(Chars0))
|
|
;
|
|
Result0 = error(Err),
|
|
Result = error(list.reverse(Chars0), Err)
|
|
;
|
|
Result0 = ok(Char),
|
|
read_file_2(Stream, [Char | Chars0], Result, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_file_as_string(Result, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
read_file_as_string(Stream, Result, !IO).
|
|
|
|
read_file_as_string(input_stream(Stream), Result, !IO) :-
|
|
read_file_as_string_2(Stream, String, _NumCUs, Error, NullCharError, !IO),
|
|
is_error(Error, "read failed: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(String, IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
(
|
|
NullCharError = yes,
|
|
Result = error("", io_error("null character in input"))
|
|
;
|
|
NullCharError = no,
|
|
Result = ok(String)
|
|
)
|
|
).
|
|
|
|
read_file_as_string_and_num_code_units(Result, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
read_file_as_string_and_num_code_units(Stream, Result, !IO).
|
|
|
|
read_file_as_string_and_num_code_units(input_stream(Stream), Result, !IO) :-
|
|
read_file_as_string_2(Stream, String, NumCUs, Error, NullCharError, !IO),
|
|
is_error(Error, "read failed: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error2(String, NumCUs, IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
(
|
|
NullCharError = yes,
|
|
Result = error2("", 0, io_error("null character in input"))
|
|
;
|
|
NullCharError = no,
|
|
Result = ok2(String, NumCUs)
|
|
)
|
|
).
|
|
|
|
:- pred read_file_as_string_2(stream::in, string::out, int::out,
|
|
system_error::out, bool::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("Java",
|
|
read_file_as_string_2(Stream::in, String::out, NumCUs::out,
|
|
Error::out, NullCharError::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
StringBuilder sb = new StringBuilder();
|
|
try {
|
|
((io.MR_TextInputFile) Stream).read_file(sb);
|
|
Error = null;
|
|
} catch (java.io.IOException e) {
|
|
Error = e;
|
|
}
|
|
String = sb.toString();
|
|
NumCUs = String.length();
|
|
NullCharError = bool.NO;
|
|
").
|
|
|
|
read_file_as_string_2(Stream, String, NumCUs, Error, NullCharError, !IO) :-
|
|
% Check if the stream is a regular file; if so, allocate a buffer
|
|
% according to the size of the file. Otherwise, just use a default buffer
|
|
% size of 4k minus a bit (to give malloc some room).
|
|
input_stream_file_size(input_stream(Stream), FileSize, !IO),
|
|
( if FileSize >= 0 then
|
|
BufferSize0 = FileSize + 1
|
|
else
|
|
BufferSize0 = 4000
|
|
),
|
|
alloc_buffer(BufferSize0, Buffer0),
|
|
|
|
% Read the file into the buffer (resizing it as we go if necessary),
|
|
% convert the buffer into a string, and see if anything went wrong.
|
|
NumCUs0 = 0,
|
|
read_file_as_string_loop(input_stream(Stream),
|
|
Buffer0, Buffer, BufferSize0, BufferSize, NumCUs0, NumCUs, Error, !IO),
|
|
require(NumCUs < BufferSize, "io.read_file_as_string: overflow"),
|
|
( if buffer_to_string(Buffer, NumCUs, StringPrime) then
|
|
String = StringPrime,
|
|
NullCharError = no
|
|
else
|
|
String = "",
|
|
NullCharError = yes
|
|
).
|
|
|
|
:- pred read_file_as_string_loop(input_stream::in, buffer::buffer_di,
|
|
buffer::buffer_uo, int::in, int::out, int::in, int::out, system_error::out,
|
|
io::di, io::uo) is det.
|
|
:- pragma consider_used(read_file_as_string_loop/10).
|
|
|
|
read_file_as_string_loop(Stream, !Buffer, BufferSize0, BufferSize,
|
|
!NumCUs, Error, !IO) :-
|
|
Stream = input_stream(RealStream),
|
|
read_into_buffer(RealStream, !Buffer, BufferSize0, !NumCUs, Error0, !IO),
|
|
( if !.NumCUs < BufferSize0 then
|
|
% Buffer not full: end-of-file or error.
|
|
BufferSize = BufferSize0,
|
|
Error = Error0
|
|
else if !.NumCUs = BufferSize0 then
|
|
% Full buffer.
|
|
BufferSize1 = BufferSize0 * 2,
|
|
resize_buffer(BufferSize0, BufferSize1, !Buffer),
|
|
read_file_as_string_loop(Stream, !Buffer, BufferSize1, BufferSize,
|
|
!NumCUs, Error, !IO)
|
|
else
|
|
error("io.read_file_as_string: buffer overflow")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_file(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_file(Stream, Result, !IO).
|
|
|
|
read_binary_file(Stream, Result, !IO) :-
|
|
read_binary_file_2(Stream, [], Result, !IO).
|
|
|
|
:- pred read_binary_file_2(binary_input_stream::in, list(int)::in,
|
|
io.result(list(int))::out, io::di, io::uo) is det.
|
|
|
|
read_binary_file_2(Stream, Bytes0, Result, !IO) :-
|
|
read_byte(Stream, Result0, !IO),
|
|
(
|
|
Result0 = eof,
|
|
list.reverse(Bytes0, Bytes),
|
|
Result = ok(Bytes)
|
|
;
|
|
Result0 = error(Err),
|
|
Result = error(Err)
|
|
;
|
|
Result0 = ok(Byte),
|
|
read_binary_file_2(Stream, [Byte | Bytes0], Result, !IO)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
read_binary_file_as_bitmap(Result, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
read_binary_file_as_bitmap(Stream, Result, !IO).
|
|
|
|
read_binary_file_as_bitmap(Stream, Result, !IO) :-
|
|
% Check if the stream is a regular file; if so, allocate a buffer
|
|
% according to the size of the file. Otherwise, just use a default buffer
|
|
% size of 4k minus a bit (to give malloc some room).
|
|
binary_input_stream_file_size(Stream, FileSize, !IO),
|
|
( if FileSize >= 0i64 then
|
|
binary_input_stream_offset64(Stream, CurrentOffset, !IO),
|
|
RemainingSizeInt64 = FileSize - CurrentOffset,
|
|
( if
|
|
int.bits_per_int = 32,
|
|
RemainingSizeInt64 > from_int(int.max_int)
|
|
then
|
|
Result = error(io_error("io.read_binary_file_as_bitmap: " ++
|
|
"file size exceeds maximum buffer size"))
|
|
else
|
|
RemainingSize = cast_to_int(RemainingSizeInt64),
|
|
some [!BM] (
|
|
!:BM = bitmap.init(RemainingSize * bits_per_byte),
|
|
( if RemainingSize = 0 then
|
|
Result = ok(!.BM)
|
|
else
|
|
read_bitmap(Stream, 0, RemainingSize, !BM, BytesRead,
|
|
ReadResult, !IO),
|
|
(
|
|
ReadResult = ok,
|
|
( if BytesRead = RemainingSize then
|
|
Result = ok(!.BM)
|
|
else
|
|
Result = error(io_error(
|
|
"io.read_binary_file_as_bitmap: " ++
|
|
"incorrect file size"))
|
|
)
|
|
;
|
|
ReadResult = error(Msg),
|
|
Result = error(Msg)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
else
|
|
BufferSize = 4000,
|
|
read_binary_file_as_bitmap_2(Stream, BufferSize,
|
|
Res, [], RevBitmaps, !IO),
|
|
(
|
|
Res = ok,
|
|
Result = ok(bitmap.append_list(reverse(RevBitmaps)))
|
|
;
|
|
Res = error(Msg),
|
|
Result = error(Msg)
|
|
)
|
|
).
|
|
|
|
:- pred read_binary_file_as_bitmap_2(io.binary_input_stream::in,
|
|
num_bytes::in, io.res::out, list(bitmap)::in, list(bitmap)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
read_binary_file_as_bitmap_2(Stream, BufferSize, Res, !BMs, !IO) :-
|
|
some [!BM] (
|
|
!:BM = bitmap.init(BufferSize * bits_per_byte),
|
|
read_bitmap(Stream, 0, BufferSize, !BM, NumBytesRead, ReadRes, !IO),
|
|
(
|
|
ReadRes = ok,
|
|
( if NumBytesRead < BufferSize then
|
|
!:BM = bitmap.shrink_without_copying(!.BM,
|
|
NumBytesRead * bits_per_byte),
|
|
!:BMs = [!.BM | !.BMs],
|
|
Res = ok
|
|
else
|
|
!:BMs = [!.BM | !.BMs],
|
|
|
|
% Double the buffer size each time.
|
|
read_binary_file_as_bitmap_2(Stream, BufferSize * 2,
|
|
Res, !BMs, !IO)
|
|
)
|
|
;
|
|
ReadRes = error(Err),
|
|
Res = error(Err)
|
|
)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
% XXX FIXME this should return an int64.
|
|
:- pred input_stream_file_size(io.input_stream::in, int::out,
|
|
io::di, io::uo) is det.
|
|
:- pragma consider_used(input_stream_file_size/4).
|
|
|
|
input_stream_file_size(input_stream(Stream), Size, !IO) :-
|
|
stream_file_size(Stream, Size64, !IO),
|
|
Size = int64.cast_to_int(Size64).
|
|
|
|
:- pred binary_input_stream_file_size(io.binary_input_stream::in, int64::out,
|
|
io::di, io::uo) is det.
|
|
|
|
binary_input_stream_file_size(binary_input_stream(Stream), Size, !IO) :-
|
|
stream_file_size(Stream, Size, !IO).
|
|
|
|
% stream_file_size(Stream, Size):
|
|
% If Stream is a regular file, then Size is its size (in bytes),
|
|
% otherwise Size is -1.
|
|
%
|
|
:- pred stream_file_size(stream::in, int64::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
stream_file_size(Stream::in, Size::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#if defined(MR_HAVE_FSTAT) && \
|
|
(defined(MR_HAVE_FILENO) || defined(fileno)) && defined(S_ISREG)
|
|
struct stat s;
|
|
if (MR_IS_FILE_STREAM(*Stream)) {
|
|
if (fstat(fileno(MR_file(*Stream)), &s) == 0 && S_ISREG(s.st_mode)) {
|
|
Size = s.st_size;
|
|
} else {
|
|
Size = -1;
|
|
}
|
|
} else {
|
|
Size = -1;
|
|
}
|
|
#else
|
|
Size = -1;
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
stream_file_size(Stream::in, Size::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"{
|
|
if (Stream.stream.CanSeek) {
|
|
Size = Stream.stream.Length;
|
|
} else {
|
|
Size = -1;
|
|
}
|
|
}").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
stream_file_size(Stream::in, Size::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
|
|
"
|
|
try {
|
|
Size = ((MR_BinaryFile) Stream).size();
|
|
} catch (java.io.IOException e) {
|
|
Size = -1;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
% A `buffer' is an array of chars.
|
|
% For C backends, it is a C array of C chars.
|
|
% For other backends, it is a Mercury array of Mercury chars.
|
|
|
|
% XXX It would be better to use a char_array type rather than array(char).
|
|
% This is because on the Java and IL backends indexing into an array whose
|
|
% element type is known statically requires less overhead.
|
|
%
|
|
% It may be possible to merge with string.string_buffer.
|
|
%
|
|
:- type buffer
|
|
---> buffer(array(char)).
|
|
|
|
:- pragma foreign_type(c, buffer, "char *", [can_pass_as_mercury_type]).
|
|
|
|
% XXX Extend the workaround for no `ui' modes in array.m.
|
|
:- inst uniq_buffer for buffer/0
|
|
---> buffer(uniq_array).
|
|
|
|
:- mode buffer_di == di(uniq_buffer).
|
|
:- mode buffer_uo == out(uniq_buffer).
|
|
|
|
:- pred alloc_buffer(int::in, buffer::buffer_uo) is det.
|
|
:- pragma consider_used(alloc_buffer/2).
|
|
|
|
:- pragma foreign_proc("C",
|
|
alloc_buffer(Size::in, Buffer::buffer_uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"{
|
|
MR_Word buf;
|
|
MR_offset_incr_hp_atomic_msg(buf, 0,
|
|
(Size * sizeof(char) + sizeof(MR_Word) - 1) / sizeof(MR_Word),
|
|
MR_ALLOC_ID, ""io.buffer/0"");
|
|
Buffer = (char *) buf;
|
|
}").
|
|
|
|
alloc_buffer(Size, buffer(Array)) :-
|
|
char.det_from_int(0, NullChar),
|
|
array.init(Size, NullChar, Array).
|
|
|
|
:- pred resize_buffer(int::in, int::in,
|
|
buffer::buffer_di, buffer::buffer_uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
resize_buffer(OldSize::in, NewSize::in,
|
|
Buffer0::buffer_di, Buffer::buffer_uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness],
|
|
"{
|
|
MR_CHECK_EXPR_TYPE(Buffer0, char *);
|
|
MR_CHECK_EXPR_TYPE(Buffer, char *);
|
|
|
|
#ifdef MR_CONSERVATIVE_GC
|
|
Buffer = MR_GC_realloc(Buffer0, NewSize * sizeof(char));
|
|
#else
|
|
if (Buffer0 + OldSize == (char *) MR_hp) {
|
|
MR_Word next;
|
|
MR_offset_incr_hp_atomic_msg(next, 0,
|
|
(NewSize * sizeof(char) + sizeof(MR_Word) - 1)
|
|
/ sizeof(MR_Word),
|
|
MR_ALLOC_ID, ""io.buffer/0"");
|
|
assert(Buffer0 + OldSize == (char *) next);
|
|
Buffer = Buffer0;
|
|
} else {
|
|
// Just have to alloc and copy.
|
|
MR_Word buf;
|
|
MR_offset_incr_hp_atomic_msg(buf, 0,
|
|
(NewSize * sizeof(char) + sizeof(MR_Word) - 1)
|
|
/ sizeof(MR_Word),
|
|
MR_ALLOC_ID, ""io.buffer/0"");
|
|
Buffer = (char *) buf;
|
|
if (OldSize > NewSize) {
|
|
MR_memcpy(Buffer, Buffer0, NewSize);
|
|
} else {
|
|
MR_memcpy(Buffer, Buffer0, OldSize);
|
|
}
|
|
}
|
|
#endif
|
|
}").
|
|
|
|
resize_buffer(_OldSize, NewSize, buffer(Array0), buffer(Array)) :-
|
|
char.det_from_int(0, Char),
|
|
array.resize(NewSize, Char, Array0, Array).
|
|
|
|
:- pred buffer_to_string(buffer::buffer_di, int::in, string::uo) is semidet.
|
|
:- pragma consider_used(buffer_to_string/3).
|
|
|
|
:- pragma foreign_proc("C",
|
|
buffer_to_string(Buffer::buffer_di, Len::in, Str::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness],
|
|
"{
|
|
Str = Buffer;
|
|
Str[Len] = '\\0';
|
|
|
|
// Check that the string doesn't contain null characters.
|
|
if (strlen(Str) != Len) {
|
|
SUCCESS_INDICATOR = MR_FALSE;
|
|
} else {
|
|
SUCCESS_INDICATOR = MR_TRUE;
|
|
}
|
|
}").
|
|
|
|
buffer_to_string(buffer(Array), Len, String) :-
|
|
array.fetch_items(Array, min(Array), min(Array) + Len - 1, List),
|
|
string.semidet_from_char_list(List, String).
|
|
|
|
:- pred read_into_buffer(stream::in, buffer::buffer_di, buffer::buffer_uo,
|
|
int::in, int::in, int::out, system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
read_into_buffer(Stream::in, Buffer0::buffer_di, Buffer::buffer_uo,
|
|
BufferSize::in, Pos0::in, Pos::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness],
|
|
"
|
|
size_t bytes_to_read;
|
|
size_t bytes_read;
|
|
|
|
MR_CHECK_EXPR_TYPE(Buffer0, char *);
|
|
MR_CHECK_EXPR_TYPE(Buffer, char *);
|
|
|
|
bytes_to_read = BufferSize - Pos0;
|
|
bytes_read = MR_READ(*Stream, Buffer0 + Pos0, bytes_to_read);
|
|
|
|
Buffer = Buffer0;
|
|
Pos = Pos0 + bytes_read;
|
|
|
|
if (bytes_read < bytes_to_read && MR_FERROR(*Stream)) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
").
|
|
|
|
read_into_buffer(Stream, buffer(Array0), buffer(Array), BufferSize,
|
|
Pos0, Pos, Error, !IO) :-
|
|
read_into_array(input_stream(Stream), Array0, Array, BufferSize,
|
|
Pos0, Pos, Error, !IO).
|
|
|
|
:- pred read_into_array(input_stream::in,
|
|
array(char)::array_di, array(char)::array_uo, int::in, int::in, int::out,
|
|
system_error::out, io::di, io::uo) is det.
|
|
:- pragma consider_used(read_into_array/9).
|
|
|
|
read_into_array(Stream, !Array, ArraySize, !Pos, Error, !IO) :-
|
|
( if !.Pos >= ArraySize then
|
|
Error = no_error
|
|
else
|
|
read_char_code(Stream, ResultCode, Char, Error0, !IO),
|
|
(
|
|
ResultCode = result_code_ok,
|
|
array.set(!.Pos, Char, !Array),
|
|
!:Pos = !.Pos + 1,
|
|
read_into_array(Stream, !Array, ArraySize, !Pos, Error, !IO)
|
|
;
|
|
( ResultCode = result_code_eof
|
|
; ResultCode = result_code_error
|
|
),
|
|
Error = Error0
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Processing the contents of a whole file.
|
|
%
|
|
|
|
input_stream_foldl(Pred, T0, Res, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
input_stream_foldl(Stream, Pred, T0, Res, !IO).
|
|
|
|
input_stream_foldl(Stream, Pred, T0, Res, !IO) :-
|
|
read_char(Stream, CharResult, !IO),
|
|
(
|
|
CharResult = ok(Char),
|
|
Pred(Char, T0, T1),
|
|
input_stream_foldl(Stream, Pred, T1, Res, !IO)
|
|
;
|
|
CharResult = eof,
|
|
Res = ok(T0)
|
|
;
|
|
CharResult = error(Error),
|
|
Res = error(T0, Error)
|
|
).
|
|
|
|
input_stream_foldl_io(Pred, Res, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
input_stream_foldl_io(Stream, Pred, Res, !IO).
|
|
|
|
input_stream_foldl_io(Stream, Pred, Res, !IO) :-
|
|
read_char(Stream, CharResult, !IO),
|
|
(
|
|
CharResult = ok(Char),
|
|
Pred(Char, !IO),
|
|
input_stream_foldl_io(Stream, Pred, Res, !IO)
|
|
;
|
|
CharResult = eof,
|
|
Res = ok
|
|
;
|
|
CharResult = error(Error),
|
|
Res = error(Error)
|
|
).
|
|
|
|
input_stream_foldl2_io(Pred, T0, Res, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
input_stream_foldl2_io(Stream, Pred, T0, Res, !IO).
|
|
|
|
input_stream_foldl2_io(Stream, Pred, T0, Res, !IO) :-
|
|
read_char(Stream, CharResult, !IO),
|
|
(
|
|
CharResult = ok(Char),
|
|
Pred(Char, T0, T1, !IO),
|
|
input_stream_foldl2_io(Stream, Pred, T1, Res, !IO)
|
|
;
|
|
CharResult = eof,
|
|
Res = ok(T0)
|
|
;
|
|
CharResult = error(Error),
|
|
Res = error(T0, Error)
|
|
).
|
|
|
|
input_stream_foldl2_io_maybe_stop(Pred, T0, Res, !IO) :-
|
|
input_stream(Stream, !IO),
|
|
input_stream_foldl2_io_maybe_stop(Stream, Pred, T0, Res, !IO).
|
|
|
|
input_stream_foldl2_io_maybe_stop(Stream, Pred, T0, Res, !IO) :-
|
|
read_char(Stream, CharResult, !IO),
|
|
(
|
|
CharResult = ok(Char),
|
|
Pred(Char, Continue, T0, T1, !IO),
|
|
(
|
|
Continue = no,
|
|
Res = ok(T1)
|
|
;
|
|
Continue = yes,
|
|
input_stream_foldl2_io_maybe_stop(Stream, Pred, T1, Res, !IO)
|
|
)
|
|
;
|
|
CharResult = eof,
|
|
Res = ok(T0)
|
|
;
|
|
CharResult = error(Error),
|
|
Res = error(T0, Error)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
binary_input_stream_foldl(Pred, T0, Res, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
binary_input_stream_foldl(Stream, Pred, T0, Res, !IO).
|
|
|
|
binary_input_stream_foldl(Stream, Pred, T0, Res, !IO) :-
|
|
read_byte(Stream, ByteResult, !IO),
|
|
(
|
|
ByteResult = ok(Byte),
|
|
Pred(Byte, T0, T1),
|
|
binary_input_stream_foldl(Stream, Pred, T1, Res, !IO)
|
|
;
|
|
ByteResult = eof,
|
|
Res = ok(T0)
|
|
;
|
|
ByteResult = error(Error),
|
|
Res = error(T0, Error)
|
|
).
|
|
|
|
binary_input_stream_foldl_io(Pred, Res, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
binary_input_stream_foldl_io(Stream, Pred, Res, !IO).
|
|
|
|
binary_input_stream_foldl_io(Stream, Pred, Res, !IO) :-
|
|
should_reduce_stack_usage(ShouldReduce),
|
|
(
|
|
ShouldReduce = no,
|
|
binary_input_stream_foldl_io_plain(Stream, Pred, Res, !IO)
|
|
;
|
|
ShouldReduce = yes,
|
|
io.binary_input_stream_foldl_io_chunk(Stream, Pred, Res, !IO)
|
|
).
|
|
|
|
:- pred binary_input_stream_foldl_io_plain(binary_input_stream,
|
|
pred(int, io, io), io.res, io, io).
|
|
:- mode binary_input_stream_foldl_io_plain(in,
|
|
(pred(in, di, uo) is det), out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl_io_plain(in,
|
|
(pred(in, di, uo) is cc_multi), out, di, uo) is cc_multi.
|
|
|
|
binary_input_stream_foldl_io_plain(Stream, Pred, Res, !IO) :-
|
|
read_byte(Stream, ByteResult, !IO),
|
|
(
|
|
ByteResult = ok(Byte),
|
|
Pred(Byte, !IO),
|
|
binary_input_stream_foldl_io_plain(Stream, Pred, Res, !IO)
|
|
;
|
|
ByteResult = eof,
|
|
Res = ok
|
|
;
|
|
ByteResult = error(Error),
|
|
Res = error(Error)
|
|
).
|
|
|
|
:- pred binary_input_stream_foldl_io_chunk(binary_input_stream,
|
|
pred(int, io, io), io.res, io, io).
|
|
:- mode binary_input_stream_foldl_io_chunk(in,
|
|
(pred(in, di, uo) is det), out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl_io_chunk(in,
|
|
(pred(in, di, uo) is cc_multi), out, di, uo) is cc_multi.
|
|
|
|
binary_input_stream_foldl_io_chunk(Stream, Pred, Res, !IO) :-
|
|
binary_input_stream_foldl_io_inner(chunk_size, Stream, Pred,
|
|
InnerRes, !IO),
|
|
(
|
|
InnerRes = ok,
|
|
Res = ok
|
|
;
|
|
InnerRes = error(Error),
|
|
Res = error(Error)
|
|
;
|
|
InnerRes = more,
|
|
binary_input_stream_foldl_io_chunk(Stream, Pred, Res, !IO)
|
|
).
|
|
|
|
:- pred binary_input_stream_foldl_io_inner(int, binary_input_stream,
|
|
pred(int, io, io), chunk_inner_res0, io, io).
|
|
:- mode binary_input_stream_foldl_io_inner(in, in,
|
|
(pred(in, di, uo) is det), out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl_io_inner(in, in,
|
|
(pred(in, di, uo) is cc_multi), out, di, uo) is cc_multi.
|
|
|
|
binary_input_stream_foldl_io_inner(Left, Stream, Pred, Res, !IO) :-
|
|
( if Left > 0 then
|
|
read_byte(Stream, ByteResult, !IO),
|
|
(
|
|
ByteResult = ok(Byte),
|
|
Pred(Byte, !IO),
|
|
binary_input_stream_foldl_io_inner(Left - 1,
|
|
Stream, Pred, Res, !IO)
|
|
;
|
|
ByteResult = eof,
|
|
Res = ok
|
|
;
|
|
ByteResult = error(Error),
|
|
Res = error(Error)
|
|
)
|
|
else
|
|
Res = more
|
|
).
|
|
|
|
binary_input_stream_foldl2_io(Pred, T0, Res, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
binary_input_stream_foldl2_io(Stream, Pred, T0, Res, !IO).
|
|
|
|
binary_input_stream_foldl2_io(Stream, Pred, T0, Res, !IO) :-
|
|
should_reduce_stack_usage(ShouldReduce),
|
|
(
|
|
ShouldReduce = no,
|
|
binary_input_stream_foldl2_io_plain(Stream, Pred, T0, Res, !IO)
|
|
;
|
|
ShouldReduce = yes,
|
|
binary_input_stream_foldl2_io_chunk(Stream, Pred, T0, Res, !IO)
|
|
).
|
|
|
|
:- pred binary_input_stream_foldl2_io_plain(binary_input_stream,
|
|
pred(int, T, T, io, io), T, io.maybe_partial_res(T), io, io).
|
|
:- mode binary_input_stream_foldl2_io_plain(in,
|
|
(pred(in, in, out, di, uo) is det), in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl2_io_plain(in,
|
|
(pred(in, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
|
|
|
|
binary_input_stream_foldl2_io_plain(Stream, Pred, T0, Res, !IO) :-
|
|
read_byte(Stream, ByteResult, !IO),
|
|
(
|
|
ByteResult = ok(Byte),
|
|
Pred(Byte, T0, T1, !IO),
|
|
binary_input_stream_foldl2_io_plain(Stream, Pred, T1, Res, !IO)
|
|
;
|
|
ByteResult = eof,
|
|
Res = ok(T0)
|
|
;
|
|
ByteResult = error(Error),
|
|
Res = error(T0, Error)
|
|
).
|
|
|
|
:- pred binary_input_stream_foldl2_io_chunk(binary_input_stream,
|
|
pred(int, T, T, io, io), T, io.maybe_partial_res(T), io, io).
|
|
:- mode binary_input_stream_foldl2_io_chunk(in,
|
|
(pred(in, in, out, di, uo) is det), in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl2_io_chunk(in,
|
|
(pred(in, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
|
|
|
|
binary_input_stream_foldl2_io_chunk(Stream, Pred, T0, Res, !IO) :-
|
|
binary_input_stream_foldl2_io_inner(chunk_size, Stream, Pred, T0,
|
|
InnerRes, !IO),
|
|
(
|
|
InnerRes = ok(T),
|
|
Res = ok(T)
|
|
;
|
|
InnerRes = error(T, Error),
|
|
Res = error(T, Error)
|
|
;
|
|
InnerRes = more(T1),
|
|
binary_input_stream_foldl2_io_chunk(Stream, Pred, T1, Res, !IO)
|
|
).
|
|
|
|
:- pred binary_input_stream_foldl2_io_inner(int, binary_input_stream,
|
|
pred(int, T, T, io, io), T, chunk_inner_res(T), io, io).
|
|
:- mode binary_input_stream_foldl2_io_inner(in, in,
|
|
(pred(in, in, out, di, uo) is det), in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl2_io_inner(in, in,
|
|
(pred(in, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
|
|
|
|
binary_input_stream_foldl2_io_inner(Left, Stream, Pred, T0, Res, !IO) :-
|
|
( if Left > 0 then
|
|
read_byte(Stream, ByteResult, !IO),
|
|
(
|
|
ByteResult = ok(Byte),
|
|
Pred(Byte, T0, T1, !IO),
|
|
binary_input_stream_foldl2_io_inner(Left - 1,
|
|
Stream, Pred, T1, Res, !IO)
|
|
;
|
|
ByteResult = eof,
|
|
Res = ok(T0)
|
|
;
|
|
ByteResult = error(Error),
|
|
Res = error(T0, Error)
|
|
)
|
|
else
|
|
Res = more(T0)
|
|
).
|
|
|
|
binary_input_stream_foldl2_io_maybe_stop(Pred, T0, Res, !IO) :-
|
|
binary_input_stream(Stream, !IO),
|
|
binary_input_stream_foldl2_io_maybe_stop(Stream, Pred, T0, Res, !IO).
|
|
|
|
binary_input_stream_foldl2_io_maybe_stop(Stream, Pred, T0, Res, !IO) :-
|
|
should_reduce_stack_usage(ShouldReduce),
|
|
(
|
|
ShouldReduce = no,
|
|
binary_input_stream_foldl2_io_maybe_stop_plain(Stream,
|
|
Pred, T0, Res, !IO)
|
|
;
|
|
ShouldReduce = yes,
|
|
binary_input_stream_foldl2_io_maybe_stop_chunk(Stream,
|
|
Pred, T0, Res, !IO)
|
|
).
|
|
|
|
:- pred binary_input_stream_foldl2_io_maybe_stop_plain(
|
|
binary_input_stream, pred(int, bool, T, T, io, io),
|
|
T, io.maybe_partial_res(T), io, io).
|
|
:- mode binary_input_stream_foldl2_io_maybe_stop_plain(
|
|
in, (pred(in, out, in, out, di, uo) is det),
|
|
in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl2_io_maybe_stop_plain(
|
|
in, (pred(in, out, in, out, di, uo) is cc_multi),
|
|
in, out, di, uo) is cc_multi.
|
|
|
|
binary_input_stream_foldl2_io_maybe_stop_plain(Stream, Pred, T0, Res,
|
|
!IO) :-
|
|
read_byte(Stream, ByteResult, !IO),
|
|
(
|
|
ByteResult = ok(Byte),
|
|
Pred(Byte, Continue, T0, T1, !IO),
|
|
(
|
|
Continue = no,
|
|
Res = ok(T1)
|
|
;
|
|
Continue = yes,
|
|
binary_input_stream_foldl2_io_maybe_stop_plain(
|
|
Stream, Pred, T1, Res, !IO)
|
|
)
|
|
;
|
|
ByteResult = eof,
|
|
Res = ok(T0)
|
|
;
|
|
ByteResult = error(Error),
|
|
Res = error(T0, Error)
|
|
).
|
|
|
|
:- pred binary_input_stream_foldl2_io_maybe_stop_chunk(
|
|
binary_input_stream, pred(int, bool, T, T, io, io),
|
|
T, io.maybe_partial_res(T), io, io).
|
|
:- mode binary_input_stream_foldl2_io_maybe_stop_chunk(
|
|
in, (pred(in, out, in, out, di, uo) is det),
|
|
in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl2_io_maybe_stop_chunk(
|
|
in, (pred(in, out, in, out, di, uo) is cc_multi),
|
|
in, out, di, uo) is cc_multi.
|
|
|
|
binary_input_stream_foldl2_io_maybe_stop_chunk(Stream, Pred, T0, Res,
|
|
!IO) :-
|
|
binary_input_stream_foldl2_io_maybe_stop_inner(chunk_size,
|
|
Stream, Pred, T0, InnerRes, !IO),
|
|
(
|
|
InnerRes = ok(T),
|
|
Res = ok(T)
|
|
;
|
|
InnerRes = error(T, Error),
|
|
Res = error(T, Error)
|
|
;
|
|
InnerRes = more(T1),
|
|
binary_input_stream_foldl2_io_maybe_stop_chunk(Stream,
|
|
Pred, T1, Res, !IO)
|
|
).
|
|
|
|
:- pred binary_input_stream_foldl2_io_maybe_stop_inner(int,
|
|
binary_input_stream, pred(int, bool, T, T, io, io),
|
|
T, chunk_inner_res(T), io, io).
|
|
:- mode binary_input_stream_foldl2_io_maybe_stop_inner(in,
|
|
in, (pred(in, out, in, out, di, uo) is det),
|
|
in, out, di, uo) is det.
|
|
:- mode binary_input_stream_foldl2_io_maybe_stop_inner(in,
|
|
in, (pred(in, out, in, out, di, uo) is cc_multi),
|
|
in, out, di, uo) is cc_multi.
|
|
|
|
binary_input_stream_foldl2_io_maybe_stop_inner(Left, Stream, Pred, T0, Res,
|
|
!IO) :-
|
|
( if Left > 0 then
|
|
read_byte(Stream, ByteResult, !IO),
|
|
(
|
|
ByteResult = ok(Byte),
|
|
Pred(Byte, Continue, T0, T1, !IO),
|
|
(
|
|
Continue = no,
|
|
Res = ok(T1)
|
|
;
|
|
Continue = yes,
|
|
binary_input_stream_foldl2_io_maybe_stop_inner(
|
|
Left - 1, Stream, Pred, T1, Res, !IO)
|
|
)
|
|
;
|
|
ByteResult = eof,
|
|
Res = ok(T0)
|
|
;
|
|
ByteResult = error(Error),
|
|
Res = error(T0, Error)
|
|
)
|
|
else
|
|
Res = more(T0)
|
|
).
|
|
|
|
:- type chunk_inner_res0
|
|
---> ok
|
|
; error(io.error)
|
|
; more.
|
|
|
|
:- type chunk_inner_res(T)
|
|
---> ok(T)
|
|
; error(T, io.error)
|
|
; more(T).
|
|
|
|
:- pred should_reduce_stack_usage(bool::out) is det.
|
|
|
|
% For non-C backends.
|
|
should_reduce_stack_usage(yes).
|
|
|
|
:- pragma foreign_proc("C",
|
|
should_reduce_stack_usage(ShouldReduce::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness],
|
|
"
|
|
#ifdef MR_EXEC_TRACE
|
|
ShouldReduce = MR_TRUE;
|
|
#else
|
|
ShouldReduce = MR_FALSE;
|
|
#endif
|
|
").
|
|
|
|
% Chunk_size gives the maximum number of recursive calls we want to
|
|
% allow in the binary_input_stream_foldl*_inner predicates. Without
|
|
% such a limit, the depth of recursion, which depends on the size of
|
|
% the file they read, will cause exhaustion of the det stack in debug
|
|
% grades, since there is no tail recursion in such grades.
|
|
%
|
|
% With this arrangement, the maximum number of stack frames needed
|
|
% to process a file of size N is N/1000 + 1000, the former being the
|
|
% number of frames of binary_input_stream_foldl*_chunk predicates,
|
|
% the latter being the max number of frames of the *_inner predicates.
|
|
%
|
|
:- func chunk_size = int.
|
|
|
|
chunk_size = 1000.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File handling predicates.
|
|
%
|
|
|
|
remove_file(FileName, Result, !IO) :-
|
|
remove_file_2(FileName, Error, !IO),
|
|
is_error(Error, "remove failed: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok
|
|
).
|
|
|
|
:- pred remove_file_2(string::in, system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
remove_file_2(FileName::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
int rc;
|
|
#ifdef MR_WIN32
|
|
rc = _wremove(ML_utf8_to_wide(FileName));
|
|
#else
|
|
rc = remove(FileName);
|
|
#endif
|
|
if (rc == 0) {
|
|
Error = 0;
|
|
} else {
|
|
Error = errno;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
remove_file_2(FileName::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
if (System.IO.File.Exists(FileName)) {
|
|
System.IO.File.Delete(FileName);
|
|
Error = null;
|
|
} else {
|
|
Error = new System.IO.FileNotFoundException();
|
|
}
|
|
}
|
|
catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
remove_file_2(FileName::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
// Java 7 java.nio.file.Files.delete() provides more detailed information
|
|
// about failure to delete.
|
|
|
|
try {
|
|
java.io.File file = new java.io.File(FileName);
|
|
|
|
if (file.delete()) {
|
|
Error = null;
|
|
} else {
|
|
Error = new java.io.IOException(""remove_file failed"");
|
|
}
|
|
} catch (java.lang.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
remove_file_recursively(FileName, Res, !IO) :-
|
|
FollowSymLinks = no,
|
|
file_type(FollowSymLinks, FileName, ResFileType, !IO),
|
|
(
|
|
ResFileType = ok(FileType),
|
|
(
|
|
FileType = directory,
|
|
dir.foldl2(remove_directory_entry, FileName, ok, Res0, !IO),
|
|
(
|
|
Res0 = ok(MaybeError),
|
|
(
|
|
MaybeError = ok,
|
|
remove_file(FileName, Res, !IO)
|
|
;
|
|
MaybeError = error(Error),
|
|
Res = error(Error)
|
|
)
|
|
;
|
|
Res0 = error(_, Error),
|
|
Res = error(Error)
|
|
)
|
|
;
|
|
( FileType = regular_file
|
|
; FileType = symbolic_link
|
|
; FileType = named_pipe
|
|
; FileType = socket
|
|
; FileType = character_device
|
|
; FileType = block_device
|
|
; FileType = message_queue
|
|
; FileType = semaphore
|
|
; FileType = shared_memory
|
|
; FileType = unknown
|
|
),
|
|
remove_file(FileName, Res, !IO)
|
|
)
|
|
;
|
|
ResFileType = error(Error),
|
|
Res = error(Error)
|
|
).
|
|
|
|
:- pred remove_directory_entry(string::in, string::in, file_type::in,
|
|
bool::out, io.res::in, io.res::out, io::di, io::uo) is det.
|
|
|
|
remove_directory_entry(DirName, FileName, _FileType, Continue, _, Res, !IO) :-
|
|
remove_file_recursively(DirName / FileName, Res0, !IO),
|
|
(
|
|
Res0 = ok,
|
|
Res = ok,
|
|
Continue = yes
|
|
;
|
|
Res0 = error(_),
|
|
Res = Res0,
|
|
Continue = no
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
rename_file(OldFileName, NewFileName, Result, !IO) :-
|
|
rename_file_2(OldFileName, NewFileName, Error, !IO),
|
|
is_error(Error, "rename failed: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok
|
|
).
|
|
|
|
:- pred rename_file_2(string::in, string::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
rename_file_2(OldFileName::in, NewFileName::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
int rc;
|
|
#ifdef MR_WIN32
|
|
rc = _wrename(ML_utf8_to_wide(OldFileName),
|
|
ML_utf8_to_wide(NewFileName));
|
|
#else
|
|
rc = rename(OldFileName, NewFileName);
|
|
#endif
|
|
if (rc == 0) {
|
|
Error = 0;
|
|
} else {
|
|
Error = errno;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
rename_file_2(OldFileName::in, NewFileName::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
if (System.IO.File.Exists(OldFileName)) {
|
|
System.IO.File.Move(OldFileName, NewFileName);
|
|
Error = null;
|
|
} else {
|
|
Error = new System.IO.FileNotFoundException();
|
|
}
|
|
}
|
|
catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
rename_file_2(OldFileName::in, NewFileName::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
// Java 7 java.nio.file.Files.move may provide more detailed information
|
|
// about failure to rename.
|
|
|
|
try {
|
|
java.io.File file = new java.io.File(OldFileName);
|
|
|
|
if (file.exists()) {
|
|
if (file.renameTo(new java.io.File(NewFileName))) {
|
|
Error = null;
|
|
} else {
|
|
Error = new java.io.IOException(""rename_file failed"");
|
|
}
|
|
} else {
|
|
Error = new java.io.IOException(""No such file or directory"");
|
|
}
|
|
} catch (java.lang.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
have_symlinks,
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#if defined(MR_HAVE_SYMLINK) && defined(MR_HAVE_READLINK)
|
|
SUCCESS_INDICATOR = MR_TRUE;
|
|
#else
|
|
SUCCESS_INDICATOR = MR_FALSE;
|
|
#endif
|
|
").
|
|
|
|
have_symlinks :-
|
|
semidet_fail.
|
|
|
|
%---------------------%
|
|
|
|
make_symlink(FileName, LinkFileName, Result, !IO) :-
|
|
( if io.have_symlinks then
|
|
make_symlink_2(FileName, LinkFileName, Error, !IO),
|
|
is_error(Error, "io.make_symlink failed: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok
|
|
)
|
|
else
|
|
Result = error(make_io_error(
|
|
"io.make_symlink not supported on this platform"))
|
|
).
|
|
|
|
:- pred make_symlink_2(string::in, string::in, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
make_symlink_2(FileName::in, LinkFileName::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#ifdef MR_HAVE_SYMLINK
|
|
if (symlink(FileName, LinkFileName) == 0) {
|
|
Error = 0;
|
|
} else {
|
|
Error = errno;
|
|
}
|
|
#else
|
|
Error = ENOSYS;
|
|
#endif
|
|
").
|
|
|
|
% XXX MISSING C# make_symlink_2
|
|
|
|
% Since io.have_symlinks will fail for Java, this procedure
|
|
% should never be called:
|
|
% XXX Java 7 has createSymbolicLink, readSymbolicLink
|
|
:- pragma foreign_proc("Java",
|
|
make_symlink_2(_FileName::in, _LinkFileName::in, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
Error = new java.lang.UnsupportedOperationException(
|
|
""io.make_symlink_2 not implemented"");
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
read_symlink(FileName, Result, !IO) :-
|
|
( if have_symlinks then
|
|
read_symlink_2(FileName, TargetFileName, Error, !IO),
|
|
is_error(Error, "io.read_symlink failed: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(TargetFileName)
|
|
)
|
|
else
|
|
Result = error(make_io_error(
|
|
"io.read_symlink not supported on this platform"))
|
|
).
|
|
|
|
:- pred read_symlink_2(string::in, string::out, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
read_symlink_2(FileName::in, TargetFileName::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#ifdef MR_HAVE_READLINK
|
|
#ifndef PATH_MAX
|
|
#define PATH_MAX 256
|
|
#endif
|
|
int num_chars;
|
|
char *buffer2 = NULL;
|
|
int buffer_size2 = PATH_MAX;
|
|
char buffer[PATH_MAX + 1];
|
|
|
|
// readlink() does not null-terminate the buffer.
|
|
num_chars = readlink(FileName, buffer, PATH_MAX);
|
|
|
|
if (num_chars == PATH_MAX) {
|
|
do {
|
|
buffer_size2 *= 2;
|
|
buffer2 = MR_RESIZE_ARRAY(buffer2, char, buffer_size2);
|
|
num_chars = readlink(FileName, buffer2, buffer_size2);
|
|
} while (num_chars == buffer_size2);
|
|
|
|
// Invariant: num_chars < buffer_size2.
|
|
|
|
if (num_chars == -1) {
|
|
TargetFileName = MR_make_string_const("""");
|
|
Error = errno;
|
|
} else {
|
|
buffer2[num_chars] = '\\0';
|
|
MR_make_aligned_string_copy_msg(TargetFileName, buffer2,
|
|
MR_ALLOC_ID);
|
|
Error = 0;
|
|
}
|
|
MR_free(buffer2);
|
|
} else if (num_chars == -1) {
|
|
TargetFileName = MR_make_string_const("""");
|
|
Error = errno;
|
|
} else {
|
|
buffer[num_chars] = '\\0';
|
|
MR_make_aligned_string_copy_msg(TargetFileName, buffer, MR_ALLOC_ID);
|
|
Error = 0;
|
|
}
|
|
#else // !MR_HAVE_READLINK
|
|
TargetFileName = MR_make_string_const("""");
|
|
Error = ENOSYS;
|
|
#endif
|
|
").
|
|
|
|
% XXX MISSING C# read_symlink_2
|
|
|
|
% Since io.have_symlinks will fail for Java, this procedure
|
|
% should never be called:
|
|
% XXX Java 7 has createSymbolicLink, readSymbolicLink
|
|
:- pragma foreign_proc("Java",
|
|
read_symlink_2(_FileName::in, TargetFileName::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
TargetFileName = """";
|
|
Error = new java.lang.UnsupportedOperationException(
|
|
""io.read_symlink_2 not implemented"");
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
check_file_accessibility(FileName, AccessTypes, Result, !IO) :-
|
|
( if have_dotnet then
|
|
check_file_accessibility_dotnet(FileName, AccessTypes, Result, !IO)
|
|
else
|
|
CheckRead = pred_to_bool(contains(AccessTypes, read)),
|
|
CheckWrite = pred_to_bool(contains(AccessTypes, write)),
|
|
CheckExecute = pred_to_bool(contains(AccessTypes, execute)),
|
|
check_file_accessibility_2(FileName, CheckRead, CheckWrite,
|
|
CheckExecute, Error, !IO),
|
|
is_error(Error, "file not accessible: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok
|
|
)
|
|
).
|
|
|
|
:- pred check_file_accessibility_2(string::in, bool::in, bool::in, bool::in,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
check_file_accessibility_2(FileName::in, CheckRead::in,
|
|
CheckWrite::in, CheckExecute::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#if defined(MR_HAVE_ACCESS)
|
|
#ifdef F_OK
|
|
const int MODE_EXISTS = F_OK;
|
|
#else
|
|
const int MODE_EXISTS = 0;
|
|
#endif
|
|
#ifdef X_OK
|
|
const int MODE_EXECUTE = X_OK;
|
|
#else
|
|
const int MODE_EXECUTE = 1;
|
|
#endif
|
|
#ifdef W_OK
|
|
const int MODE_WRITE = W_OK;
|
|
#else
|
|
const int MODE_WRITE = 2;
|
|
#endif
|
|
#ifdef R_OK
|
|
const int MODE_READ = R_OK;
|
|
#else
|
|
const int MODE_READ = 4;
|
|
#endif
|
|
|
|
int mode = MODE_EXISTS;
|
|
int access_result;
|
|
|
|
#if !defined(MR_WIN32) || defined(MR_CYGWIN)
|
|
// Earlier versions of MSVCRT ignored flags it doesn't support,
|
|
// later versions return an error (e.g. on Vista).
|
|
if (CheckExecute) {
|
|
mode |= MODE_EXECUTE;
|
|
}
|
|
#endif
|
|
if (CheckWrite) {
|
|
mode |= MODE_WRITE;
|
|
}
|
|
if (CheckRead) {
|
|
mode |= MODE_READ;
|
|
}
|
|
|
|
#ifdef MR_WIN32
|
|
access_result = _waccess(ML_utf8_to_wide(FileName), mode);
|
|
#else
|
|
access_result = access(FileName, mode);
|
|
#endif
|
|
|
|
if (access_result == 0) {
|
|
Error = 0;
|
|
} else {
|
|
Error = errno;
|
|
}
|
|
#else // !MR_HAVE_ACCESS
|
|
Error = ENOSYS;
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
check_file_accessibility_2(FileName::in, CheckRead::in, CheckWrite::in,
|
|
CheckExecute::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
java.io.File file = new java.io.File(FileName);
|
|
try {
|
|
boolean ok = true;
|
|
|
|
if (CheckRead == bool.YES) {
|
|
ok = file.canRead();
|
|
}
|
|
|
|
if (ok && CheckWrite == bool.YES) {
|
|
ok = file.canWrite();
|
|
}
|
|
|
|
if (ok && CheckExecute == bool.YES) {
|
|
ok = file.canExecute();
|
|
}
|
|
|
|
if (ok) {
|
|
Error = null;
|
|
} else {
|
|
Error = new java.io.FileNotFoundException(""Permission denied"");
|
|
}
|
|
}
|
|
catch (java.lang.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
% XXX why not write this as check_file_accessibility_2?
|
|
%
|
|
:- pred check_file_accessibility_dotnet(string::in, list(access_type)::in,
|
|
io.res::out, io::di, io::uo) is det.
|
|
|
|
check_file_accessibility_dotnet(FileName, AccessTypes, Result, !IO) :-
|
|
% The .NET CLI doesn't provide an equivalent of access(), so we have to
|
|
% try to open the file to see if it is accessible.
|
|
|
|
CheckRead0 = pred_to_bool(contains(AccessTypes, read)),
|
|
CheckWrite = pred_to_bool(contains(AccessTypes, write)),
|
|
CheckExec = pred_to_bool(contains(AccessTypes, execute)),
|
|
% We need to be able to read a file to execute it.
|
|
CheckRead = bool.or(CheckRead0, CheckExec),
|
|
|
|
file_type(yes, FileName, FileTypeRes, !IO),
|
|
(
|
|
FileTypeRes = ok(FileType),
|
|
( if FileType = directory then
|
|
check_directory_accessibility_dotnet(FileName,
|
|
CheckRead, CheckWrite, Error, !IO),
|
|
is_error(Error, "file not accessible: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok
|
|
)
|
|
else
|
|
(
|
|
CheckRead = yes,
|
|
open_input(FileName, InputRes, !IO),
|
|
(
|
|
InputRes = ok(InputStream),
|
|
io.close_input(InputStream, !IO),
|
|
CheckReadRes = ok
|
|
;
|
|
InputRes = error(InputError),
|
|
CheckReadRes = error(InputError)
|
|
)
|
|
;
|
|
CheckRead = no,
|
|
CheckReadRes = ok
|
|
),
|
|
( if
|
|
CheckReadRes = ok,
|
|
CheckWrite = yes
|
|
then
|
|
open_append(FileName, OutputRes, !IO),
|
|
(
|
|
OutputRes = ok(OutputStream),
|
|
io.close_output(OutputStream, !IO),
|
|
CheckWriteRes = ok
|
|
;
|
|
OutputRes = error(OutputError),
|
|
CheckWriteRes = error(OutputError)
|
|
)
|
|
else
|
|
CheckWriteRes = CheckReadRes
|
|
),
|
|
( if
|
|
CheckWriteRes = ok,
|
|
% Unix programs need to check whether the execute bit is set
|
|
% for the directory, but we can't actually execute the
|
|
% directory.
|
|
CheckExec = yes
|
|
then
|
|
have_dotnet_exec_permission(Error, !IO),
|
|
is_error(Error, "file not accessible: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok
|
|
)
|
|
else
|
|
Result = CheckWriteRes
|
|
)
|
|
)
|
|
;
|
|
FileTypeRes = error(FileTypeError),
|
|
Result = error(FileTypeError)
|
|
).
|
|
|
|
:- pred have_dotnet_exec_permission(system_error::out, io::di, io::uo) is det.
|
|
|
|
have_dotnet_exec_permission(Error, !IO) :-
|
|
% Avoid determinism warnings.
|
|
( if semidet_succeed then
|
|
error("io.have_dotnet_exec_permission invoked " ++
|
|
"for non-.NET CLI backend")
|
|
else
|
|
% Never reached.
|
|
Error = no_error
|
|
).
|
|
|
|
:- pragma foreign_proc("C#",
|
|
have_dotnet_exec_permission(Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
try {
|
|
// We need unrestricted permissions to execute unmanaged code.
|
|
(new System.Security.Permissions.SecurityPermission(
|
|
System.Security.Permissions.SecurityPermissionFlag.
|
|
AllFlags)).Demand();
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pred check_directory_accessibility_dotnet(string::in, bool::in, bool::in,
|
|
system_error::out, io::di, io::uo) is det.
|
|
|
|
check_directory_accessibility_dotnet(_, _, _, Error, !IO) :-
|
|
% Avoid determinism warnings.
|
|
( if semidet_succeed then
|
|
error("io.check_directory_accessibility_dotnet called " ++
|
|
"for non-.NET CLI backend")
|
|
else
|
|
% Never reached.
|
|
Error = no_error
|
|
).
|
|
|
|
:- pragma foreign_proc("C#",
|
|
check_directory_accessibility_dotnet(FileName::in, CheckRead::in,
|
|
CheckWrite::in, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
Error = null;
|
|
if (CheckRead == mr_bool.YES) {
|
|
// XXX This is less efficient than I would like.
|
|
// Unfortunately the .NET CLI has no function
|
|
// corresponding to access() or opendir().
|
|
System.IO.Directory.GetFileSystemEntries(FileName);
|
|
}
|
|
if (CheckWrite == mr_bool.YES) {
|
|
// This will fail if the .NET CLI security regime
|
|
// we're operating under doesn't allow writing
|
|
// to the file. Even if this succeeds, the file
|
|
// system may disallow write access.
|
|
System.IO.Directory.SetLastAccessTime(FileName,
|
|
System.DateTime.Now);
|
|
|
|
// XXX This isn't quite right. Just because the directory
|
|
// isn't read-only doesn't mean we have permission to write to it.
|
|
// The only way to test whether a directory is writable is to
|
|
// write a file to it. The ideal way to do that would be
|
|
// io.make_temp, but currently the C# backend version of that
|
|
// ignores the directory passed to it.
|
|
System.IO.FileAttributes attrs =
|
|
System.IO.File.GetAttributes(FileName);
|
|
if ((attrs & System.IO.FileAttributes.ReadOnly) ==
|
|
System.IO.FileAttributes.ReadOnly)
|
|
{
|
|
Error = new System.Exception(""file is read-only"");
|
|
}
|
|
}
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_export_enum("C", file_type/0,
|
|
[prefix("ML_FILE_TYPE_"), uppercase]).
|
|
:- pragma foreign_export_enum("C#", file_type/0,
|
|
[prefix("ML_FILE_TYPE_"), uppercase]).
|
|
:- pragma foreign_export_enum("Java", file_type/0,
|
|
[prefix("ML_FILE_TYPE_"), uppercase]).
|
|
|
|
file_type(FollowSymLinks, FileName, Result, !IO) :-
|
|
(
|
|
FollowSymLinks = yes,
|
|
FollowSymLinksInt = 1
|
|
;
|
|
FollowSymLinks = no,
|
|
FollowSymLinksInt = 0
|
|
),
|
|
file_type_2(FollowSymLinksInt, FileName, FileType, Error, !IO),
|
|
is_error(Error, "can't find file type: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(FileType)
|
|
).
|
|
|
|
:- pred file_type_2(int::in, string::in, file_type::out, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
file_type_2(FollowSymLinks::in, FileName::in, FileType::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#ifdef MR_HAVE_STAT
|
|
#ifdef MR_WIN32
|
|
struct _stat s;
|
|
int stat_result = _wstat(ML_utf8_to_wide(FileName), &s);
|
|
#else
|
|
struct stat s;
|
|
int stat_result;
|
|
|
|
if (FollowSymLinks == 1) {
|
|
stat_result = stat(FileName, &s);
|
|
} else {
|
|
#ifdef MR_HAVE_LSTAT
|
|
stat_result = lstat(FileName, &s);
|
|
#else
|
|
stat_result = stat(FileName, &s);
|
|
#endif
|
|
}
|
|
#endif
|
|
|
|
if (stat_result == 0) {
|
|
// Do we still need the non-POSIX S_IFMT style?
|
|
if
|
|
#if defined(S_ISREG)
|
|
(S_ISREG(s.st_mode))
|
|
#elif defined(S_IFMT) && defined(S_IFREG)
|
|
((s.st_mode & S_IFMT) == S_IFREG)
|
|
#else
|
|
(0)
|
|
#endif
|
|
{
|
|
FileType = ML_FILE_TYPE_REGULAR_FILE;
|
|
}
|
|
else if
|
|
#if defined(S_ISDIR)
|
|
(S_ISDIR(s.st_mode))
|
|
#elif defined(S_IFMT) && defined(S_IFDIR)
|
|
((s.st_mode & S_IFMT) == S_IFDIR)
|
|
#else
|
|
(0)
|
|
#endif
|
|
{
|
|
FileType = ML_FILE_TYPE_DIRECTORY;
|
|
}
|
|
else if
|
|
#if defined(S_ISBLK)
|
|
(S_ISBLK(s.st_mode))
|
|
#elif defined(S_IFMT) && defined(S_IFBLK)
|
|
((s.st_mode & S_IFMT) == S_IFBLK)
|
|
#else
|
|
(0)
|
|
#endif
|
|
{
|
|
FileType = ML_FILE_TYPE_BLOCK_DEVICE;
|
|
}
|
|
else if
|
|
#if defined(S_ISCHR)
|
|
(S_ISCHR(s.st_mode))
|
|
#elif defined(S_IFMT) && defined(S_IFCHR)
|
|
((s.st_mode & S_IFMT) == S_IFCHR)
|
|
#else
|
|
(0)
|
|
#endif
|
|
{
|
|
FileType = ML_FILE_TYPE_CHARACTER_DEVICE;
|
|
}
|
|
else if
|
|
#if defined(S_ISFIFO)
|
|
(S_ISFIFO(s.st_mode))
|
|
#elif defined(S_IFMT) && defined(S_IFIFO)
|
|
((s.st_mode & S_IFMT) == S_IFIFO)
|
|
#else
|
|
(0)
|
|
#endif
|
|
{
|
|
FileType = ML_FILE_TYPE_NAMED_PIPE;
|
|
}
|
|
else if
|
|
#if defined(S_ISLNK)
|
|
(S_ISLNK(s.st_mode))
|
|
#elif defined(S_IFMT) && defined(S_IFLNK)
|
|
((s.st_mode & S_IFMT) == S_IFLNK)
|
|
#else
|
|
(0)
|
|
#endif
|
|
{
|
|
FileType = ML_FILE_TYPE_SYMBOLIC_LINK;
|
|
}
|
|
else if
|
|
#if defined(S_ISSOCK)
|
|
(S_ISSOCK(s.st_mode))
|
|
#elif defined(S_IFMT) && defined(S_IFSOCK)
|
|
((s.st_mode & S_IFMT) == S_IFSOCK)
|
|
#else
|
|
(0)
|
|
#endif
|
|
{
|
|
FileType = ML_FILE_TYPE_SOCKET;
|
|
} else {
|
|
|
|
#ifdef S_TYPEISMQ
|
|
if (S_TYPEISMQ(&s)) {
|
|
FileType = ML_FILE_TYPE_MESSAGE_QUEUE;
|
|
} else
|
|
#endif
|
|
|
|
#ifdef S_TYPEISSEM
|
|
if (S_TYPEISSEM(&s)) {
|
|
FileType = ML_FILE_TYPE_SEMAPHORE;
|
|
} else
|
|
#endif
|
|
|
|
#ifdef S_TYPEISSHM
|
|
if (S_TYPEISSHM(&s)) {
|
|
FileType = ML_FILE_TYPE_SHARED_MEMORY;
|
|
} else
|
|
#endif
|
|
|
|
{
|
|
FileType = ML_FILE_TYPE_UNKNOWN;
|
|
}
|
|
}
|
|
Error = 0;
|
|
} else {
|
|
FileType = ML_FILE_TYPE_UNKNOWN;
|
|
Error = errno;
|
|
}
|
|
#else
|
|
FileType = ML_FILE_TYPE_UNKNOWN;
|
|
Error = ENOSYS;
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
file_type_2(_FollowSymLinks::in, FileName::in, FileType::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
System.IO.FileAttributes attrs =
|
|
System.IO.File.GetAttributes(FileName);
|
|
if ((attrs & System.IO.FileAttributes.Directory) ==
|
|
System.IO.FileAttributes.Directory)
|
|
{
|
|
FileType = io.ML_FILE_TYPE_DIRECTORY;
|
|
}
|
|
else if ((attrs & System.IO.FileAttributes.Device) ==
|
|
System.IO.FileAttributes.Device)
|
|
{
|
|
// XXX It may be a block device, but .NET doesn't
|
|
// distinguish between character and block devices.
|
|
FileType = io.ML_FILE_TYPE_CHARACTER_DEVICE;
|
|
}
|
|
else
|
|
{
|
|
FileType = io.ML_FILE_TYPE_REGULAR_FILE;
|
|
}
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
FileType = ML_FILE_TYPE_UNKNOWN;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
file_type_2(_FollowSymLinks::in, FileName::in, FileType::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
// The Java implementation can distinguish between regular files and
|
|
// directories, and for everything else it just returns unknown.
|
|
|
|
FileType = io.ML_FILE_TYPE_UNKNOWN;
|
|
Error = null;
|
|
|
|
try {
|
|
java.io.File file = new java.io.File(FileName);
|
|
if (file.isFile()) {
|
|
FileType = io.ML_FILE_TYPE_REGULAR_FILE;
|
|
} else if (file.isDirectory()) {
|
|
FileType = io.ML_FILE_TYPE_DIRECTORY;
|
|
} else if (file.exists()) {
|
|
FileType = io.ML_FILE_TYPE_UNKNOWN;
|
|
} else {
|
|
Error = new java.io.FileNotFoundException(
|
|
""File not found or I/O error"");
|
|
}
|
|
} catch (java.lang.Exception e) {
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
file_modification_time(File, Result, !IO) :-
|
|
file_modification_time_2(File, Time, Error, !IO),
|
|
is_error(Error, "can't get file modification time: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(Time)
|
|
).
|
|
|
|
:- pred file_modification_time_2(string::in, time_t::out, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
file_modification_time_2(FileName::in, Time::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[may_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#ifdef MR_HAVE_STAT
|
|
#ifdef MR_WIN32
|
|
struct _stat s;
|
|
int stat_result = _wstat(ML_utf8_to_wide(FileName), &s);
|
|
#else
|
|
struct stat s;
|
|
int stat_result = stat(FileName, &s);
|
|
#endif
|
|
|
|
if (stat_result == 0) {
|
|
// XXX avoid ML_construct_time_t by returning time_t_rep?
|
|
Time = ML_construct_time_t(s.st_mtime);
|
|
Error = 0;
|
|
} else {
|
|
Error = errno;
|
|
Time = 0;
|
|
}
|
|
#else
|
|
Error = ENOSYS;
|
|
Time = 0;
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
file_modification_time_2(FileName::in, Time::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
if (System.IO.File.Exists(FileName)) {
|
|
System.DateTime t = System.IO.File.GetLastWriteTime(FileName);
|
|
Time = time.ML_construct_time_t(t);
|
|
Error = null;
|
|
} else {
|
|
Error = new System.IO.FileNotFoundException();
|
|
Time = null;
|
|
}
|
|
} catch (System.Exception e) {
|
|
Error = e;
|
|
Time = null;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
file_modification_time_2(FileName::in, Time::out, Error::out,
|
|
_IO0::di, _IO::uo),
|
|
[may_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
try {
|
|
long modtime = (new java.io.File(FileName)).lastModified();
|
|
if (modtime == 0) {
|
|
Error = new java.io.FileNotFoundException(
|
|
""File not found or I/O error"");
|
|
Time = null;
|
|
} else {
|
|
Time = time.ML_construct_time_t(
|
|
java.time.Instant.ofEpochMilli(modtime));
|
|
Error = null;
|
|
}
|
|
} catch (java.lang.Exception e) {
|
|
Error = e;
|
|
Time = null;
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Predicates for handling temporary files.
|
|
%
|
|
|
|
make_temp_file(Result, !IO) :-
|
|
get_temp_directory(Dir, !IO),
|
|
make_temp_file(Dir, "mtmp", "", Result, !IO).
|
|
|
|
make_temp_file(Dir, Prefix, Suffix, Result, !IO) :-
|
|
do_make_temp(Dir, Prefix, Suffix, char_to_string(dir.directory_separator),
|
|
Name, Error, !IO),
|
|
is_error(Error, "error creating temporary file: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(Name)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
% XXX The code for io.make_temp assumes POSIX. It uses the functions open(),
|
|
% close(), and getpid() and the macros EEXIST, O_WRONLY, O_CREAT, and O_EXCL.
|
|
% We should be using conditional compilation here to avoid these POSIX
|
|
% dependencies.
|
|
|
|
:- pred do_make_temp(string::in, string::in, string::in, string::in,
|
|
string::out, system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_make_temp(Dir::in, Prefix::in, Suffix::in, Sep::in, FileName::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure,
|
|
not_thread_safe, % due to ML_io_tempnam_counter
|
|
tabled_for_io, does_not_affect_liveness],
|
|
"
|
|
#ifdef MR_HAVE_MKSTEMP
|
|
int err, fd;
|
|
|
|
// We cannot append Suffix because the last six chars in the argument
|
|
// to mkstemp() must be XXXXXX.
|
|
FileName = MR_make_string(MR_ALLOC_ID, ""%s%s%.5sXXXXXX"",
|
|
Dir, Sep, Prefix);
|
|
fd = mkstemp(FileName);
|
|
if (fd == -1) {
|
|
Error = errno;
|
|
} else {
|
|
do {
|
|
err = close(fd);
|
|
} while (err == -1 && MR_is_eintr(errno));
|
|
if (err == 0) {
|
|
Error = 0;
|
|
} else {
|
|
Error = errno;
|
|
}
|
|
}
|
|
#else
|
|
// Constructs a temporary name by concatenating Dir, `/', the first 5 chars
|
|
// of Prefix, six hex digits, and Suffix. The six digit hex number is
|
|
// generated by starting with the pid of this process. Uses
|
|
// `open(..., O_CREATE | O_EXCL, ...)' to create the file, checking that
|
|
// there was no existing file with that name.
|
|
|
|
int err, fd, num_tries;
|
|
int flags;
|
|
|
|
if (ML_io_tempnam_counter == 0) {
|
|
ML_io_tempnam_counter = getpid();
|
|
}
|
|
num_tries = 0;
|
|
do {
|
|
FileName = MR_make_string(MR_ALLOC_ID, ""%s%s%.5s%06lX%s"",
|
|
Dir, Sep, Prefix, ML_io_tempnam_counter & 0xffffffL, Suffix);
|
|
flags = O_WRONLY | O_CREAT | O_EXCL;
|
|
do {
|
|
#ifdef MR_WIN32
|
|
fd = _wopen(ML_utf8_to_wide(FileName), flags, 0600);
|
|
#else
|
|
fd = open(FileName, flags, 0600);
|
|
#endif
|
|
} while (fd == -1 && MR_is_eintr(errno));
|
|
num_tries++;
|
|
ML_io_tempnam_counter += (1 << num_tries);
|
|
} while (fd == -1 && errno == EEXIST &&
|
|
num_tries < ML_MAX_TEMPNAME_TRIES);
|
|
if (fd == -1) {
|
|
Error = errno;
|
|
} else {
|
|
do {
|
|
err = close(fd);
|
|
} while (err == -1 && MR_is_eintr(errno));
|
|
if (err == 0) {
|
|
Error = 0;
|
|
} else {
|
|
Error = errno;
|
|
}
|
|
}
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_make_temp(_Dir::in, _Prefix::in, _Suffix::in, _Sep::in, FileName::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
try {
|
|
FileName = System.IO.Path.GetTempFileName();
|
|
Error = null;
|
|
} catch (System.Exception e) {
|
|
FileName = """";
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_make_temp(Dir::in, Prefix::in, Suffix::in, _Sep::in, FileName::out,
|
|
Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
try {
|
|
File new_file;
|
|
|
|
if (Prefix.length() > 5) {
|
|
// The documentation for io.make_temp says that we should only use
|
|
// the first five characters of Prefix.
|
|
Prefix = Prefix.substring(0, 5);
|
|
}
|
|
|
|
new_file = new File(new File(Dir), makeTempName(Prefix, Suffix));
|
|
if (new_file.createNewFile()) {
|
|
FileName = new_file.getAbsolutePath();
|
|
Error = null;
|
|
} else {
|
|
FileName = """";
|
|
Error = new java.io.IOException(""Could not create file"");
|
|
}
|
|
} catch (IOException e) {
|
|
FileName = """";
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
make_temp_directory(Result, !IO) :-
|
|
get_temp_directory(Dir, !IO),
|
|
make_temp_directory(Dir, "mtmp", "", Result, !IO).
|
|
|
|
make_temp_directory(Dir, Prefix, Suffix, Result, !IO) :-
|
|
do_make_temp_directory(Dir, Prefix, Suffix,
|
|
char_to_string(dir.directory_separator), DirName, Error, !IO),
|
|
is_error(Error, "error creating temporary directory: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(DirName)
|
|
).
|
|
|
|
:- pred do_make_temp_directory(string::in, string::in, string::in, string::in,
|
|
string::out, system_error::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
do_make_temp_directory(Dir::in, Prefix::in, Suffix::in, Sep::in,
|
|
DirName::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness],
|
|
"
|
|
#ifdef MR_HAVE_MKDTEMP
|
|
int err;
|
|
|
|
// We cannot append Suffix because the last six chars in the argument
|
|
// to mkdtemp() must be XXXXXX.
|
|
|
|
DirName = MR_make_string(MR_ALLOC_ID, ""%s%s%.5sXXXXXX"",
|
|
Dir, Sep, Prefix);
|
|
DirName = mkdtemp(DirName);
|
|
if (DirName == NULL) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
#else
|
|
Error = ENOSYS;
|
|
DirName = MR_make_string_const("""");
|
|
#endif // HAVE_MKDTEMP
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
do_make_temp_directory(Dir::in, _Prefix::in, _Suffix::in, _Sep::in,
|
|
DirName::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"{
|
|
try
|
|
{
|
|
DirName = Path.Combine(Dir, Path.GetRandomFileName());
|
|
|
|
switch (Environment.OSVersion.Platform)
|
|
{
|
|
case PlatformID.Win32NT:
|
|
// obtain the owner of the temporary directory
|
|
IdentityReference tempInfo =
|
|
new DirectoryInfo(Dir)
|
|
.GetAccessControl(AccessControlSections.Owner)
|
|
.GetOwner(typeof(SecurityIdentifier));
|
|
|
|
DirectorySecurity security = new DirectorySecurity();
|
|
security.AddAccessRule(
|
|
new FileSystemAccessRule(tempInfo,
|
|
FileSystemRights.ListDirectory
|
|
| FileSystemRights.Read
|
|
| FileSystemRights.Modify,
|
|
InheritanceFlags.None,
|
|
PropagationFlags.None,
|
|
AccessControlType.Allow
|
|
)
|
|
);
|
|
Directory.CreateDirectory(DirName, security);
|
|
Error = null;
|
|
break;
|
|
|
|
#if __MonoCS__
|
|
case PlatformID.Unix:
|
|
case (PlatformID)6: // MacOSX:
|
|
int errorNo = ML_sys_mkdir(DirName, 0x7 << 6);
|
|
if (errorNo == 0)
|
|
{
|
|
Error = null;
|
|
}
|
|
else
|
|
{
|
|
Error = new System.Exception(string.Format(
|
|
""Creating directory {0} failed with: {1:X}"",
|
|
DirName, errorNo));
|
|
}
|
|
break;
|
|
#endif
|
|
|
|
default:
|
|
Error = new System.Exception(
|
|
""Changing folder permissions is not supported for: "" +
|
|
Environment.OSVersion);
|
|
break;
|
|
}
|
|
}
|
|
catch (System.Exception e)
|
|
{
|
|
DirName = string.Empty;
|
|
Error = e;
|
|
}
|
|
}").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
do_make_temp_directory(Dir::in, Prefix::in, Suffix::in, _Sep::in,
|
|
DirName::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
File new_dir;
|
|
|
|
if (Prefix.length() > 5) {
|
|
// The documentation for io.make_temp says that we should only use
|
|
// the first five characters of Prefix.
|
|
Prefix = Prefix.substring(0, 5);
|
|
}
|
|
|
|
new_dir = new File(new File(Dir), makeTempName(Prefix, Suffix));
|
|
if (new_dir.mkdir()) {
|
|
DirName = new_dir.getAbsolutePath();
|
|
Error = null;
|
|
} else {
|
|
DirName = """";
|
|
Error = new java.io.IOException(""Couldn't create directory"");
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
have_make_temp_directory,
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
#ifdef MR_HAVE_MKDTEMP
|
|
SUCCESS_INDICATOR = MR_TRUE;
|
|
#else
|
|
SUCCESS_INDICATOR = MR_FALSE;
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
have_make_temp_directory,
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
SUCCESS_INDICATOR = true;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
have_make_temp_directory,
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
SUCCESS_INDICATOR = true;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_decl("C", "
|
|
#ifdef MR_HAVE_UNISTD_H
|
|
#include <unistd.h>
|
|
#endif
|
|
#include <sys/types.h>
|
|
#include <sys/stat.h>
|
|
#include <fcntl.h>
|
|
|
|
#define ML_MAX_TEMPNAME_TRIES (6 * 4)
|
|
|
|
extern long ML_io_tempnam_counter;
|
|
").
|
|
|
|
:- pragma foreign_code("C", "
|
|
long ML_io_tempnam_counter = 0;
|
|
").
|
|
|
|
:- pragma foreign_decl("Java", local, "
|
|
import java.io.File;
|
|
import java.io.IOException;
|
|
import java.util.Random;
|
|
").
|
|
|
|
:- pragma foreign_code("Java", "
|
|
public static Random ML_rand = new Random();
|
|
|
|
public static String makeTempName(String prefix, String suffix)
|
|
{
|
|
StringBuilder sb = new StringBuilder();
|
|
|
|
sb.append(prefix);
|
|
// Make an 8-digit mixed case alpha-numeric code.
|
|
for (int i = 0; i < 8; i++) {
|
|
char c;
|
|
int c_num = ML_rand.nextInt(10+26+26);
|
|
if (c_num < 10) {
|
|
c_num = c_num + '0';
|
|
} else if (c_num < 10+26) {
|
|
c_num = c_num + 'A' - 10;
|
|
} else{
|
|
c_num = c_num + 'a' - 10 - 26;
|
|
}
|
|
c = (char)c_num;
|
|
sb.append(c);
|
|
}
|
|
sb.append(suffix);
|
|
|
|
return sb.toString();
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
get_temp_directory(Dir, !IO) :-
|
|
% If using the Java or C# backend then use their API to get the location of
|
|
% temporary files.
|
|
system_temp_dir(Dir0, OK, !IO),
|
|
( if OK = 1 then
|
|
Dir = Dir0
|
|
else
|
|
% Either this is not a Java or C# grade or the Java or C# backend
|
|
% couldn't determine the temporary directory.
|
|
%
|
|
% We need to do an explicit check of TMPDIR because not all
|
|
% systems check TMPDIR for us (eg Linux #$%*@&).
|
|
Var = ( if dir.use_windows_paths then "TMP" else "TMPDIR" ),
|
|
get_environment_var(Var, Result, !IO),
|
|
(
|
|
Result = yes(Dir)
|
|
;
|
|
Result = no,
|
|
( if dir.use_windows_paths then
|
|
Dir = dir.this_directory
|
|
else
|
|
Dir = "/tmp"
|
|
)
|
|
)
|
|
).
|
|
|
|
:- pred system_temp_dir(string::out, int::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("Java",
|
|
system_temp_dir(Dir::out, OK::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
try {
|
|
Dir = java.lang.System.getProperty(""java.io.tmpdir"");
|
|
OK = (Dir != null) ? 1 : 0;
|
|
} catch (Exception e) {
|
|
Dir = null;
|
|
OK = 0;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
system_temp_dir(Dir::out, OK::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
try {
|
|
Dir = System.IO.Path.GetTempPath();
|
|
OK = (Dir != null) ? 1 : 0;
|
|
} catch (System.Exception _) {
|
|
Dir = null;
|
|
OK = 0;
|
|
}
|
|
").
|
|
|
|
system_temp_dir("", 0, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Global state predicates.
|
|
%
|
|
|
|
:- pragma foreign_proc("C",
|
|
progname(DefaultProgname::in, PrognameOut::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
if (MR_progname) {
|
|
MR_make_aligned_string(PrognameOut, MR_progname);
|
|
} else {
|
|
PrognameOut = DefaultProgname;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
progname(Default::in, PrognameOut::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
may_not_duplicate],
|
|
"
|
|
PrognameOut = jmercury.runtime.JavaInternal.progname;
|
|
if (PrognameOut == null) {
|
|
PrognameOut = Default;
|
|
}
|
|
").
|
|
|
|
% Fallback implementation.
|
|
progname(DefaultProgName, ProgName, !IO) :-
|
|
ProgName = DefaultProgName.
|
|
|
|
progname_base(DefaultName, PrognameBase, !IO) :-
|
|
progname(DefaultName, Progname, !IO),
|
|
PrognameBase = dir.det_basename(Progname).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
command_line_arguments(Args::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, may_not_duplicate,
|
|
no_sharing],
|
|
% no_sharing is okay because the string elements can't reused.
|
|
"{
|
|
int i;
|
|
|
|
// Convert mercury_argv from a vector to a list.
|
|
i = mercury_argc;
|
|
Args = MR_list_empty_msg(MR_ALLOC_ID);
|
|
while (--i >= 0) {
|
|
Args = MR_string_list_cons_msg((MR_Word) mercury_argv[i], Args,
|
|
MR_ALLOC_ID);
|
|
}
|
|
}").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
command_line_arguments(Args::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
string[] arg_vector = System.Environment.GetCommandLineArgs();
|
|
int i = arg_vector.Length;
|
|
Args = list.empty_list();
|
|
// We don't get the 0th argument: it is the executable name.
|
|
while (--i > 0) {
|
|
Args = list.cons(arg_vector[i], Args);
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
command_line_arguments(Args::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
|
|
"
|
|
String[] arg_vector = jmercury.runtime.JavaInternal.args;
|
|
Args = list.empty_list();
|
|
// The argument vector may not be set if Mercury is being used
|
|
// as a library by a native Java application.
|
|
if (arg_vector != null) {
|
|
// arg_vector does not include the executable name.
|
|
for (int i = arg_vector.length - 1; i >= 0; --i) {
|
|
Args = list.cons(arg_vector[i], Args);
|
|
}
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_exit_status(ExitStatus::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
ExitStatus = mercury_exit_status;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
get_exit_status(ExitStatus::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
ExitStatus = System.Environment.ExitCode;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
get_exit_status(ExitStatus::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
may_not_duplicate],
|
|
"
|
|
ExitStatus = jmercury.runtime.JavaInternal.exit_status;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
set_exit_status(ExitStatus::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
mercury_exit_status = (int) ExitStatus;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
set_exit_status(ExitStatus::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
System.Environment.ExitCode = ExitStatus;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
set_exit_status(ExitStatus::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io,
|
|
may_not_duplicate],
|
|
"
|
|
jmercury.runtime.JavaInternal.exit_status = ExitStatus;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma promise_pure(get_environment_var/4).
|
|
get_environment_var(Var, OptValue, !IO) :-
|
|
( if semipure getenv(Var, Value) then
|
|
OptValue0 = yes(Value)
|
|
else
|
|
OptValue0 = no
|
|
),
|
|
OptValue = OptValue0.
|
|
|
|
:- pragma promise_pure(set_environment_var/5).
|
|
set_environment_var(Var, Value, Res, !IO) :-
|
|
( if have_set_environment_var then
|
|
( if impure setenv(Var, Value) then
|
|
Res = ok
|
|
else
|
|
string.format("Could not set environment variable `%s'",
|
|
[s(Var)], Message),
|
|
Res = error(io_error(Message))
|
|
)
|
|
else
|
|
Message = "Cannot set environment variables on this platform",
|
|
Res = error(io_error(Message))
|
|
).
|
|
|
|
set_environment_var(Var, Value, IO0, IO) :-
|
|
io.set_environment_var(Var, Value, Res, IO0, IO1),
|
|
(
|
|
Res = ok,
|
|
IO = IO1
|
|
;
|
|
Res = error(ErrorCode),
|
|
error(io.error_message(ErrorCode))
|
|
).
|
|
|
|
:- pragma foreign_proc("C",
|
|
have_set_environment_var,
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
SUCCESS_INDICATOR = MR_TRUE;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
have_set_environment_var,
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
SUCCESS_INDICATOR = false;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
have_set_environment_var,
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
SUCCESS_INDICATOR = true;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_decl("C", "
|
|
#include <stdlib.h> // for getenv() and setenv()
|
|
").
|
|
|
|
:- pragma foreign_decl("C", "
|
|
// A note regarding the declaration of the environ global variable
|
|
// that follows:
|
|
//
|
|
// The man page (on Linux) says that it should be declared by the user
|
|
// program.
|
|
//
|
|
// On MinGW, environ is a macro (defined in stdlib.h) that expands to a
|
|
// function call that returns the user environment; no additional
|
|
// declaration is required.
|
|
//
|
|
// On Mac OS X shared libraries do not have direct access to environ.
|
|
// The man page for environ(7) says that we should look it up at
|
|
// runtime using _NSGetEnviron().
|
|
|
|
#if defined(MR_HAVE_ENVIRON) && !defined(MR_MAC_OSX)
|
|
#include <unistd.h>
|
|
|
|
#if !defined(MR_MINGW)
|
|
extern char **environ;
|
|
#endif
|
|
#endif
|
|
|
|
#if defined(MR_MAC_OSX)
|
|
#include <crt_externs.h>
|
|
#endif
|
|
|
|
#ifdef MR_HAVE_SPAWN_H
|
|
#include <spawn.h>
|
|
#endif
|
|
").
|
|
|
|
% getenv(Var, Value):
|
|
%
|
|
% Gets the value Value associated with the environment variable Var.
|
|
% Fails if the variable was not set.
|
|
%
|
|
:- semipure pred getenv(string::in, string::out) is semidet.
|
|
|
|
:- pragma foreign_proc("C",
|
|
getenv(Var::in, Value::out),
|
|
[promise_semipure, will_not_call_mercury, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#ifdef MR_WIN32
|
|
wchar_t *ValueW = _wgetenv(ML_utf8_to_wide(Var));
|
|
if (ValueW != NULL) {
|
|
Value = ML_wide_to_utf8(ValueW, MR_ALLOC_ID);
|
|
} else {
|
|
Value = NULL;
|
|
}
|
|
#else
|
|
Value = getenv(Var);
|
|
#endif
|
|
SUCCESS_INDICATOR = (Value != 0);
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
getenv(Var::in, Value::out),
|
|
[promise_semipure, will_not_call_mercury, tabled_for_io],
|
|
"
|
|
Value = System.Environment.GetEnvironmentVariable(Var);
|
|
SUCCESS_INDICATOR = (Value != null);
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
getenv(Var::in, Value::out),
|
|
[promise_semipure, will_not_call_mercury, tabled_for_io,
|
|
may_not_duplicate],
|
|
"
|
|
Value = System.getenv(Var);
|
|
SUCCESS_INDICATOR = (Value != null);
|
|
").
|
|
|
|
% setenv(NameString, ValueString):
|
|
%
|
|
% Sets the named environment variable to the specified value.
|
|
% Fails if the operation does not work.
|
|
%
|
|
:- impure pred setenv(string::in, string::in) is semidet.
|
|
|
|
:- pragma foreign_proc("C",
|
|
setenv(Var::in, Value::in),
|
|
[will_not_call_mercury, not_thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#ifdef MR_WIN32
|
|
SUCCESS_INDICATOR =
|
|
(_wputenv_s(ML_utf8_to_wide(Var), ML_utf8_to_wide(Value)) == 0);
|
|
#else
|
|
SUCCESS_INDICATOR = (setenv(Var, Value, 1) == 0);
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
setenv(Var::in, Value::in),
|
|
[will_not_call_mercury, tabled_for_io],
|
|
"
|
|
try {
|
|
System.Environment.SetEnvironmentVariable(Var, Value);
|
|
SUCCESS_INDICATOR = true;
|
|
} catch (System.Exception) {
|
|
SUCCESS_INDICATOR = false;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
setenv(Var::in, Value::in),
|
|
[will_not_call_mercury, tabled_for_io, may_not_duplicate],
|
|
"
|
|
// Java does not provide a method to set environment variables, only a way
|
|
// to modify the environment when creating a new process.
|
|
|
|
// Avoid warning: Var, Value
|
|
SUCCESS_INDICATOR = false;
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% System access predicates.
|
|
%
|
|
|
|
call_system(Command, Result, !IO) :-
|
|
call_system_return_signal(Command, Result0, !IO),
|
|
(
|
|
Result0 = ok(exited(Code)),
|
|
Result = ok(Code)
|
|
;
|
|
Result0 = ok(signalled(Signal)),
|
|
string.int_to_string(Signal, SignalStr),
|
|
ErrMsg = "system command killed by signal number " ++ SignalStr,
|
|
Result = error(io_error(ErrMsg))
|
|
;
|
|
Result0 = error(Error),
|
|
Result = error(Error)
|
|
).
|
|
|
|
call_system_return_signal(Command, Result, !IO) :-
|
|
call_system_code(Command, Status, Error, !IO),
|
|
is_error(Error, "error invoking system command: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = decode_system_command_exit_code(Status)
|
|
).
|
|
|
|
% call_system_code(Command, Status, Error, !IO):
|
|
%
|
|
% Invokes the operating system shell with the specified Command.
|
|
% Status is valid when Error indicates success.
|
|
%
|
|
:- pred call_system_code(string::in, int::out, system_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
call_system_code(Command::in, Status::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
// In multithreaded grades, try to use posix_spawn() instead of system().
|
|
// There were problems with threads and system() on Linux/glibc, probably
|
|
// because system() uses fork().
|
|
#if defined(MR_THREAD_SAFE) && defined(MR_HAVE_POSIX_SPAWN) && \
|
|
defined(MR_HAVE_ENVIRON)
|
|
|
|
char *argv[4];
|
|
pid_t pid;
|
|
int err;
|
|
int st;
|
|
|
|
argv[0] = (char *) ""sh"";
|
|
argv[1] = (char *) ""-c"";
|
|
argv[2] = Command;
|
|
argv[3] = NULL;
|
|
|
|
// Protect `environ' from concurrent modifications.
|
|
MR_OBTAIN_GLOBAL_LOCK(""io.call_system_code/5"");
|
|
|
|
// See the comment at the head of the body of preceding foreign_decl
|
|
// for details of why Mac OS X is different here.
|
|
#if defined(MR_MAC_OSX)
|
|
err = posix_spawn(&pid, ""/bin/sh"", NULL, NULL, argv,
|
|
*_NSGetEnviron());
|
|
#else
|
|
err = posix_spawn(&pid, ""/bin/sh"", NULL, NULL, argv, environ);
|
|
#endif
|
|
|
|
MR_RELEASE_GLOBAL_LOCK(""io.call_system_code/5"");
|
|
|
|
if (err != 0) {
|
|
// Spawn failed.
|
|
Error = errno;
|
|
} else {
|
|
// Wait for the spawned process to exit.
|
|
do {
|
|
err = waitpid(pid, &st, 0);
|
|
} while (err == -1 && MR_is_eintr(errno));
|
|
if (err == -1) {
|
|
Error = errno;
|
|
} else {
|
|
Status = st;
|
|
Error = 0;
|
|
}
|
|
}
|
|
|
|
#else // !MR_THREAD_SAFE || !MR_HAVE_POSIX_SPAWN || !MR_HAVE_ENVIRON
|
|
|
|
#ifdef MR_WIN32
|
|
Status = _wsystem(ML_utf8_to_wide(Command));
|
|
#else
|
|
Status = system(Command);
|
|
#endif
|
|
|
|
if (Status == -1) {
|
|
Error = errno;
|
|
} else {
|
|
Error = 0;
|
|
}
|
|
|
|
#endif // !MR_THREAD_SAFE || !MR_HAVE_POSIX_SPAWN || !MR_HAVE_ENVIRON
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
call_system_code(Command::in, Status::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
try {
|
|
// XXX This could be better... need to handle embedded spaces
|
|
// in the command name ...
|
|
// XXX ... and redirection, and everything else done by sh.
|
|
int index = Command.IndexOf("" "");
|
|
string command, arguments;
|
|
if (index > 0) {
|
|
command = Command.Substring(0, index);
|
|
arguments = Command.Remove(0, index + 1);
|
|
} else {
|
|
command = Command;
|
|
arguments = """";
|
|
}
|
|
|
|
System.Diagnostics.Process process = new System.Diagnostics.Process();
|
|
// Never interpret the command as a document to open with whatever
|
|
// application is registered for that document type. This also
|
|
// prevents creating a new window for console programs on Windows.
|
|
process.StartInfo.UseShellExecute = false;
|
|
process.StartInfo.FileName = command;
|
|
process.StartInfo.Arguments = arguments;
|
|
process.Start();
|
|
process.WaitForExit();
|
|
Status = process.ExitCode;
|
|
Error = null;
|
|
}
|
|
catch (System.Exception e) {
|
|
Status = 1;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
call_system_code(Command::in, Status::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, may_not_duplicate],
|
|
"
|
|
boolean has_sh;
|
|
try {
|
|
SecurityManager sm = System.getSecurityManager();
|
|
if (sm != null) {
|
|
sm.checkExec(""/bin/sh"");
|
|
has_sh = true;
|
|
} else {
|
|
// If there is no security manager installed we just check if the
|
|
// file exists.
|
|
has_sh = new java.io.File(""/bin/sh"").exists();
|
|
}
|
|
} catch (java.lang.Exception e) {
|
|
has_sh = false;
|
|
}
|
|
|
|
try {
|
|
// Emulate system() if /bin/sh is available.
|
|
java.lang.Process process;
|
|
if (has_sh) {
|
|
final String[] args = {""/bin/sh"", ""-c"", Command};
|
|
process = java.lang.Runtime.getRuntime().exec(args);
|
|
} else {
|
|
process = java.lang.Runtime.getRuntime().exec(Command);
|
|
}
|
|
|
|
StreamPipe stdin = new StreamPipe(mercury_stdin,
|
|
process.getOutputStream());
|
|
StreamPipe stdout = new StreamPipe(process.getInputStream(),
|
|
mercury_stdout);
|
|
StreamPipe stderr = new StreamPipe(process.getErrorStream(),
|
|
mercury_stderr);
|
|
stdin.start();
|
|
stdout.start();
|
|
stderr.start();
|
|
|
|
Status = process.waitFor();
|
|
Error = null;
|
|
|
|
// The stdin StreamPipe is killed off after the Process is finished
|
|
// so as not to waste CPU cycles with a pointless thread.
|
|
stdin.interrupt();
|
|
|
|
// Wait for all the outputs to be written.
|
|
stdout.join();
|
|
stderr.join();
|
|
|
|
if (stdin.exception != null) {
|
|
throw stdin.exception;
|
|
}
|
|
if (stdout.exception != null) {
|
|
throw stdout.exception;
|
|
}
|
|
if (stderr.exception != null) {
|
|
throw stderr.exception;
|
|
}
|
|
} catch (java.lang.Exception e) {
|
|
Status = 1;
|
|
Error = e;
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Managing the globals structure that Mercury attaches to the I/O state.
|
|
%
|
|
|
|
get_globals(Globals, !IO) :-
|
|
lock_globals(!IO),
|
|
unsafe_get_globals(Globals, !IO),
|
|
unlock_globals(!IO).
|
|
|
|
set_globals(Globals, !IO) :-
|
|
lock_globals(!IO),
|
|
unsafe_set_globals(Globals, !IO),
|
|
unlock_globals(!IO).
|
|
|
|
:- pragma promise_pure(update_globals/3).
|
|
update_globals(UpdatePred, !IO) :-
|
|
lock_globals(!IO),
|
|
unsafe_get_globals(Globals0, !IO),
|
|
promise_equivalent_solutions [!:IO] (
|
|
Update = (pred(G::out) is det :-
|
|
UpdatePred(Globals0, G)
|
|
),
|
|
try(Update, UpdateResult),
|
|
(
|
|
UpdateResult = succeeded(Globals),
|
|
unsafe_set_globals(Globals, !IO),
|
|
unlock_globals(!IO)
|
|
;
|
|
% If the update operation threw an exception
|
|
% then release the lock and rethrow the exception.
|
|
UpdateResult = exception(_),
|
|
impure io.unlock_globals,
|
|
rethrow(UpdateResult)
|
|
)
|
|
).
|
|
|
|
:- pred lock_globals(io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
lock_globals(_IO0::di, _IO::uo),
|
|
[promise_pure, will_not_call_mercury, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#ifdef MR_THREAD_SAFE
|
|
MR_LOCK(&ML_io_user_globals_lock, \"io.lock_globals/2\");
|
|
#endif
|
|
").
|
|
|
|
% For the non-C backends.
|
|
lock_globals(!IO).
|
|
|
|
:- pred unlock_globals(io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
unlock_globals(_IO0::di, _IO::uo),
|
|
[promise_pure, will_not_call_mercury, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#ifdef MR_THREAD_SAFE
|
|
MR_UNLOCK(&ML_io_user_globals_lock, \"io.unlock_globals/2\");
|
|
#endif
|
|
").
|
|
|
|
% For the non-C backends.
|
|
unlock_globals(!IO).
|
|
|
|
:- impure pred unlock_globals is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
unlock_globals,
|
|
[will_not_call_mercury, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#ifdef MR_THREAD_SAFE
|
|
MR_UNLOCK(&ML_io_user_globals_lock, \"io.unlock_globals/2\");
|
|
#endif
|
|
").
|
|
|
|
% For the non-C backends.
|
|
unlock_globals :-
|
|
impure impure_true.
|
|
|
|
%---------------------%
|
|
|
|
% NOTE: io.unsafe_{get, set}_globals/3 are marked as `thread_safe' so that
|
|
% calling them to does not acquire the global lock. Since calls to these
|
|
% predicates should be surrounded by calls to io.{lock, unlock}_globals/2,
|
|
% this is safe.
|
|
%
|
|
:- pred unsafe_get_globals(univ::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
unsafe_get_globals(Globals::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness],
|
|
"
|
|
Globals = ML_io_user_globals;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
unsafe_get_globals(Globals::out, _IOState0::di, _IOState::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
Globals = io.ML_io_user_globals;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
unsafe_get_globals(Globals::out, _IOState0::di, _IOState::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, may_not_duplicate],
|
|
"
|
|
Globals = io.ML_io_user_globals;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pred unsafe_set_globals(univ::in, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
unsafe_set_globals(Globals::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
// XXX need to globalize the memory.
|
|
ML_io_user_globals = Globals;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
unsafe_set_globals(Globals::in, _IOState0::di, _IOState::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
io.ML_io_user_globals = Globals;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
unsafe_set_globals(Globals::in, _IOState0::di, _IOState::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, may_not_duplicate],
|
|
"
|
|
io.ML_io_user_globals = Globals;
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Predicates that report statistics about the current program execution.
|
|
%
|
|
|
|
report_stats(!IO) :-
|
|
report_stats("standard", !IO).
|
|
|
|
:- pragma promise_pure(io.report_stats/3).
|
|
report_stats(Selector, !IO) :-
|
|
( if Selector = "standard" then
|
|
impure report_stats
|
|
else if Selector = "full_memory_stats" then
|
|
impure report_full_memory_stats
|
|
else if Selector = "tabling" then
|
|
impure table_builtin.table_report_statistics
|
|
else
|
|
string.format("io.report_stats: selector `%s' not understood",
|
|
[s(Selector)], Message),
|
|
error(Message)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Interpreting I/O error messages.
|
|
%
|
|
|
|
% This definition is subject to change.
|
|
% Note that we use `io_error' rather than `io.error' because io.print,
|
|
% which may be called to print out the uncaught exception if there is
|
|
% no exception handler, does not print out the module name.
|
|
:- type io.error
|
|
---> io_error(string).
|
|
|
|
make_io_error(Error) = io_error(Error).
|
|
|
|
error_message(Error) = Msg :-
|
|
io.error_message(Error, Msg).
|
|
|
|
error_message(io_error(Error), Error).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% For use by library.m.
|
|
%
|
|
|
|
init_state(!IO) :-
|
|
init_std_streams(!IO),
|
|
init_current_streams(!IO),
|
|
io.gc_init(type_of(StreamDb), type_of(Globals), !IO),
|
|
map.init(StreamDb),
|
|
type_to_univ("<globals>", Globals),
|
|
io.set_stream_db(StreamDb, !IO),
|
|
io.set_op_table(ops.init_mercury_op_table, !IO),
|
|
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).
|
|
|
|
:- pred init_current_streams(io::di, io::uo) is det.
|
|
|
|
init_current_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.
|
|
set_input_stream(stdin_stream, _, !IO),
|
|
set_output_stream(stdout_stream, _, !IO),
|
|
stdin_binary_stream(StdinBinary, !IO),
|
|
stdout_binary_stream(StdoutBinary, !IO),
|
|
set_binary_input_stream(StdinBinary, _, !IO),
|
|
set_binary_output_stream(StdoutBinary, _, !IO).
|
|
|
|
:- pragma foreign_proc("C#",
|
|
init_current_streams(_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
// Do nothing in the C# grade -- setting the current streams is handled
|
|
// during class initialization.
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
init_current_streams(_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
// Do nothing in the Java grade -- setting the current streams is handled
|
|
// during class initialization.
|
|
").
|
|
|
|
:- pred gc_init(type_desc::in, type_desc::in, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
gc_init(StreamDbType::in, UserGlobalsType::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, not_thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
// For Windows DLLs, we need to call GC_INIT() from each DLL.
|
|
#ifdef MR_BOEHM_GC
|
|
GC_INIT();
|
|
#endif
|
|
MR_add_root(&ML_io_stream_db, (MR_TypeInfo) StreamDbType);
|
|
MR_add_root(&ML_io_user_globals, (MR_TypeInfo) UserGlobalsType);
|
|
").
|
|
|
|
gc_init(_, _, !IO).
|
|
|
|
:- pred insert_std_stream_names(io::di, io::uo) is det.
|
|
|
|
insert_std_stream_names(!IO) :-
|
|
stdin_stream(input_stream(Stdin), !IO),
|
|
insert_stream_info(Stdin, stream(0, input, preopen, stdin), !IO),
|
|
stdout_stream(output_stream(Stdout), !IO),
|
|
insert_stream_info(Stdout, stream(1, output, preopen, stdout), !IO),
|
|
stderr_stream(output_stream(Stderr), !IO),
|
|
insert_stream_info(Stderr, stream(1, output, preopen, stderr), !IO).
|
|
|
|
% Currently no finalization needed...
|
|
% (Perhaps we should close all open Mercury files?
|
|
% That will happen on process exit anyway, so currently we don't bother.)
|
|
finalize_state(!IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% For use by dir.m.
|
|
%
|
|
|
|
:- pragma foreign_proc("C",
|
|
have_win32,
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#if defined(MR_WIN32)
|
|
SUCCESS_INDICATOR = MR_TRUE;
|
|
#else
|
|
SUCCESS_INDICATOR = MR_FALSE;
|
|
#endif
|
|
").
|
|
|
|
have_win32 :-
|
|
semidet_fail.
|
|
|
|
:- pragma foreign_proc("C",
|
|
have_cygwin,
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#if defined(MR_CYGWIN)
|
|
SUCCESS_INDICATOR = MR_TRUE;
|
|
#else
|
|
SUCCESS_INDICATOR = MR_FALSE;
|
|
#endif
|
|
").
|
|
|
|
have_cygwin :-
|
|
semidet_fail.
|
|
|
|
:- pragma foreign_proc("C#",
|
|
have_dotnet,
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
SUCCESS_INDICATOR = true;
|
|
").
|
|
|
|
have_dotnet :-
|
|
semidet_fail.
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_decl("C", "
|
|
#include <string.h>
|
|
#include <errno.h>
|
|
|
|
// ML_make_err_msg(errnum, msg, alloc_id, error_msg):
|
|
// Append `msg' and a message for errnum to give `error_msg'.
|
|
//
|
|
// WARNING: this must only be called when the `hp' register is valid.
|
|
// That means it must only be called from procedures declared
|
|
// `[will_not_call_mercury, promise_pure]'.
|
|
//
|
|
// This is defined as a macro rather than a C function
|
|
// to avoid worrying about the `hp' register being
|
|
// invalidated by the function call.
|
|
|
|
#define ML_make_err_msg(errnum, msg, alloc_id, error_msg) \\
|
|
do { \\
|
|
char errbuf[MR_STRERROR_BUF_SIZE]; \\
|
|
const char *errno_msg; \\
|
|
size_t total_len; \\
|
|
\\
|
|
errno_msg = MR_strerror(errnum, errbuf, sizeof(errbuf)); \\
|
|
total_len = strlen(msg) + strlen(errno_msg); \\
|
|
MR_allocate_aligned_string_msg((error_msg), total_len, (alloc_id)); \\
|
|
strcpy((error_msg), msg); \\
|
|
strcat((error_msg), errno_msg); \\
|
|
} while(0)
|
|
|
|
// ML_make_win32_err_msg(error, msg, alloc_id, error_msg):
|
|
// Append `msg' and the string returned by the Win32 API function
|
|
// FormatMessage() for the last error to give `error_msg'.
|
|
//
|
|
// WARNING: this must only be called when the `hp' register is valid.
|
|
// That means it must only be called from procedures declared
|
|
// `[will_not_call_mercury]'.
|
|
//
|
|
// This is defined as a macro rather than a C function
|
|
// to avoid worrying about the `hp' register being
|
|
// invalidated by the function call.
|
|
|
|
#ifdef MR_WIN32
|
|
|
|
#define ML_make_win32_err_msg(error, msg, alloc_id, error_msg) \\
|
|
do { \\
|
|
size_t total_len; \\
|
|
LPVOID err_buf; \\
|
|
MR_bool free_err_buf = MR_TRUE; \\
|
|
\\
|
|
if (!FormatMessage( \\
|
|
FORMAT_MESSAGE_ALLOCATE_BUFFER \\
|
|
| FORMAT_MESSAGE_FROM_SYSTEM \\
|
|
| FORMAT_MESSAGE_IGNORE_INSERTS, \\
|
|
NULL, \\
|
|
error, \\
|
|
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), \\
|
|
(LPTSTR) &err_buf, \\
|
|
0, \\
|
|
NULL)) \\
|
|
{ \\
|
|
free_err_buf = MR_FALSE; \\
|
|
err_buf = (LPVOID) ""could not retrieve error message""; \\
|
|
} \\
|
|
total_len = strlen(msg) + strlen((char *)err_buf); \\
|
|
MR_allocate_aligned_string_msg((error_msg), total_len, (alloc_id)); \\
|
|
strcpy((error_msg), msg); \\
|
|
strcat((error_msg), (char *)err_buf); \\
|
|
if (free_err_buf) { \\
|
|
LocalFree(err_buf); \\
|
|
} \\
|
|
} while(0)
|
|
|
|
#endif // !MR_WIN32
|
|
").
|
|
|
|
:- func no_error = system_error.
|
|
|
|
:- pragma foreign_proc("C",
|
|
no_error = (Error::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
Error = 0;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
no_error = (Error::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
Error = null;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
no_error = (Error::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
Error = null;
|
|
").
|
|
|
|
:- pred is_success(system_error::in) is semidet.
|
|
|
|
:- pragma foreign_proc("C",
|
|
is_success(Error::in),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
// This works for errno and Win32 error values (ERROR_SUCCESS == 0).
|
|
SUCCESS_INDICATOR = (Error == 0) ? MR_TRUE : MR_FALSE;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
is_success(Error::in),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
SUCCESS_INDICATOR = (Error == null);
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
is_success(Error::in),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
SUCCESS_INDICATOR = (Error == null);
|
|
").
|
|
|
|
is_error(Error, Prefix, MaybeError, !IO) :-
|
|
( if is_success(Error) then
|
|
MaybeError = no
|
|
else
|
|
make_err_msg(Error, Prefix, Message, !IO),
|
|
IOError = io_error(Message),
|
|
MaybeError = yes(IOError)
|
|
).
|
|
|
|
is_maybe_win32_error(Error, Prefix, MaybeError, !IO) :-
|
|
( if is_success(Error) then
|
|
MaybeError = no
|
|
else
|
|
make_maybe_win32_err_msg(Error, Prefix, Message, !IO),
|
|
IOError = io_error(Message),
|
|
MaybeError = yes(IOError)
|
|
).
|
|
|
|
:- pragma foreign_proc("C",
|
|
make_err_msg(Error::in, Msg0::in, Msg::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness, no_sharing, tabled_for_io],
|
|
"
|
|
ML_make_err_msg(Error, Msg0, MR_ALLOC_ID, Msg);
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
make_err_msg(Error::in, Msg0::in, Msg::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
Msg = System.String.Concat(Msg0, Error.Message);
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
make_err_msg(Error::in, Msg0::in, Msg::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
if (Error.getMessage() != null) {
|
|
Msg = Msg0 + Error.getMessage();
|
|
} else {
|
|
Msg = Msg0;
|
|
}
|
|
").
|
|
|
|
make_maybe_win32_err_msg(Error, Msg0, Msg, !IO) :-
|
|
( if have_win32 then
|
|
make_win32_err_msg(Error, Msg0, Msg, !IO)
|
|
else
|
|
make_err_msg(Error, Msg0, Msg, !IO)
|
|
).
|
|
|
|
:- pred make_win32_err_msg(system_error::in, string::in, string::out,
|
|
io::di, io::uo) is det.
|
|
|
|
make_win32_err_msg(_, _, "", !IO) :-
|
|
( if semidet_succeed then
|
|
error("io.make_win32_err_msg called for non Win32 back-end")
|
|
else
|
|
true
|
|
).
|
|
|
|
% Is FormatMessage thread-safe?
|
|
%
|
|
:- pragma foreign_proc("C",
|
|
make_win32_err_msg(Error::in, Msg0::in, Msg::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, does_not_affect_liveness,
|
|
no_sharing, tabled_for_io],
|
|
"
|
|
#ifdef MR_WIN32
|
|
ML_make_win32_err_msg(Error, Msg0, MR_ALLOC_ID, Msg);
|
|
#else
|
|
MR_fatal_error(""io.make_win32_err_msg called on non-Windows platform"");
|
|
#endif
|
|
").
|
|
|
|
:- pred throw_on_error(system_error::in, string::in, io::di, io::uo) is det.
|
|
|
|
throw_on_error(Error, Prefix, !IO) :-
|
|
is_error(Error, Prefix, MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
throw(IOError)
|
|
;
|
|
MaybeIOError = no
|
|
).
|
|
|
|
:- pred throw_on_output_error(system_error::in, io::di, io::uo) is det.
|
|
|
|
throw_on_output_error(Error, !IO) :-
|
|
throw_on_error(Error, "error writing to output file: ", !IO).
|
|
|
|
:- pred throw_on_close_error(system_error::in, io::di, io::uo) is det.
|
|
|
|
throw_on_close_error(Error, !IO) :-
|
|
throw_on_error(Error, "error closing file: ", !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- type file_id
|
|
---> file_id.
|
|
|
|
:- pragma foreign_type("C", file_id, "ML_File_Id")
|
|
where comparison is compare_file_id.
|
|
|
|
:- pragma foreign_decl("C", "
|
|
#ifdef MR_HAVE_DEV_T
|
|
typedef dev_t ML_dev_t;
|
|
#else
|
|
typedef MR_Integer ML_dev_t;
|
|
#endif
|
|
|
|
#ifdef MR_HAVE_INO_T
|
|
typedef ino_t ML_ino_t;
|
|
#else
|
|
typedef MR_Integer ML_ino_t;
|
|
#endif
|
|
|
|
typedef struct {
|
|
ML_dev_t device;
|
|
ML_ino_t inode;
|
|
} ML_File_Id;
|
|
").
|
|
|
|
:- pred compare_file_id(comparison_result::uo, file_id::in, file_id::in)
|
|
is det.
|
|
:- pragma consider_used(compare_file_id/3).
|
|
|
|
compare_file_id(Result, FileId1, FileId2) :-
|
|
compare_file_id_2(Result0, FileId1, FileId2),
|
|
( if Result0 < 0 then
|
|
Result = (<)
|
|
else if Result0 = 0 then
|
|
Result = (=)
|
|
else
|
|
Result = (>)
|
|
).
|
|
|
|
:- pred compare_file_id_2(int::out, file_id::in, file_id::in) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_file_id_2(Res::out, FileId1::in, FileId2::in),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
int device_cmp;
|
|
int inode_cmp;
|
|
|
|
// For compilers other than GCC, glibc defines dev_t as struct (dev_t
|
|
// is 64 bits, and other compilers may not have a 64 bit arithmetic type).
|
|
// XXX This code assumes that dev_t and ino_t do not include padding bits.
|
|
// In practice, that should be OK.
|
|
device_cmp = memcmp(&(FileId1.device), &(FileId2.device),
|
|
sizeof(ML_dev_t));
|
|
|
|
if (device_cmp < 0) {
|
|
Res = -1;
|
|
} else if (device_cmp > 0) {
|
|
Res = 1;
|
|
} else {
|
|
inode_cmp = memcmp(&(FileId1.inode), &(FileId2.inode),
|
|
sizeof(ML_ino_t));
|
|
if (inode_cmp < 0) {
|
|
Res = -1;
|
|
} else if (inode_cmp > 0) {
|
|
Res = 1;
|
|
} else {
|
|
Res = 0;
|
|
}
|
|
}
|
|
").
|
|
|
|
compare_file_id_2(_, _, _) :-
|
|
unexpected($pred, "File IDs are not supported by Java").
|
|
|
|
file_id(FileName, Result, !IO) :-
|
|
file_id_2(FileName, FileId, Error, !IO),
|
|
is_error(Error, "cannot get file id: ", MaybeIOError, !IO),
|
|
(
|
|
MaybeIOError = yes(IOError),
|
|
Result = error(IOError)
|
|
;
|
|
MaybeIOError = no,
|
|
Result = ok(FileId)
|
|
).
|
|
|
|
:- pred file_id_2(string::in, file_id::out, system_error::out, io::di, io::uo)
|
|
is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
file_id_2(FileName::in, FileId::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
// Win32 returns junk in the st_ino field of `struct stat'.
|
|
#if defined(MR_HAVE_STAT) && !defined(MR_WIN32)
|
|
struct stat s;
|
|
int stat_result = stat(FileName, &s);
|
|
|
|
if (stat_result == 0) {
|
|
FileId.device = s.st_dev;
|
|
FileId.inode = s.st_ino;
|
|
Error = 0;
|
|
} else {
|
|
Error = errno;
|
|
}
|
|
#else
|
|
Error = ENOSYS;
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
file_id_2(_FileName::in, _FileId::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
Error = new System.NotSupportedException(
|
|
""io.file_id not supported on this platform"");
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
file_id_2(_FileName::in, _FileId::out, Error::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
Error = new java.lang.UnsupportedOperationException(
|
|
""io.file_id not supported on this platform"");
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% For use by term_io.m.
|
|
%
|
|
|
|
% XXX Design flaw with regard to unique modes and io.get_op_table.
|
|
|
|
get_op_table(ops.init_mercury_op_table, !IO).
|
|
|
|
set_op_table(_OpTable, !IO).
|
|
|
|
%---------------------%
|
|
%
|
|
% For use by browser/browse.m.
|
|
%
|
|
|
|
% Caller must hold the stream_db lock.
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_stream_db(StreamDb::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness],
|
|
"
|
|
StreamDb = ML_io_stream_db;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
get_stream_db(StreamDb::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
StreamDb = io.ML_io_stream_db;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
get_stream_db(StreamDb::out, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
StreamDb = io.ML_io_stream_db;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
% Caller must NOT hold the stream_db lock.
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_stream_db_with_locking(StreamDb::out),
|
|
[will_not_call_mercury, thread_safe, tabled_for_io],
|
|
"
|
|
MR_LOCK(&ML_io_stream_db_lock, ""io.get_stream_db/1"");
|
|
StreamDb = ML_io_stream_db;
|
|
MR_UNLOCK(&ML_io_stream_db_lock, ""io.get_stream_db/1"");
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
get_stream_db_with_locking(StreamDb::out),
|
|
[will_not_call_mercury, tabled_for_io],
|
|
"
|
|
StreamDb = io.ML_io_stream_db;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
get_stream_db_with_locking(StreamDb::out),
|
|
[will_not_call_mercury, tabled_for_io],
|
|
"
|
|
StreamDb = io.ML_io_stream_db;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
% Caller must hold the stream_db lock.
|
|
%
|
|
:- pred set_stream_db(io.stream_db::in, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
set_stream_db(StreamDb::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
ML_io_stream_db = StreamDb;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
set_stream_db(StreamDb::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
io.ML_io_stream_db = StreamDb;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
set_stream_db(StreamDb::in, _IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
io.ML_io_stream_db = StreamDb;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pred lock_stream_db(io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
io.lock_stream_db(_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
no_sharing],
|
|
"
|
|
MR_LOCK(&ML_io_stream_db_lock, ""io.lock_stream_db/2"");
|
|
").
|
|
|
|
lock_stream_db(!IO).
|
|
|
|
:- pred unlock_stream_db(io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
unlock_stream_db(_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
|
|
no_sharing],
|
|
"
|
|
MR_UNLOCK(&ML_io_stream_db_lock, ""io.unlock_stream_db/2"");
|
|
").
|
|
|
|
unlock_stream_db(!IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred stream_name(stream::in, string::out, io::di, io::uo) is det.
|
|
|
|
stream_name(Stream, Name, !IO) :-
|
|
stream_info(Stream, MaybeInfo, !IO),
|
|
(
|
|
MaybeInfo = yes(Info),
|
|
Info = stream(_, _, _, Source),
|
|
Name = source_name(Source)
|
|
;
|
|
MaybeInfo = no,
|
|
Name = "<stream name unavailable>"
|
|
).
|
|
|
|
:- pred stream_info(io.stream::in, maybe(stream_info)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
stream_info(Stream, MaybeInfo, !IO) :-
|
|
lock_stream_db(!IO),
|
|
get_stream_db(StreamDb, !IO),
|
|
unlock_stream_db(!IO),
|
|
( if map.search(StreamDb, get_stream_id(Stream), Info) then
|
|
MaybeInfo = yes(Info)
|
|
else
|
|
MaybeInfo = no
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
input_stream_info(StreamDb, input_stream(Stream)) =
|
|
maybe_stream_info(StreamDb, Stream).
|
|
|
|
binary_input_stream_info(StreamDb, binary_input_stream(Stream)) =
|
|
maybe_stream_info(StreamDb, Stream).
|
|
|
|
%---------------------%
|
|
|
|
output_stream_info(StreamDb, output_stream(Stream)) =
|
|
maybe_stream_info(StreamDb, Stream).
|
|
|
|
binary_output_stream_info(StreamDb, binary_output_stream(Stream)) =
|
|
maybe_stream_info(StreamDb, Stream).
|
|
|
|
%---------------------%
|
|
|
|
:- func maybe_stream_info(io.stream_db, io.stream) = maybe_stream_info.
|
|
|
|
maybe_stream_info(StreamDb, Stream) = Info :-
|
|
( if map.search(StreamDb, get_stream_id(Stream), Info0) then
|
|
% Info0 and Info have different types.
|
|
Info0 = stream(Id, Mode, Content, Source),
|
|
Info = stream(Id, Mode, Content, Source)
|
|
else
|
|
Info = unknown_stream
|
|
).
|
|
|
|
get_io_stream_info(StreamDB, Stream) = StreamInfo :-
|
|
( if dynamic_cast(Stream, input_stream(IOStream0)) then
|
|
IOStream = IOStream0
|
|
else if dynamic_cast(Stream, output_stream(IOStream0)) then
|
|
IOStream = IOStream0
|
|
else if dynamic_cast(Stream, binary_input_stream(IOStream0)) then
|
|
IOStream = IOStream0
|
|
else if dynamic_cast(Stream, binary_output_stream(IOStream0)) then
|
|
IOStream = IOStream0
|
|
else if dynamic_cast(Stream, IOStream0) then
|
|
IOStream = IOStream0
|
|
else
|
|
fail
|
|
),
|
|
StreamInfo = io.maybe_stream_info(StreamDB, IOStream).
|
|
|
|
:- func source_name(stream_source) = string.
|
|
|
|
source_name(file(Name)) = Name.
|
|
source_name(stdin) = "<standard input>".
|
|
source_name(stdout) = "<standard output>".
|
|
source_name(stderr) = "<standard error>".
|
|
|
|
%---------------------%
|
|
|
|
:- func get_stream_id(stream) = stream_id.
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_stream_id(Stream::in) = (Id::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
#ifndef MR_NATIVE_GC
|
|
// Most of the time, we can just use the pointer to the stream
|
|
// as a unique identifier.
|
|
Id = (MR_Word) Stream;
|
|
#else
|
|
// For accurate GC we embed an ID in the MercuryFile
|
|
// and retrieve it here.
|
|
Id = (Stream)->id;
|
|
#endif
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
get_stream_id(Stream::in) = (Id::out),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
Id = Stream.id;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
get_stream_id(Stream::in) = (Id::out),
|
|
[will_not_call_mercury, promise_pure, may_not_duplicate],
|
|
"
|
|
Id = Stream.id;
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% For use by compiler/process_util.m.
|
|
%
|
|
|
|
decode_system_command_exit_code(Code0) = Status :-
|
|
decode_system_command_exit_code(Code0, Exited, ExitCode, Signalled,
|
|
Signal),
|
|
(
|
|
Exited = yes,
|
|
Status = ok(exited(ExitCode))
|
|
;
|
|
Exited = no,
|
|
(
|
|
Signalled = yes,
|
|
Status = ok(signalled(Signal))
|
|
;
|
|
Signalled = no,
|
|
Status = error(io_error("unknown result code from system command"))
|
|
)
|
|
).
|
|
|
|
% Interpret the child process exit status returned by system() or wait():
|
|
%
|
|
:- pred decode_system_command_exit_code(int::in, bool::out, int::out,
|
|
bool::out, int::out) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
decode_system_command_exit_code(Status0::in, Exited::out, Status::out,
|
|
Signalled::out, Signal::out),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, no_sharing],
|
|
"
|
|
Exited = MR_NO;
|
|
Status = 0;
|
|
Signalled = MR_NO;
|
|
Signal = 0;
|
|
|
|
#if defined (WIFEXITED) && defined (WEXITSTATUS) && \
|
|
defined (WIFSIGNALED) && defined (WTERMSIG)
|
|
if (WIFEXITED(Status0)) {
|
|
Exited = MR_YES;
|
|
Status = WEXITSTATUS(Status0);
|
|
} else if (WIFSIGNALED(Status0)) {
|
|
Signalled = MR_YES;
|
|
Signal = -WTERMSIG(Status0);
|
|
}
|
|
#else
|
|
Exited = MR_YES;
|
|
Status = Status0;
|
|
#endif
|
|
").
|
|
|
|
% This is a fall-back for back-ends that don't support the C interface.
|
|
decode_system_command_exit_code(Status, yes, Status, no, 0).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Predicates to temporarily change the input/output stream.
|
|
% XXX We should not need these if we passed streams explicitly everywhere.
|
|
%
|
|
|
|
:- pred with_input_stream(input_stream, pred(T, io, io), T, io, io).
|
|
:- mode with_input_stream(in, pred(out, di, uo) is det, out, di, uo) is det.
|
|
:- mode with_input_stream(in, pred(out, di, uo) is cc_multi, out, di, uo)
|
|
is cc_multi.
|
|
|
|
with_input_stream(Stream, Pred, Result, !IO) :-
|
|
set_input_stream(Stream, OrigStream, !IO),
|
|
finally(Pred, Result,
|
|
restore_input_stream(Pred, OrigStream), _CleanupRes, !IO).
|
|
|
|
:- pred with_output_stream(output_stream, pred(io, io), io, io).
|
|
:- mode with_output_stream(in, pred(di, uo) is det, di, uo) is det.
|
|
:- mode with_output_stream(in, pred(di, uo) is cc_multi, di, uo) is cc_multi.
|
|
|
|
with_output_stream(Stream, Pred, !IO) :-
|
|
set_output_stream(Stream, OrigStream, !IO),
|
|
finally(call_pred_no_result(Pred), _Result,
|
|
restore_output_stream(Pred, OrigStream), _CleanupRes, !IO).
|
|
|
|
:- pred call_pred_no_result(pred(io, io), {}, io, io).
|
|
:- mode call_pred_no_result(pred(di, uo) is det, out, di, uo) is det.
|
|
:- mode call_pred_no_result(pred(di, uo) is cc_multi, out, di, uo)
|
|
is cc_multi.
|
|
|
|
call_pred_no_result(Pred, {}, !IO) :-
|
|
Pred(!IO).
|
|
|
|
:- pragma no_determinism_warning(restore_input_stream/5).
|
|
:- pred restore_input_stream(pred(T, io, io), input_stream, io.res, io, io).
|
|
:- mode restore_input_stream(pred(out, di, uo) is det, in, out, di, uo)
|
|
is det.
|
|
:- mode restore_input_stream(pred(out, di, uo) is cc_multi, in, out, di, uo)
|
|
is cc_multi.
|
|
|
|
restore_input_stream(_DummyPred, Stream, ok, !IO) :-
|
|
set_input_stream(Stream, _OldStream, !IO).
|
|
|
|
:- pragma no_determinism_warning(restore_output_stream/5).
|
|
:- pred restore_output_stream(pred(io, io), output_stream, io.res, io, io).
|
|
:- mode restore_output_stream(pred(di, uo) is det, in, out, di, uo) is det.
|
|
:- mode restore_output_stream(pred(di, uo) is cc_multi, in, out, di, uo)
|
|
is cc_multi.
|
|
|
|
restore_output_stream(_DummyPred, Stream, ok, !IO) :-
|
|
set_output_stream(Stream, _OldStream, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|