[m-rev.] for review: bit buffers
Simon Taylor
staylr at gmail.com
Mon May 14 16:17:12 AEST 2007
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.
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_test.exp:
Update for change to io.read_bitmap.
Test bounds error messages.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.460
diff -u -u -r1.460 NEWS
--- NEWS 10 May 2007 05:55:37 -0000 1.460
+++ NEWS 14 May 2007 05:52:35 -0000
@@ -92,25 +92,22 @@
for use as a general container for binary data. See runtime/mercury_types.h
for the new definition of the bitmap type for interoperability with C code.
-* Bitmaps now have fields `bit', `bits' and `byte' for getting and
+ Bitmaps now have fields `bit', `bits' and `byte' for getting and
setting a single bit, a group of bits (up to machine word size),
and an aligned eight bit byte respectively.
bitmap.get/2 has been deprecated; use bitmap.bit/2 instead.
-* Version bitmaps now have a field `bit' for getting and setting a single bit.
-
- version_bitmap.get/2 has been deprecated; use version_bitmap.bit/2 instead.
-
-* There are new functions in the bitmap module to move data around in bulk:
+ There are new functions to move data around in bulk:
copy_bits/5
copy_bits_in_bitmap/4
copy_bytes/5
copy_bytes_in_bitmap/4
-* The io module now contains predicates io.read_bitmap/{4,5,6,7} and
- io.write_bitmap{3,4,5,6}. io.write_bytes/{3,4} are now marked as
- obsolete.
+ Other added functions include:
+ shrink_without_copying/2
+ append_list/1
+ to_byte_string/1
* The operations in bitmap.m and version_bitmap.m which treat bitmaps
as sets have been modified to throw an exception when the input
@@ -118,9 +115,24 @@
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.
+ 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.
+
+ version_bitmap.get/2 has been deprecated; use version_bitmap.bit/2 instead.
-* bitmap.xor/2 and version_bitmap.xor/2 have been added.
+* The io module now contains predicates io.read_bitmap/{4,5,6,7},
+ io.write_bitmap{3,4,5,6} and io.read_file_as_bitmap/{3,4}.
+ io.write_bytes/{3,4} are now marked as obsolete. Note that the
+ interface of io.read_bitmap/* has changed since the first release
+ of the day implementation.
+
+* There are new modules bit_buffer, bit_buffer.write and bit_buffer.read
+ which give a bit-oriented interface to byte-oriented streams.
+
+* There are new typeclasses stream.bulk_reader/5 and stream.bulk_writer/4.
+ Instances of these classes support reading and writing of multiple
+ items at once to or from a container such as an array or a bitmap.
* Comparison of version_arrays is now the same as for arrays.
Index: library/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/mercury/library/Mercury.options,v
retrieving revision 1.23
diff -u -r1.23 Mercury.options
--- library/Mercury.options 13 Feb 2007 01:58:52 -0000 1.23
+++ library/Mercury.options 9 May 2007 04:50:43 -0000
@@ -32,16 +32,16 @@
# io.m uses library features that are supported by POSIX but which are not
# part of ANSI C, such as `struct stat', fileno(), and putenv().
# We need to pass --no-ansi to mgnuc to ensure that these are declared.
-MGNUCFLAGS-io = --no-ansi
+MGNUCFLAGS-io += --no-ansi
# This is needed to avoid errors on the calls that implement e.g. io.format/3
# in terms of io.format/4, and string.format/2 in terms of string.format/3.
# varset.trans_opt includes the relevant part of string.opt.
-MCFLAGS-io = --no-warn-unknown-format-calls
-MCFLAGS-stream = --no-warn-unknown-format-calls
-MCFLAGS-string = --no-warn-unknown-format-calls
+MCFLAGS-io += --no-warn-unknown-format-calls
+MCFLAGS-stream += --no-warn-unknown-format-calls
+MCFLAGS-string += --no-warn-unknown-format-calls
-MCFLAGS-mer_std = --no-warn-nothing-exported
+MCFLAGS-mer_std += --no-warn-nothing-exported
# Avoid warnings about insts with non-existent function symbols in their
# bound lists. The non-existent function symbols are used here to represent
Index: library/bit_buffer.m
===================================================================
RCS file: library/bit_buffer.m
diff -N library/bit_buffer.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/bit_buffer.m 14 May 2007 04:10:37 -0000
@@ -0,0 +1,350 @@
+%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ft=mercury
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2007 The University of Melbourne
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% File: bit_buffer.m.
+% Main author: stayl.
+% 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.
+%
+% 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
+% non-unique modes until the situation is rectified; this places
+% a small burden on the programmer to ensure the correctness of his
+% code that would otherwise be assured by the compiler.)
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module bit_buffer.
+
+:- interface.
+
+:- import_module bitmap.
+:- import_module stream.
+
+:- include_module bit_buffer.read.
+:- include_module bit_buffer.write.
+
+ % An error_stream throws an `error_stream_error' exception if any of
+ % its output methods are called, or returns an `error_stream_error'
+ % if any of its input methods are called.
+ %
+:- type error_stream ---> error_stream.
+:- type error_state ---> error_state.
+:- type error_stream_error
+ ---> error_stream_error.
+:- instance stream.error(error_stream_error).
+:- instance stream.stream(error_stream, error_state).
+:- instance stream.input(error_stream, error_state).
+:- instance stream.bulk_reader(error_stream, byte_index, bitmap,
+ error_state, error_stream_error).
+
+:- instance stream.output(error_stream, error_state).
+:- instance stream.bulk_writer(error_stream, byte_index, bitmap, error_state).
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module bool.
+:- import_module exception.
+:- import_module int.
+:- import_module list.
+
+:- instance stream.error(error_stream_error) where
+[
+ error_message(_) = "method called for error_stream"
+].
+
+:- instance stream.stream(error_stream, error_state) where
+[
+ name(_Stream, "error_stream", !State)
+].
+
+:- instance stream.input(error_stream, error_state) where
+[].
+
+:- instance stream.bulk_reader(error_stream, byte_index, bitmap,
+ error_state, error_stream_error) where
+[
+ bulk_get(_, _, _, !BM, 0, error(error_stream_error), !State)
+].
+
+:- instance stream.output(error_stream, error_state) where
+[
+ flush(_, !State) :- throw(error_stream_error)
+].
+
+:- instance stream.bulk_writer(error_stream, byte_index, bitmap, error_state)
+ where
+[
+ bulk_put(_, _, _, _, !State) :- throw(error_stream_error)
+].
+
+ % The bitmap has room for the chunk size given as an argument
+ % to `new', plus a word.
+ %
+ % This means that a for a write buffer a word can always
+ % be written to the buffer, and the buffer will be flushed
+ % if the position is greater than the chunk size.
+ %
+ % For a read_buffer, bits will be read from the input stream
+ % and placed starting at bit number `bits_per_int'. When the
+ % buffer is nearly exhausted (less than a word left), the last
+ % word is copied to the start of the buffer and the buffer is
+ % refilled.
+ %
+:- type bit_buffer(Stream, State, Error)
+ ---> bit_buffer(
+ mer_bitmap :: bitmap,
+ mer_pos :: bit_index,
+ mer_size :: num_bits,
+
+ mer_use_stream :: bool,
+
+ mer_stream :: Stream,
+ mer_state :: State,
+
+ % For write buffers only.
+ % If we're not writing to a stream, keep a list of filled
+ % bitmaps in reverse order. These will be concatenated
+ % into a single bitmap by finalize_to_bitmap.
+ %
+ mer_filled_bitmaps :: list(bitmap),
+
+ % For read buffers only. The first error found
+ % when reading from a stream. Subsequent calls
+ % will return this error.
+ %
+ mer_read_status :: stream.res(Error)
+ ).
+
+:- type bit_buffer(Stream, State) == bit_buffer(Stream, State, {}).
+
+ % XXX These should be unique.
+:- mode bit_buffer_ui == in.
+:- mode bit_buffer_di == in.
+:- mode bit_buffer_uo == out.
+
+ % Allocating memory for every read or write would be bad, so
+ % we manually perform destructive update in C.
+ %
+:- pragma foreign_decl("C", "
+typedef struct {
+ MR_BitmapPtr ML_bit_buffer_bitmap;
+ MR_Integer ML_bit_buffer_pos;
+ MR_Integer ML_bit_buffer_size;
+ MR_Word ML_bit_buffer_use_stream;
+ MR_Word ML_bit_buffer_stream;
+ MR_Word ML_bit_buffer_state;
+ MR_Word ML_bit_buffer_filled_bitmaps;
+ MR_Word ML_bit_buffer_read_status;
+} ML_BitBuffer;
+
+typedef ML_BitBuffer *ML_BitBufferPtr;
+").
+
+:- pragma foreign_type("C", bit_buffer(Stream, State, Error),
+ "ML_BitBufferPtr").
+
+:- func new_buffer(bitmap, bit_index, num_bits, bool, Stream, State) =
+ bit_buffer(Stream, State, Error).
+
+new_buffer(BM, Pos, Size, UseStream, Stream, State) =
+ ( if Size =< 0 then
+ throw("bit_buffer: invalid buffer size")
+ else
+ new_buffer_2(BM, Pos, Size, UseStream, Stream, State, ok)
+ ).
+
+:- func new_buffer_2(bitmap, num_bits, bit_index, bool,
+ Stream, State, stream.result(Error)) = bit_buffer(Stream, State, Error).
+
+new_buffer_2(BM, Pos, Size, UseStream, Stream, State, ReadStatus) =
+ bit_buffer(BM, Pos, Size, UseStream, Stream, State, [], ReadStatus).
+
+:- pragma foreign_proc("C",
+ new_buffer_2(BM::in, Pos::in, Size::in, UseStream::in,
+ Stream::in, State::in, ReadStatus::in) = (Buffer::out),
+ [will_not_call_mercury, promise_pure],
+"{
+ Buffer = MR_GC_NEW(ML_BitBuffer);
+ Buffer->ML_bit_buffer_bitmap = BM;
+ Buffer->ML_bit_buffer_pos = Pos;
+ Buffer->ML_bit_buffer_size = Size;
+ Buffer->ML_bit_buffer_use_stream = UseStream;
+ Buffer->ML_bit_buffer_stream = Stream;
+ Buffer->ML_bit_buffer_state = State;
+ Buffer->ML_bit_buffer_filled_bitmaps = MR_list_empty();
+ Buffer->ML_bit_buffer_read_status = ReadStatus;
+}").
+
+:- func (bit_buffer(_, _, _)::bit_buffer_ui) ^ bitmap =
+ (bitmap::bitmap_uo) is det.
+:- func (bit_buffer(_, _, _)::bit_buffer_ui) ^ pos = (int::out) is det.
+:- func (bit_buffer(_, _, _)::bit_buffer_ui) ^ size = (int::out) is det.
+:- func (bit_buffer(_, _, _)::bit_buffer_ui) ^ use_stream = (bool::out) is det.
+:- func (bit_buffer(Stream, _, _)::bit_buffer_ui) ^ stream =
+ (Stream::out) is det.
+:- func (bit_buffer(_, State, _)::bit_buffer_ui) ^ state = (State::uo) is det.
+:- func (bit_buffer(_, _, _)::bit_buffer_ui) ^ filled_bitmaps =
+ (list(bitmap)::out) is det.
+:- func (bit_buffer(_, _, Error)::bit_buffer_ui) ^ read_status =
+ (stream.res(Error)::out) is det.
+
+Buffer ^ bitmap = Buffer ^ mer_bitmap.
+Buffer ^ pos = Buffer ^ mer_pos.
+Buffer ^ size = Buffer ^ mer_size.
+Buffer ^ use_stream = Buffer ^ mer_use_stream.
+Buffer ^ stream = Buffer ^ mer_stream.
+Buffer ^ state = unsafe_promise_unique(Buffer ^ mer_state).
+Buffer ^ filled_bitmaps = Buffer ^ mer_filled_bitmaps.
+Buffer ^ read_status = Buffer ^ mer_read_status.
+
+:- pragma foreign_proc("C",
+ bitmap(Buffer::bit_buffer_ui) = (BM::bitmap_uo),
+ [will_not_call_mercury, promise_pure],
+ "BM = Buffer->ML_bit_buffer_bitmap;"
+).
+
+:- pragma foreign_proc("C",
+ pos(Buffer::bit_buffer_ui) = (Pos::out),
+ [will_not_call_mercury, promise_pure],
+ "Pos = Buffer->ML_bit_buffer_pos;"
+).
+
+:- pragma foreign_proc("C",
+ size(Buffer::bit_buffer_ui) = (Size::out),
+ [will_not_call_mercury, promise_pure],
+ "Size = Buffer->ML_bit_buffer_size;"
+).
+
+:- pragma foreign_proc("C",
+ use_stream(Buffer::bit_buffer_ui) = (UseStream::out),
+ [will_not_call_mercury, promise_pure],
+ "UseStream = Buffer->ML_bit_buffer_use_stream;"
+).
+
+:- pragma foreign_proc("C",
+ stream(Buffer::bit_buffer_ui) = (Stream::out),
+ [will_not_call_mercury, promise_pure],
+ "Stream = Buffer->ML_bit_buffer_stream;"
+).
+
+:- pragma foreign_proc("C",
+ state(Buffer::bit_buffer_ui) = (State::uo),
+ [will_not_call_mercury, promise_pure],
+ "State = Buffer->ML_bit_buffer_state;"
+).
+
+:- pragma foreign_proc("C",
+ filled_bitmaps(Buffer::bit_buffer_ui) = (FilledBMs::out),
+ [will_not_call_mercury, promise_pure],
+ "FilledBMs = Buffer->ML_bit_buffer_filled_bitmaps;"
+).
+
+:- pragma foreign_proc("C",
+ read_status(Buffer::bit_buffer_ui) = (ReadStatus::out),
+ [will_not_call_mercury, promise_pure],
+ "ReadStatus = Buffer->ML_bit_buffer_read_status;"
+).
+
+:- pred set_all(bitmap::bitmap_di, bit_index::in, num_bits::in, State::di,
+ list(bitmap)::in, bit_buffer(Stream, State, Error)::bit_buffer_di,
+ bit_buffer(Stream, State, Error)::bit_buffer_uo) is det.
+
+set_all(BM, Pos, Size, State, FilledBMs, !Buffer) :-
+ !:Buffer = ((((!.Buffer ^ mer_bitmap := BM)
+ ^ mer_pos := Pos)
+ ^ mer_state := State)
+ ^ mer_filled_bitmaps := FilledBMs)
+ ^ mer_size := Size.
+
+:- pragma foreign_proc("C",
+ set_all(BM::bitmap_di, Pos::in, Size::in, State::di, FilledBMs::in,
+ Buffer0::bit_buffer_di, Buffer::bit_buffer_uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Buffer = Buffer0;
+ Buffer->ML_bit_buffer_bitmap = BM;
+ Buffer->ML_bit_buffer_pos = Pos;
+ Buffer->ML_bit_buffer_size = Size;
+ Buffer->ML_bit_buffer_state = State;
+ Buffer->ML_bit_buffer_filled_bitmaps = FilledBMs;
+").
+
+:- pred set_bitmap(bitmap::bitmap_di, bit_index::in,
+ bit_buffer(Stream, State, Error)::bit_buffer_di,
+ bit_buffer(Stream, State, Error)::bit_buffer_uo) is det.
+
+set_bitmap(BM, Pos, !Buffer) :-
+ !:Buffer = (!.Buffer ^ mer_bitmap := BM)
+ ^ mer_pos := Pos.
+
+:- pragma foreign_proc("C",
+ set_bitmap(BM::bitmap_di, Pos::in,
+ Buffer0::bit_buffer_di, Buffer::bit_buffer_uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Buffer = Buffer0;
+ Buffer->ML_bit_buffer_bitmap = BM;
+ Buffer->ML_bit_buffer_pos = Pos;
+").
+
+:- pred set_state(State::di,
+ bit_buffer(Stream, State, Error)::bit_buffer_di,
+ bit_buffer(Stream, State, Error)::bit_buffer_uo) is det.
+
+set_state(State, !Buffer) :-
+ !:Buffer = !.Buffer ^ mer_state := State.
+
+:- pragma foreign_proc("C",
+ set_state(State::di, Buffer0::bit_buffer_di, Buffer::bit_buffer_uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Buffer = Buffer0;
+ Buffer->ML_bit_buffer_state = State;
+").
+
+:- pred set_use_stream(bool::in,
+ bit_buffer(Stream, State, Error)::bit_buffer_di,
+ bit_buffer(Stream, State, Error)::bit_buffer_uo) is det.
+
+set_use_stream(UseStream, !Buffer) :-
+ !:Buffer = !.Buffer ^ mer_use_stream := UseStream.
+
+:- pragma foreign_proc("C",
+ set_use_stream(UseStream::in,
+ Buffer0::bit_buffer_di, Buffer::bit_buffer_uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Buffer = Buffer0;
+ Buffer->ML_bit_buffer_use_stream = UseStream;
+").
+
+:- pred set_read_status(stream.res(Error)::in,
+ bit_buffer(Stream, State, Error)::bit_buffer_di,
+ bit_buffer(Stream, State, Error)::bit_buffer_uo) is det.
+
+set_read_status(ReadStatus, !Buffer) :-
+ !:Buffer = !.Buffer ^ mer_read_status := ReadStatus.
+
+:- pragma foreign_proc("C",
+ set_read_status(ReadStatus::in,
+ Buffer0::bit_buffer_di, Buffer::bit_buffer_uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Buffer = Buffer0;
+ Buffer->ML_bit_buffer_read_status = ReadStatus;
+").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: library/bit_buffer.read.m
===================================================================
RCS file: library/bit_buffer.read.m
diff -N library/bit_buffer.read.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/bit_buffer.read.m 14 May 2007 05:34:22 -0000
@@ -0,0 +1,664 @@
+%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ft=mercury
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2007 The University of Melbourne
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% File: bit_buffer.read.m.
+% Main author: stayl.
+% Stability: low.
+%
+% A bit buffer provides an interface between bit-oriented input requests
+% and byte-oriented streams, getting a large chunk of bits with one call
+% to `bulk_get', then satisfying bit-oriented requests from the buffer.
+%
+% 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
+% non-unique modes until the situation is rectified; this places
+% a small burden on the programmer to ensure the correctness of his
+% code that would otherwise be assured by the compiler.)
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module bit_buffer.read.
+
+:- interface.
+
+:- import_module io.
+
+:- type read_buffer(Stream, State, Error).
+ % <= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
+
+:- type read_buffer ==
+ read_buffer(error_stream, error_state, error_stream_error).
+
+:- 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).
+:- mode read_buffer_uo == out(uniq_read_buffer).
+
+ % new(NumBytes, Stream, State) creates a buffer which will read from
+ % the stream specified by Stream and State in chunks of NumBytes bytes.
+ % `NumBytes' must at least the size of a Mercury int, given by
+ % int.bits_per_int. If it is less, the size of an int will be used
+ % instead.
+ %
+:- func new(num_bytes, Stream, State) = read_buffer(Stream, State, Error)
+ <= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
+:- 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.
+ %
+:- func new_bitmap_reader(bitmap, bit_index, num_bits) = read_buffer.
+:- mode new_bitmap_reader(in, in, in) = read_buffer_uo is det.
+
+:- func new_bitmap_reader(bitmap) = read_buffer.
+:- mode new_bitmap_reader(in) = read_buffer_uo is det.
+
+ % How many bits to be read does the buffer contain.
+ %
+:- func num_buffered_bits(read_buffer(_, _, _)) = num_bits.
+:- mode num_buffered_bits(read_buffer_ui) = out is det.
+
+ % Find out whether there are bits left in the stream or an error
+ % has been found.
+ %
+:- pred buffer_status(bit_buffer_result(Error),
+ read_buffer(Stream, State, Error),
+ read_buffer(Stream, State, Error))
+ <= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
+:- mode buffer_status(out, read_buffer_di, read_buffer_uo) is det.
+
+ % Read a bit from the buffer.
+ %
+:- pred get_bit(bit_buffer_res(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.
+ %
+:- 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.
+ %
+:- pred get_byte(bit_buffer_res(byte, 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.
+
+ % 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),
+ read_buffer(Stream, State, Error))
+ <= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
+:- mode get_bitmap(bitmap_di, bitmap_uo, out, out,
+ read_buffer_di, read_buffer_uo) is det.
+
+ % 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).
+ %
+:- pred get_bitmap(bit_index, num_bits, bitmap, bitmap, num_bits,
+ bit_buffer_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.
+ %
+:- pred skip_padding_to_byte(bit_buffer_res(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.
+
+ % finalize(Buffer, Stream, State, BufferBM,
+ % IndexInBufferBM, NumBitsInBufferBM)
+ %
+ % Returns the stream, state and the unread buffered bits.
+ %
+:- pred finalize(read_buffer(Stream, State, Error), Stream, State,
+ bitmap, bit_index, num_bits)
+ <= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
+:- mode finalize(read_buffer_di, out, uo, bitmap_uo, out, out) is det.
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module maybe.
+:- import_module require.
+:- import_module string.
+
+ % If an operation reports an error, it must set the read_error
+ % field so that all further operations report an error as well.
+ % This is done at the site the error is discovered; places which
+ % just convert the type of an error value don't need to set the
+ % read_error field.
+ %
+:- type read_buffer(Stream, State, Error)
+ ---> read_buffer(bit_buffer ::
+ bit_buffer(Stream, State, read_error(Error))).
+ % <= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
+
+new(NumBytes, Stream, State) = Buffer :-
+ % We store Size + bits_per_int bits in the buffer. The first word
+ % of the buffer contains the bits that were in the buffer when it
+ % was last refilled.
+ %
+ % We require the buffer size to be at least bits_per_int so
+ % that a call to `get_bits' can always be satisfied with a
+ % single buffer refill. Allowing smaller buffer sizes would
+ % complicate the code for a case that shouldn't occur in practice
+ % anyway.
+ %
+ SizeInBits = NumBytes * bits_per_byte,
+ ChunkSize = int.max(SizeInBits, bits_per_int),
+ BMSize = ChunkSize + bits_per_int,
+ BM = bitmap.new(BMSize, no),
+
+ % Start at the end of the buffer to force a fill on the first read.
+ %
+ Pos = BMSize,
+ Buffer = read_buffer(new_buffer(BM, Pos, BMSize, yes, Stream, State)).
+
+new_bitmap_reader(BM, StartIndex, NumBits) = Buffer :-
+ Buffer = read_buffer(new_buffer(BM, StartIndex, NumBits, no,
+ error_stream, error_state)).
+
+new_bitmap_reader(BM) = new_bitmap_reader(BM, 0, BM ^ num_bits).
+
+ % The computed number of bits may be negative if there has been an error.
+num_buffered_bits(Buffer) =
+ int.max(Buffer ^ bit_buffer ^ size - Buffer ^ bit_buffer ^ pos, 0).
+
+buffer_status(Result, !Buffer) :-
+ Status = !.Buffer ^ bit_buffer ^ read_status,
+ (
+ Status = ok,
+ NumBufferedBits = !.Buffer ^ num_buffered_bits,
+ ( NumBufferedBits > 0 ->
+ Result = ok
+ ;
+ refill_read_buffer(RefillResult, !Buffer),
+ (
+ RefillResult = ok,
+ NewNumBufferedBits = !.Buffer ^ num_buffered_bits,
+ ( NewNumBufferedBits > 0 ->
+ Result = ok
+ ;
+ Result = eof
+ )
+ ;
+ RefillResult = error(Err),
+ Result = error(Err)
+ )
+ )
+ ;
+ Status = error(Err),
+ Result = error(Err)
+ ).
+
+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(NumBits, BitsResult, !Buffer) :-
+ Status = !.Buffer ^ bit_buffer ^ read_status,
+ (
+ Status = ok,
+ ( NumBits > 0 ->
+ ( NumBits > bits_per_int ->
+ error("bit_buffer.read.get_bits: invalid number of bits")
+ ;
+ true
+ ),
+ ( !.Buffer ^ num_buffered_bits >= NumBits ->
+ do_get_bits(NumBits, BitsResult, !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)
+ )
+ ;
+ RefillResult = error(Err),
+ BitsResult = error(Err)
+ )
+ )
+ ; NumBits = 0 ->
+ BitsResult = ok(0)
+ ;
+ error("bit_buffer.read.get_bits: negative number of bits")
+ )
+ ;
+ Status = error(Err),
+ 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,
+ 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)) :-
+ Pos = !.Buffer ^ pos,
+ BitsResult = ok(!.Buffer ^ bitmap ^ bits(Pos, NumBits)),
+ set_bitmap(!.Buffer ^ bitmap, Pos + NumBits, !Buffer).
+
+get_byte(Result, !Buffer) :-
+ get_bits(bits_per_byte, Result, !Buffer).
+
+get_bitmap(!BM, NumBitsRead, Result, !Buffer) :-
+ get_bitmap(0, !.BM ^ num_bits, !BM, NumBitsRead, Result, !Buffer).
+
+get_bitmap(Index, NumBits, !BM, NumBitsRead, Result,
+ read_buffer(!.Buffer), read_buffer(!:Buffer)) :-
+ Status = !.Buffer ^ read_status,
+ (
+ Status = ok,
+ (
+ NumBits > 0,
+ in_range(!.BM, Index),
+ in_range(!.BM, Index + NumBits - 1)
+ ->
+ UseStream = !.Buffer ^ use_stream,
+ (
+ UseStream = yes,
+ recursively_get_bitmap(Index, NumBits, !BM, 0,
+ NumBitsRead, Result, !Buffer)
+ ;
+ UseStream = no,
+ Pos = !.Buffer ^ pos,
+ Size = !.Buffer ^ size,
+ NumBitsRead = min(Size - Pos, NumBits),
+ !: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)
+ )
+ )
+ ;
+ NumBits = 0,
+ ( in_range(!.BM, Index)
+ ; Index = 0
+ )
+ ->
+ NumBitsRead = 0,
+ Result = ok
+ ;
+ bitmap.throw_bounds_error(!.BM, "bit_buffer.read.get_bitmap",
+ Index, NumBits)
+ )
+ ;
+ Status = error(Error),
+ NumBitsRead = 0,
+ Result = error(Error)
+ ).
+
+:- 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
+ <= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
+
+recursively_get_bitmap(!.Index, !.NumBits, !BM, !NumBitsRead,
+ Result, !Buffer) :-
+ ( !.NumBits = 0 ->
+ Result = ok
+ ;
+ %
+ % Take the bits that are already in the buffer.
+ %
+ copy_buffered_bits_to_bitmap(!Index, !NumBits, !BM,
+ !NumBitsRead, !Buffer),
+ (
+ !.NumBits = 0
+ ->
+ Result = ok
+ ;
+ !.Index `unchecked_rem` bits_per_byte = 0
+ ->
+ %
+ % We can do a bulk_get straight into the result bitmap.
+ %
+ bulk_get_into_result_bitmap(!Index, !NumBits, !BM, !NumBitsRead,
+ BulkGetResult, !Buffer),
+ (
+ BulkGetResult = ok,
+ ( !.NumBits > 0 ->
+ !:Buffer = read_buffer(!.Buffer),
+ get_bits(!.NumBits, LastBitsResult, !Buffer),
+ !:Buffer = !.Buffer ^ bit_buffer,
+ (
+ LastBitsResult = ok(LastBits),
+ !:BM =
+ !.BM ^ bits(!.Index, !.NumBits) := LastBits,
+ !:NumBitsRead = !.NumBitsRead + !.NumBits,
+ Result = ok
+ ;
+ LastBitsResult = error(Err),
+ Result = error(Err)
+ )
+ ;
+ Result = ok
+ )
+ ;
+ BulkGetResult = error(Err),
+ Result = error(Err)
+ )
+ ;
+ do_refill_read_buffer(RefillRes, !Buffer),
+ (
+ RefillRes = ok,
+ ( read_buffer(!.Buffer) ^ num_buffered_bits > 0 ->
+ recursively_get_bitmap(!.Index, !.NumBits, !BM,
+ !NumBitsRead, Result, !Buffer)
+ ;
+ Result = error(unexpected_eof_error),
+ do_set_buffer_error(unexpected_eof_error, !Buffer)
+ )
+ ;
+ RefillRes = error(Err),
+ Result = error(Err)
+ )
+ )
+ ).
+
+:- 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.
+
+copy_buffered_bits_to_bitmap(!Index, !NumBits, !BM, !NumBitsRead, !Buffer) :-
+ NumBufferedBits = read_buffer(!.Buffer) ^ num_buffered_bits,
+ NumBitsToGet = int.min(!.NumBits, NumBufferedBits),
+ Pos0 = !.Buffer ^ pos,
+ !:BM = copy_bits(!.Buffer ^ bitmap, Pos0, !.BM, !.Index, NumBitsToGet),
+ Pos = Pos0 + NumBitsToGet,
+ set_bitmap(!.Buffer ^ bitmap, Pos, !Buffer),
+ !:Index = !.Index + NumBitsToGet,
+ !:NumBits = !.NumBits - NumBitsToGet,
+ !:NumBitsRead = !.NumBitsRead + NumBitsToGet.
+
+:- 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
+ <= stream.bulk_reader(S, byte_index, bitmap, St, E).
+
+bulk_get_into_result_bitmap(!Index, !NumBits, !BM, !NumBitsRead,
+ Result, !Buffer) :-
+ StartByteIndex = !.Index `unchecked_quotient` bits_per_byte,
+ NumBytesToBulkGet = !.NumBits `unchecked_quotient` bits_per_byte,
+ Stream = !.Buffer ^ stream,
+ State0 = !.Buffer ^ state,
+ stream.bulk_get(Stream, StartByteIndex, NumBytesToBulkGet, !BM,
+ NumBytesRead, BulkGetResult, 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)
+ ),
+ NumBitsBulkRead = NumBytesRead * bits_per_byte,
+ !:Index = !.Index + NumBitsBulkRead,
+ !:NumBitsRead = !.NumBitsRead + NumBitsBulkRead,
+ !:NumBits = !.NumBits - NumBitsBulkRead,
+ set_state(State, !Buffer).
+
+skip_padding_to_byte(Result, !Buffer) :-
+ OldResult = !.Buffer ^ bit_buffer ^ read_status,
+ (
+ OldResult = ok,
+ Pos = !.Buffer ^ bit_buffer ^ pos,
+ PosInByte = Pos `unchecked_rem` bits_per_byte,
+ ( PosInByte = 0 ->
+ Result = ok
+ ;
+ NumPaddingBits = bits_per_byte - PosInByte,
+ ( !.Buffer ^ num_buffered_bits < NumPaddingBits ->
+ % This can only happen when reading from a bitmap.
+ %
+ Result = error(unexpected_eof_error),
+ set_buffer_error(unexpected_eof_error, !Buffer)
+ ;
+ get_bits(NumPaddingBits, GetResult, !Buffer),
+ (
+ GetResult = ok(Bits),
+ ( Bits = 0 ->
+ Result = ok
+ ;
+ Error = buffer_error(expected_padding_zeros),
+ Result = error(Error),
+ set_buffer_error(Error, !Buffer)
+ )
+ ;
+ GetResult = error(Error),
+ Result = error(Error)
+ )
+ )
+ )
+ ;
+ OldResult = error(Err),
+ Result = error(Err)
+ ).
+
+ % 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,
+ 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).
+
+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
+ <= stream.bulk_reader(Stream, byte_index, bitmap, State, Error).
+
+do_refill_read_buffer(Result, !.Buffer, !:Buffer) :-
+ UseStream = !.Buffer ^ use_stream,
+ (
+ UseStream = yes,
+ ( read_buffer(!.Buffer) ^ num_buffered_bits =< bits_per_int ->
+ true
+ ;
+ error(
+ "bit_buffer.read.refill_read_buffer: too many bits in buffer")
+ ),
+ some [!BM, !State, !Pos, !Size] (
+
+ !:BM = !.Buffer ^ bitmap,
+ !:Pos = !.Buffer ^ pos,
+ !:Size = !.Buffer ^ size,
+ !:State = !.Buffer ^ state,
+
+ % Copy the remaining bits back to the first word of the buffer.
+ %
+ Remain = !.Size - !.Pos,
+ OldPos = !.Pos,
+ !:Pos = bits_per_int - Remain,
+ ( Remain > 0 ->
+ !:BM = !.BM ^ bits(!.Pos, Remain) :=
+ !.BM ^ bits(OldPos, Remain)
+ ;
+ true
+ ),
+
+ % Perform a bulk get from the stream into the buffer
+ % starting at the second word. bit_buffer.read.new
+ % guarantees that !.Size is at least as big as bits_per_int.
+ %
+ ChunkSize = !.Size - bits_per_int,
+ StartByteIndex = bits_per_int `unchecked_quotient` bits_per_byte,
+ NumBytesToRead = ChunkSize `unchecked_quotient` bits_per_byte,
+ Stream = !.Buffer ^ stream,
+ stream.bulk_get(Stream, StartByteIndex, NumBytesToRead, !BM,
+ NumBytesRead, BulkGetResult, !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 ->
+ true
+ ;
+ % XXX We should probably allow the user to attempt to reset
+ % the error flag and try again if an error was transient, but
+ % the current stream interface doesn't allow for that.
+ % If that was allowed we shouldn't modify the size of the
+ % buffer or change it to bitmap only here.
+ %
+ !:Size = NumBytesRead * bits_per_byte + bits_per_int,
+ set_use_stream(no, !Buffer)
+ ),
+ set_all(!.BM, !.Pos, !.Size, !.State, [], !Buffer),
+ (
+ BulkGetResult = ok,
+ Result = ok
+ ;
+ BulkGetResult = eof,
+ Result = ok
+ ;
+ BulkGetResult = error(Error),
+ StreamError = stream_error(Error),
+ Result = error(StreamError),
+ do_set_buffer_error(StreamError, !Buffer)
+ )
+ )
+ ;
+ UseStream = no,
+ Result = ok
+ ).
+
+finalize(ReadBuffer @ read_buffer(Buffer), Buffer ^ stream, Buffer ^ state,
+ Buffer ^ bitmap, Buffer ^ pos, ReadBuffer ^ num_buffered_bits).
+
+ % 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,
+ 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).
+
+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.
+
+do_set_buffer_error(Error, !Buffer) :-
+ set_read_status(error(Error), !Buffer).
+
+:- func unexpected_eof_error = read_error(Error).
+
+unexpected_eof_error = buffer_error(unexpected_eof).
+
+:- end_module bit_buffer.read.
Index: library/bit_buffer.write.m
===================================================================
RCS file: library/bit_buffer.write.m
diff -N library/bit_buffer.write.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/bit_buffer.write.m 13 May 2007 00:54:09 -0000
@@ -0,0 +1,372 @@
+%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ft=mercury
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2007 The University of Melbourne
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% File: bit_buffer.write.m.
+% Main author: stayl.
+% Stability: low.
+%
+% 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.
+%
+% 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
+% non-unique modes until the situation is rectified; this places
+% a small burden on the programmer to ensure the correctness of his
+% code that would otherwise be assured by the compiler.)
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module bit_buffer.write.
+
+:- interface.
+
+:- import_module io.
+
+:- type write_buffer(Stream, State).
+ % <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+
+:- type write_buffer == write_buffer(error_stream, error_state).
+:- type io_write_buffer == write_buffer(io.binary_output_stream, io.state).
+
+:- inst uniq_write_buffer == ground. % XXX Should be unique.
+:- mode write_buffer_di == in(uniq_write_buffer).
+:- mode write_buffer_ui == in(uniq_write_buffer).
+:- mode write_buffer_uo == out(uniq_write_buffer).
+
+ % new(NumBytes, Stream, State) creates a buffer which will write to
+ % the stream specified by Stream and State in chunks of NumBytes bytes.
+ % If NumBytes is less than the size of an integer (given by
+ % 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).
+:- mode new(in, in, di) = write_buffer_uo is det.
+
+ % new(NumBytes)
+ % Create a buffer which collects all of the bits written, and does
+ % not write them to a stream. The bits are collected in chunks of
+ % size NumBytes bytes, and are written to a bitmap by
+ % `finalize_to_bitmap/1'.
+:- func new_bitmap_builder(num_bytes) = write_buffer.
+:- mode new_bitmap_builder(in) = out is det.
+
+ % How many bits to be written does the buffer contain.
+ %
+:- func num_buffered_bits(write_buffer(_, _)) = num_bits.
+:- mode num_buffered_bits(write_buffer_ui) = out is det.
+
+ % 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).
+:- 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.
+ % The number of bits must be less than int.bits_per_int.
+ %
+:- pred put_bits(word, num_bits, write_buffer(Stream, State),
+ write_buffer(Stream, State))
+ <= stream.bulk_writer(Stream, byte_index, bitmap, 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.
+ % The number of bits must be less than int.bits_per_int.
+ %
+:- pred put_byte(word, write_buffer(Stream, State),
+ write_buffer(Stream, State))
+ <= stream.bulk_writer(Stream, byte_index, bitmap, State).
+:- mode put_byte(in, write_buffer_di, write_buffer_uo) is det.
+
+ % Write bits from a bitmap to the buffer.
+ % The buffer does not keep a reference to the bitmap.
+ %
+:- pred put_bitmap(bitmap, write_buffer(Stream, State),
+ write_buffer(Stream, State))
+ <= stream.bulk_writer(Stream, byte_index, bitmap, 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).
+:- 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).
+:- mode pad_to_byte(write_buffer_di, write_buffer_uo) is det.
+
+ % Flush all complete bytes in the buffer to the output stream.
+ % If there is an incomplete final byte it will remain unwritten
+ % in the buffer.
+ %
+:- pred flush(write_buffer(Stream, State), write_buffer(Stream, State))
+ <= stream.bulk_writer(Stream, byte_index, bitmap, 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).
+:- mode finalize(write_buffer_di, out, uo) is det.
+
+ % Copy the data from a non-streamed write_buffer to a bitmap.
+ % The output is not padded to an even number of bits.
+ %
+:- func finalize_to_bitmap(write_buffer) = bitmap.
+:- mode finalize_to_bitmap(write_buffer_di) = bitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+ % For a write_buffer, a bit_buffer is allocated that is bits_per_int
+ % larger than the size requested. This allows a full word to be
+ % written at any time. After each write, the position is checked.
+ % If the position is greater than the requested size, a chunk of the
+ % requested size is written to the stream. The unwritten bits are
+ % then copied to the start of the buffer.
+ %
+ % 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
+ % for a case that shouldn't occur in practice.
+ %
+ % For a bitmap_builder, we store the filled bitmaps in a list rather
+ % than writing them to an output stream.
+ %
+:- type write_buffer(Stream, State)
+ ---> write_buffer(bit_buffer :: bit_buffer(Stream, State)).
+
+new(NumBytes, Stream, State) = Buffer :-
+ SizeInBits = NumBytes * bits_per_byte,
+ Size = int.max(SizeInBits, bits_per_int),
+ BM = bitmap.new(Size + int.bits_per_int, no),
+ Buffer = write_buffer(new_buffer(BM, 0, Size, yes, Stream, State)).
+
+new_bitmap_builder(NumBytes) = Buffer :-
+ Size = NumBytes * bits_per_byte,
+ BM = bitmap.new(Size + int.bits_per_int, no),
+ Buffer = write_buffer(new_buffer(BM, 0, Size, no,
+ error_stream, error_state)).
+
+num_buffered_bits(write_buffer(Buffer)) =
+ Buffer ^ pos +
+ foldl((func(BM, N) = N + BM ^ num_bits),
+ Buffer ^ filled_bitmaps, 0).
+
+put_bit(yes, !Buffer) :-
+ put_bits(1, 1, !Buffer).
+put_bit(no, !Buffer) :-
+ put_bits(0, 1, !Buffer).
+
+put_bits(Bits, NumBits, write_buffer(!.Buffer), write_buffer(!:Buffer)) :-
+ BM0 = !.Buffer ^ bitmap,
+ Pos0 = !.Buffer ^ pos,
+
+ % We always make sure there is enough room in the buffer for a full
+ % word to be written, so this can't run off the end of the bitmap.
+ %
+ BM = BM0 ^ bits(Pos0, NumBits) := Bits,
+ Pos = Pos0 + NumBits,
+ set_bitmap(BM, Pos, !Buffer),
+ maybe_make_room(!Buffer).
+
+put_byte(Byte, !Buffer) :-
+ put_bits(Byte, bits_per_byte, !Buffer).
+
+put_bitmap(BM, !Buffer) :-
+ put_bitmap(BM, 0, BM ^ num_bits, !Buffer).
+
+put_bitmap(BM, Index, NumBits,
+ write_buffer(!.Buffer), write_buffer(!:Buffer)) :-
+ put_bitmap_2(BM, Index, NumBits, !Buffer).
+
+ % XXX If we're writing to a list of bitmaps and the user doesn't want
+ % to write to the bitmap again, we should just add the bitmap passed
+ % by the user to the list of filled bitmaps, if the current buffer
+ % bitmap is full enough that we're not wasting too much space.
+ %
+:- 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).
+:- mode put_bitmap_2(bitmap_ui, in, in,
+ write_buffer_di, write_buffer_uo) is det.
+
+put_bitmap_2(BM, Index, NumBits, !Buffer) :-
+ ( NumBits = 0 ->
+ true
+ ;
+ BufferBM0 = !.Buffer ^ bitmap,
+ Pos = !.Buffer ^ pos,
+ Size = !.Buffer ^ size,
+ Remain = Size - Pos,
+ NumBitsToWrite = int.min(Remain, NumBits),
+ BufferBM = copy_bits(BM, Index, BufferBM0, Pos, NumBitsToWrite),
+ set_bitmap(BufferBM, Pos + NumBitsToWrite, !Buffer),
+ maybe_make_room(!Buffer),
+ put_bitmap_2(BM, Index + NumBitsToWrite,
+ NumBits - NumBitsToWrite, !Buffer)
+ ).
+
+finalize(!.Buffer, Stream, State) :-
+ pad_to_byte(!Buffer),
+ flush(!Buffer),
+ Stream = !.Buffer ^ bit_buffer ^ stream,
+ State = unsafe_promise_unique(!.Buffer ^ bit_buffer ^ state).
+
+finalize_to_bitmap(write_buffer(Buffer)) = !:BM :-
+ NumBits = num_buffered_bits(write_buffer(Buffer)),
+ !:BM = bitmap.new(NumBits),
+
+ % Copy out the filled bitmaps starting at the end of the result bitmap.
+ %
+ LastBM = shrink_without_copying(Buffer ^ bitmap, Buffer ^ pos),
+ copy_out_bitmap(LastBM, NumBits, Index, !BM),
+ list.foldl2(copy_out_bitmap, Buffer ^ filled_bitmaps, Index, _, !BM).
+
+ % Copy the bitmap to the result bitmap, starting at the end.
+:- pred copy_out_bitmap(bitmap::in, bit_index::in,
+ bit_index::out, bitmap::bitmap_di, bitmap::bitmap_uo) is det.
+
+copy_out_bitmap(FilledBM, !Index, !BM) :-
+ Size = FilledBM ^ num_bits,
+ !:Index = !.Index - Size,
+ !:BM = bitmap.copy_bits(FilledBM, 0, !.BM, !.Index, Size).
+
+:- 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).
+
+maybe_make_room(!Buffer) :-
+ ( !.Buffer ^ pos >= !.Buffer ^ size ->
+ make_room(!Buffer)
+ ;
+ true
+ ).
+
+:- 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).
+
+make_room(!Buffer) :-
+ UseStream = !.Buffer ^ use_stream,
+ (
+ UseStream = yes,
+ flush_chunk_to_stream(!Buffer)
+ ;
+ UseStream = no,
+ store_full_buffer(!Buffer)
+ ).
+
+flush(write_buffer(!.Buffer), write_buffer(!:Buffer)) :-
+ UseStream = !.Buffer ^ use_stream,
+ (
+ UseStream = yes,
+ flush_all_to_stream(!Buffer)
+ ;
+ UseStream = no
+ ).
+
+:- 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).
+
+flush_all_to_stream(!Buffer) :-
+ ( num_buffered_bits(write_buffer(!.Buffer)) >= bits_per_byte ->
+ flush_chunk_to_stream(!Buffer),
+ flush_all_to_stream(!Buffer)
+ ;
+ true
+ ).
+
+:- 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).
+
+flush_chunk_to_stream(!Buffer) :-
+ % Write at most Size bytes at once (this is the output chunk
+ % size set in the call to `new').
+ %
+ Pos = !.Buffer ^ pos,
+ Size = !.Buffer ^ size,
+ NumBitsToWrite0 = int.min(Size, Pos),
+ NumBytes = NumBitsToWrite0 `unchecked_quotient` bits_per_byte,
+ ( NumBytes \= 0 ->
+ NumBitsToWrite = NumBytes * bits_per_byte,
+ stream.bulk_put(!.Buffer ^ stream, !.Buffer ^ bitmap, 0, NumBytes,
+ unsafe_promise_unique(!.Buffer ^ state), NewState),
+ Remain = Pos - NumBitsToWrite,
+ ( Remain \= 0 ->
+ % Copy the remainder to the start of the bitmap.
+ % (We know that there are at most int.bits_per_int bits
+ % after the flush because that was the size of the
+ % bitmap created in `new', so we don't need to use
+ % copy_bits here).
+ %
+ NewBM0 = !.Buffer ^ bitmap,
+ NewBM = NewBM0 ^ bits(0, Remain) :=
+ NewBM0 ^ bits(NumBitsToWrite, Remain)
+ ;
+ NewBM = !.Buffer ^ bitmap
+ ),
+ set_all(NewBM, Remain, !.Buffer ^ size, NewState,
+ !.Buffer ^ filled_bitmaps, !Buffer)
+ ;
+ true
+ ).
+
+ % This must only be called when the buffer has less than a word
+ % of space left.
+ %
+:- pred store_full_buffer(bit_buffer(Stream, State)::in,
+ bit_buffer(Stream, State)::out) is det
+ <= stream.bulk_writer(Stream, int, bitmap, State).
+
+store_full_buffer(!Buffer) :-
+ Pos = !.Buffer ^ pos,
+ Size = !.Buffer ^ size,
+ OldBM = !.Buffer ^ bitmap,
+ State = !.Buffer ^ state,
+
+ % Double the buffer size at each allocation.
+ NewSize = (!.Buffer ^ size) * 2,
+
+ % Create the new bitmap, copying the left-over bytes from
+ % the old one.
+ % (We know that there are at most int.bits_per_int bits
+ % after the flush because that was the size of the
+ % bitmap created in `new', so we don't need to use
+ % copy_bits here).
+ %
+ NewBM0 = bitmap.new(NewSize + int.bits_per_int),
+ Remain = Pos - Size,
+ NewPos = Remain,
+ NewBM = NewBM0 ^ bits(0, Remain) := OldBM ^ bits(Size, Remain),
+ FilledBM = shrink_without_copying(OldBM, Size),
+
+ FilledBMs = [FilledBM | !.Buffer ^ filled_bitmaps],
+
+ set_all(NewBM, NewPos, NewSize,
+ unsafe_promise_unique(State), FilledBMs, !Buffer).
+
+pad_to_byte(!Buffer) :-
+ Pos = !.Buffer ^ bit_buffer ^ pos,
+ Rem = Pos `unchecked_rem` bits_per_byte,
+ ( Rem = 0 ->
+ true
+ ;
+ put_bits(0, bits_per_byte - Rem, !Buffer)
+ ).
+
+:- end_module bit_buffer.write.
+%-----------------------------------------------------------------------------%
Index: library/bitmap.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/bitmap.m,v
retrieving revision 1.18
diff -u -r1.18 bitmap.m
--- library/bitmap.m 2 May 2007 06:16:38 -0000 1.18
+++ library/bitmap.m 13 May 2007 00:54:32 -0000
@@ -26,6 +26,7 @@
:- interface.
:- import_module bool.
+:- import_module list.
%-----------------------------------------------------------------------------%
@@ -76,6 +77,10 @@
:- func new(num_bits, bool) = bitmap.
:- mode new(in, in) = bitmap_uo is det.
+ % Same as new(N, no).
+:- func new(num_bits) = bitmap.
+:- mode new(in) = bitmap_uo is det.
+
% Create a new copy of a bitmap.
%
:- func copy(bitmap) = bitmap.
@@ -91,6 +96,11 @@
:- func resize(bitmap, num_bits, bool) = bitmap.
:- mode resize(bitmap_di, in, in) = bitmap_uo is det.
+ % Shrink a bitmap without copying it into a smaller memory allocation.
+ %
+:- func shrink_without_copying(bitmap, num_bits) = bitmap.
+:- mode shrink_without_copying(bitmap_di, in) = bitmap_uo is det.
+
% Is the given bit number in range.
%
:- pred in_range(bitmap, bit_index).
@@ -235,6 +245,12 @@
%-----------------------------------------------------------------------------%
+ % Condense a list of bitmaps into a single bitmap.
+:- func append_list(list(bitmap)) = bitmap.
+:- mode append_list(in) = bitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
%
% Operations to copy part of a bitmap.
%
@@ -373,6 +389,13 @@
:- implementation.
:- interface.
+ % Used by io.m.
+
+ % throw_bounds_error(BM, PredName, Index, NumBits)
+ %
+:- pred throw_bounds_error(bitmap::in, string::in, bit_index::in, num_bits::in)
+ is erroneous.
+
% Replaced by BM ^ bits(I).
% get(BM, I) returns `yes' if is_set(BM, I) and `no' otherwise.
@@ -397,11 +420,12 @@
:- import_module char.
:- import_module exception.
:- import_module int.
-:- import_module list.
:- import_module string.
%-----------------------------------------------------------------------------%
+new(N) = new(N, no).
+
new(N, B) = BM :-
( if N < 0 then
throw_bitmap_error("bitmap.new: negative size") = _ : int
@@ -440,6 +464,16 @@
%-----------------------------------------------------------------------------%
+shrink_without_copying(!.BM, NewSize) = !:BM :-
+ ( if 0 =< NewSize, NewSize =< !.BM ^ num_bits then
+ !:BM = !.BM ^ num_bits := NewSize
+ else
+ throw_bounds_error(!.BM,
+ "bitmap.shrink_without_copying", NewSize) = _ : int
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- func clear_filler_bits(bitmap) = bitmap.
:- mode clear_filler_bits(bitmap_di) = bitmap_uo is det.
@@ -498,7 +532,7 @@
BM ^ bit(I) =
( if in_range(BM, I)
then BM ^ unsafe_bit(I)
- else throw_bitmap_error("bitmap.bit: out of range")
+ else throw_bounds_error(BM, "bitmap.bit", I)
).
BM ^ unsafe_bit(I) =
@@ -507,7 +541,7 @@
(BM ^ bit(I) := B) =
( if in_range(BM, I)
then BM ^ unsafe_bit(I) := B
- else throw_bitmap_error("bitmap.'bit :=': out of range")
+ else throw_bounds_error(BM, "bitmap.'bit :='", I)
).
(BM ^ unsafe_bit(I) := yes) = unsafe_set(BM, I).
@@ -523,8 +557,15 @@
NumBits =< int.bits_per_int
then
BM ^ unsafe_bits(FirstBit, NumBits)
+ else if
+ ( NumBits < 0
+ ; NumBits > int.bits_per_int
+ )
+ then
+ throw_bitmap_error(
+ "bitmap.bits: number of bits must be between 0 and `int.bits_per_int'.")
else
- throw_bitmap_error("bitmap.bits: out of range")
+ throw_bounds_error(BM, "bitmap.bits", FirstBit)
).
BM ^ unsafe_bits(FirstBit, NumBits) = Bits :-
@@ -574,13 +615,25 @@
(BM ^ bits(FirstBit, NumBits) := Bits) =
( if
FirstBit >= 0,
- in_range(BM, FirstBit + NumBits - 1),
- NumBits >= 0,
- NumBits =< int.bits_per_int
+ (
+ NumBits > 0,
+ in_range(BM, FirstBit + NumBits - 1),
+ NumBits =< int.bits_per_int
+ ;
+ NumBits = 0
+ )
then
BM ^ unsafe_bits(FirstBit, NumBits) := Bits
+ else if
+ ( NumBits < 0
+ ; NumBits > int.bits_per_int
+ )
+ then
+ throw_bitmap_error(
+ "bitmap.'bits :=': number of bits must be between " ++
+ "0 and `int.bits_per_int'.")
else
- throw_bitmap_error("bitmap.'bits :=': out of range")
+ throw_bounds_error(BM, "bitmap.'bits :='", FirstBit)
).
(BM0 ^ unsafe_bits(FirstBit, NumBits) := Bits) = BM :-
@@ -625,19 +678,19 @@
set(BM, I) =
( if in_range(BM, I)
then unsafe_set(BM, I)
- else throw_bitmap_error("bitmap.set: out of range")
+ else throw_bounds_error(BM, "bitmap.set", I)
).
clear(BM, I) =
( if in_range(BM, I)
then unsafe_clear(BM, I)
- else throw_bitmap_error("bitmap.clear: out of range")
+ else throw_bounds_error(BM, "bitmap.clear", I)
).
flip(BM, I) =
( if in_range(BM, I)
then unsafe_flip(BM, I)
- else throw_bitmap_error("bitmap.flip: out of range")
+ else throw_bounds_error(BM, "bitmap.flip", I)
).
set(I, BM, set(BM, I)).
@@ -671,13 +724,13 @@
is_set(BM, I) :-
( if in_range(BM, I)
then unsafe_is_set(BM, I)
- else throw_bitmap_error("bitmap.is_set: out of range") = _ : int
+ else throw_bounds_error(BM, "bitmap.is_set", I) = _ : int
).
is_clear(BM, I) :-
( if in_range(BM, I)
then unsafe_is_clear(BM, I)
- else throw_bitmap_error("bitmap.is_clear: out of range") = _ : int
+ else throw_bounds_error(BM, "bitmap.is_clear", I) = _ : int
).
%-----------------------------------------------------------------------------%
@@ -782,6 +835,20 @@
%-----------------------------------------------------------------------------%
+append_list(BMs) = !:BM :-
+ BMSize = list.foldl((func(BM, Size) = Size + BM ^ num_bits), BMs, 0),
+ !:BM = new(BMSize),
+ list.foldl2(copy_bitmap_into_place, BMs, 0, _, !BM).
+
+:- pred copy_bitmap_into_place(bitmap::in, int::in, int::out,
+ bitmap::bitmap_di, bitmap::bitmap_uo) is det.
+
+copy_bitmap_into_place(ThisBM, !Index, !BM) :-
+ !:BM = unsafe_copy_bits(0, ThisBM, 0, !.BM, !.Index, ThisBM ^ num_bits),
+ !:Index = !.Index + ThisBM ^ num_bits.
+
+%-----------------------------------------------------------------------------%
+
copy_bits(SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits) =
copy_bits(0, SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits).
@@ -795,16 +862,37 @@
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,
+ SrcStartBit >= 0,
+ in_range(SrcBM, SrcStartBit + NumBits - 1),
+ DestStartBit >= 0,
+ in_range(DestBM, DestStartBit + NumBits - 1)
+ ;
+ NumBits = 0
+ )
then
unsafe_copy_bits(SameBM, SrcBM, SrcStartBit,
DestBM, DestStartBit, NumBits)
else
- throw_bitmap_error("bitmap.copy_bits_in_bitmap: out of range")
+ ( if
+ ( NumBits < 0
+ ; SrcStartBit < 0
+ ; \+ in_range(SrcBM, SrcStartBit + NumBits - 1)
+ )
+ then
+ throw_bounds_error(SrcBM, "copy_bits (source)",
+ SrcStartBit, NumBits)
+ else if
+ ( DestStartBit < 0
+ ; \+ in_range(DestBM, DestStartBit + NumBits - 1)
+ )
+ then
+ throw_bounds_error(DestBM, "copy_bits (destination)",
+ DestStartBit, NumBits)
+ else
+ throw_bitmap_error("bitmap.copy_bits: failed to diagnose error")
+ )
).
:- func unsafe_copy_bits(int, bitmap, bit_index,
@@ -1474,7 +1562,8 @@
( if Bytes0 = num_bytes(BM) then
Bytes = Bytes0
else
- throw_bitmap_error("det_num_bytes: bitmap has a partial final byte")
+ throw_bitmap_error(
+ "bitmap.det_num_bytes: bitmap has a partial final byte")
).
%-----------------------------------------------------------------------------%
@@ -1538,7 +1627,7 @@
BM ^ byte(N) =
( if N >= 0, in_range(BM, N * bits_per_byte + bits_per_byte - 1)
then BM ^ unsafe_byte(N)
- else throw_bitmap_error("bitmap.byte: out of range")
+ else throw_bounds_error(BM, "bitmap.byte", N)
).
_ ^ unsafe_byte(_) = _ :- private_builtin.sorry("bitmap.unsafe_byte").
@@ -1571,7 +1660,7 @@
(BM ^ byte(N) := Byte) =
( if N >= 0, in_range(BM, N * bits_per_byte + bits_per_byte - 1)
then BM ^ unsafe_byte(N) := Byte
- else throw_bitmap_error("bitmap.'byte :=': out of range")
+ else throw_bounds_error(BM, "bitmap.'byte :='", N)
).
:- pragma promise_pure('unsafe_byte :='/3).
@@ -1699,8 +1788,7 @@
%-----------------------------------------------------------------------------%
% Construct the bitmask for a given bit in a byte. Bits are numbered
- % from most significant to least significant (starting at zero) so that
- % comparison works properly.
+ % from most significant to least significant (starting at zero).
%
% E.g. assuming bits_per_byte = 8 and I = 3 then
% bitmask(I) = 2'00010000
@@ -1757,6 +1845,44 @@
%-----------------------------------------------------------------------------%
+ % throw_bounds_error(BM, PredName, Index)
+ %
+:- func throw_bounds_error(bitmap, string, bit_index) = _ is erroneous.
+
+throw_bounds_error(BM, Pred, Index) =
+ throw_bitmap_error(
+ string.append_list([
+ Pred, ": index ",
+ string.int_to_string(Index),
+ " is out of bounds [0 - ",
+ string.int_to_string(BM ^ num_bits),
+ ")."])).
+
+ % throw_bounds_error(BM, PredName, Index, NumBits)
+ %
+:- func throw_bounds_error(bitmap, string, bit_index, num_bits) = _
+ is erroneous.
+
+throw_bounds_error(BM, Pred, Index, NumBits) = _ :-
+ throw_bounds_error(BM, Pred, Index, NumBits).
+
+throw_bounds_error(BM, Pred, Index, NumBits) :-
+ ( NumBits < 0 ->
+ Msg = string.append_list([
+ Pred, ": negative number of bits: ",
+ string.int_to_string(NumBits), "."])
+ ;
+ Msg = string.append_list([
+ Pred, ": ",
+ string.int_to_string(NumBits),
+ " bits starting at bit ",
+ string.int_to_string(Index),
+ " is out of bounds [0, ",
+ string.int_to_string(BM ^ num_bits),
+ ")."])
+ ),
+ throw_bitmap_error(Msg).
+
:- func throw_bitmap_error(string) = _ is erroneous.
throw_bitmap_error(Msg) = _ :-
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.381
diff -u -r1.381 io.m
--- library/io.m 23 Apr 2007 02:43:59 -0000 1.381
+++ library/io.m 14 May 2007 03:08:16 -0000
@@ -769,42 +769,60 @@
:- pred io.read_byte(io.binary_input_stream::in, io.result(int)::out,
io::di, io::uo) is det.
- % XXX The bitmap returned is actually unique.
-:- inst read_bitmap == io.maybe_partial_res(bound({bitmap, ground})).
-
% 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'.
%
-:- pred io.read_bitmap(bitmap::bitmap_di,
- io.maybe_partial_res({bitmap, int})::out(read_bitmap),
- io::di, io::uo) is det.
+:- pred io.read_bitmap(bitmap::bitmap_di, bitmap::bitmap_uo,
+ int::out, io.result::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'.
%
:- pred io.read_bitmap(io.binary_input_stream::in,
- bitmap::bitmap_di, io.maybe_partial_res({bitmap, int})::out(read_bitmap),
+ bitmap::bitmap_di, bitmap::bitmap_uo, int::out, io.result::out,
io::di, io::uo) is det.
- % io.read_bitmap(Bitmap, StartByte, NumBytes, ok({Bitmap, BytesRead}), !IO)
+ % io.read_bitmap(StartByte, NumBytes, !Bitmap, BytesRead, Result, !IO)
+ %
% Read NumBytes bytes into a bitmap starting at StartByte
% 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'.
%
-:- pred io.read_bitmap(bitmap::bitmap_di, int::in, int::in,
- io.maybe_partial_res({bitmap, int})::out(read_bitmap),
- io::di, io::uo) is det.
+:- 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.read_bitmap(Stream, Bitmap, StartByte, NumBytes,
- % ok({Bitmap, BytesRead}), !IO)
+ % io.read_bitmap(Stream, !Bitmap, StartByte, NumBytes,
+ % BytesRead, Result, !IO)
+ %
% Read NumBytes bytes into a bitmap starting at StartByte
% 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'.
+ %
+:- 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.
+
+ % Reads all the bytes from the current binary input stream
+ % until eof or error into a bitmap.
%
-:- pred io.read_bitmap(io.binary_input_stream::in, bitmap::bitmap_di,
- int::in, int::in, io.maybe_partial_res({bitmap, int})::out(read_bitmap),
+:- pred io.read_binary_file_as_bitmap(io.res(bitmap)::out,
io::di, io::uo) is det.
+ % Reads all the bytes from the given binary input stream into a bitmap
+ % until eof or error.
+ %
+:- pred io.read_binary_file_as_bitmap(io.binary_input_stream::in,
+ io.res(bitmap)::out, io::di, io::uo) is det.
+
% Reads all the bytes from the current binary input stream
% until eof or error.
%
@@ -1471,12 +1489,16 @@
:- instance stream.stream(io.binary_output_stream, io).
:- instance stream.output(io.binary_output_stream, io).
-:- instance stream.writer(io.binary_output_stream, int, io).
+:- instance stream.writer(io.binary_output_stream, byte, io).
+:- instance stream.bulk_writer(io.binary_output_stream, int,
+ bitmap, io).
:- instance stream.seekable(io.binary_output_stream, io).
:- instance stream.stream(io.binary_input_stream, io).
:- instance stream.input(io.binary_input_stream, io).
:- instance stream.reader(io.binary_input_stream, int, io, io.error).
+:- instance stream.bulk_reader(io.binary_input_stream, int,
+ bitmap, io, io.error).
:- instance stream.putback(io.binary_input_stream, int, io, io.error).
:- instance stream.seekable(io.binary_input_stream, io).
@@ -1865,41 +1887,56 @@
Result = error(io_error(Msg))
).
-io.read_bitmap(Bitmap, Result, !IO) :-
+io.read_bitmap(!Bitmap, BytesRead, Result, !IO) :-
io.binary_input_stream(Stream, !IO),
- io.read_bitmap(Stream, Bitmap, Result, !IO).
+ io.read_bitmap(Stream, !Bitmap, BytesRead, Result, !IO).
-io.read_bitmap(Bitmap, StartByte, NumBytes, Result, !IO) :-
+io.read_bitmap(StartByte, NumBytes, !Bitmap, BytesRead, Result, !IO) :-
io.binary_input_stream(Stream, !IO),
- io.read_bitmap(Stream, Bitmap, StartByte, NumBytes, Result, !IO).
+ io.read_bitmap(Stream, StartByte, NumBytes, !Bitmap,
+ BytesRead, Result, !IO).
-io.read_bitmap(Stream, Bitmap, Result, !IO) :-
- ( NumBytes = Bitmap ^ num_bytes ->
- io.read_bitmap(Stream, Bitmap, 0, NumBytes, Result, !IO)
+io.read_bitmap(Stream, !Bitmap, BytesRead, Result, !IO) :-
+ ( NumBytes = !.Bitmap ^ num_bytes ->
+ io.read_bitmap(Stream, 0, NumBytes, !Bitmap, BytesRead, Result, !IO)
;
error("io.read_bitmap: bitmap contains partial final byte")
).
-io.read_bitmap(binary_input_stream(Stream), Bitmap0, Start, NumBytes,
- Result, !IO) :-
+io.read_bitmap(binary_input_stream(Stream), Start, NumBytes, !Bitmap,
+ BytesRead, Result, !IO) :-
(
- byte_in_range(Bitmap0, Start),
- byte_in_range(Bitmap0, Start + NumBytes - 1)
+ NumBytes > 0,
+ byte_in_range(!.Bitmap, Start),
+ byte_in_range(!.Bitmap, Start + NumBytes - 1)
->
io.do_read_bitmap(Stream, Start, NumBytes,
- Bitmap0, Bitmap, 0, BytesRead, !IO),
+ !Bitmap, 0, BytesRead, !IO),
io.ferror(Stream, ErrInt, ErrMsg, !IO),
( ErrInt = 0 ->
- Result = ok({Bitmap, BytesRead})
+ ( BytesRead = NumBytes ->
+ Result = ok
+ ;
+ Result = eof
+ )
;
- Result = error({Bitmap, BytesRead}, io_error(ErrMsg))
+ Result = error(io_error(ErrMsg))
)
;
- error("io.read_bitmap: bitmap index out of range")
+ NumBytes = 0,
+ ( Start = 0
+ ; byte_in_range(!.Bitmap, Start - 1)
+ )
+ ->
+ Result = ok,
+ BytesRead = 0
+ ;
+ bitmap.throw_bounds_error(!.Bitmap, "io.read_bitmap",
+ Start * bits_per_byte, NumBytes * bits_per_byte)
).
-:- pred io.do_read_bitmap(io.stream::in, int::in, int::in,
- bitmap::bitmap_di, bitmap::bitmap_uo, int::in, int::out,
+:- pred io.do_read_bitmap(io.stream::in, byte_index::in, num_bytes::in,
+ bitmap::bitmap_di, bitmap::bitmap_uo, num_bytes::in, num_bytes::out,
io::di, io::uo) is det.
:- pragma promise_pure(io.do_read_bitmap/9).
@@ -1933,6 +1970,79 @@
MR_READ(*Stream, Bitmap->elements + StartByte, NumBytes);
").
+io.read_binary_file_as_bitmap(Result, !IO) :-
+ io.binary_input_stream(Stream, !IO),
+ io.read_binary_file_as_bitmap(Stream, Result, !IO).
+
+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).
+ io.binary_input_stream_file_size(Stream, FileSize, !IO),
+ ( FileSize >= 0 ->
+ some [!BM] (
+ !:BM = bitmap.new(FileSize * bits_per_byte),
+ io.read_bitmap(Stream, 0, FileSize,
+ !BM, BytesRead, ReadResult, !IO),
+ (
+ ( ReadResult = ok
+ ; ReadResult = eof
+ ),
+ ( BytesRead = FileSize ->
+ Result = ok(!.BM)
+ ;
+ Result = error(io_error(
+ "io.read_binary_file_as_bitmap: incorrect file size"))
+ )
+ ;
+ ReadResult = error(Msg),
+ Result = error(Msg)
+ )
+ )
+ ;
+ BufferSize = 4000,
+ io.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 io.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.
+
+io.read_binary_file_as_bitmap_2(Stream, BufferSize, Res, !BMs, !IO) :-
+ some [!BM] (
+ !:BM = bitmap.new(BufferSize * bits_per_byte),
+ io.read_bitmap(0, BufferSize, !BM, NumBytesRead, ReadRes, !IO),
+ (
+ ( ReadRes = ok
+ ; ReadRes = eof
+ ),
+ ( NumBytesRead < BufferSize ->
+ !:BM = bitmap.shrink_without_copying(!.BM,
+ NumBytesRead * bits_per_byte),
+ !:BMs = [!.BM | !.BMs],
+ Res = ok
+ ;
+ !:BMs = [!.BM | !.BMs],
+
+ % Double the buffer size each time.
+ %
+ io.read_binary_file_as_bitmap_2(Stream, BufferSize * 2,
+ Res, !BMs, !IO)
+ )
+ ;
+ ReadRes = error(Err),
+ Res = error(Err)
+ )
+ ).
+
%-----------------------------------------------------------------------------%
io.read_word(Result, !IO) :-
@@ -2547,6 +2657,12 @@
io.input_stream_file_size(input_stream(Stream), Size, !IO) :-
io.stream_file_size(Stream, Size, !IO).
+:- pred io.binary_input_stream_file_size(io.binary_input_stream::in, int::out,
+ io::di, io::uo) is det.
+
+io.binary_input_stream_file_size(binary_input_stream(Stream), Size, !IO) :-
+ io.stream_file_size(Stream, Size, !IO).
+
:- pred io.output_stream_file_size(io.output_stream::in, int::out,
io::di, io::uo) is det.
@@ -7012,7 +7128,8 @@
->
io.do_write_bitmap(Stream, Bitmap, Start, NumBytes, !IO)
;
- error("io.write_bitmap: out of range")
+ bitmap.throw_bounds_error(Bitmap, "io.write_bitmap",
+ Start * bits_per_byte, NumBytes * bits_per_byte)
).
:- pred io.do_write_bitmap(io.stream, bitmap, int, int, io, io).
@@ -9121,6 +9238,12 @@
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
[
@@ -9200,6 +9323,17 @@
)
].
+:- instance stream.bulk_reader(io.binary_input_stream, int,
+ bitmap, io, io.error)
+ where
+[
+ ( 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)
+ )
+].
+
:- instance stream.putback(io.binary_input_stream, int, io, io.error)
where
[
@@ -9240,6 +9374,13 @@
pred(put/4) is io.write_byte
].
+:- instance stream.bulk_writer(io.binary_output_stream, int, bitmap, io)
+ where
+[
+ pred(bulk_put/6) is io.write_bitmap
+].
+
+
:- instance stream.seekable(io.binary_output_stream, io)
where
[
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.104
diff -u -r1.104 library.m
--- library/library.m 20 Apr 2007 05:18:38 -0000 1.104
+++ library/library.m 9 May 2007 04:50:43 -0000
@@ -52,6 +52,9 @@
:- import_module bintree.
:- import_module bintree_set.
:- import_module bitmap.
+:- import_module bit_buffer.
+:- import_module bit_buffer.read.
+:- import_module bit_buffer.write.
:- import_module bool.
:- import_module bt_array.
:- import_module builtin.
@@ -107,7 +110,9 @@
:- import_module std_util.
:- import_module store.
:- import_module stream.
+:- import_module stream.string_writer.
:- import_module string.
+:- import_module string.builder.
:- import_module svarray.
:- import_module svbag.
:- import_module svbimap.
@@ -191,6 +196,9 @@
mercury_std_library_module("bintree").
mercury_std_library_module("bintree_set").
mercury_std_library_module("bitmap").
+mercury_std_library_module("bit_buffer").
+mercury_std_library_module("bit_buffer.read").
+mercury_std_library_module("bit_buffer.write").
mercury_std_library_module("bool").
mercury_std_library_module("bt_array").
mercury_std_library_module("builtin").
Index: library/stream.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/stream.m,v
retrieving revision 1.7
diff -u -r1.7 stream.m
--- library/stream.m 23 Apr 2007 02:44:01 -0000 1.7
+++ library/stream.m 14 May 2007 01:06:00 -0000
@@ -8,6 +8,7 @@
%
% File: stream.m.
% Authors: juliensf, maclarty.
+% Stability: low
%
% This module provides a family of typeclasses for defining streams
% in Mercury. It also provides some generic predicates that operate
@@ -47,6 +48,10 @@
---> ok
; error(Error).
+:- type stream.res(T, Error)
+ ---> ok(T)
+ ; error(Error).
+
% stream.maybe_partial_res is used when it is possible to return
% a partial result when an error occurs.
%
@@ -103,12 +108,58 @@
(Stream, Unit -> Error)) where
[
% Get the next unit from the given stream.
- % The get operation should block until the next unit is available.
+ % 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.
+ %
+ % XXX We should provide an interface to allow the user to reset the
+ % error status to try again if an error is transient.
%
pred get(Stream::in, stream.result(Unit, Error)::out,
State::di, State::uo) is det
].
+ % A bulk_reader stream is a subclass of specific input stream that can
+ % be used to read multiple items of data of a specific type from that
+ % input stream into a specified container. For example, binary input
+ % streams may be able to efficiently read bytes into a bitmap.
+ % A single input stream can support multiple bulk_reader subclasses.
+ %
+:- typeclass stream.bulk_reader(Stream, Index, Store, State, Error)
+ <= (stream.input(Stream, State), stream.error(Error),
+ (Stream, Index, Store -> Error)) where
+[
+ % bulk_get(Stream, Index, NumItems, !Store, NumItemsRead, Result, !State).
+ %
+ % 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.
+ %
+ 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
+].
+
+ % XXX These should be di and uo, but with the current state of the mode
+ % system an unsafe_promise_unique call would be required at each call
+ % to bulk_get.
+:- mode bulk_get_di == in.
+:- mode bulk_get_uo == out.
+
+
%-----------------------------------------------------------------------------%
%
% Output streams
@@ -136,11 +187,37 @@
<= stream.output(Stream, State) where
[
% Write the next unit to the given stream.
- % The put operation should block until the unit is completely written.
+ % Blocks if the whole unit can't be written to the stream at the time
+ % of the call (for example because a buffer is full).
%
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
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.315
diff -u -r1.315 Mmakefile
--- tests/hard_coded/Mmakefile 20 Apr 2007 05:18:39 -0000 1.315
+++ tests/hard_coded/Mmakefile 13 May 2007 01:01:19 -0000
@@ -15,6 +15,7 @@
bag_various \
bidirectional \
bitmap_test \
+ bit_buffer_test \
boyer \
brace \
builtin_inst_rename \
Index: tests/hard_coded/bit_buffer_test.exp
===================================================================
RCS file: tests/hard_coded/bit_buffer_test.exp
diff -N tests/hard_coded/bit_buffer_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/bit_buffer_test.exp 13 May 2007 15:09:43 -0000
@@ -0,0 +1,234 @@
+Test reading and writing full bytes.
+Testing with buffer size 8.
+Testing writes: [bits(10101010, 8), bits(11001100, 8), check_buffer_status(ok), bits(1000110, 8), bits(0, 0), bits(10111001, 8), bits(10101010, 8), bits(11001100, 8), check_buffer_status(ok), bits(1000110, 8), bits(0, 0), bits(10111001, 8), bits(10101010, 8), bits(11001100, 8), check_buffer_status(ok), bits(1000110, 8), bits(0, 0), bits(10111001, 8), bits(10101010, 8), bits(11001100, 8), check_buffer_status(ok), bits(1000110, 8), bits(0, 0), bits(10111001, 8), check_buffer_status(eof), pad_to_byte]
+Expected result: 10101010.11001100.01000110.10111001.10101010.11001100.01000110.10111001.10101010.11001100.01000110.10111001.10101010.11001100.01000110.10111001
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+Testing reads:
+bitmap read tests completed.
+I/O read tests completed.
+
+Test reading and writing partial bytes.
+Testing with buffer size 8.
+Testing writes: [bits(10101010, 7), bits(1, 1), bits(11001100, 6), bits(1000110, 7), bits(10111001, 4), bits(10101010, 7), bits(1, 1), bits(11001100, 6), bits(1000110, 7), bits(10111001, 4), bits(10101010, 7), bits(1, 1), bits(11001100, 6), bits(1000110, 7), bits(10111001, 4), bits(10101010, 7), bits(1, 1), bits(11001100, 6), bits(1000110, 7), bits(10111001, 4), bits(10101010, 7), bits(1, 1), bits(11001100, 6), bits(1000110, 7), bits(10111001, 4), bits(10101010, 7), bits(1, 1), bits(11001100, 6), bits(1000110, 7), bits(10111001, 4), pad_to_byte]
+Expected result: 01010101.00110010.00110100.10101010.10011001.00011010.01010101.01001100.10001101.00101010.10100110.01000110.10010101.01010011.00100011.01001010.10101001.10010001.10100100
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+Testing reads:
+bitmap read tests completed.
+I/O read tests completed.
+
+Test flushes when the stream is at a byte boundary and when it is not.
+Testing with buffer size 8.
+Testing writes: [flush, bits(10101010, 7), bits(0, 1), flush, bits(11001100, 6), bits(1000110, 7), flush, bits(10111001, 4), flush, bits(10101010, 7), bits(0, 1), flush, bits(11001100, 6), bits(1000110, 7), flush, bits(10111001, 4), flush, bits(10101010, 7), bits(0, 1), flush, bits(11001100, 6), bits(1000110, 7), flush, bits(10111001, 4), flush, bits(10101010, 7), bits(0, 1), flush, bits(11001100, 6), bits(1000110, 7), flush, bits(10111001, 4), flush, bits(10101010, 7), bits(0, 1), flush, bits(11001100, 6), bits(1000110, 7), flush, bits(10111001, 4), flush, bits(10101010, 7), bits(0, 1), flush, bits(11001100, 6), bits(1000110, 7), flush, bits(10111001, 4), pad_to_byte]
+Expected result: 01010100.00110010.00110100.10101010.00011001.00011010.01010101.00001100.10001101.00101010.10000110.01000110.10010101.01000011.00100011.01001010.10100001.10010001.10100100
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+Testing reads:
+bitmap read tests completed.
+I/O read tests completed.
+
+Test simple reading and writing of bitmaps.
+Testing with buffer size 8.
+Testing writes: [bitmap(10101010.11001100.01000110, 0, 24), pad_to_byte]
+Expected result: 10101010.11001100.01000110
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+Testing reads:
+bitmap read tests completed.
+I/O read tests completed.
+
+Test a simple offset bitmap read.
+Testing with buffer size 8.
+Testing writes: [bitmap(10101010.11001100.01000110, 8, 16), pad_to_byte]
+Expected result: 11001100.01000110
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+Testing reads:
+bitmap read tests completed.
+I/O read tests completed.
+
+Test zero size requests.
+Testing with buffer size 8.
+Testing writes: [bits(11001100, 0), bits(10101010, 4), bits(11001100, 0), bitmap(10101010.11001100.01000110, 0, 0), pad_to_byte]
+Expected result: 10100000
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+Testing reads:
+bitmap read tests completed.
+I/O read tests completed.
+
+Test pad_to_byte
+Testing with buffer size 8.
+Testing writes: [pad_to_byte, bits(10101010, 3), pad_to_byte, pad_to_byte, bits(11001100, 8), pad_to_byte, bits(11001100, 2), pad_to_byte]
+Expected result: 01000000.11001100.00000000
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+Testing reads:
+bitmap read tests completed.
+I/O read tests completed.
+
+Test a bitmap that spans multiple buffer flushed.
+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
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+Testing reads:
+bitmap read tests completed.
+I/O read tests completed.
+
+Test a bitmap starting at a position that isn't on a byte boundary.
+Testing with buffer size 8.
+Testing writes: [bits(10101010, 3), 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: 01010101.01011001.10001000.11010111.00110101.01011001.10001000.11010111.00110101.01011001.10001000.11010111.00110101.01011001.10001000.11010111.00101010.10100110.01000110.10010101.01010011.00100011.01001010.10101001.10010001.10100101.01010100.11001000.11010010.10101010.01100100.01101001.01010101.00110010.00110100.10000000
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+Testing reads:
+bitmap read tests completed.
+I/O read tests completed.
+
+Test offsets passed to put_bitmap.
+Testing with buffer size 8.
+Testing writes: [bits(10101010, 3), 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, 3, 275), pad_to_byte]
+Expected result: 01001010.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
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+Testing reads:
+bitmap read tests completed.
+I/O read tests completed.
+
+========== Read Error Tests ==========
+Test unexpected end-of-file.
+Testing sequence that should cause an error:
+Using setup requests:
+[bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), check_buffer_status(eof), pad_to_byte]
+Using error requests:
+[bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), check_buffer_status(eof), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), check_buffer_status(eof), pad_to_byte]
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+bitmap reads failed as expected:
+univ_cons(buffer_error(unexpected_eof))
+I/O reads failed as expected:
+univ_cons(buffer_error(unexpected_eof))
+
+Test read sequence of bitmaps one byte too long.
+Testing sequence that should cause an error:
+Using setup requests:
+[bitmap("<128:AACC46B9AACC46B9AACC46B9AACC46B9>", 0, 128), pad_to_byte]
+Using error requests:
+[bitmap("<136:AACC46B9AACC46B9AACC46B9AACC46B955>", 0, 136), pad_to_byte]
+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))
+I/O reads failed as expected:
+univ_cons("I/O: error in request 1" - buffer_error(unexpected_eof))
+
+Test read sequence of bitmaps one byte too long.
+Testing sequence that should cause an error:
+Using setup requests:
+[bitmap("<128:AACC46B9AACC46B9AACC46B9AACC46B9>", 0, 128), pad_to_byte]
+Using error requests:
+[bitmap("<136:AACC46B9AACC46B9AACC46B9AACC46B955>", 0, 136), pad_to_byte]
+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))
+I/O reads failed as expected:
+univ_cons("I/O: error in request 1" - buffer_error(unexpected_eof))
+
+Test non-zero padding bits.
+Testing sequence that should cause an error:
+Using setup requests:
+[bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), check_buffer_status(eof), pad_to_byte]
+Using error requests:
+[bits(170, 2), pad_to_byte, pad_to_byte]
+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))
+I/O reads failed as expected:
+univ_cons("I/O: error in request 2" - buffer_error(expected_padding_zeros))
+
+========== Bitmap error tests ==========
+Test eof when skipping padding in bitmap
+Testing sequence that should cause an error:
+Using setup requests:
+[bits(0, 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))
+
+========== Argument Error Tests ==========
+Testing sequence that should cause an error:
+Using setup requests:
+[bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), check_buffer_status(eof), pad_to_byte]
+Using error requests:
+[bits(0, -1), pad_to_byte]
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+bitmap reads failed as expected:
+univ_cons(software_error("bit_buffer.read.get_bits: negative number of bits"))
+I/O reads failed as expected:
+univ_cons(software_error("bit_buffer.read.get_bits: negative number of bits"))
+
+Testing sequence that should cause an error:
+Using setup requests:
+[bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), check_buffer_status(eof), pad_to_byte]
+Using error requests:
+[bits(0, 100), pad_to_byte]
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+bitmap reads failed as expected:
+univ_cons(software_error("bit_buffer.read.get_bits: invalid number of bits"))
+I/O reads failed as expected:
+univ_cons(software_error("bit_buffer.read.get_bits: invalid number of bits"))
+
+Testing sequence that should cause an error:
+Using setup requests:
+[bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), check_buffer_status(eof), pad_to_byte]
+Using error requests:
+[bitmap("<24:AACC46>", 0, -1), pad_to_byte]
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+bitmap reads failed as expected:
+univ_cons(bitmap_error("bit_buffer.read.get_bitmap: negative number of bits: -1."))
+I/O reads failed as expected:
+univ_cons(bitmap_error("bit_buffer.read.get_bitmap: negative number of bits: -1."))
+
+Testing sequence that should cause an error:
+Using setup requests:
+[bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), check_buffer_status(eof), pad_to_byte]
+Using error requests:
+[bitmap("<24:AACC46>", 0, 10000), pad_to_byte]
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+bitmap reads failed as expected:
+univ_cons(bitmap_error("bit_buffer.read.get_bitmap: 10000 bits starting at bit 0 is out of bounds [0, 24)."))
+I/O reads failed as expected:
+univ_cons(bitmap_error("bit_buffer.read.get_bitmap: 10000 bits starting at bit 0 is out of bounds [0, 24)."))
+
+========== Stream Error Tests ==========
+Testing sequence that should cause an error:
+Using setup requests:
+[bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), check_buffer_status(eof)]
+Using error requests:
+[bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), bits(170, 8), bits(204, 8), check_buffer_status(ok), bits(70, 8), bits(0, 0), bits(185, 8), check_buffer_status(eof)]
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+stream read error reads failed as expected:
+univ_cons(stream_error(bang))
+
+Test error when refilling buffer
+Testing sequence that should cause an error:
+Using setup requests:
+[bitmap("<72:AACC46B9AACC46B9AA>", 0, 72)]
+Using error requests:
+[bits(-1429453127, 32), bits(-1429453127, 32), check_buffer_status(ok), bits(170, 8)]
+Collected bitmap compares OK.
+I/O bitmap compares OK.
+stream read error reads failed as expected:
+univ_cons(stream_error(bang))
+
Index: tests/hard_coded/bitmap_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/bitmap_test.exp,v
retrieving revision 1.2
diff -u -r1.2 bitmap_test.exp
--- tests/hard_coded/bitmap_test.exp 24 Feb 2007 03:44:07 -0000 1.2
+++ tests/hard_coded/bitmap_test.exp 13 May 2007 15:09:38 -0000
@@ -215,3 +215,13 @@
Second read succeeded
First read succeeded
Second read succeeded
+Found exception as expected: bitmap_error("bitmap.bit: index -1 is out of bounds [0 - 64).")
+Found exception as expected: bitmap_error("bitmap.bit: index 64 is out of bounds [0 - 64).")
+Found exception as expected: bitmap_error("bitmap.bit: index 73 is out of bounds [0 - 64).")
+Found exception as expected: bitmap_error("copy_bits (source): 32 bits starting at bit -1 is out of bounds [0, 64).")
+Found exception as expected: bitmap_error("copy_bits (source): 32 bits starting at bit 33 is out of bounds [0, 64).")
+Found exception as expected: bitmap_error("copy_bits (destination): 32 bits starting at bit 33 is out of bounds [0, 64).")
+Found exception as expected: bitmap_error("bitmap.bits: index -1 is out of bounds [0 - 64).")
+Found exception as expected: bitmap_error("bitmap.bits: index 33 is out of bounds [0 - 64).")
+Found exception as expected: bitmap_error("bitmap.bits: number of bits must be between 0 and `int.bits_per_int\'.")
+Found exception as expected: bitmap_error("bitmap.bits: number of bits must be between 0 and `int.bits_per_int\'.")
Index: tests/hard_coded/bitmap_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/bitmap_test.m,v
retrieving revision 1.2
diff -u -r1.2 bitmap_test.m
--- tests/hard_coded/bitmap_test.m 24 Feb 2007 03:44:07 -0000 1.2
+++ tests/hard_coded/bitmap_test.m 14 May 2007 04:49:47 -0000
@@ -37,7 +37,7 @@
)
).
-:- pred run_test({}::out, io::di, io::uo) is det.
+:- pred run_test({}::out, io::di, io::uo) is cc_multi.
run_test({}, !IO) :-
some [!BM] (
@@ -162,7 +162,70 @@
test_binary_op("test_unify", bitmap_tester.test_unify, !IO),
test_text_io(!IO),
- test_binary_io(!IO).
+ test_binary_io(!IO),
+
+ some [!BM] (
+ !:BM = bitmap.new(64, yes),
+ !:BM = !.BM ^ bits(32, 16) := 0b1011011100100101,
+ test_exception(
+ ((pred) is semidet :-
+ _ = !.BM ^ bit(-1)
+ ), !IO),
+ test_exception(
+ ((pred) is semidet :-
+ _ = !.BM ^ bit(64)
+ ), !IO),
+ test_exception(
+ ((pred) is semidet :-
+ _ = !.BM ^ bit(73)
+ ), !IO),
+ test_exception(
+ ((pred) is semidet :-
+ _ = copy_bits_in_bitmap(copy(!.BM), -1, 1, 32)
+ ), !IO),
+ test_exception(
+ ((pred) is semidet :-
+ _ = copy_bits_in_bitmap(copy(!.BM), 33, 32, 32)
+ ), !IO),
+ test_exception(
+ ((pred) is semidet :-
+ _ = copy_bits_in_bitmap(copy(!.BM), 32, 33, 32)
+ ), !IO),
+ test_exception(
+ ((pred) is semidet :-
+ _ = copy(!.BM) ^ bits(-1, 32)
+ ), !IO),
+ test_exception(
+ ((pred) is semidet :-
+ _ = copy(!.BM) ^ bits(33, 32)
+ ), !IO),
+ test_exception(
+ ((pred) is semidet :-
+ _ = copy(!.BM) ^ bits(0, 65)
+ ), !IO),
+ test_exception(
+ ((pred) is semidet :-
+ _ = copy(!.BM) ^ bits(0, -1)
+ ), !IO)
+ ).
+
+:- pred test_exception((pred)::in((pred) is semidet),
+ io::di, io::uo) is cc_multi.
+
+test_exception(Pred, !IO) :-
+ try((pred({}::out) is semidet :- Pred), Result),
+ (
+ Result = succeeded(_),
+ io.write_string("Error: test succeeded, expected exception\n", !IO)
+ ;
+ Result = failed,
+ io.write_string("Error: test failed, expected exception\n", !IO)
+ ;
+ Result = exception(Exception),
+ io.write_string("Found exception as expected: ", !IO),
+ io.write(univ_value(Exception), !IO),
+ io.nl(!IO)
+ ).
% Do the copy tests to a few different bitmaps, to make sure
% correct results aren't a fluke of the original contents, and
@@ -298,25 +361,24 @@
(
OpenInputRes = ok(IStream),
InputBMa0 = bitmap.new(64, no),
- io.read_bitmap(IStream, InputBMa0, ReadResA, !IO),
- ( ReadResA = ok({BMa, 8}) ->
+ io.read_bitmap(IStream, InputBMa0, InputBMa,
+ BytesReadA, ReadResA, !IO),
+ ( ReadResA = ok, BytesReadA = 8, InputBMa = BMa ->
io.write_string("First read succeeded\n", !IO)
;
- io.write_string("First read failed\n", !IO),
- io.close_binary_input(IStream, !IO),
- throw(ReadResA)
+ io.write_string("First read failed\n", !IO)
),
InputBMb0 = bitmap.new(32, no),
- io.read_bitmap(IStream, InputBMb0, ReadResB, !IO),
+ io.read_bitmap(IStream, InputBMb0, InputBMb,
+ BytesReadB, ReadResB, !IO),
(
- ReadResB = ok({InputBMb, 3}),
+ ReadResB = eof,
+ BytesReadB = 3,
BMb ^ bits(16, 24) = InputBMb ^ bits(0, 24)
->
io.write_string("Second read succeeded\n", !IO)
;
- io.write_string("Second read failed\n", !IO),
- io.close_binary_input(IStream, !IO),
- throw(ReadResB)
+ io.write_string("Second read failed\n", !IO)
),
io.close_binary_input(IStream, !IO),
io.remove_file(FileName, _, !IO)
--------------------------------------------------------------------------
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