[m-rev.] for review: bit buffers
Simon Taylor
staylr at gmail.com
Mon May 28 20:56:17 AEST 2007
On 14-May-2007, Julien Fischer <juliensf at csse.unimelb.edu.au> wrote:
> On Mon, 14 May 2007, Simon Taylor wrote:
> > Add a function `append_list' to condense a list of bitmaps.
>
> I think it should be called `condense_list' rather than `append_list'.
> (For symmetry with list.condense/2).
I thought of calling it that, but bitmap.append list has more in
common with string.append_list. I'll leave it as one for the Great
Library V2 Renaming.
> >+:- module bit_buffer.
> >+
> >+:- interface.
>
> For consistency with the other library modules remove the blank line
> between the module and interface declarations.
Done (and for the other modules).
> That can have an `can_pass_as_mercury_type' annotation attached to it.
Done.
The stream.bulk_writer class has been removed.
The interface to bit_buffer.read has been changed to match the
stream.bulk_reader class.
stream.bulk_get now returns `ok' or `error(...)', but not `eof'.
I did this because it was unclear what a result of `ok' on a read
returning less than the number of units requested read would mean.
`eof' was expressed both in the `stream.result' and in the returned
number of units read. I also removed error checking from
bit_buffer.read.m that really belongs in the user of the read_buffer.
Simon.
Estimated hours taken: 90
Branches: main
NEWS:
library/bit_buffer.m:
library/bit_buffer.read.m:
library/bit_buffer.write.m:
Add bit_buffers to the standard library. A bit_buffer
provides a bit-oriented interface to byte streams.
These will be used as a base for write_binary and read_binary.
library/stream.m:
Add classes bulk_writer and bulk_reader, which support
reading and writing multiple items at once into a store.
Clarify the blocking behaviour of `put' and `get'.
Document the behaviour of subsequent calls to `get'
after a call returns eof or an error.
library/bitmap.m:
Add a shorthand for `new(N, no)'.
Add `shrink_without_copying' to destructively shrink a bitmap
without copying the data.
Add a function `append_list' to condense a list of bitmaps.
Improve bounds error messages.
Clean up the handling of zero-length bit ranges.
Add type `bitmap.slice' to represent a segment of a bitmap,
and functions to create slices.
library/io.m:
Change the interface of io.read_bitmap to conform to
the stream.bulk_reader interface, by not returning the
bitmap inside the return code. The bitmap is still
valid (although maybe not completely filled) no matter
what result is returned.
Add io.read_binary_file_as_bitmap/N.
library/library.m:
Add recent additions to the list of library modules.
library/Mercury.options:
Use "+=" rather than "=" when setting target-specific
options to allow them to be added to be Mmake.params.
tests/hard_coded/Mmakefile:
tests/hard_coded/bit_buffer_test.m:
tests/hard_coded/bit_buffer_test.exp:
Test case.
tests/hard_coded/bitmap_test.m:
tests/hard_coded/bitmap_simple.m:
tests/hard_coded/bitmap_test.exp:
Update for change to io.read_bitmap.
Test bounds error messages.
diff -u NEWS NEWS
--- NEWS
+++ NEWS
@@ -108,7 +108,6 @@
shrink_without_copying/2
append_list/1
to_byte_string/1
- xor/2
* The operations in bitmap.m and version_bitmap.m which treat bitmaps
as sets have been modified to throw an exception when the input
@@ -116,9 +115,7 @@
computed the wrong answer when the input bitmaps were of different sizes.
* bitmap.difference/2 and version_bitmap.difference/2 now compute difference,
- not xor.
-
-* bitmap.xor/2 and version_bitmap.xor/2 have been added.
+ not xor. bitmap.xor/2 and version_bitmap.xor/2 have been added.
* Version bitmaps now have a field `bit' for getting and setting a single bit.
diff -u library/bit_buffer.m library/bit_buffer.m
--- library/bit_buffer.m
+++ library/bit_buffer.m
@@ -10,8 +10,8 @@
% Stability: low.
%
% A bit buffer provides an interface between bit-oriented I/O requests
-% and byte-oriented streams, storing bits until there are enough bytes
-% to make calling the `bulk_put' method worthwhile.
+% and byte-oriented streams. The useful part of the interface is defined
+% in bit_buffer.read and bit_buffer.write.
%
% CAVEAT: the user is referred to the documentation in the header
% of array.m regarding programming with unique objects (the compiler
@@ -24,7 +24,6 @@
%-----------------------------------------------------------------------------%
:- module bit_buffer.
-
:- interface.
:- import_module bitmap.
@@ -48,7 +47,7 @@
error_state, error_stream_error).
:- instance stream.output(error_stream, error_state).
-:- instance stream.bulk_writer(error_stream, byte_index, bitmap, error_state).
+:- instance stream.writer(error_stream, bitmap.slice, error_state).
%-----------------------------------------------------------------------------%
@@ -83,10 +82,10 @@
flush(_, !State) :- throw(error_stream_error)
].
-:- instance stream.bulk_writer(error_stream, byte_index, bitmap, error_state)
+:- instance stream.writer(error_stream, bitmap.slice, error_state)
where
[
- bulk_put(_, _, _, _, !State) :- throw(error_stream_error)
+ put(_, _, _, _) :- throw(error_stream_error)
].
% The bitmap has room for the chunk size given as an argument
@@ -153,7 +152,7 @@
").
:- pragma foreign_type("C", bit_buffer(Stream, State, Error),
- "ML_BitBufferPtr").
+ "ML_BitBufferPtr", [can_pass_as_mercury_type]).
:- func new_buffer(bitmap, bit_index, num_bits, bool, Stream, State) =
bit_buffer(Stream, State, Error).
diff -u library/bit_buffer.read.m library/bit_buffer.read.m
--- library/bit_buffer.read.m
+++ library/bit_buffer.read.m
@@ -13,6 +13,15 @@
% and byte-oriented streams, getting a large chunk of bits with one call
% to `bulk_get', then satisfying bit-oriented requests from the buffer.
%
+% Return values of `error(...)' are only used for errors in the stream
+% being read. Once an error value has been returned, all future calls
+% will return that error.
+%
+% Bounds errors or invalid argument errors (for example a read request
+% for a negative number of bits) will result in an exception being thrown.
+% Requests triggering an exception in this way will not change the state
+% of the stream.
+%
% CAVEAT: the user is referred to the documentation in the header
% of array.m regarding programming with unique objects (the compiler
% does not currently recognise them, hence we are forced to use
@@ -24,7 +33,6 @@
%-----------------------------------------------------------------------------%
:- module bit_buffer.read.
-
:- interface.
:- import_module io.
@@ -38,50 +46,6 @@
:- type io_read_buffer ==
read_buffer(io.binary_input_stream, io.state, io.error).
- % Read buffers are typically used to read a record from an input stream
- % using a number of read requests.
- %
- % Normally the user will call `buffer_status/3' to check that more
- % bits are available and the stream and buffer are not in an error
- % state before attempting to read a record from the buffer.
- %
- % It is an error for end-of-file to occur in the middle of a record.
- % If a read request cannot be fully satisfied,
- % `error(buffer_error(unexpected_eof))' is returned.
- %
- % Return values of `error(...)' are only used for errors in the stream
- % being read or mismatches between the read requests and the stream being
- % read. Once an error value has been returned, all future calls will
- % return that error.
- %
- % Bounds errors or invalid argument errors (for example a read request
- % for a negative number of bits) will result in an exception being thrown.
- % Requests triggering an exception in this way will not change the state
- % of the stream.
- %
-:- type read_error(Error)
- ---> stream_error(Error)
- ; buffer_error(buffer_error)
- .
-
-:- type buffer_error
- --->
- % A request couldn't be satisfied because end of stream
- % was reached.
- %
- unexpected_eof
-
- % The writer was expected to pad to a byte boundary with
- % zero bits, but some one bits were found.
- %
- ; expected_padding_zeros
- .
-
-:- type bit_buffer_result(T, Error) == stream.result(T, read_error(Error)).
-:- type bit_buffer_result(Error) == stream.result(read_error(Error)).
-:- type bit_buffer_res(T, Error) == stream.res(T, read_error(Error)).
-:- type bit_buffer_res(Error) == stream.res(read_error(Error)).
-
:- inst uniq_read_buffer == ground. % XXX Should be unique.
:- mode read_buffer_di == in(uniq_read_buffer).
:- mode read_buffer_ui == in(uniq_read_buffer).
@@ -98,7 +62,7 @@
:- mode new(in, in, di) = read_buffer_uo is det.
% new(BitIndex, StartIndex, NumBits)
- % Create a buffer which reads bits from a bitmaap, not from a stream.
+ % Create a buffer which reads bits from a bitmap, not from a stream.
%
:- func new_bitmap_reader(bitmap, bit_index, num_bits) = read_buffer.
:- mode new_bitmap_reader(in, in, in) = read_buffer_uo is det.
@@ -114,7 +78,7 @@
% Find out whether there are bits left in the stream or an error
% has been found.
%
-:- pred buffer_status(bit_buffer_result(Error),
+:- pred buffer_status(stream.result(Error),
read_buffer(Stream, State, Error),
read_buffer(Stream, State, Error))
<= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
@@ -122,46 +86,42 @@
% Read a bit from the buffer.
%
-:- pred get_bit(bit_buffer_res(bool, Error), read_buffer(Stream, State, Error),
+ % This implements the get/4 method of class stream.reader.
+ %
+:- pred get_bit(stream.result(bool, Error), read_buffer(Stream, State, Error),
read_buffer(Stream, State, Error))
<= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
:- mode get_bit(out, read_buffer_di, read_buffer_uo) is det.
- % Read bits from the buffer into the low-order bits of an int.
- % The number of bits must be less than int.bits_per_int.
- % Returns `error(buffer_error(unexpected_eof))' if there are
- % not enough bits to satisfy this request, in which case no
- % bits are read from the buffer.
+ % get_bits(Index, NumBits, !Word, NumBitsRead, Result, !Buffer).
%
-:- pred get_bits(num_bits, bit_buffer_res(word, Error),
- read_buffer(Stream, State, Error), read_buffer(Stream, State, Error))
- <= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
-:- mode get_bits(in, out, read_buffer_di, read_buffer_uo) is det.
-
- % Read eight bits from the buffer into the low-order bits of an int.
- % Returns `error(buffer_error(unexpected_eof))' if there are
- % not enough bits to satisfy this request, in which case no bits
- % are removed from the buffer.
+ % Read NumBits bits from the buffer into a word starting at Index,
+ % where the highest order bit is bit zero.
+ % 0 =< NumBits =< int.bits_per_int.
%
-:- pred get_byte(bit_buffer_res(byte, Error),
- read_buffer(Stream, State, Error), read_buffer(Stream, State, Error))
+ % This implements the bulk_get/9 method of stream.bulk_reader.
+ %
+ % To read into the lower order bits of the word, use
+ % `get_bits(bits_per_int - NumBits, NumBits, ...)'.
+ %
+:- pred get_bits(bit_index, num_bits, word, word, num_bits,
+ stream.res(Error), read_buffer(Stream, State, Error),
+ read_buffer(Stream, State, Error))
<= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
-:- mode get_byte(out, read_buffer_di, read_buffer_uo) is det.
+:- mode get_bits(in, in, di, uo, out, out,
+ read_buffer_di, read_buffer_uo) is det.
% get_bitmap(!Bitmap, NumBitsRead, Result, !Buffer)
%
% Fill a bitmap from the buffered stream, returning the number
% of bits read.
%
- % Result is `error(buffer_error(unexpected_eof))' if there are
- % not enough bits to satisfy this request.
- %
% Note that this is much more efficient if the initial position in
% the buffer is at a byte boundary (for example after a call to
% skip_padding_to_byte).
%
:- pred get_bitmap(bitmap, bitmap, num_bits,
- bit_buffer_res(Error), read_buffer(Stream, State, Error),
+ stream.res(Error), read_buffer(Stream, State, Error),
read_buffer(Stream, State, Error))
<= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
:- mode get_bitmap(bitmap_di, bitmap_uo, out, out,
@@ -169,24 +129,26 @@
% get_bitmap(Index, NumBits, !Bitmap, NumBitsRead, Result, !Buffer)
%
- % Result is `error(buffer_error(unexpected_eof))' if there are
- % not enough bits to satisfy this request.
- %
% Note that this is much more efficient if both Index and the initial
% position in the buffer are both at a byte boundary (for example after
% a call to skip_padding_to_byte).
%
+ % This implements the bulk_get method of stream.bulk_reader.
+ %
:- pred get_bitmap(bit_index, num_bits, bitmap, bitmap, num_bits,
- bit_buffer_res(Error), read_buffer(Stream, State, Error),
+ stream.res(Error), read_buffer(Stream, State, Error),
read_buffer(Stream, State, Error))
<= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
:- mode get_bitmap(in, in, bitmap_di, bitmap_uo, out, out,
read_buffer_di, read_buffer_uo) is det.
- % Skip padding zero bits to the next byte boundary.
- % Returns `expected_padding_zeros' if any of the bits are set.
+ % Skip padding zero bits to the next byte boundary, if the
+ % buffer is not already at a byte boundary.
+ % Returns `ok(yes)' if the bits skipped were all zeroes.
+ % Returns `ok(no)' if some bits skipped were ones.
+ % Returns `error(...)' for a stream error.
%
-:- pred skip_padding_to_byte(bit_buffer_res(Error),
+:- pred skip_padding_to_byte(stream.res(bool, Error),
read_buffer(Stream, State, Error), read_buffer(Stream, State, Error))
<= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
:- mode skip_padding_to_byte(out, read_buffer_di, read_buffer_uo) is det.
@@ -204,6 +166,43 @@
%-----------------------------------------------------------------------------%
:- implementation.
+/*
+** None of these instances work because of limitations in the type and
+** RTTI system.
+**
+
+:- interface.
+
+ %
+ % A bit buffer is a stream of bits.
+ %
+
+:- type read_buffer_stream
+ ---> read_buffer_stream.
+
+:- instance stream.stream(read_buffer_stream,
+ read_buffer(Stream, State, Error))
+ <= stream.bulk_reader(Stream, bit_index, bitmap, State, Error).
+
+:- instance stream.input(read_buffer_stream, read_buffer(Stream, State, Error))
+ <= stream.input(Stream, State).
+
+:- instance stream.reader(read_buffer_stream, bool,
+ read_buffer(Stream, State, Error), Error)
+ <= stream.bulk_reader(Stream, bit_index, bitmap, State, Error).
+
+:- instance stream.bulk_reader(read_buffer_stream, bit_index, word,
+ read_buffer(Stream, State, Error), Error)
+ <= stream.bulk_reader(Stream, bit_index, bitmap, State, Error).
+
+:- instance stream.bulk_reader(read_buffer_stream, bit_index, bitmap,
+ read_buffer(Stream, State, Error), Error)
+ <= stream.bulk_reader(Stream, bit_index, bitmap, State, Error).
+*/
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
:- import_module maybe.
:- import_module require.
:- import_module string.
@@ -215,8 +214,7 @@
% read_error field.
%
:- type read_buffer(Stream, State, Error)
- ---> read_buffer(bit_buffer ::
- bit_buffer(Stream, State, read_error(Error))).
+ ---> read_buffer(bit_buffer :: bit_buffer(Stream, State, Error)).
% <= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
new(NumBytes, Stream, State) = Buffer :-
@@ -278,12 +276,20 @@
).
get_bit(BitResult, !Buffer) :-
- get_bits(1, BitsResult, !Buffer),
- ( BitsResult = ok(Bits), BitResult = ok(Bits = 0 -> no ; yes)
- ; BitsResult = error(Error), BitResult = error(Error)
+ get_bits(0, 1, 0, Word, NumBitsRead, BitsResult, !Buffer),
+ (
+ BitsResult = ok,
+ ( NumBitsRead = 1 ->
+ BitResult = ok(Word = 0 -> no ; yes)
+ ;
+ BitResult = eof
+ )
+ ;
+ BitsResult = error(Error), BitResult = error(Error)
).
-get_bits(NumBits, BitsResult, !Buffer) :-
+get_bits(Index, NumBits, !.Word, unsafe_promise_unique(!:Word),
+ NumBitsRead, BitsResult, !Buffer) :-
Status = !.Buffer ^ bit_buffer ^ read_status,
(
Status = ok,
@@ -294,47 +300,57 @@
true
),
( !.Buffer ^ num_buffered_bits >= NumBits ->
- do_get_bits(NumBits, BitsResult, !Buffer)
+ BitsResult = ok,
+ do_get_bits(Index, NumBits, !Word, NumBitsRead, !Buffer)
;
refill_read_buffer(RefillResult, !Buffer),
(
RefillResult = ok,
- ( !.Buffer ^ num_buffered_bits >= NumBits ->
- do_get_bits(NumBits, BitsResult, !Buffer)
- ;
- BitsResult = error(unexpected_eof_error),
- set_buffer_error(unexpected_eof_error, !Buffer)
- )
+ BitsResult = ok,
+ do_get_bits(Index, NumBits, !Word, NumBitsRead, !Buffer)
;
RefillResult = error(Err),
+ NumBitsRead = 0,
BitsResult = error(Err)
)
)
; NumBits = 0 ->
- BitsResult = ok(0)
+ NumBitsRead = 0,
+ BitsResult = ok
;
error("bit_buffer.read.get_bits: negative number of bits")
)
;
Status = error(Err),
+ NumBitsRead = 0,
BitsResult = error(Err)
).
- % There must be enough bits in the buffer to satisfy the request.
- %
-:- pred do_get_bits(num_bits::in, bit_buffer_res(word, Error)::out,
- read_buffer(Stream, State, Error)::read_buffer_di,
+:- pred do_get_bits(bit_index::in, num_bits::in, word::in, word::out,
+ num_bits::out, read_buffer(Stream, State, Error)::read_buffer_di,
read_buffer(Stream, State, Error)::read_buffer_uo) is det
<= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
-do_get_bits(NumBits, BitsResult, read_buffer(!.Buffer),
- read_buffer(!:Buffer)) :-
+do_get_bits(Index, NumBits, !Word, NumBitsRead,
+ RB @ read_buffer(!.Buffer), read_buffer(!:Buffer)) :-
+ NumBitsAvailable = RB ^ num_buffered_bits,
Pos = !.Buffer ^ pos,
- BitsResult = ok(!.Buffer ^ bitmap ^ bits(Pos, NumBits)),
- set_bitmap(!.Buffer ^ bitmap, Pos + NumBits, !Buffer).
+ ( NumBitsAvailable < NumBits ->
+ NumBitsRead = NumBitsAvailable
+ ;
+ NumBitsRead = NumBits
+ ),
+ Bits0 = !.Buffer ^ bitmap ^ bits(Pos, NumBitsRead),
+ Bits = Bits0 `unchecked_left_shift` (NumBits - NumBitsRead),
+
+ LastBit = Index + NumBitsRead - 1,
+ Shift = bits_per_int - 1 - LastBit,
+ BitMask = 1 `unchecked_left_shift` (NumBits - 1),
+ BitsMask = BitMask \/ (BitMask - 1),
+ !:Word = !.Word /\ \ (BitsMask `unchecked_left_shift` Shift),
+ !:Word = !.Word \/ (Bits `unchecked_left_shift` Shift),
-get_byte(Result, !Buffer) :-
- get_bits(bits_per_byte, Result, !Buffer).
+ set_bitmap(!.Buffer ^ bitmap, Pos + NumBits, !Buffer).
get_bitmap(!BM, NumBitsRead, Result, !Buffer) :-
get_bitmap(0, !.BM ^ num_bits, !BM, NumBitsRead, Result, !Buffer).
@@ -362,12 +378,7 @@
!:BM = copy_bits(!.Buffer ^ bitmap, Pos, !.BM,
Index, NumBitsRead),
set_bitmap(!.Buffer ^ bitmap, Pos + NumBits, !Buffer),
- ( NumBitsRead = NumBits ->
- Result = ok
- ;
- Result = error(unexpected_eof_error),
- do_set_buffer_error(unexpected_eof_error, !Buffer)
- )
+ Result = ok
)
;
NumBits = 0,
@@ -389,9 +400,9 @@
:- pred recursively_get_bitmap(bit_index::in, num_bits::in,
bitmap::bitmap_di, bitmap::bitmap_uo,
- num_bits::in, num_bits::out, bit_buffer_res(Error)::out,
- bit_buffer(Stream, State, read_error(Error))::bit_buffer_di,
- bit_buffer(Stream, State, read_error(Error))::bit_buffer_uo) is det
+ num_bits::in, num_bits::out, stream.res(Error)::out,
+ bit_buffer(Stream, State, Error)::bit_buffer_di,
+ bit_buffer(Stream, State, Error)::bit_buffer_uo) is det
<= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
recursively_get_bitmap(!.Index, !.NumBits, !BM, !NumBitsRead,
@@ -420,18 +431,23 @@
BulkGetResult = ok,
( !.NumBits > 0 ->
!:Buffer = read_buffer(!.Buffer),
- get_bits(!.NumBits, LastBitsResult, !Buffer),
+ get_bits(bits_per_int - !.NumBits, !.NumBits,
+ 0, LastBits, NumLastBitsRead, LastBitsResult, !Buffer),
!:Buffer = !.Buffer ^ bit_buffer,
(
- LastBitsResult = ok(LastBits),
- !:BM =
- !.BM ^ bits(!.Index, !.NumBits) := LastBits,
- !:NumBitsRead = !.NumBitsRead + !.NumBits,
+ LastBitsResult = ok,
+
+ % !.NumBitsis correct here, if we didn't read
+ % enough bits this will just fill the rest of the
+ % range with zero bits.
+ %
+ !:BM = !.BM ^ bits(!.Index, !.NumBits) := LastBits,
Result = ok
;
LastBitsResult = error(Err),
Result = error(Err)
- )
+ ),
+ !:NumBitsRead = !.NumBitsRead + NumLastBitsRead
;
Result = ok
)
@@ -447,8 +463,7 @@
recursively_get_bitmap(!.Index, !.NumBits, !BM,
!NumBitsRead, Result, !Buffer)
;
- Result = error(unexpected_eof_error),
- do_set_buffer_error(unexpected_eof_error, !Buffer)
+ Result = ok
)
;
RefillRes = error(Err),
@@ -459,9 +474,8 @@
:- pred copy_buffered_bits_to_bitmap(bit_index::in, bit_index::out,
num_bits::in, num_bits::out, bitmap::bitmap_di, bitmap::bitmap_uo,
- num_bits::in, num_bits::out,
- bit_buffer(S, St, read_error(E))::bit_buffer_di,
- bit_buffer(S, St, read_error(E))::bit_buffer_uo) is det.
+ num_bits::in, num_bits::out, bit_buffer(S, St, E)::bit_buffer_di,
+ bit_buffer(S, St, E)::bit_buffer_uo) is det.
copy_buffered_bits_to_bitmap(!Index, !NumBits, !BM, !NumBitsRead, !Buffer) :-
NumBufferedBits = read_buffer(!.Buffer) ^ num_buffered_bits,
@@ -476,9 +490,9 @@
:- pred bulk_get_into_result_bitmap(bit_index::in, bit_index::out,
num_bits::in, num_bits::out, bitmap::bitmap_di, bitmap::bitmap_uo,
- num_bits::in, num_bits::out, bit_buffer_res(E)::out,
- bit_buffer(S, St, read_error(E))::bit_buffer_di,
- bit_buffer(S, St, read_error(E))::bit_buffer_uo) is det
+ num_bits::in, num_bits::out, stream.res(E)::out,
+ bit_buffer(S, St, E)::bit_buffer_di,
+ bit_buffer(S, St, E)::bit_buffer_uo) is det
<= stream.bulk_reader(S, byte_index, bitmap, St, E).
bulk_get_into_result_bitmap(!Index, !NumBits, !BM, !NumBitsRead,
@@ -488,19 +502,12 @@
Stream = !.Buffer ^ stream,
State0 = !.Buffer ^ state,
stream.bulk_get(Stream, StartByteIndex, NumBytesToBulkGet, !BM,
- NumBytesRead, BulkGetResult, State0, State),
+ NumBytesRead, Result, State0, State),
(
- BulkGetResult = ok,
Result = ok
;
- BulkGetResult = eof,
- Result = error(unexpected_eof_error),
- do_set_buffer_error(unexpected_eof_error, !Buffer)
- ;
- BulkGetResult = error(Error),
- StreamError = stream_error(Error),
- Result = error(StreamError),
- do_set_buffer_error(StreamError, !Buffer)
+ Result = error(_),
+ do_set_buffer_error(Result, !Buffer)
),
NumBitsBulkRead = NumBytesRead * bits_per_byte,
!:Index = !.Index + NumBitsBulkRead,
@@ -515,24 +522,24 @@
Pos = !.Buffer ^ bit_buffer ^ pos,
PosInByte = Pos `unchecked_rem` bits_per_byte,
( PosInByte = 0 ->
- Result = ok
+ Result = ok(yes)
;
NumPaddingBits = bits_per_byte - PosInByte,
( !.Buffer ^ num_buffered_bits < NumPaddingBits ->
% This can only happen when reading from a bitmap.
+ % In this case, we return success, and any later
+ % read will hit end of stream.
%
- Result = error(unexpected_eof_error),
- set_buffer_error(unexpected_eof_error, !Buffer)
+ Result = ok(yes)
;
- get_bits(NumPaddingBits, GetResult, !Buffer),
+ get_bits(bits_per_int - NumPaddingBits, NumPaddingBits,
+ 0, Word, _NumBitsRead, GetResult, !Buffer),
(
- GetResult = ok(Bits),
- ( Bits = 0 ->
- Result = ok
+ GetResult = ok,
+ ( Word = 0 ->
+ Result = ok(yes)
;
- Error = buffer_error(expected_padding_zeros),
- Result = error(Error),
- set_buffer_error(Error, !Buffer)
+ Result = ok(no)
)
;
GetResult = error(Error),
@@ -548,7 +555,7 @@
% This predicate may only be called when the number of buffered bits
% is less than bits_per_int.
%
-:- pred refill_read_buffer(bit_buffer_res(Error)::out,
+:- pred refill_read_buffer(stream.res(Error)::out,
read_buffer(Stream, State, Error)::read_buffer_di,
read_buffer(Stream, State, Error)::read_buffer_uo) is det
<= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
@@ -556,9 +563,9 @@
refill_read_buffer(Result, read_buffer(!.Buffer), read_buffer(!:Buffer)) :-
do_refill_read_buffer(Result, !Buffer).
-:- pred do_refill_read_buffer(bit_buffer_res(Error)::out,
- bit_buffer(Stream, State, read_error(Error))::bit_buffer_di,
- bit_buffer(Stream, State, read_error(Error))::bit_buffer_uo) is det
+:- pred do_refill_read_buffer(stream.res(Error)::out,
+ bit_buffer(Stream, State, Error)::bit_buffer_di,
+ bit_buffer(Stream, State, Error)::bit_buffer_uo) is det
<= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
do_refill_read_buffer(Result, !.Buffer, !:Buffer) :-
@@ -599,13 +606,13 @@
NumBytesToRead = ChunkSize `unchecked_quotient` bits_per_byte,
Stream = !.Buffer ^ stream,
stream.bulk_get(Stream, StartByteIndex, NumBytesToRead, !BM,
- NumBytesRead, BulkGetResult, !State),
+ NumBytesRead, Result, !State),
% Record the new size of the buffer if `bulk_get' hit eof
% or an error. Further attempts to refill the buffer will
% do nothing.
%
- ( BulkGetResult = ok ->
+ ( NumBytesRead = NumBytesToRead ->
true
;
% XXX We should probably allow the user to attempt to reset
@@ -619,16 +626,11 @@
),
set_all(!.BM, !.Pos, !.Size, !.State, [], !Buffer),
(
- BulkGetResult = ok,
- Result = ok
- ;
- BulkGetResult = eof,
+ Result = ok,
Result = ok
;
- BulkGetResult = error(Error),
- StreamError = stream_error(Error),
- Result = error(StreamError),
- do_set_buffer_error(StreamError, !Buffer)
+ Result = error(_),
+ do_set_buffer_error(Result, !Buffer)
)
)
;
@@ -642,7 +644,7 @@
% We didn't have enough bits to satisfy a request, so move the position
% to the end of the buffer.
%
-:- pred set_buffer_error(read_error(Error)::in,
+:- pred set_buffer_error(stream.res(Error)::in,
read_buffer(Stream, State, Error)::read_buffer_di,
read_buffer(Stream, State, Error)::read_buffer_uo) is det
<= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
@@ -650,15 +652,66 @@
set_buffer_error(Error, read_buffer(!.Buffer), read_buffer(!:Buffer)) :-
do_set_buffer_error(Error, !Buffer).
-:- pred do_set_buffer_error(read_error(Error)::in,
- bit_buffer(Stream, State, read_error(Error))::bit_buffer_di,
- bit_buffer(Stream, State, read_error(Error))::bit_buffer_uo) is det.
+:- pred do_set_buffer_error(stream.res(Error)::in,
+ bit_buffer(Stream, State, Error)::bit_buffer_di,
+ bit_buffer(Stream, State, Error)::bit_buffer_uo) is det.
do_set_buffer_error(Error, !Buffer) :-
- set_read_status(error(Error), !Buffer).
+ set_read_status(Error, !Buffer).
+
+%-----------------------------------------------------------------------------%
+
+/*
+** None of these instances work because of limitations in the type and
+** RTTI system.
+**
+
+:- instance stream.stream(read_buffer_stream,
+ read_buffer(Stream, State, Error)) where
+ <= stream.bulk_reader(Stream, bit_index, bitmap, State, Error)
+[
+ (name(_, Name, !Buffer) :-
+ name(!.Buffer ^ read_buffer_stream, StreamName,
+ !.Buffer ^ read_buffer_state, State)
+ set_state(State, !Buffer)
+ !:Buffer = unsafe_promise_unique(!.Buffer)
+ )
+].
+
+:- instance stream.input(read_buffer_stream, read_buffer(_, _, _))
+ where [].
+
+:- instance stream.reader(read_buffer_stream, bool,
+ read_buffer(Stream, State, Error), Error)
+ <= stream.bulk_reader(Stream, bit_index, bitmap, State, Error)
+ where
+[
+
+ (get(_, Result, !Buffer) :-
+ get_bit(Result, !Buffer)
+ )
+].
-:- func unexpected_eof_error = read_error(Error).
+:- instance stream.bulk_reader(read_buffer_stream, bit_index, word,
+ read_buffer(Stream, State, Error), Error)
+ <= stream.bulk_reader(Stream, bit_index, bitmap, State, Error)
+ where
+[
+ (bulk_get(_, Index, NumBits, !Word, NumBitsRead, Result, !Buffer) :-
+ get_bits(Index, NumBits, !Word, NumBitsRead, Result, !Buffer)
+ )
+].
+
+:- instance stream.bulk_reader(read_buffer_stream, bit_index, bitmap,
+ read_buffer(Stream, State, Error), Error)
+ <= stream.bulk_reader(Stream, bit_index, bitmap, State, Error)
+ where
+[
+ (bulk_get(_, Index, NumBits, !BM, NumBitsRead, Result, !Buffer) :-
+ get_bitmap(Index, NumBits, !BM, NumBitsRead, Result, !Buffer)
+ )
+].
-unexpected_eof_error = buffer_error(unexpected_eof).
+*/
:- end_module bit_buffer.read.
diff -u library/bit_buffer.write.m library/bit_buffer.write.m
--- library/bit_buffer.write.m
+++ library/bit_buffer.write.m
@@ -11,7 +11,7 @@
%
% A bit buffer provides an interface between bit-oriented output requests
% and byte-array-oriented streams, storing bits until there are enough bytes
-% to make calling the `bulk_put' method on the stream worthwhile.
+% to make calling the `put' method on the stream worthwhile.
%
% CAVEAT: the user is referred to the documentation in the header
% of array.m regarding programming with unique objects (the compiler
@@ -24,13 +24,12 @@
%-----------------------------------------------------------------------------%
:- module bit_buffer.write.
-
:- interface.
:- import_module io.
:- type write_buffer(Stream, State).
- % <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ % <= stream.writer(Stream, bitmap.slice, State).
:- type write_buffer == write_buffer(error_stream, error_state).
:- type io_write_buffer == write_buffer(io.binary_output_stream, io.state).
@@ -46,7 +45,7 @@
% int.bits_per_int), the size of an integer will be used instead.
%
:- func new(num_bytes, Stream, State) = write_buffer(Stream, State)
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, byte_index, State).
:- mode new(in, in, di) = write_buffer_uo is det.
% new(NumBytes)
@@ -64,9 +63,8 @@
% Write a bit to the buffer.
%
-:- pred put_bit(bool, write_buffer(Stream, State),
- write_buffer(Stream, State))
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+:- pred put_bit(bool, write_buffer(Stream, State), write_buffer(Stream, State))
+ <= stream.writer(Stream, bitmap.slice, State).
:- mode put_bit(in, write_buffer_di, write_buffer_uo) is det.
% Write the given number of low-order bits from an int to the buffer.
@@ -74,7 +72,7 @@
%
:- pred put_bits(word, num_bits, write_buffer(Stream, State),
write_buffer(Stream, State))
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
:- mode put_bits(in, in, write_buffer_di, write_buffer_uo) is det.
% Write the eight low-order bits from an int to the buffer.
@@ -82,7 +80,7 @@
%
:- pred put_byte(word, write_buffer(Stream, State),
write_buffer(Stream, State))
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
:- mode put_byte(in, write_buffer_di, write_buffer_uo) is det.
% Write bits from a bitmap to the buffer.
@@ -90,19 +88,19 @@
%
:- pred put_bitmap(bitmap, write_buffer(Stream, State),
write_buffer(Stream, State))
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
:- mode put_bitmap(bitmap_ui, write_buffer_di, write_buffer_uo) is det.
:- pred put_bitmap(bitmap, bit_index, num_bits,
write_buffer(Stream, State), write_buffer(Stream, State))
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
:- mode put_bitmap(bitmap_ui, in, in, write_buffer_di, write_buffer_uo) is det.
% Add padding zero bits to complete a partial final byte.
%
:- pred pad_to_byte(write_buffer(Stream, State),
write_buffer(Stream, State))
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
:- mode pad_to_byte(write_buffer_di, write_buffer_uo) is det.
% Flush all complete bytes in the buffer to the output stream.
@@ -110,14 +108,14 @@
% in the buffer.
%
:- pred flush(write_buffer(Stream, State), write_buffer(Stream, State))
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
:- mode flush(write_buffer_di, write_buffer_uo) is det.
% Pad the buffered data out to a byte boundary, flush it to
% the output stream, then return the Stream and State.
%
:- pred finalize(write_buffer(Stream, State), Stream, State)
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
:- mode finalize(write_buffer_di, out, uo) is det.
% Copy the data from a non-streamed write_buffer to a bitmap.
@@ -138,7 +136,7 @@
%
% We always use a buffer size that is at least the size of a word
% so that writing a word to the buffer will require at most a single
- % call to `bulk_put'. Allowing smaller sizes complicates the code
+ % call to `put'. Allowing smaller sizes complicates the code
% for a case that shouldn't occur in practice.
%
% For a bitmap_builder, we store the filled bitmaps in a list rather
@@ -198,7 +196,7 @@
%
:- pred put_bitmap_2(bitmap, bit_index, num_bits,
bit_buffer(Stream, State), bit_buffer(Stream, State))
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
:- mode put_bitmap_2(bitmap_ui, in, in,
write_buffer_di, write_buffer_uo) is det.
@@ -245,7 +243,7 @@
:- pred maybe_make_room(bit_buffer(Stream, State)::bit_buffer_di,
bit_buffer(Stream, State)::bit_buffer_uo) is det
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
maybe_make_room(!Buffer) :-
( !.Buffer ^ pos >= !.Buffer ^ size ->
@@ -256,7 +254,7 @@
:- pred make_room(bit_buffer(Stream, State)::bit_buffer_di,
bit_buffer(Stream, State)::bit_buffer_uo) is det
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
make_room(!Buffer) :-
UseStream = !.Buffer ^ use_stream,
@@ -279,7 +277,7 @@
:- pred flush_all_to_stream(bit_buffer(Stream, State)::bit_buffer_di,
bit_buffer(Stream, State)::bit_buffer_uo) is det
- <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
flush_all_to_stream(!Buffer) :-
( num_buffered_bits(write_buffer(!.Buffer)) >= bits_per_byte ->
@@ -291,7 +289,7 @@
:- pred flush_chunk_to_stream(bit_buffer(Stream, State)::bit_buffer_di,
bit_buffer(Stream, State)::bit_buffer_uo) is det
- <= stream.bulk_writer(Stream, int, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
flush_chunk_to_stream(!Buffer) :-
% Write at most Size bytes at once (this is the output chunk
@@ -303,7 +301,8 @@
NumBytes = NumBitsToWrite0 `unchecked_quotient` bits_per_byte,
( NumBytes \= 0 ->
NumBitsToWrite = NumBytes * bits_per_byte,
- stream.bulk_put(!.Buffer ^ stream, !.Buffer ^ bitmap, 0, NumBytes,
+ stream.put(!.Buffer ^ stream,
+ bitmap.byte_slice(!.Buffer ^ bitmap, 0, NumBytes),
unsafe_promise_unique(!.Buffer ^ state), NewState),
Remain = Pos - NumBitsToWrite,
( Remain \= 0 ->
@@ -330,7 +329,7 @@
%
:- pred store_full_buffer(bit_buffer(Stream, State)::in,
bit_buffer(Stream, State)::out) is det
- <= stream.bulk_writer(Stream, int, bitmap, State).
+ <= stream.writer(Stream, bitmap.slice, State).
store_full_buffer(!Buffer) :-
Pos = !.Buffer ^ pos,
diff -u library/bitmap.m library/bitmap.m
--- library/bitmap.m
+++ library/bitmap.m
@@ -209,6 +209,33 @@
%-----------------------------------------------------------------------------%
+ % Slice = bitmap.slice(BM, StartIndex, NumBits)
+ %
+ % A bitmap slice represents the sub-range of a bitmap of NumBits bits
+ % starting at bit index StartIndex. Throws an exception if the slice
+ % is not within the bounds of the bitmap.
+ %
+:- type bitmap.slice.
+:- func bitmap.slice(bitmap, bit_index, num_bits) = bitmap.slice.
+
+ % As above, but use byte indices.
+ %
+:- func bitmap.byte_slice(bitmap, byte_index, num_bytes) = bitmap.slice.
+
+ % Access functions for slices.
+ %
+:- func slice ^ slice_bitmap = bitmap.
+:- func slice ^ slice_start_bit_index = bit_index.
+:- func slice ^ slice_num_bits = num_bits.
+
+ % As above, but return byte indices, throwing an exception if
+ % the slice doesn't start and end on a byte boundary.
+ %
+:- func slice ^ slice_start_byte_index = byte_index.
+:- func slice ^ slice_num_bytes = num_bytes.
+
+%-----------------------------------------------------------------------------%
+
% Flip the given bit.
%
:- func flip(bitmap, bit_index) = bitmap.
@@ -616,11 +643,12 @@
( if
FirstBit >= 0,
(
- NumBits > 0,
- in_range(BM, FirstBit + NumBits - 1),
- NumBits =< int.bits_per_int
+ NumBits >= 0,
+ NumBits =< int.bits_per_int,
+ in_range(BM, FirstBit + NumBits - 1)
;
- NumBits = 0
+ NumBits = 0,
+ in_range(BM, FirstBit + NumBits)
)
then
BM ^ unsafe_bits(FirstBit, NumBits) := Bits
@@ -675,6 +703,52 @@
%-----------------------------------------------------------------------------%
+:- type bitmap.slice
+ ---> bitmap.slice_ctor(
+ slice_bitmap_field :: bitmap,
+ slice_start_bit_index_field :: bit_index,
+ slice_num_bits_field :: num_bits
+ ).
+
+slice(BM, StartBit, NumBits) = Slice :-
+ ( if
+ NumBits >= 0,
+ StartBit >= 0,
+ ( in_range(BM, StartBit + NumBits - 1)
+ ; NumBits = 0, in_range(BM, StartBit + NumBits)
+ )
+ then
+ Slice = bitmap.slice_ctor(BM, StartBit, NumBits)
+ else
+ throw_bounds_error(BM, "bitmap.slice", StartBit, NumBits)
+ ).
+
+Slice ^ slice_bitmap = Slice ^ slice_bitmap_field.
+Slice ^ slice_start_bit_index = Slice ^ slice_start_bit_index_field.
+Slice ^ slice_num_bits = Slice ^ slice_num_bits_field.
+
+byte_slice(BM, StartByte, NumBytes) =
+ slice(BM, StartByte * bits_per_byte, NumBytes * bits_per_byte).
+
+Slice ^ slice_start_byte_index =
+ quotient_bits_per_byte_with_rem_zero("bitmap.slice_start_byte_index",
+ Slice ^ slice_start_bit_index).
+Slice ^ slice_num_bytes =
+ quotient_bits_per_byte_with_rem_zero("bitmap.slice_num_bytes",
+ Slice ^ slice_num_bits).
+
+:- func quotient_bits_per_byte_with_rem_zero(string, int) = int is det.
+
+quotient_bits_per_byte_with_rem_zero(Pred, Int) =
+ Int `unchecked_quotient` bits_per_byte :-
+ ( Int `unchecked_rem` bits_per_byte = 0 ->
+ true
+ ;
+ throw_bitmap_error(Pred ++ ": not a byte slice.")
+ ).
+
+%-----------------------------------------------------------------------------%
+
set(BM, I) =
( if in_range(BM, I)
then unsafe_set(BM, I)
@@ -862,14 +936,14 @@
copy_bits(SameBM, SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits) =
( if
- (
- NumBits >= 0,
- SrcStartBit >= 0,
- in_range(SrcBM, SrcStartBit + NumBits - 1),
- DestStartBit >= 0,
- in_range(DestBM, DestStartBit + NumBits - 1)
- ;
- NumBits = 0
+ NumBits >= 0,
+ SrcStartBit >= 0,
+ DestStartBit >= 0,
+ ( in_range(SrcBM, SrcStartBit + NumBits - 1)
+ ; NumBits = 0, in_range(SrcBM, SrcStartBit + NumBits)
+ ),
+ ( in_range(DestBM, DestStartBit + NumBits - 1)
+ ; NumBits = 0, in_range(DestBM, DestStartBit + NumBits)
)
then
unsafe_copy_bits(SameBM, SrcBM, SrcStartBit,
diff -u library/io.m library/io.m
--- library/io.m
+++ library/io.m
@@ -151,6 +151,9 @@
% as a string. See the documentation for `string.line' for the
% definition of a line.
%
+ % Throws an exception if the line contains a null character, because
+ % null characters are not allowed in Mercury strings.
+ %
:- pred io.read_line_as_string(io.result(string)::out, io::di, io::uo) is det.
% Reads all the characters from the current input stream until
@@ -166,6 +169,9 @@
% Returns an error if the file contains a null character, because
% null characters are not allowed in Mercury strings.
%
+ % Throws an exception if the file contains a null character, because
+ % null characters are not allowed in Mercury strings.
+ %
:- pred io.read_file_as_string(io.maybe_partial_res(string)::out,
io::di, io::uo) is det.
@@ -241,6 +247,9 @@
% result as a string. See the documentation for `string.line' for
% the definition of a line.
%
+ % Throws an exception if the line contains a null character, because
+ % null characters are not allowed in Mercury strings.
+ %
:- pred io.read_line_as_string(io.input_stream::in, io.result(string)::out,
io::di, io::uo) is det.
@@ -256,6 +265,9 @@
% Returns an error if the file contains a null character, because
% null characters are not allowed in Mercury strings.
%
+ % Throws an exception if the file contains a null character, because
+ % null characters are not allowed in Mercury strings.
+ %
:- pred io.read_file_as_string(io.input_stream::in,
io.maybe_partial_res(string)::out, io::di, io::uo) is det.
@@ -772,18 +784,18 @@
% Fill a bitmap from the current binary input stream.
% Returns 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 `eof'.
+ % of the bitmap, and the result will be `ok'.
%
:- pred io.read_bitmap(bitmap::bitmap_di, bitmap::bitmap_uo,
- int::out, io.result::out, io::di, io::uo) is det.
+ int::out, io.res::out, io::di, io::uo) is det.
% Fill a bitmap from the specified binary input stream.
% Returns 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 `eof'.
+ % of the bitmap, and the result will be `ok'.
%
:- pred io.read_bitmap(io.binary_input_stream::in,
- bitmap::bitmap_di, bitmap::bitmap_uo, int::out, io.result::out,
+ bitmap::bitmap_di, bitmap::bitmap_uo, int::out, io.res::out,
io::di, io::uo) is det.
% io.read_bitmap(StartByte, NumBytes, !Bitmap, BytesRead, Result, !IO)
@@ -792,11 +804,11 @@
% from the current binary input stream.
% Returns the number of bytes read.
% On end-of-file, the number of bytes read will be less than NumBytes,
- % and the result will be `eof'.
+ % and the result will be `ok'.
%
:- pred io.read_bitmap(byte_index::in, num_bytes::in,
bitmap::bitmap_di, bitmap::bitmap_uo, num_bytes::out,
- io.result::out, io::di, io::uo) is det.
+ io.res::out, io::di, io::uo) is det.
% io.read_bitmap(Stream, !Bitmap, StartByte, NumBytes,
% BytesRead, Result, !IO)
@@ -805,11 +817,11 @@
% from the specified binary input stream.
% Returns the number of bytes read.
% On end-of-file, the number of bytes read will be less than NumBytes,
- % and the result will be `eof'.
+ % and the result will be `ok'.
%
:- pred io.read_bitmap(io.binary_input_stream::in,
byte_index::in, num_bytes::in, bitmap::bitmap_di, bitmap::bitmap_uo,
- num_bytes::out, io.result::out, io::di, io::uo) is det.
+ num_bytes::out, io.res::out, io::di, io::uo) is det.
% Reads all the bytes from the current binary input stream
% until eof or error into a bitmap.
@@ -1490,8 +1502,7 @@
:- instance stream.stream(io.binary_output_stream, io).
:- instance stream.output(io.binary_output_stream, io).
:- instance stream.writer(io.binary_output_stream, byte, io).
-:- instance stream.bulk_writer(io.binary_output_stream, int,
- bitmap, io).
+:- instance stream.writer(io.binary_output_stream, bitmap.slice, io).
:- instance stream.seekable(io.binary_output_stream, io).
:- instance stream.stream(io.binary_input_stream, io).
@@ -1915,11 +1926,7 @@
!Bitmap, 0, BytesRead, !IO),
io.ferror(Stream, ErrInt, ErrMsg, !IO),
( ErrInt = 0 ->
- ( BytesRead = NumBytes ->
- Result = ok
- ;
- Result = eof
- )
+ Result = ok
;
Result = error(io_error(ErrMsg))
)
@@ -1986,9 +1993,7 @@
io.read_bitmap(Stream, 0, FileSize,
!BM, BytesRead, ReadResult, !IO),
(
- ( ReadResult = ok
- ; ReadResult = eof
- ),
+ ReadResult = ok,
( BytesRead = FileSize ->
Result = ok(!.BM)
;
@@ -2022,9 +2027,7 @@
!:BM = bitmap.new(BufferSize * bits_per_byte),
io.read_bitmap(0, BufferSize, !BM, NumBytesRead, ReadRes, !IO),
(
- ( ReadRes = ok
- ; ReadRes = eof
- ),
+ ReadRes = ok,
( NumBytesRead < BufferSize ->
!:BM = bitmap.shrink_without_copying(!.BM,
NumBytesRead * bits_per_byte),
@@ -9238,12 +9241,6 @@
io.result_to_stream_result(eof) = eof.
io.result_to_stream_result(error(Error)) = error(Error).
-:- func io.result_0_to_stream_result(io.result) = stream.result(io.error).
-
-io.result_0_to_stream_result(ok) = ok.
-io.result_0_to_stream_result(eof) = eof.
-io.result_0_to_stream_result(error(Error)) = error(Error).
-
:- instance stream.line_oriented(io.input_stream, io) where
[
@@ -9331,7 +9328,7 @@
( bulk_get(Stream, Index, Int, !Store, NumRead, Result, !State) :-
io.read_bitmap(Stream, Index, Int, !Store, NumRead,
Result0, !State),
- Result = io.result_0_to_stream_result(Result0)
+ Result = io.res_to_stream_res(Result0)
)
].
@@ -9356,31 +9353,48 @@
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).
+
+io.res_to_stream_res(ok) = ok.
+io.res_to_stream_res(error(E)) = error(E).
+
%-----------------------------------------------------------------------------%
%
% Binary output streams
%
-:- instance stream.stream(io.binary_output_stream, io) where [
+:- instance stream.stream(io.binary_output_stream, io)
+ where
+[
pred(name/4) is io.binary_output_stream_name
].
-:- instance stream.output(io.binary_output_stream, io) where [
+:- instance stream.output(io.binary_output_stream, io)
+ where
+[
pred(flush/3) is io.flush_binary_output
].
-:- instance stream.writer(io.binary_output_stream, int, io)
+:- instance stream.writer(io.binary_output_stream, byte, io)
where
[
pred(put/4) is io.write_byte
].
-:- instance stream.bulk_writer(io.binary_output_stream, int, bitmap, io)
+:- instance stream.writer(io.binary_output_stream, bitmap, io)
where
[
- pred(bulk_put/6) is io.write_bitmap
+ pred(put/4) is io.write_bitmap
].
+:- instance stream.writer(io.binary_output_stream, bitmap.slice, io)
+ where
+[
+ ( put(Stream, Slice, !IO) :-
+ io.write_bitmap(Stream, Slice ^ slice_bitmap,
+ Slice ^ slice_start_byte_index, Slice ^ slice_num_bytes, !IO)
+ )
+].
:- instance stream.seekable(io.binary_output_stream, io)
where
diff -u library/stream.m library/stream.m
--- library/stream.m
+++ library/stream.m
@@ -108,12 +108,14 @@
(Stream, Unit -> Error)) where
[
% Get the next unit from the given stream.
+ %
% The get operation should block until the next unit is available,
% or the end of the stream or an error is detected.
- % If a call to get/4 returns `eof', all further calls to get/4
- % for that stream must return `eof'.
- % If a call to get/4 returns `error(...)', all further calls to get/4
- % for that stream must return an error, not necessarily the same one.
+ %
+ % If a call to get/4 returns `eof', all further calls to get/4 or
+ % bulk_get/9 for that stream return `eof'. If a call to get/4
+ % returns `error(...)', all further calls to get/4 or bulk_get/4 for
+ % that stream return an error, although not necessarily the same one.
%
% XXX We should provide an interface to allow the user to reset the
% error status to try again if an error is transient.
@@ -136,21 +138,30 @@
%
% Read at most NumItems items into the given Store starting at the
% given index, returning the number of items read.
- % On end-of-stream, NumItemsRead is less than NumItems,
- % and Result is `eof'.
- % bulk_get should block until NumItems items are available or the
- % end of the stream is reached or an error is detected.
- % Implementations of bulk_get should throw an exception if Index given
- % is out of range or NumItems units can't be stored starting at that index.
- %
- % If a call to get/4 returns `eof', all further calls to get/4 must
- % return `eof'.
- % If a read returns `error(...)', all further reads must return
- % an error, although not necessarily the same one.
+ %
+ % If the read succeeds, Result is `ok' and NumItemsRead equals NumItems.
+ %
+ % On end-of-stream, bulk_get/9 puts as many items as it can into !Store.
+ % NumItemsRead is less than NumItems, and Result is `ok'.
+ %
+ % If an error is detected, bulk_get/9 puts as many items as it can into
+ % !Store. NumItemsRead is less than NumItems, and Result is `error(Err)'.
+ %
+ % Blocks until NumItems items are available or the end of the stream
+ % is reached or an error is detected.
+ %
+ % Throws an exception if Index given is out of range or NumItems units
+ % starting at Index will not fit in !Store.
+ %
+ % If a call to bulk_get/4 returns less than NumItems items, all further
+ % calls to get/4 or bulk_get/4 for that stream return no items. If a
+ % call to bulk_get/9 returns `error(...)', all further calls to get/4
+ % or bulk_get/9 for that stream return an error, although not necessarily
+ % the same one.
%
pred bulk_get(Stream::in, Index::in, int::in,
Store::bulk_get_di, Store::bulk_get_uo,
- int::out, stream.result(Error)::out, State::di, State::uo) is det
+ int::out, stream.res(Error)::out, State::di, State::uo) is det
].
% XXX These should be di and uo, but with the current state of the mode
@@ -159,7 +170,6 @@
:- mode bulk_get_di == in.
:- mode bulk_get_uo == out.
-
%-----------------------------------------------------------------------------%
%
% Output streams
@@ -193,31 +203,6 @@
pred put(Stream::in, Unit::in, State::di, State::uo) is det
].
- % A bulk_writer stream is a subclass of specific output stream that
- % can be used to write multiple items from a container to a stream.
- % A single output stream can support multiple bulk_writer subclasses.
- %
-:- typeclass stream.bulk_writer(Stream, Index, Store, State)
- <= stream.output(Stream, State) where
-[
- % bulk_put(Stream, Index, NumUnits, Store, !State).
- %
- % Write NumUnits units from Store starting at Index to the given stream.
- % Blocks if all of the units can't be written at the time of the call.
- %
- % The State must not keep a reference to any part of the Store argument.
- % This is useful where the user wants to write part of a large
- % destructively updatable object (such as a bitmap) and be able to
- % continue to update it afterwards.
- %
- pred bulk_put(Stream::in, Store::stream_ui, Index::in, int::in,
- State::di, State::uo) is det
-].
-
- % XXX This will be changed to a unique mode when the mode system
- % is fully implemented.
-:- mode stream_ui == in.
-
%-----------------------------------------------------------------------------%
%
% Duplex streams
--- bit_buffer_test.exp 2007-05-28 20:33:24.036156324 +1000
+++ ../tests/hard_coded/bit_buffer_test.exp 2007-05-27 12:23:56.000000000 +1000
@@ -68,7 +68,7 @@
bitmap read tests completed.
I/O read tests completed.
-Test a bitmap that spans multiple buffer flushed.
+Test a bitmap that spans multiple buffer flushes.
Testing with buffer size 8.
Testing writes: [bitmap(10101010.11001100.01000110.10111001.10101010.11001100.01000110.10111001.10101010.11001100.01000110.10111001.10101010.11001100.01000110.10111001.01010101.00110010.00110100.10101010.10011001.00011010.01010101.01001100.10001101.00101010.10100110.01000110.10010101.01010011.00100011.01001010.10101001.10010001.101001, 0, 278), pad_to_byte]
Expected result: 10101010.11001100.01000110.10111001.10101010.11001100.01000110.10111001.10101010.11001100.01000110.10111001.10101010.11001100.01000110.10111001.01010101.00110010.00110100.10101010.10011001.00011010.01010101.01001100.10001101.00101010.10100110.01000110.10010101.01010011.00100011.01001010.10101001.10010001.10100100
@@ -108,9 +108,9 @@
Collected bitmap compares OK.
I/O bitmap compares OK.
bitmap reads failed as expected:
-univ_cons(buffer_error(unexpected_eof))
+univ_cons("bitmap: error in request 26" - bits(170, 0, 8))
I/O reads failed as expected:
-univ_cons(buffer_error(unexpected_eof))
+univ_cons("I/O: error in request 26" - bits(170, 0, 8))
Test read sequence of bitmaps one byte too long.
Testing sequence that should cause an error:
@@ -121,9 +121,9 @@
Collected bitmap compares OK.
I/O bitmap compares OK.
bitmap reads failed as expected:
-univ_cons("bitmap: error in request 1" - buffer_error(unexpected_eof))
+univ_cons("bitmap: error in request 1" - bitmap("<136:AACC46B9AACC46B9AACC46B9AACC46B955>", "<136:AACC46B9AACC46B9AACC46B9AACC46B900>", 136, 128))
I/O reads failed as expected:
-univ_cons("I/O: error in request 1" - buffer_error(unexpected_eof))
+univ_cons("I/O: error in request 1" - bitmap("<136:AACC46B9AACC46B9AACC46B9AACC46B955>", "<136:AACC46B9AACC46B9AACC46B9AACC46B900>", 136, 128))
Test read sequence of bitmaps one byte too long.
Testing sequence that should cause an error:
@@ -134,9 +134,9 @@
Collected bitmap compares OK.
I/O bitmap compares OK.
bitmap reads failed as expected:
-univ_cons("bitmap: error in request 1" - buffer_error(unexpected_eof))
+univ_cons("bitmap: error in request 1" - bitmap("<136:AACC46B9AACC46B9AACC46B9AACC46B955>", "<136:AACC46B9AACC46B9AACC46B9AACC46B900>", 136, 128))
I/O reads failed as expected:
-univ_cons("I/O: error in request 1" - buffer_error(unexpected_eof))
+univ_cons("I/O: error in request 1" - bitmap("<136:AACC46B9AACC46B9AACC46B9AACC46B955>", "<136:AACC46B9AACC46B9AACC46B9AACC46B900>", 136, 128))
Test non-zero padding bits.
Testing sequence that should cause an error:
@@ -147,9 +147,9 @@
Collected bitmap compares OK.
I/O bitmap compares OK.
bitmap reads failed as expected:
-univ_cons("bitmap: error in request 2" - buffer_error(expected_padding_zeros))
+univ_cons("bitmap: error in request 2" - bits(0, 42, 6))
I/O reads failed as expected:
-univ_cons("I/O: error in request 2" - buffer_error(expected_padding_zeros))
+univ_cons("I/O: error in request 2" - bits(0, 42, 6))
========== Bitmap error tests ==========
Test eof when skipping padding in bitmap
@@ -159,7 +159,7 @@
Using error requests:
[bits(0, 1), pad_to_byte]
bitmap reads failed as expected:
-univ_cons("bitmap: error in request 2" - buffer_error(unexpected_eof))
+univ_cons("bitmap: error in request 2" - bits(0, 0, 7))
========== Argument Error Tests ==========
Testing sequence that should cause an error:
@@ -219,7 +219,7 @@
Collected bitmap compares OK.
I/O bitmap compares OK.
stream read error reads failed as expected:
-univ_cons(stream_error(bang))
+univ_cons(bang)
Test error when refilling buffer
Testing sequence that should cause an error:
@@ -230,5 +230,5 @@
Collected bitmap compares OK.
I/O bitmap compares OK.
stream read error reads failed as expected:
-univ_cons(stream_error(bang))
+univ_cons(bang)
Index: tests/hard_coded/bit_buffer_test.m
===================================================================
RCS file: tests/hard_coded/bit_buffer_test.m
diff -N tests/hard_coded/bit_buffer_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/bit_buffer_test.m 26 May 2007 14:42:43 -0000
@@ -0,0 +1,767 @@
+%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ft=mercury
+%-----------------------------------------------------------------------------%
+:- module bit_buffer_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module assoc_list.
+:- import_module bitmap.
+:- import_module bit_buffer.
+:- import_module bit_buffer.read.
+:- import_module bit_buffer.write.
+:- import_module bitmap.
+:- import_module bool.
+:- import_module exception.
+:- import_module int.
+:- import_module list.
+:- import_module pair.
+:- import_module stream.
+:- import_module string.
+:- import_module univ.
+
+:- type request
+ ---> bits(word, num_bits)
+ ; bitmap(bitmap, bit_index, num_bits)
+ ; flush
+ ; pad_to_byte
+ ; check_buffer_status(stream.result(univ))
+ .
+
+:- type read_error
+ ---> bits(expected_word :: word, found_word :: word, num_bits)
+ ; bitmap(expected_bitmap :: bitmap, found_bitmap :: bitmap,
+ request_size :: num_bits, bits_read :: num_bits)
+ ; check_buffer_status(expected_status :: stream.result(univ),
+ found_status :: stream.result(univ)).
+
+main(!IO) :-
+ % Distinctive byte patterns so we can tell where bits came from.
+ %
+ Byte1 = 0b10101010,
+ Byte2 = 0b11001100,
+ Byte3 = 0b01000110,
+ Byte4 = 0b10111001,
+
+ % Uncomment this to debug read errors.
+ % bit_buffer.read.set_logging_level(1, !IO),
+
+ some [!Seq, !ShortBM, !ShortSeq, !LongSeq, !ShortBM, !LongBM, !ErrorSeq] (
+ %
+ % Test with request sequences that are a minimum of 8 bytes to
+ % test overflow even on 64-bit machines (buffers are at least
+ % as big as the word size).
+ %
+
+ io.write_string("Test reading and writing full bytes.\n", !IO),
+ !:Seq = condense(duplicate(4,
+ [bits(Byte1, 8), bits(Byte2, 8), check_buffer_status(ok),
+ bits(Byte3, 8), bits(0, 0), bits(Byte4, 8)]))
+ ++ [check_buffer_status(eof)],
+ Seq1 = !.Seq,
+ test_sequence(8, !.Seq, !IO),
+
+ io.write_string("Test reading and writing partial bytes.\n", !IO),
+
+ % This also tests a request split over a flush and handling of
+ % a list of requests for which the length is not a multiple of
+ % the buffer size.
+ %
+ !:Seq = condense(duplicate(6,
+ [bits(Byte1, 7), bits(1, 1), bits(Byte2, 6),
+ bits(Byte3, 7), bits(Byte4, 4)])),
+ Seq2 = !.Seq,
+ test_sequence(8, !.Seq, !IO),
+
+ io.write_string(
+ "Test flushes when the stream is at a byte boundary and when it is not.\n",
+ !IO),
+ !:Seq = condense(duplicate(6,
+ [flush, bits(Byte1, 7), bits(0, 1), flush, bits(Byte2, 6),
+ bits(Byte3, 7), flush, bits(Byte4, 4)])),
+ test_sequence(8, !.Seq, !IO),
+
+ % A short simple bitmap.
+ %
+ !:Seq = [bits(Byte1, 8), bits(Byte2, 8), bits(Byte3, 8)],
+ BM1 = requests_to_bitmap(!.Seq),
+
+ % A longer bitmap.
+ %
+ BM2 = requests_to_bitmap(Seq1 ++ Seq2),
+
+ io.write_string("Test simple reading and writing of bitmaps.\n", !IO),
+ !:Seq = [bitmap(BM1, 0, num_bits(BM1))],
+ test_sequence(8, !.Seq, !IO),
+
+ io.write_string("Test a simple offset bitmap read.\n", !IO),
+ !:Seq = [bitmap(BM1, bits_per_byte,
+ num_bits(BM1) - bits_per_byte)],
+ test_sequence(8, !.Seq, !IO),
+
+ io.write_string("Test zero size requests.\n", !IO),
+ !:Seq = [bits(Byte2, 0), bits(Byte1, 4),
+ bits(Byte2, 0), bitmap(BM1, 0, 0)],
+ test_sequence(8, !.Seq, !IO),
+
+ io.write_string("Test pad_to_byte\n", !IO),
+ !:Seq = [pad_to_byte, bits(Byte1, 3), pad_to_byte, pad_to_byte,
+ bits(Byte2, 8), pad_to_byte, bits(Byte2, 2)],
+ test_sequence(8, !.Seq, !IO),
+
+ io.write_string("Test a bitmap that spans multiple buffer flushes.\n",
+ !IO),
+ !:Seq = [bitmap(BM2, 0, num_bits(BM2))],
+ test_sequence(8, !.Seq, !IO),
+
+ io.write_string(
+ "Test a bitmap starting at a position that isn't on a byte boundary.\n",
+ !IO),
+ !:Seq = [bits(Byte1, 3), bitmap(BM2, 0, num_bits(BM2))],
+ test_sequence(8, !.Seq, !IO),
+
+ io.write_string("Test offsets passed to put_bitmap.\n", !IO),
+ !:Seq = [bits(Byte1, 3), bitmap(BM2, 3, num_bits(BM2) - 3)],
+ test_sequence(8, !.Seq, !IO),
+
+ io.write_string("========== Read Error Tests ==========\n", !IO),
+
+ io.write_string("Test unexpected end-of-file.\n", !IO),
+ !:ShortSeq = Seq1,
+ !:LongSeq = Seq1 ++ Seq1,
+ test_error_sequence(io_and_bitmap, 8, !.ShortSeq, !.LongSeq, !IO),
+
+ io.write_string(
+ "Test read sequence of bitmaps one byte too long.\n", !IO),
+ !:LongBM = shrink_without_copying(copy(BM2), 136),
+ !:ShortBM = shrink_without_copying(copy(BM2), 128),
+ !:ShortSeq = [bitmap(!.ShortBM, 0, num_bits(!.ShortBM))],
+ !:LongSeq = [bitmap(!.LongBM, 0, num_bits(!.LongBM))],
+ test_error_sequence(io_and_bitmap, 8, !.ShortSeq, !.LongSeq, !IO),
+
+ io.write_string(
+ "Test read sequence of bitmaps one byte too long.\n", !IO),
+ !:LongBM = shrink_without_copying(copy(BM2), 136),
+ !:ShortBM = shrink_without_copying(copy(BM2), 128),
+ !:ShortSeq = [bitmap(!.ShortBM, 0, num_bits(!.ShortBM))],
+ !:LongSeq = [bitmap(!.LongBM, 0, num_bits(!.LongBM))],
+ test_error_sequence(io_and_bitmap, 8, !.ShortSeq, !.LongSeq, !IO),
+
+ io.write_string("Test non-zero padding bits.\n", !IO),
+ PaddingBitsErrorSeq = [bits(Byte1, 2), pad_to_byte],
+ test_error_sequence(io_and_bitmap, 8, Seq1, PaddingBitsErrorSeq, !IO),
+
+ % Test cases which only occur with bitmaps of a size not a multiple
+ % of bits_per_byte.
+ %
+ io.write_string("========== Bitmap error tests ==========\n", !IO),
+ io.write_string("Test eof when skipping padding in bitmap\n", !IO),
+ !:Seq = [bits(0, 7)],
+ !:ErrorSeq = [bits(0, 1), pad_to_byte],
+ test_error_sequence(bitmap_only, 8, !.Seq, !.ErrorSeq, !IO),
+
+ io.write_string("========== Argument Error Tests ==========\n", !IO),
+ test_error_sequence(io_and_bitmap, 8, Seq1, [bits(0, -1)], !IO),
+ test_error_sequence(io_and_bitmap, 8, Seq1, [bits(0, 100)], !IO),
+ test_error_sequence(io_and_bitmap, 8, Seq1, [bitmap(BM1, 0, -1)], !IO),
+ test_error_sequence(io_and_bitmap, 8, Seq1,
+ [bitmap(BM1, 0, 10000)], !IO),
+
+ io.write_string("========== Stream Error Tests ==========\n", !IO),
+ test_error_sequence(timebomb(10), 8, Seq1, Seq1, !IO),
+
+ io.write_string("Test error when refilling buffer\n", !IO),
+ !:Seq = [bitmap(shrink_without_copying(copy(BM2), 72), 0, 72)],
+ !:ErrorSeq = [bits(BM2 ^ bits(0, 32), 32),
+ bits(BM2 ^ bits(32, 32), 32),
+ check_buffer_status(ok),
+ bits(BM2 ^ bits(64, 8), 8)],
+ test_error_sequence(timebomb(8), 8, !.Seq, !.ErrorSeq, !IO)
+ ),
+ io.remove_file(bit_buffer_test_tmp_file, _, !IO).
+
+:- pred test_sequence(num_bytes::in, list(request)::in,
+ io::di, io::uo) is det.
+
+test_sequence(BufferSize, Requests0, !IO) :-
+
+ % This makes the results for bitmap and I/O buffers consistent.
+ Requests = Requests0 ++ [pad_to_byte],
+
+ io.format("Testing with buffer size %d.\n", [i(BufferSize)], !IO),
+ TempFile = bit_buffer_test_tmp_file,
+ io.write_string("Testing writes: [", !IO),
+ io.write_list(Requests, ", ", output_request, !IO),
+ io.write_string("]\n", !IO),
+ io.write_string("Expected result: ", !IO),
+ ExpectedBM = requests_to_bitmap(Requests),
+ io.write_string(to_byte_string(ExpectedBM), !IO),
+ io.nl(!IO),
+ io.flush_output(!IO),
+ test_writes(BufferSize, TempFile, Requests, ExpectedBM, !IO),
+ io.write_string("Testing reads:\n", !IO),
+ test_reads(BufferSize, TempFile, Requests, ExpectedBM, !IO),
+ io.write_string("\n", !IO),
+ io.flush_output(!IO).
+
+ % Read the given number of bits, then fail on the next.
+:- type timer == int.
+
+:- type error_test_type
+ ---> io_and_bitmap
+ ; bitmap_only
+ ; timebomb(timer)
+ .
+
+ % SetupRequests will set up a bitmap and the file returned by
+ % `bit_buffer_test_tmp_file'. Requests is a list of requests
+ % that will result in a read error when applied to that input.
+ %
+:- pred test_error_sequence(error_test_type::in, num_bytes::in,
+ list(request)::in, list(request)::in,
+ io::di, io::uo) is cc_multi.
+
+test_error_sequence(ErrorTestType, BufferSize,
+ SetupRequests0, Requests0, !IO) :-
+ (
+ ErrorTestType = io_and_bitmap,
+ % This makes the results for bitmap and I/O buffers consistent.
+ Requests = Requests0 ++ [pad_to_byte],
+ SetupRequests = SetupRequests0 ++ [pad_to_byte]
+ ;
+ ErrorTestType = bitmap_only,
+ SetupRequests = SetupRequests0,
+ Requests = Requests0
+ ;
+ ErrorTestType = timebomb(_),
+ SetupRequests = SetupRequests0,
+ Requests = Requests0
+ ),
+
+ io.write_string("Testing sequence that should cause an error:\n", !IO),
+ io.write_string("Using setup requests:\n", !IO),
+ io.write(SetupRequests, !IO),
+ io.nl(!IO),
+ io.write_string("Using error requests:\n", !IO),
+ io.write(Requests, !IO),
+ io.nl(!IO),
+ ExpectedBM = requests_to_bitmap(SetupRequests),
+ TempFile = bit_buffer_test_tmp_file,
+ ( ( ErrorTestType = io_and_bitmap ; ErrorTestType = timebomb(_) ) ->
+ test_writes(8, TempFile, SetupRequests, ExpectedBM, !IO)
+ ;
+ true
+ ),
+ (
+ ( ErrorTestType = io_and_bitmap
+ ; ErrorTestType = bitmap_only
+ )
+ ->
+ check_that_error_occurs("bitmap",
+ test_bitmap_reads(Requests, ExpectedBM),
+ !IO)
+ ;
+ true
+ ),
+ (
+ ErrorTestType = io_and_bitmap
+ ->
+ check_that_error_occurs("I/O",
+ test_io_reads(BufferSize, TempFile, Requests),
+ !IO)
+ ;
+ true
+ ),
+ (
+ ErrorTestType = timebomb(Timer)
+ ->
+ check_that_error_occurs("stream read error",
+ test_io_timebomb_reads(BufferSize, Timer, TempFile, Requests),
+ !IO)
+ ;
+ true
+ ),
+
+ io.write_string("\n", !IO),
+ io.flush_output(!IO).
+
+:- pred check_that_error_occurs(string::in,
+ pred(io, io)::(pred(di, uo) is det), io::di, io::uo) is cc_multi.
+
+check_that_error_occurs(Desc, P, !IO) :-
+ Q = (pred({}::out, !.IO::di, !:IO::uo) is det :- P(!IO)),
+ try_io(Q, Result, !IO),
+ (
+ Result = succeeded(_),
+ io.write_string(Desc ++ " reads unexpectedly succeeded\n", !IO)
+ ;
+ Result = exception(Error),
+ io.write_string(Desc ++ " reads failed as expected:\n", !IO),
+ io.write(Error, !IO),
+ io.nl(!IO)
+ ).
+
+:- pred output_request(request::in, io::di, io::uo) is det.
+
+output_request(bits(Word, NumBits), !IO) :-
+ io.write_string("bits(", !IO),
+ io.write_string(int_to_base_string(Word, 2), !IO),
+ io.write_string(", ", !IO),
+ io.write_int(NumBits, !IO),
+ io.write_string(")", !IO).
+output_request(bitmap(BM, Index, NumBits), !IO) :-
+ io.write_string("bitmap(", !IO),
+ io.write_string(bitmap.to_byte_string(BM), !IO),
+ io.write_string(", ", !IO),
+ io.write_int(Index, !IO),
+ io.write_string(", ", !IO),
+ io.write_int(NumBits, !IO),
+ io.write_string(")", !IO).
+output_request(pad_to_byte, !IO) :-
+ io.write_string("pad_to_byte", !IO).
+output_request(flush, !IO) :-
+ io.write_string("flush", !IO).
+output_request(check_buffer_status(BufferStatus), !IO) :-
+ io.write_string("check_buffer_status(", !IO),
+ io.write(BufferStatus, !IO),
+ io.write_string(")", !IO).
+
+:- pred test_writes(num_bytes::in, string::in, list(request)::in,
+ bitmap::in, io::di, io::uo) is det.
+
+test_writes(BufferSize, FileName, Writes, ExpectedBM, !IO) :-
+ io.open_binary_output(FileName, WriteOpenRes, !IO),
+ (
+ WriteOpenRes = ok(WriteStream),
+ some [!BMBuffer, !IOBuffer] (
+ !:BMBuffer = new_bitmap_builder(BufferSize),
+ !:IOBuffer = new(BufferSize, WriteStream, !.IO),
+
+ list.foldl(do_write, Writes, !BMBuffer),
+ list.foldl(do_write, Writes, !IOBuffer),
+
+ finalize(!.IOBuffer, _, !:IO),
+ BM = finalize_to_bitmap(!.BMBuffer),
+ io.close_binary_output(WriteStream, !IO)
+ ),
+
+ ( BM = ExpectedBM ->
+ io.write_string("Collected bitmap compares OK.\n", !IO)
+ ;
+ io.write_string("Collected bitmap differs: \n", !IO),
+ io.write_string(to_byte_string(BM), !IO),
+ io.nl(!IO),
+ io.flush_output(!IO)
+ ),
+
+ io.open_binary_input(FileName, ReadOpenRes, !IO),
+ (
+ ReadOpenRes = ok(ReadStream),
+ io.read_binary_file_as_bitmap(ReadStream, BMReadResult, !IO),
+ (
+ BMReadResult = ok(ReadBM),
+ ( ReadBM = ExpectedBM ->
+ io.write_string("I/O bitmap compares OK.\n", !IO),
+ io.flush_output(!IO)
+ ;
+ io.write_string("I/O bitmap differs: \n", !IO),
+ io.write_string(to_byte_string(ReadBM), !IO),
+ io.nl(!IO),
+ io.flush_output(!IO)
+ )
+ ;
+ BMReadResult = error(Error),
+ io.write_string(io.error_message(Error), !IO),
+ io.nl(!IO),
+ io.flush_output(!IO)
+ ),
+ io.close_binary_input(ReadStream, !IO)
+ ;
+ ReadOpenRes = error(Msg),
+ io.write_string(io.error_message(Msg), !IO),
+ io.nl(!IO),
+ io.flush_output(!IO)
+ )
+ ;
+ WriteOpenRes = error(Msg),
+ io.write_string(io.error_message(Msg), !IO),
+ io.nl(!IO),
+ io.flush_output(!IO)
+ ).
+
+:- pred do_write(request::in,
+ write_buffer(S, St)::write_buffer_di,
+ write_buffer(S, St)::write_buffer_uo) is det
+ <= stream.writer(S, bitmap.slice, St).
+
+do_write(bits(Word, NumBits), !Buffer) :-
+ ( NumBits = 1 ->
+ Bit = ( Word = 0 -> no ; yes ),
+ put_bit(Bit, !Buffer)
+ ; NumBits = 8 ->
+ put_byte(Word, !Buffer)
+ ;
+ put_bits(Word, NumBits, !Buffer)
+ ).
+do_write(bitmap(BM, Index, NumBits), !Buffer) :-
+ ( Index = 0, NumBits = BM ^ num_bits ->
+ put_bitmap(BM, !Buffer)
+ ;
+ put_bitmap(BM, Index, NumBits, !Buffer)
+ ).
+do_write(pad_to_byte, !Buffer) :-
+ NumPaddingBits = num_bits_to_byte_boundary(!.Buffer),
+ put_bits(0, NumPaddingBits, !Buffer).
+do_write(flush, !Buffer) :-
+ flush(!Buffer).
+do_write(check_buffer_status(_), !Buffer).
+
+ % Create a bitmap directly from the list of requests.
+:- func requests_to_bitmap(list(request)::in) =
+ (bitmap::bitmap_uo) is det.
+
+requests_to_bitmap(Requests) = !:BM :-
+ Size = request_list_length(Requests, 0),
+ !:BM = bitmap.new(Size),
+ list.foldl2(request_to_bitmap, Requests, 0, _, !BM).
+
+:- func request_list_length(list(request), int) = int.
+
+request_list_length([], L) = L.
+request_list_length([Req | Reqs], L0) = L :-
+ ( Req = bits(_, NumBits)
+ ; Req = bitmap(_, _, NumBits)
+ ; Req = pad_to_byte, Rem = L0 `rem` bits_per_byte,
+ NumBits = ( Rem = 0 -> 0 ; bits_per_byte - Rem )
+ ; Req = flush, NumBits = 0
+ ; Req = check_buffer_status(_), NumBits = 0
+ ),
+ L = request_list_length(Reqs, L0 + NumBits).
+
+:- pred request_to_bitmap(request::in, int::in, int::out,
+ bitmap::bitmap_di, bitmap::bitmap_uo) is det.
+
+request_to_bitmap(bits(Word, NumBits), !Index, !BM) :-
+ !:BM = !.BM ^ bits(!.Index, NumBits) := Word,
+ !:Index = !.Index + NumBits.
+request_to_bitmap(bitmap(OtherBM, Start, NumBits), !Index, !BM) :-
+ !:BM = copy_bits(OtherBM, Start, !.BM, !.Index, NumBits),
+ !:Index = !.Index + NumBits.
+request_to_bitmap(pad_to_byte, !Index, !BM) :-
+ Rem = !.Index `rem` bits_per_byte,
+ NumBits = ( Rem = 0 -> 0 ; bits_per_byte - Rem ),
+ !:BM = !.BM ^ bits(!.Index, NumBits) := 0,
+ !:Index = !.Index + NumBits.
+request_to_bitmap(flush, !Index, !BM).
+request_to_bitmap(check_buffer_status(_), !Index, !BM).
+
+:- pred test_reads(num_bytes::in, string::in, list(request)::in,
+ bitmap::in, io::di, io::uo) is det.
+
+test_reads(BufferSize, FileName, Requests, ExpectedBM, !IO) :-
+ test_bitmap_reads(Requests, ExpectedBM, !IO),
+ test_io_reads(BufferSize, FileName, Requests, !IO).
+
+:- pred test_bitmap_reads(list(request)::in,
+ bitmap::in, io::di, io::uo) is det.
+
+test_bitmap_reads(Requests, ExpectedBM, !IO) :-
+ some [!BMBuffer] (
+ !:BMBuffer = new_bitmap_reader(ExpectedBM, 0, ExpectedBM ^ num_bits),
+ do_reads("bitmap", 1, Requests, !BMBuffer),
+ finalize(!.BMBuffer, _, _, _, _, BMNumFinalBits),
+ ( BMNumFinalBits = 0 ->
+ true
+ ;
+ throw(string.format("bitmap reader has %d bits left over: \n",
+ [i(BMNumFinalBits)]) : string)
+ ),
+ io.write_string("bitmap read tests completed.\n", !IO)
+ ).
+
+:- pred test_io_reads(num_bytes::in, string::in, list(request)::in,
+ io::di, io::uo) is det.
+
+test_io_reads(BufferSize, FileName, Requests, !IO) :-
+ io.open_binary_input(FileName, ReadOpenRes, !IO),
+ some [!IOBuffer] (
+ ReadOpenRes = ok(ReadStream),
+ !:IOBuffer = new(BufferSize, ReadStream, !.IO) : io_read_buffer,
+ do_reads("I/O", 1, Requests, !IOBuffer),
+ finalize(!.IOBuffer, _, !:IO, _, _, IONumFinalBits),
+ ( IONumFinalBits = 0 ->
+ true
+ ;
+ throw(string.format("I/O reader has %d bits left over: \n",
+ [i(IONumFinalBits)]): string)
+ ),
+ io.write_string("I/O read tests completed.\n", !IO),
+ io.close_binary_input(ReadStream, !IO)
+ ;
+ ReadOpenRes = error(Msg),
+ throw(Msg)
+ ).
+
+:- pred test_io_timebomb_reads(num_bytes::in, num_bytes::in,
+ string::in, list(request)::in, io::di, io::uo) is det.
+
+test_io_timebomb_reads(BufferSize, Countdown, FileName, Requests, !IO) :-
+ io.open_binary_input(FileName, ReadOpenRes, !IO),
+ some [!ErrorBuffer] (
+ ReadOpenRes = ok(ReadStream),
+ ErrorState0 = 'new timebomb_state'(ReadStream, !.IO, Countdown),
+ !:ErrorBuffer = bit_buffer.read.new(BufferSize,
+ timebomb_byte_stream,
+ unsafe_promise_unique(ErrorState0)) :
+ read_buffer(timebomb_byte_stream,
+ timebomb_state, timebomb_error),
+
+ do_reads("timebomb", 1, Requests, !ErrorBuffer),
+ finalize(!.ErrorBuffer, _, ErrorState, _, _, ErrorNumFinalBits),
+ ( ErrorNumFinalBits = 0 ->
+ true
+ ;
+ throw(string.format("timebomb reader has %d bits left over: \n",
+ [i(ErrorNumFinalBits)]) : string)
+ ),
+ det_univ_to_type(univ(ErrorState ^ timebombed_state), !:IO),
+ !:IO = unsafe_promise_unique(!.IO),
+ io.write_string("timebomb read tests completed.\n", !IO),
+ io.close_binary_input(ReadStream, !IO)
+ ;
+ ReadOpenRes = error(Msg),
+ throw(Msg)
+ ).
+
+:- pred do_reads(string::in, int::in, list(request)::in,
+ read_buffer(S, St, E)::read_buffer_di,
+ read_buffer(S, St, E)::read_buffer_uo) is det
+ <= stream.bulk_reader(S, byte_index, bitmap, St, E).
+
+do_reads(_, _, [], !Buffer).
+do_reads(Desc, Index, [Req | Reqs], !Buffer) :-
+ do_read(Desc, Index, Req, !Buffer),
+ do_reads(Desc, Index + 1, Reqs, !Buffer).
+
+:- pred do_read(string::in, int::in, request::in,
+ read_buffer(S, St, E)::read_buffer_di,
+ read_buffer(S, St, E)::read_buffer_uo) is det
+ <= stream.bulk_reader(S, byte_index, bitmap, St, E).
+
+do_read(Desc, ReqIndex, bits(ExpectedWord0, NumBits), !Buffer) :-
+ ExpectedWord = mask_word(ExpectedWord0, NumBits),
+ ( NumBits = 1 ->
+ get_bit(GetResult, !Buffer),
+ (
+ GetResult = ok(ResultBit),
+ ResultWord = ( ResultBit = yes -> 1 ; 0 ),
+ ( ResultWord = ExpectedWord ->
+ true
+ ;
+ throw_read_result_error(bits(ExpectedWord, ResultWord, 1),
+ Desc, ReqIndex)
+ )
+ ;
+ GetResult = eof,
+ throw("bit_buffer_test: unexpected eof in get_bit")
+ ;
+ GetResult = error(Err),
+ throw(Err)
+ )
+ ;
+ get_bits(bits_per_int - NumBits, NumBits, 0, ResultWord,
+ NumBitsRead, GetResult, !Buffer),
+ (
+ GetResult = ok,
+ ( NumBitsRead = NumBits, ExpectedWord = ResultWord ->
+ true
+ ;
+ throw_read_result_error(
+ bits(ExpectedWord, ResultWord, NumBits),
+ Desc, ReqIndex)
+ )
+ ;
+ GetResult = error(Err),
+ throw(Err)
+ )
+ ).
+
+do_read(Desc, ReqIndex, bitmap(SourceBM, Index, NumBits), !Buffer) :-
+ some [!BM] (
+ !:BM = bitmap.new(SourceBM ^ num_bits),
+ ( Index = 0, NumBits = SourceBM ^ num_bits ->
+ get_bitmap(!BM, BitsRead, GetResult, !Buffer)
+ ;
+ get_bitmap(Index, NumBits, !BM, BitsRead, GetResult, !Buffer)
+ ),
+ (
+ GetResult = ok,
+ ExpectedBM0 = bitmap.new(SourceBM ^ num_bits),
+ ExpectedBM = copy_bits(SourceBM, Index,
+ ExpectedBM0, Index, NumBits),
+ ( ExpectedBM = !.BM ->
+ true
+ ;
+ throw_read_result_error(
+ bitmap(ExpectedBM, !.BM, NumBits, BitsRead),
+ Desc, ReqIndex)
+ )
+ ;
+ GetResult = error(Err),
+ throw_read_stream_error(Err, Desc, ReqIndex)
+ )
+ ).
+do_read(Desc, ReqIndex, pad_to_byte, !Buffer) :-
+ NumPaddingBits = num_bits_to_byte_boundary(!.Buffer),
+ do_read(Desc, ReqIndex, bits(0, NumPaddingBits), !Buffer).
+do_read(_Desc, _Index, flush, !Buffer).
+do_read(Desc, ReqIndex, check_buffer_status(ExpectedStatus), !Buffer) :-
+ buffer_status(FoundStatus0, !Buffer),
+ ( FoundStatus0 = ok, FoundStatus = ok
+ ; FoundStatus0 = eof, FoundStatus = eof
+ ; FoundStatus0 = error(Err),
+ FoundStatus = error(univ(Err))
+ ),
+ ( ExpectedStatus = FoundStatus ->
+ true
+ ;
+ throw_read_result_error(
+ check_buffer_status(ExpectedStatus, FoundStatus),
+ Desc, ReqIndex)
+ ).
+
+:- type read_result_exception == pair(string, read_error).
+
+:- pred throw_read_result_error(read_error::in, string::in, int::in)
+ is erroneous.
+
+throw_read_result_error(Error, Desc, ReqIndex) :-
+ throw((Desc ++ ": error in request " ++ int_to_string(ReqIndex)) - Error).
+
+:- pred throw_read_stream_error(T::in, string::in, int::in)
+ is erroneous.
+
+throw_read_stream_error(Error, Desc, ReqIndex) :-
+ throw((Desc ++ ": error in request " ++ int_to_string(ReqIndex)) - Error).
+
+:- func mask_word(word, num_bits) = word.
+
+mask_word(ExpectedWord0, N) = ExpectedWord :-
+ ( N \= 0 ->
+ BitMask = 1 `unchecked_left_shift` (N - 1),
+ BitsMask = BitMask \/ (BitMask - 1),
+ ExpectedWord = ExpectedWord0 /\ BitsMask
+ ;
+ ExpectedWord = 0
+ ).
+
+:- func bit_buffer_test_tmp_file = string.
+
+bit_buffer_test_tmp_file = "bit_buffer_test_tmp".
+
+ % A timebomb stream counts down bytes until it returns an error.
+ % XXX It should be possible to produce a generic version of this
+ % that works on all Unit types, but the current restrictions on
+ % instances don't allow that. Also, the Error type of the stream
+ % can't be exposed for the same reason.
+ %
+:- type timebomb_byte_stream ---> timebomb_byte_stream.
+:- type timebomb_state ---> some [Stream, State, Error]
+ timebomb_state(timebombed_stream :: Stream,
+ timebombed_state :: State, countdown :: int) =>
+ (reader(Stream, byte, State, Error),
+ bulk_reader(Stream, int, bitmap, State, Error)).
+
+:- type timebomb_error
+ ---> bang
+ ; already_exploded
+ ; stream_error(univ).
+
+:- instance stream.error(timebomb_error) where [
+ error_message(bang) = "Bang!!!",
+ error_message(already_exploded) = "This stream is already exploded.",
+ error_message(stream_error(_Univ)) = "stream_error"
+].
+
+:- instance stream.stream(timebomb_byte_stream, timebomb_state) where [
+ name(_, "timebomb_byte_stream", !State)
+].
+
+:- instance stream.input(timebomb_byte_stream, timebomb_state) where [].
+
+:- instance stream.reader(timebomb_byte_stream, byte,
+ timebomb_state, timebomb_error)
+ where
+[
+ (get(_Stream, Result, !.State, unsafe_promise_unique(!:State)) :-
+ !.State = timebomb_state(TStream, TState0, Countdown0),
+ ( Countdown0 < 0 ->
+ Result = error(already_exploded)
+ ; Countdown0 = 0 ->
+ Result = error(bang),
+ !:State = 'new timebomb_state'(TStream, TState0, -1)
+ ;
+ get(TStream, ByteResult, unsafe_promise_unique(TState0), TState),
+ (
+ ByteResult = ok(Byte),
+ Countdown = Countdown0 - 1,
+ Result = ok(Byte)
+ ;
+ ByteResult = eof,
+ Countdown = -1,
+ Result = eof
+ ;
+ ByteResult = error(Error),
+ Countdown = -1,
+ Result = error(stream_error(univ(Error)))
+ ),
+ !:State = 'new timebomb_state'(TStream, TState, Countdown)
+ )
+ )
+].
+
+:- instance stream.bulk_reader(timebomb_byte_stream, int, bitmap,
+ timebomb_state, timebomb_error)
+ where
+[
+ (bulk_get(_, Index, NumBytes, !BM, NumBytesRead, Result,
+ !.State, unsafe_promise_unique(!:State)) :-
+ !.State = timebomb_state(TStream, TState0, Countdown0),
+ ( Countdown0 < 0 ->
+ NumBytesRead = 0,
+ Result = error(already_exploded)
+ ; Countdown0 = 0 ->
+ NumBytesRead = 0,
+ Result = error(bang),
+ !:State = 'new timebomb_state'(TStream, TState0, -1)
+ ;
+ unsafe_promise_unique(TState0, TState1),
+ bulk_get(TStream, Index, NumBytes, !BM, NumBytesRead0,
+ BulkGetResult, TState1, TState),
+ (
+ BulkGetResult = ok,
+ ( NumBytesRead0 >= Countdown0 ->
+ NumBytesRead = Countdown0,
+ Result = error(bang)
+ ;
+ NumBytesRead = NumBytesRead0,
+ Result = ok
+ ),
+ Countdown = Countdown0 - NumBytesRead
+ ;
+ BulkGetResult = error(Error),
+ NumBytesRead = 0,
+ Countdown = -1,
+ Result = error(stream_error(univ(Error)))
+ ),
+ !:State = 'new timebomb_state'(TStream, TState, Countdown)
+ )
+ )
+].
+
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list