mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 17:33:38 +00:00
Code Issues Projects Releases Wiki Activity
Files
019ea41ec48b68191a91f65ea8a097a752275ade
mercury/library/bitmap.m
Julien Fischer b85f11b41d Fix library documentation errors. 
library/*.m:
    As above.

library/getopt.m:
    Regenerate this file.
2026-01-22 21:22:38 +11:00

2606 lines
88 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
% Copyright (C) 2001-2002, 2004-2007, 2009-2011 The University of Melbourne
% Copyright (C) 2013-2026 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: bitmap.m.
% Main author: rafe, stayl.
% Stability: medium.
%
% Efficient bitmap implementation.
%
% 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 programmers
% to ensure the correctness of their code that would otherwise be assured
% by the compiler).
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module bitmap.
:- interface.
:- import_module bool.
:- import_module io.
:- import_module list.
:- import_module stream.
%---------------------------------------------------------------------------%
% Type `bitmap' is equivalent to `array(bool)', but is implemented
% much more efficiently. Accessing bitmaps as if they were an array
% of eight-bit bytes is especially efficient.
%
% See runtime/mercury_types.h for the definition of MR_BitmapPtr for
% use in foreign code.
%
% Comparison of bitmaps first compares the size. If the sizes are equal,
% then it compares each bit in turn, starting from bit zero.
%
:- type bitmap.
:- inst bitmap == ground.
:- inst uniq_bitmap == bitmap. % XXX should be unique
:- mode bitmap_di == in(uniq_bitmap). % XXX should be di
:- mode bitmap_uo == out(uniq_bitmap).
:- mode bitmap_ui == in(uniq_bitmap).
% The exception thrown for any error.
%
:- type bitmap_error
---> bitmap_error(string).
%---------------------------------------------------------------------------%
:- type bit_index == int.
:- type byte_index == int.
:- type num_bits == int.
:- type num_bytes == int.
% 8 bits stored in the least significant bits of the integer.
%
:- type byte == int.
% An integer interpreted as a vector of int.bits_per_int bits.
%
:- type word == int.
%---------------------------------------------------------------------------%
% init(N, B) creates a bitmap of size N (indexed 0 .. N-1)
% setting each bit if B = yes and clearing each bit if B = no.
% An exception is thrown if N is negative.
%
:- func init(num_bits::in, bool::in) = (bitmap::bitmap_uo) is det.
% A synonym for init(N, no).
%
:- func init(num_bits::in) = (bitmap::bitmap_uo) is det.
% Is the given bit number in range?
%
:- pred in_range(bitmap, bit_index).
% :- mode in_range(bitmap_ui, in) is semidet.
:- mode in_range(in, in) is semidet.
% Is the given byte number in range?
%
:- pred byte_in_range(bitmap, byte_index).
% :- mode byte_in_range(bitmap_ui, in) is semidet.
:- mode byte_in_range(in, in) is semidet.
% Return the number of bits in a bitmap.
%
:- func num_bits(bitmap) = num_bits.
% :- mode num_bits(bitmap_ui) = out is det.
:- mode num_bits(in) = out is det.
% Return the number of bytes in a bitmap, failing if the bitmap
% has a partial final byte.
%
:- func num_bytes(bitmap) = num_bytes.
% :- mode num_bytes(bitmap_ui) = out is semidet.
:- mode num_bytes(in) = out is semidet.
% NOTE_TO_IMPLEMENTORS CFF :- pragma obsolete(func(num_bytes/1), [num_bytes/2]).
:- pred num_bytes(bitmap, num_bytes).
% :- mode num_bytes(bitmap_ui, out) is semidet.
:- mode num_bytes(in, out) is semidet.
% As above, but throw an exception if the bitmap has a partial final byte.
%
:- func det_num_bytes(bitmap) = num_bytes.
% :- mode det_num_bytes(bitmap_ui) = out is det.
:- mode det_num_bytes(in) = out is det.
% Return the number of bits in a byte (always 8).
%
:- func bits_per_byte = int.
% is_empty(Bitmap):
% True if-and-only-if Bitmap is a bitmap containing zero bits.
%
:- pred is_empty(bitmap).
%:- mode is_empty(bitmap_ui) is semidet.
:- mode is_empty(in) is semidet.
%---------------------------------------------------------------------------%
% get_bit(Bitmap, Index) = Bit:
% Bitmap ^ bit(Index) = Bit:
%
% Get the indicated bit of Bitmap.
%
% Throws an exception if Index is not in range.
%
:- func get_bit(bitmap, bit_index) = bool.
% :- mode get_bit(bitmap_ui, in) = out is det.
:- mode get_bit(in, in) = out is det.
:- func bit(bit_index, bitmap) = bool.
% :- mode bit(in, bitmap_ui) = out is det.
:- mode bit(in, in) = out is det.
% unsafe_get_bit(Bitmap, Index) = Bit:
% Bitmap ^ unsafe_bit(Index) = Bit:
%
% Does the same job as get_bit, but the result is undefined
% if Index is not in range.
%
:- func unsafe_get_bit(bitmap, bit_index) = bool.
% :- mode unsafe_get_bit(bitmap_ui, in) = out is det.
:- mode unsafe_get_bit(in, in) = out is det.
:- func unsafe_bit(bit_index, bitmap) = bool.
% :- mode unsafe_bit(in, bitmap_ui) = out is det.
:- mode unsafe_bit(in, in) = out is det.
% set_bit(Index, NewBit, !BitMap):
% !.Bitmap ^ bit(Index) := NewBit:
%
% Set the indicated bit of !.Bitmap to NewBit.
%
% Throws an exception if Index is not in range.
%
:- pred set_bit(bit_index, bool, bitmap, bitmap).
:- mode set_bit(in, in, bitmap_di, bitmap_uo) is det.
:- func 'bit :='(bit_index, bitmap, bool) = bitmap.
:- mode 'bit :='(in, bitmap_di, in) = bitmap_uo is det.
% unsafe_set_bit(Index, NewBit, !BitMap):
% !.Bitmap ^ unsafe_bit(Index) := NewBit:
%
% Does the same job as set_bit, but the result is undefined
% if Index is not in range.
%
:- pred unsafe_set_bit(bit_index, bool, bitmap, bitmap).
:- mode unsafe_set_bit(in, in, bitmap_di, bitmap_uo) is det.
:- func 'unsafe_bit :='(bit_index, bitmap, bool) = bitmap.
:- mode 'unsafe_bit :='(in, bitmap_di, in) = bitmap_uo is det.
%---------------------------------------------------------------------------%
% get_bits(Bitmap, Index, NumBits) = Word:
% Bitmap ^ bits(Index) = Word:
%
% Get some number of bits at the indicated Index out of Bitmap.
% The low order bits of Word will contain the NumBits bits of Bitmap
% starting at Index. NumBits must be in the range given by
% 0 =< NumBits =< int.bits_per_int.
%
% Throws an exception if either Index or NumBits is not in range.
%
:- func get_bits(bitmap, bit_index, num_bits) = word.
% :- mode get_bits(bitmap_ui, in, in) = out is det.
:- mode get_bits(in, in, in) = out is det.
:- func bits(bit_index, num_bits, bitmap) = word.
% :- mode bits(in, in, bitmap_ui) = out is det.
:- mode bits(in, in, in) = out is det.
% unsafe_get_bits(Bitmap, Index, NumBits) = Word:
% Bitmap ^ unsafe_bits(Index) = Word:
%
% Does the same job as get_bits, but the result is undefined
% if either Index or NumBits is not in range.
%
:- func unsafe_get_bits(bitmap, bit_index, num_bits) = word.
% :- mode unsafe_get_bits(bitmap_ui, in, in) = out is det.
:- mode unsafe_get_bits(in, in, in) = out is det.
:- func unsafe_bits(bit_index, num_bits, bitmap) = word.
% :- mode unsafe_bits(in, in, bitmap_ui) = out is det.
:- mode unsafe_bits(in, in, in) = out is det.
% set_bits(Index, NumBits, Word, Bitmap0, BitMap):
% Bitmap0 ^ bits(Index) := Word = BitMap:
%
% Set the NumBits bits of Bitmap0 starting at Index to the low order
% NumBits bits of Words, returning the updated bitmap as Bitmap.
%
% NumBits must be in the range given by 0 =< NumBits =< int.bits_per_int.
%
% Throws an exception if either Index or NumBits is not in range.
%
:- pred set_bits(bit_index, num_bits, word, bitmap, bitmap).
:- mode set_bits(in, in, in, bitmap_di, bitmap_uo) is det.
:- func 'bits :='(bit_index, num_bits, bitmap, word) = bitmap.
:- mode 'bits :='(in, in, bitmap_di, in) = bitmap_uo is det.
% unsafe_set_bits(Index, NumBits, Word, Bitmap0, BitMap):
% Bitmap0 ^ unsafe_bits(Index) := Word = BitMap:
%
% Does the same job as set_bits, but the result is undefined
% if either Index or NumBits is not in range.
%
:- pred unsafe_set_bits(bit_index, num_bits, word, bitmap, bitmap).
:- mode unsafe_set_bits(in, in, in, bitmap_di, bitmap_uo) is det.
:- func 'unsafe_bits :='(bit_index, num_bits, bitmap, word) = bitmap.
:- mode 'unsafe_bits :='(in, in, bitmap_di, in) = bitmap_uo is det.
%---------------------------------------------------------------------------%
%
% Get or set the given numbered byte (multiply ByteNumber by bits_per_byte
% to get the bit index of the start of the byte).
%
% The bits are stored in or taken from the least significant bits of an int.
% The safe versions will throw an exception if the given ByteNumber is out of
% bounds. Final partial bytes are out of bounds. The unsafe versions do not
% check whether the byte is in range.
%
:- func get_byte(bitmap, byte_index) = byte.
% :- mode get_byte(bitmap_ui, in) = out is det.
:- mode get_byte(in, in) = out is det.
:- func byte(byte_index, bitmap) = word.
% :- mode byte(in, bitmap_ui) = out is det.
:- mode byte(in, in) = out is det.
:- func unsafe_get_byte(bitmap, byte_index) = byte.
% :- mode unsafe_get_byte(bitmap_ui, in) = out is det.
:- mode unsafe_get_byte(in, in) = out is det.
:- func unsafe_byte(byte_index, bitmap) = word.
% :- mode unsafe_byte(in, bitmap_ui) = out is det.
:- mode unsafe_byte(in, in) = out is det.
:- pred set_byte(byte_index, byte, bitmap, bitmap).
:- mode set_byte(in, in, bitmap_di, bitmap_uo) is det.
:- func 'byte :='(byte_index, bitmap, byte) = bitmap.
:- mode 'byte :='(in, bitmap_di, in) = bitmap_uo is det.
:- pred unsafe_set_byte(byte_index, byte, bitmap, bitmap).
:- mode unsafe_set_byte(in, in, bitmap_di, bitmap_uo) is det.
:- func 'unsafe_byte :='(byte_index, bitmap, byte) = bitmap.
:- mode 'unsafe_byte :='(in, bitmap_di, in) = bitmap_uo is det.
%
% Versions of the above that set or take uint8 values instead of a byte stored
% in the least significant bits of an int.
%
:- func get_uint8(bitmap, byte_index) = uint8.
%:- mode get_uint8(bitmap_ui, in) = out is det.
:- mode get_uint8(in, in) = out is det.
:- func unsafe_get_uint8(bitmap, byte_index) = uint8.
%:- mode unsafe_get_uint8(bitmap_ui, in) = out is det.
:- mode unsafe_get_uint8(in, in) = out is det.
:- pred set_uint8(byte_index::in, uint8::in,
bitmap::bitmap_di, bitmap::bitmap_uo) is det.
:- pred unsafe_set_uint8(byte_index::in, uint8::in,
bitmap::bitmap_di, bitmap::bitmap_uo) is det.
%---------------------------------------------------------------------------%
% Flip the given bit.
%
:- func flip(bitmap, bit_index) = bitmap.
:- mode flip(bitmap_di, in) = bitmap_uo is det.
:- pred flip(bit_index, bitmap, bitmap).
:- mode flip(in, bitmap_di, bitmap_uo) is det.
%---------------------------------------------------------------------------%
%
% Variations that might be slightly more efficient by not
% converting bits to bool.
%
:- func set(bitmap, bit_index) = bitmap.
:- mode set(bitmap_di, in) = bitmap_uo is det.
:- pred set(bit_index, bitmap, bitmap).
:- mode set(in, bitmap_di, bitmap_uo) is det.
:- func clear(bitmap, bit_index) = bitmap.
:- mode clear(bitmap_di, in) = bitmap_uo is det.
:- pred clear(bit_index, bitmap, bitmap).
:- mode clear(in, bitmap_di, bitmap_uo) is det.
% is_set(BM, I) succeeds if-and-only-if bit I in BM is set.
%
:- pred is_set(bitmap, bit_index).
% :- mode is_set(bitmap_ui, in) is semidet.
:- mode is_set(in, in) is semidet.
% is_clear(BM, I) succeeds if-and-only-if bit I in BM is clear.
%
:- pred is_clear(bitmap, bit_index).
% :- mode is_clear(bitmap_ui, in) is semidet.
:- mode is_clear(in, in) is semidet.
%---------------------------------------------------------------------------%
%
% Unsafe versions of the above. If the index is out of range,
% then behaviour is undefined, and bad things are likely to happen.
%
:- func unsafe_flip(bitmap, bit_index) = bitmap.
:- mode unsafe_flip(bitmap_di, in) = bitmap_uo is det.
:- pred unsafe_flip(bit_index, bitmap, bitmap).
:- mode unsafe_flip(in, bitmap_di, bitmap_uo) is det.
:- func unsafe_set(bitmap, bit_index) = bitmap.
:- mode unsafe_set(bitmap_di, in) = bitmap_uo is det.
:- pred unsafe_set(bit_index, bitmap, bitmap).
:- mode unsafe_set(in, bitmap_di, bitmap_uo) is det.
:- func unsafe_clear(bitmap, bit_index) = bitmap.
:- mode unsafe_clear(bitmap_di, in) = bitmap_uo is det.
:- pred unsafe_clear(bit_index, bitmap, bitmap).
:- mode unsafe_clear(in, bitmap_di, bitmap_uo) is det.
:- pred unsafe_is_set(bitmap, bit_index).
% :- mode unsafe_is_set(bitmap_ui, in) is semidet.
:- mode unsafe_is_set(in, in) is semidet.
:- pred unsafe_is_clear(bitmap, bit_index).
% :- mode unsafe_is_clear(bitmap_ui, in) is semidet.
:- mode unsafe_is_clear(in, in) is semidet.
%---------------------------------------------------------------------------%
% Create a new copy of a bitmap.
%
:- func copy(bitmap) = bitmap.
% :- mode copy(bitmap_ui) = bitmap_uo is det.
:- mode copy(in) = bitmap_uo is det.
% resize(BM, N, B) resizes bitmap BM to have N bits; if N is smaller
% than the current number of bits in BM then the excess are discarded.
% If N is larger than the current number of bits in BM, then
% the new bits are set if B = yes and cleared if B = no.
%
:- 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.
%---------------------------------------------------------------------------%
% Slice = slice(BM, StartIndex, NumBits)
%
% A bitmap slice represents the sub-range of a bitmap of NumBits bits
% starting at bit index StartIndex. Throws an exception if the slice
% is not within the bounds of the bitmap.
%
:- type slice.
:- func slice(bitmap, bit_index, num_bits) = slice.
% As above, but use byte indices.
%
:- func byte_slice(bitmap, byte_index, num_bytes) = slice.
% Access functions for slices.
%
:- func slice ^ slice_bitmap = bitmap.
:- func slice ^ slice_start_bit_index = bit_index.
:- func slice ^ slice_num_bits = num_bits.
% As above, but return byte indices, throwing an exception
% if the slice doesn't start and end on a byte boundary.
%
:- func slice ^ slice_start_byte_index = byte_index.
:- func slice ^ slice_num_bytes = num_bytes.
%---------------------------------------------------------------------------%
%
% Set operations; for binary operations the second argument is altered
% in all cases. The input bitmaps must have the same size.
%
:- func complement(bitmap) = bitmap.
:- mode complement(bitmap_di) = bitmap_uo is det.
:- func union(bitmap, bitmap) = bitmap.
% :- mode union(bitmap_ui, bitmap_di) = bitmap_uo is det.
:- mode union(in, bitmap_di) = bitmap_uo is det.
:- func intersect(bitmap, bitmap) = bitmap.
% :- mode intersect(bitmap_ui, bitmap_di) = bitmap_uo is det.
:- mode intersect(in, bitmap_di) = bitmap_uo is det.
:- func difference(bitmap, bitmap) = bitmap.
% :- mode difference(bitmap_ui, bitmap_di) = bitmap_uo is det.
:- mode difference(in, bitmap_di) = bitmap_uo is det.
:- func xor(bitmap, bitmap) = bitmap.
% :- mode xor(bitmap_ui, bitmap_di) = bitmap_uo is det.
:- mode xor(in, bitmap_di) = bitmap_uo is det.
%---------------------------------------------------------------------------%
% 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.
%
% copy_bits(SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits)
%
% Overwrite NumBits bits in DestBM starting at DestStartBit with
% the NumBits bits starting at SrcStartBit in SrcBM.
%
:- func copy_bits(bitmap, bit_index, bitmap, bit_index, num_bits) = bitmap.
% :- mode copy_bits(bitmap_ui, in, bitmap_di, in, in) = bitmap_uo is det.
:- mode copy_bits(in, in, bitmap_di, in, in) = bitmap_uo is det.
% copy_bits_in_bitmap(BM, SrcStartBit, DestStartBit, NumBits)
%
% Overwrite NumBits bits starting at DestStartBit with the NumBits
% bits starting at SrcStartBit in the same bitmap.
%
:- func copy_bits_in_bitmap(bitmap, bit_index, bit_index, num_bits) = bitmap.
:- mode copy_bits_in_bitmap(bitmap_di, in, in, in) = bitmap_uo is det.
% copy_bytes(SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes)
%
% Overwrite NumBytes bytes in DestBM starting at DestStartByte with
% the NumBytes bytes starting at SrcStartByte in SrcBM.
%
:- func copy_bytes(bitmap, byte_index, bitmap, byte_index, num_bytes) = bitmap.
% :- mode copy_bytes(bitmap_ui, in, bitmap_di, in, in) = bitmap_uo is det.
:- mode copy_bytes(in, in, bitmap_di, in, in) = bitmap_uo is det.
% copy_bytes_in_bitmap(BM, SrcStartByte, DestStartByte, NumBytes)
%
% Overwrite NumBytes bytes starting at DestStartByte with the NumBytes
% bytes starting at SrcStartByte in the same bitmap.
%
:- func copy_bytes_in_bitmap(bitmap, byte_index,
byte_index, num_bytes) = bitmap.
:- mode copy_bytes_in_bitmap(bitmap_di, in, in, in) = bitmap_uo is det.
%---------------------------------------------------------------------------%
% Compute a hash function for a bitmap.
%
:- func hash(bitmap) = int.
% :- mode hash(bitmap_ui) = out is det.
:- mode hash(in) = out is det.
%---------------------------------------------------------------------------%
% Convert a bitmap to a string of the form "<length:hex digits>",
% e.g. "<24:10AFBD>".
%
:- func to_string(bitmap) = string.
% :- mode to_string(bitmap_ui) = out is det.
:- mode to_string(in) = out is det.
% Convert a string created by to_string back into a bitmap.
% Fails if the string is not of the form created by to_string.
%
:- func from_string(string) = bitmap.
:- mode from_string(in) = bitmap_uo is semidet.
% NOTE_TO_IMPLEMENTORS CFF :- pragma obsolete(func(from_string/1), [from_string/2]).
:- pred from_string(string, bitmap).
:- mode from_string(in, bitmap_uo) is semidet.
% As above, but throws an exception instead of failing.
%
:- func det_from_string(string) = bitmap.
:- mode det_from_string(in) = bitmap_uo is det.
% Convert a bitmap to a string of `1' and `0' characters, where
% the bytes are separated by `.'.
%
:- func to_byte_string(bitmap) = string.
% :- mode to_byte_string(bitmap_ui) = out is det.
:- mode to_byte_string(in) = out is det.
%---------------------------------------------------------------------------%
%
% Bitmap input and output predicates.
%
% Fill a bitmap from the current binary input stream
% or from the specified binary input stream.
% Return the number of bytes read. On end-of-file, the number of
% bytes read will be less than the size of the bitmap, and
% the result will be `ok'.
% Throws an exception if the bitmap has a partial final byte.
%
:- pred read_bitmap(bitmap::bitmap_di, bitmap::bitmap_uo,
int::out, io.res::out, io::di, io::uo) is det.
:- pred read_bitmap(io.binary_input_stream::in,
bitmap::bitmap_di, bitmap::bitmap_uo,
int::out, io.res::out, io::di, io::uo) is det.
% read_bitmap_range(StartByte, NumBytes, !Bitmap, BytesRead, Result, !IO):
%
% Read NumBytes bytes into a bitmap starting at StartByte from the
% current binary input stream, or from the specified binary input stream.
% Return the number of bytes read. On end-of-file, the number of
% bytes read will be less than NumBytes, and the result will be `ok'.
%
:- pred read_bitmap_range(byte_index::in, num_bytes::in,
bitmap::bitmap_di, bitmap::bitmap_uo, num_bytes::out, io.res::out,
io::di, io::uo) is det.
:- pred read_bitmap_range(io.binary_input_stream::in,
byte_index::in, num_bytes::in,
bitmap::bitmap_di, bitmap::bitmap_uo, num_bytes::out, io.res::out,
io::di, io::uo) is det.
%---------------------%
% Write a bitmap to the current binary output stream
% or to the specified binary output stream. The bitmap must not contain
% a partial final byte.
%
:- pred write_bitmap(bitmap, io, io).
%:- mode write_bitmap(bitmap_ui, di, uo) is det.
:- mode write_bitmap(in, di, uo) is det.
:- pred write_bitmap(io.binary_output_stream, bitmap, io, io).
%:- mode write_bitmap(in, bitmap_ui, di, uo) is det.
:- mode write_bitmap(in, in, di, uo) is det.
% write_bitmap_range(BM, StartByte, NumBytes, !IO):
% write_bitmap_range(Stream, BM, StartByte, NumBytes, !IO):
%
% Write part of a bitmap to the current binary output stream
% or to the specified binary output stream.
%
:- pred write_bitmap_range(bitmap, int, int, io, io).
%:- mode write_bitmap_range(bitmap_ui, in, in, di, uo) is det.
:- mode write_bitmap_range(in, in, in, di, uo) is det.
:- pred write_bitmap_range(io.binary_output_stream, bitmap, int, int, io, io).
%:- mode write_bitmap_range(in, bitmap_ui, in, in, di, uo) is det.
:- mode write_bitmap_range(in, in, in, in, di, uo) is det.
%---------------------------------------------------------------------------%
:- instance stream.bulk_reader(binary_input_stream, int, bitmap, io, io.error).
:- instance stream.writer(binary_output_stream, bitmap, io).
:- instance stream.writer(binary_output_stream, bitmap.slice, io).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- interface.
% throw_bounds_error(BM, PredName, Index, NumBits):
%
% Exported for use by bit_buffer.read.
%
:- pred throw_bounds_error(bitmap::in, string::in, bit_index::in, num_bits::in)
is erroneous.
%---------------------------------------------------------------------------%
:- implementation.
:- import_module char.
:- import_module exception.
:- import_module int.
:- import_module io.error_util.
:- import_module maybe.
:- import_module require.
:- import_module string.
:- pragma foreign_import_module("C#", io.stream_ops).
:- pragma foreign_import_module("Java", io.stream_ops).
%---------------------------------------------------------------------------%
init(N, B) = BM :-
( if N < 0 then
throw_bitmap_error("bitmap.init: negative size")
else
X = initializer(B),
BM0 = allocate_bitmap(N),
initialize_bitmap(N, X, BM0, BM1),
clear_filler_bits(BM1, BM)
).
init(N) = init(N, no).
:- pred clear_filler_bits(bitmap::bitmap_di, bitmap::bitmap_uo) is det.
clear_filler_bits(!BM) :-
set_trailing_bits_in_byte(num_bits(!.BM) - 1, 0, !BM).
:- pred set_trailing_bits_in_byte(bit_index::in, byte::in,
bitmap::bitmap_di, bitmap::bitmap_uo) is det.
set_trailing_bits_in_byte(Bit, Initializer, !BM) :-
FirstTrailingBit = Bit + 1,
FirstTrailingBitIndex = bit_index_in_byte(FirstTrailingBit),
( if FirstTrailingBitIndex > 0 then
ByteIndex = det_byte_index_for_bit(FirstTrailingBit),
NumBitsToSet = bits_per_byte - FirstTrailingBitIndex,
Byte0 = unsafe_get_byte(!.BM, ByteIndex),
set_bits_in_byte(FirstTrailingBitIndex, NumBitsToSet, Initializer,
Byte0, Byte),
unsafe_set_byte(ByteIndex, Byte, !BM)
else
true
).
:- func initializer(bool) = byte.
initializer(no) = 0.
initializer(yes) = \0.
:- pred initialize_bitmap(num_bits::in, byte::in,
bitmap::bitmap_di, bitmap::bitmap_uo) is det.
initialize_bitmap(N, Init, !BM) :-
initialize_bitmap_bytes(0, byte_index_for_bit(N - 1), Init, !BM).
:- pred initialize_bitmap_bytes(byte_index::in, byte_index::in, byte::in,
bitmap::bitmap_di, bitmap::bitmap_uo) is det.
initialize_bitmap_bytes(ByteIndex, LastByteIndex, Init, !BM) :-
( if ByteIndex > LastByteIndex then
true
else
unsafe_set_byte(ByteIndex, Init, !BM),
initialize_bitmap_bytes(ByteIndex + 1, LastByteIndex, Init, !BM)
).
%---------------------------------------------------------------------------%
in_range(BM, I) :-
0 =< I, I < num_bits(BM).
:- pred in_range_rexcl(bitmap::in, bit_index::in) is semidet.
in_range_rexcl(BM, I) :-
0 =< I, I =< num_bits(BM).
byte_in_range(BM, I) :-
in_range(BM, I * bits_per_byte + bits_per_byte - 1).
%---------------------------------------------------------------------------%
num_bits(_) = _ :-
private_builtin.sorry("bitmap.num_bits").
:- pragma foreign_proc("C",
num_bits(BM::in) = (NumBits::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
NumBits = BM->num_bits;
").
:- pragma foreign_proc("Java",
num_bits(BM::in) = (NumBits::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
NumBits = BM.num_bits;
").
:- pragma foreign_proc("C#",
num_bits(BM::in) = (NumBits::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
NumBits = BM.num_bits;
").
%---------------------------------------------------------------------------%
num_bytes(BM) = Bytes :-
num_bytes(BM, Bytes).
num_bytes(BM, Bytes) :-
NumBits = num_bits(BM),
NumBits `unchecked_rem` bits_per_byte = 0,
Bytes = NumBits `unchecked_quotient` bits_per_byte.
det_num_bytes(BM) = Bytes :-
( if num_bytes(BM, Bytes0) then
Bytes = Bytes0
else
throw_bitmap_error(
"bitmap.det_num_bytes: bitmap has a partial final byte")
).
bits_per_byte = 8.
%---------------------------------------------------------------------------%
is_empty(BM) :-
num_bits(BM) = 0.
%---------------------------------------------------------------------------%
get_bit(BM, I) = B :-
( if in_range(BM, I) then
B = unsafe_get_bit(BM, I)
else
throw_bit_bounds_error(BM, "bitmap.get_bit", I)
).
bit(I, BM) = B :-
( if in_range(BM, I) then
B = unsafe_get_bit(BM, I)
else
throw_bit_bounds_error(BM, "bitmap.bit", I)
).
unsafe_get_bit(BM, I) = B :-
( if unsafe_is_set(BM, I) then B = yes else B = no ).
unsafe_bit(I, BM) = B :-
unsafe_get_bit(BM, I) = B.
set_bit(I, B, !BM) :-
( if in_range(!.BM, I) then
unsafe_set_bit(I, B, !BM)
else
throw_bit_bounds_error(!.BM, "bitmap.set_bit", I)
).
'bit :='(I, !.BM, B) = !:BM :-
( if in_range(!.BM, I) then
unsafe_set_bit(I, B, !BM)
else
throw_bit_bounds_error(!.BM, "bitmap.'bit :='", I)
).
unsafe_set_bit(I, yes, !BM) :-
unsafe_set(I, !BM).
unsafe_set_bit(I, no, !BM) :-
unsafe_clear(I, !BM).
'unsafe_bit :='(I, !.BM, B) = !:BM :-
unsafe_set_bit(I, B, !BM).
%---------------------------------------------------------------------------%
get_bits(BM, FirstBit, NumBits) = Word :-
( if
FirstBit >= 0,
NumBits >= 0,
NumBits =< int.bits_per_int,
in_range_rexcl(BM, FirstBit + NumBits)
then
Word = unsafe_get_bits(BM, FirstBit, NumBits)
else if
( NumBits < 0
; NumBits > int.bits_per_int
)
then
throw_bitmap_error("bitmap.get_bits: number of bits " ++
"must be between 0 and `int.bits_per_int'.")
else
throw_bit_bounds_error(BM, "bitmap.get_bits", FirstBit)
).
bits(FirstBit, NumBits, BM) = Word :-
( if
FirstBit >= 0,
NumBits >= 0,
NumBits =< int.bits_per_int,
in_range_rexcl(BM, FirstBit + NumBits)
then
Word = unsafe_get_bits(BM, 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_bit_bounds_error(BM, "bitmap.bits", FirstBit)
).
unsafe_get_bits(BM, FirstBit, NumBits) = Bits :-
FirstByteIndex = byte_index_for_bit(FirstBit),
FirstBitIndex = bit_index_in_byte(FirstBit),
extract_bits_from_bytes(FirstByteIndex, FirstBitIndex,
NumBits, BM, 0, Bits).
unsafe_bits(FirstBit, NumBits, BM) = Word :-
unsafe_get_bits(BM, FirstBit, NumBits) = Word.
% Extract the given number of bits starting at the most significant.
%
:- pred extract_bits_from_bytes(byte_index, bit_index_in_byte, num_bits,
bitmap, word, word).
% :- mode extract_bits_from_bytes(in, in, in, bitmap_ui, in, out) is det.
:- mode extract_bits_from_bytes(in, in, in, in, in, out) is det.
extract_bits_from_bytes(FirstByteIndex, FirstBitIndex, NumBits, BM, !Bits) :-
RemainingBitsInByte = bits_per_byte - FirstBitIndex,
( if
NumBits > RemainingBitsInByte
then
NumBitsThisByte = RemainingBitsInByte,
extract_bits_from_byte_index(FirstByteIndex, FirstBitIndex,
NumBitsThisByte, BM, !Bits),
extract_bits_from_bytes(FirstByteIndex + 1, 0,
NumBits - NumBitsThisByte, BM, !Bits)
else if
NumBits > 0
then
extract_bits_from_byte_index(FirstByteIndex, FirstBitIndex,
NumBits, BM, !Bits)
else
true
).
:- pred extract_bits_from_byte_index(byte_index, bit_index_in_byte, num_bits,
bitmap, word, word).
% :- mode extract_bits_from_byte_index(in, in, in, bitmap_ui, in, out) is det.
:- mode extract_bits_from_byte_index(in, in, in, in, in, out) is det.
extract_bits_from_byte_index(ByteIndex, FirstBitIndex,
NumBitsThisByte, BM, !Bits) :-
BitsThisByte = extract_bits_from_byte(unsafe_get_byte(BM, ByteIndex),
FirstBitIndex, NumBitsThisByte),
!:Bits = (!.Bits `unchecked_left_shift` NumBitsThisByte) \/ BitsThisByte.
%---------------------------------------------------------------------------%
set_bits(FirstBit, NumBits, Bits, !BM) :-
( if
FirstBit >= 0,
NumBits >= 0,
NumBits =< int.bits_per_int,
in_range_rexcl(!.BM, FirstBit + NumBits)
then
unsafe_set_bits(FirstBit, NumBits, Bits, !BM)
else if
( NumBits < 0
; NumBits > int.bits_per_int
)
then
throw_bitmap_error(
"bitmap.set_bits: number of bits " ++
"must be between 0 and `int.bits_per_int'.")
else
throw_bit_bounds_error(!.BM, "bitmap.set_bits", FirstBit)
).
'bits :='(FirstBit, NumBits, !.BM, Bits) = !:BM :-
( if
FirstBit >= 0,
NumBits >= 0,
NumBits =< int.bits_per_int,
in_range_rexcl(!.BM, FirstBit + NumBits)
then
unsafe_set_bits(FirstBit, NumBits, Bits, !BM)
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_bit_bounds_error(!.BM, "bitmap.'bits :='", FirstBit)
).
unsafe_set_bits(FirstBit, NumBits, Bits, !BM) :-
LastBit = FirstBit + NumBits - 1,
LastByteIndex = byte_index_for_bit(LastBit),
LastBitIndex = bit_index_in_byte(LastBit),
set_bits_in_bytes(LastByteIndex, LastBitIndex, NumBits, Bits, !BM).
'unsafe_bits :='(FirstBit, NumBits, !.BM, Bits) = !:BM :-
unsafe_set_bits(FirstBit, NumBits, Bits, !BM).
% Set the given number of bits starting at the least significant.
%
:- pred set_bits_in_bytes(byte_index, bit_index_in_byte, num_bits, word,
bitmap, bitmap).
:- mode set_bits_in_bytes(in, in, in, in, bitmap_di, bitmap_uo) is det.
set_bits_in_bytes(LastByteIndex, LastBitIndex, NumBits, Bits, !BM) :-
RemainingBitsInByte = LastBitIndex + 1,
( if NumBits > RemainingBitsInByte then
NumBitsThisByte = RemainingBitsInByte,
set_bits_in_byte_index(LastByteIndex, LastBitIndex, NumBitsThisByte,
Bits, !BM),
set_bits_in_bytes(LastByteIndex - 1, bits_per_byte - 1,
NumBits - NumBitsThisByte,
Bits `unchecked_right_shift` NumBitsThisByte, !BM)
else if NumBits > 0 then
set_bits_in_byte_index(LastByteIndex, LastBitIndex, NumBits, Bits, !BM)
else
true
).
:- pred set_bits_in_byte_index(byte_index::in, bit_index_in_byte::in,
num_bits::in, word::in, bitmap::bitmap_di, bitmap::bitmap_uo) is det.
set_bits_in_byte_index(ByteIndex, LastBitIndex, NumBitsThisByte, Bits, !BM) :-
FirstBitInByte = LastBitIndex - NumBitsThisByte + 1,
Byte0 = unsafe_get_byte(!.BM, ByteIndex),
set_bits_in_byte(FirstBitInByte, NumBitsThisByte, Bits, Byte0, Byte),
unsafe_set_byte(ByteIndex, Byte, !BM).
%---------------------------------------------------------------------------%
get_byte(BM, N) = Byte :-
( if byte_in_range(BM, N) then
Byte = unsafe_get_byte(BM, N)
else
throw_byte_bounds_error(BM, "bitmap.get_byte", N)
).
byte(N, BM) = Byte :-
( if byte_in_range(BM, N) then
Byte = unsafe_get_byte(BM, N)
else
throw_byte_bounds_error(BM, "bitmap.byte", N)
).
:- pragma foreign_proc("C",
unsafe_get_byte(BM::in, N::in) = (Byte::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
Byte = (MR_Integer) BM->elements[N];
").
:- pragma foreign_proc("Java",
unsafe_get_byte(BM::in, N::in) = (Byte::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
// Mask off sign bits so Byte is in range 0-255.
Byte = ((int) BM.elements[N]) & 0xff;
").
:- pragma foreign_proc("C#",
unsafe_get_byte(BM::in, N::in) = (Byte::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
Byte = BM.elements[N];
").
unsafe_get_byte(_BM, _N) = _Byte :-
private_builtin.sorry("bitmap.unsafe_byte").
unsafe_byte(N, BM) = Byte :-
unsafe_get_byte(BM, N) = Byte.
%---------------------------------------------------------------------------%
set_byte(N, Byte, !BM) :-
( if byte_in_range(!.BM, N) then
unsafe_set_byte(N, Byte, !BM)
else
throw_byte_bounds_error(!.BM, "bitmap.set_byte", N)
).
'byte :='(N, !.BM, Byte) = !:BM :-
( if byte_in_range(!.BM, N) then
unsafe_set_byte(N, Byte, !BM)
else
throw_byte_bounds_error(!.BM, "bitmap.'byte :='", N)
).
:- pragma foreign_proc("C",
unsafe_set_byte(N::in, Byte::in, BM0::bitmap_di, BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
BM = BM0;
BM->elements[N] = (MR_uint_least8_t) Byte;
").
:- pragma foreign_proc("Java",
unsafe_set_byte(N::in, Byte::in, BM0::bitmap_di, BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
BM = BM0;
BM.elements[N] = (byte) Byte;
").
:- pragma foreign_proc("C#",
unsafe_set_byte(N::in, Byte::in, BM0::bitmap_di, BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
BM = BM0;
BM.elements[N] = (byte) Byte;
").
unsafe_set_byte(_N, _Byte, !BM) :-
private_builtin.sorry("bitmap.unsafe_set_byte").
'unsafe_byte :='(N, !.BM, Byte) = !:BM :-
unsafe_set_byte(N, Byte, !BM).
%---------------------------------------------------------------------------%
get_uint8(BM, N) = U8 :-
( if byte_in_range(BM, N) then
U8 = unsafe_get_uint8(BM, N)
else
throw_byte_bounds_error(BM, "bitmap.get_uint8", N)
).
:- pragma foreign_proc("C",
unsafe_get_uint8(BM::in, N::in) = (U8::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
U8 = (uint8_t) BM->elements[N];
").
:- pragma foreign_proc("Java",
unsafe_get_uint8(BM::in, N::in) = (U8::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
U8 = BM.elements[N];
").
:- pragma foreign_proc("C#",
unsafe_get_uint8(BM::in, N::in) = (U8::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
U8 = BM.elements[N];
").
%---------------------------------------------------------------------------%
set_uint8(N, U8, !BM) :-
( if byte_in_range(!.BM, N) then
unsafe_set_uint8(N, U8, !BM)
else
throw_byte_bounds_error(!.BM, "bitmap.set_uint", N)
).
:- pragma foreign_proc("C",
unsafe_set_uint8(N::in, U8::in, BM0::bitmap_di, BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
BM = BM0;
BM->elements[N] = (MR_uint_least8_t) U8;
").
:- pragma foreign_proc("Java",
unsafe_set_uint8(N::in, U8::in, BM0::bitmap_di, BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
BM = BM0;
BM.elements[N] = (byte) U8;
").
:- pragma foreign_proc("C#",
unsafe_set_uint8(N::in, U8::in, BM0::bitmap_di, BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
BM = BM0;
BM.elements[N] = (byte) U8;
").
%---------------------------------------------------------------------------%
flip(!.BM, I) = !:BM :-
flip(I, !BM).
flip(I, !BM) :-
( if in_range(!.BM, I) then
unsafe_flip(I, !BM)
else
throw_bit_bounds_error(!.BM, "bitmap.flip", I)
).
set(!.BM, I) = !:BM :-
set(I, !BM).
set(I, !BM) :-
( if in_range(!.BM, I) then
unsafe_set(I, !BM)
else
throw_bit_bounds_error(!.BM, "bitmap.set", I)
).
clear(!.BM, I) = !:BM :-
clear(I, !BM).
clear(I, !BM) :-
( if in_range(!.BM, I) then
unsafe_clear(I, !BM)
else
throw_bit_bounds_error(!.BM, "bitmap.clear", I)
).
is_set(BM, I) :-
( if in_range(BM, I) then
unsafe_is_set(BM, I)
else
throw_bit_bounds_error(BM, "bitmap.is_set", I)
).
is_clear(BM, I) :-
( if in_range(BM, I) then
unsafe_is_clear(BM, I)
else
throw_bit_bounds_error(BM, "bitmap.is_clear", I)
).
%---------------------------------------------------------------------------%
unsafe_flip(BM0, I) = BM :-
unsafe_flip(I, BM0, BM).
unsafe_flip(I, BM0, BM) :-
ByteIndex = det_byte_index_for_bit(I),
Byte0 = unsafe_get_byte(BM0, ByteIndex),
Byte = Byte0 `xor` bitmask(I),
unsafe_set_byte(ByteIndex, Byte, BM0, BM).
unsafe_set(BM0, I) = BM :-
unsafe_set(I, BM0, BM).
unsafe_set(I, BM0, BM) :-
ByteIndex = det_byte_index_for_bit(I),
Byte0 = unsafe_get_byte(BM0, ByteIndex),
Byte = Byte0 \/ bitmask(I),
unsafe_set_byte(ByteIndex, Byte, BM0, BM).
unsafe_clear(BM0, I) = BM :-
unsafe_clear(I, BM0, BM).
unsafe_clear(I, BM0, BM) :-
ByteIndex = det_byte_index_for_bit(I),
Byte0 = unsafe_get_byte(BM0, ByteIndex),
Byte = Byte0 /\ \bitmask(I),
unsafe_set_byte(ByteIndex, Byte, BM0, BM).
unsafe_is_set(BM, I) :-
not unsafe_is_clear(BM, I).
unsafe_is_clear(BM, I) :-
unsafe_get_byte(BM, det_byte_index_for_bit(I)) /\ bitmask(I) = 0.
%---------------------------------------------------------------------------%
:- pragma foreign_proc("C",
copy(BM0::in) = (BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
MR_allocate_bitmap_msg(BM, BM0->num_bits, MR_ALLOC_ID);
MR_copy_bitmap(BM, BM0);
").
:- pragma foreign_proc("C#",
copy(BM0::in) = (BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
BM = new mercury.runtime.MercuryBitmap(BM0.num_bits);
System.Array.Copy(BM0.elements, 0, BM.elements, 0, BM0.elements.Length);
").
:- pragma foreign_proc("Java",
copy(BM0::in) = (BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
BM = new jmercury.runtime.MercuryBitmap(BM0.num_bits);
System.arraycopy(BM0.elements, 0, BM.elements, 0, BM0.elements.length);
").
copy(BM0) = BM :-
NumBits = num_bits(BM0),
BM1 = allocate_bitmap(NumBits),
unsafe_copy_bits(0, BM0, 0, 0, NumBits, BM1, BM2),
clear_filler_bits(BM2, BM).
%---------------------------------------------------------------------------%
resize(!.BM, NewSize, InitializerBit) = !:BM :-
( if NewSize =< 0 then
!:BM = init(NewSize, InitializerBit)
else
OldSize = num_bits(!.BM),
InitializerByte = initializer(InitializerBit),
!:BM = resize_bitmap(!.BM, NewSize),
( if NewSize > OldSize then
% Fill in the trailing bits in the previous final byte.
set_trailing_bits_in_byte(OldSize - 1, InitializerByte, !BM),
OldLastByteIndex = byte_index_for_bit(OldSize - 1),
NewLastByteIndex = byte_index_for_bit(NewSize - 1),
( if NewLastByteIndex > OldLastByteIndex then
initialize_bitmap_bytes(OldLastByteIndex + 1,
NewLastByteIndex, InitializerByte, !BM)
else
true
)
else
true
),
clear_filler_bits(!BM)
).
%---------------------------------------------------------------------------%
shrink_without_copying(!.BM, NewSize) = !:BM :-
( if 0 =< NewSize, NewSize =< num_bits(!.BM) then
set_num_bits(NewSize, !BM)
else
throw_bit_bounds_error(!.BM,
"bitmap.shrink_without_copying", NewSize)
).
:- pred set_num_bits(num_bits::in, bitmap::bitmap_di, bitmap::bitmap_uo)
is det.
:- pragma foreign_proc("C",
set_num_bits(NumBits::in, BM0::bitmap_di, BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
BM = BM0;
BM->num_bits = NumBits;
").
:- pragma foreign_proc("Java",
set_num_bits(NumBits::in, BM0::bitmap_di, BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
BM = BM0;
BM.num_bits = NumBits;
").
:- pragma foreign_proc("C#",
set_num_bits(NumBits::in, BM0::bitmap_di, BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
BM = BM0;
BM.num_bits = NumBits;
").
set_num_bits(_, !BM) :-
private_builtin.sorry("bitmap.set_num_bits").
%---------------------------------------------------------------------------%
:- type slice
---> slice_ctor(
slice_bitmap_field :: bitmap,
slice_start_bit_index_field :: bit_index,
slice_num_bits_field :: num_bits
).
slice(BM, StartBit, NumBits) = Slice :-
( if
NumBits >= 0,
StartBit >= 0,
in_range_rexcl(BM, StartBit + NumBits)
then
Slice = slice_ctor(BM, StartBit, NumBits)
else
throw_bounds_error(BM, "bitmap.slice", StartBit, NumBits)
).
byte_slice(BM, StartByte, NumBytes) =
slice(BM, StartByte * bits_per_byte, NumBytes * bits_per_byte).
Slice ^ slice_bitmap = Slice ^ slice_bitmap_field.
Slice ^ slice_start_bit_index = Slice ^ slice_start_bit_index_field.
Slice ^ slice_num_bits = Slice ^ slice_num_bits_field.
Slice ^ slice_start_byte_index =
quotient_bits_per_byte_with_rem_zero("bitmap.slice_start_byte_index",
Slice ^ slice_start_bit_index).
Slice ^ slice_num_bytes =
quotient_bits_per_byte_with_rem_zero("bitmap.slice_num_bytes",
Slice ^ slice_num_bits).
:- func quotient_bits_per_byte_with_rem_zero(string, int) = int is det.
quotient_bits_per_byte_with_rem_zero(Pred, Int) = Quotient :-
( if unchecked_rem(Int, bits_per_byte) = 0 then
Quotient = unchecked_quotient(Int, bits_per_byte)
else
throw_bitmap_error(Pred ++ ": not a byte slice.")
).
%---------------------------------------------------------------------------%
complement(!.BM) = !:BM :-
complement_loop(byte_index_for_bit(num_bits(!.BM) - 1), !BM),
clear_filler_bits(!BM).
:- pred complement_loop(int::in, bitmap::bitmap_di, bitmap::bitmap_uo) is det.
complement_loop(ByteIndex, !BM) :-
( if ByteIndex < 0 then
true
else
X = unsafe_get_byte(!.BM, ByteIndex),
unsafe_set_byte(ByteIndex, \ X, !BM),
complement_loop(ByteIndex - 1, !BM)
).
%---------------------------------------------------------------------------%
union(BM_A, BM_B) = BM :-
( if num_bits(BM_A) = num_bits(BM_B) then
zip((\/), BM_A, BM_B, BM)
else
throw_bitmap_error("bitmap.union: bitmaps not the same size")
).
intersect(BM_A, BM_B) = BM :-
( if num_bits(BM_A) = num_bits(BM_B) then
zip((/\), BM_A, BM_B, BM)
else
throw_bitmap_error("bitmap.intersect: bitmaps not the same size")
).
difference(BM_A, BM_B) = BM :-
( if num_bits(BM_A) = num_bits(BM_B) then
zip((func(X, Y) = (X /\ \Y)), BM_A, BM_B, BM)
else
throw_bitmap_error("bitmap.difference: bitmaps not the same size")
).
xor(BM_A, BM_B) = BM :-
( if num_bits(BM_A) = num_bits(BM_B) then
zip((func(X, Y) = (X `xor` Y)), BM_A, BM_B, BM)
else
throw_bitmap_error("bitmap.xor: bitmaps not the same size")
).
%---------------------------------------------------------------------------%
% Applies a function to every corresponding element between +ve I
% and 0 inclusive, destructively updating the second bitmap.
%
:- pred zip(func(byte, byte) = byte, bitmap, bitmap, bitmap).
% :- mode zip(in(func(in, in) = out is det),
% bitmap_ui, bitmap_di, bitmap_uo) is det.
:- mode zip(in(func(in, in) = out is det), in, bitmap_di, bitmap_uo) is det.
zip(Fn, BM_A, BM_B, BM) :-
( if num_bits(BM_B) = 0 then
BM = BM_B
else
zip_loop(byte_index_for_bit(num_bits(BM_B) - 1), Fn, BM_A, BM_B, BM)
).
:- pred zip_loop(byte_index, func(byte, byte) = byte, bitmap, bitmap, bitmap).
% :- mode zip_loop(in, in(func(in, in) = out is det),
% bitmap_ui, bitmap_di, bitmap_uo) is det.
:- mode zip_loop(in, in(func(in, in) = out is det), in, bitmap_di, bitmap_uo)
is det.
zip_loop(I, Fn, BM_A, BM_B, BM) :-
( if I >= 0 then
XA = unsafe_get_byte(BM_A, I),
XB = unsafe_get_byte(BM_B, I),
unsafe_set_byte(I, Fn(XA, XB), BM_B, BM_C),
zip_loop(I - 1, Fn, BM_A, BM_C, BM)
else
BM = BM_B
).
%---------------------------------------------------------------------------%
append_list(BMs) = !:BM :-
BMSize = list.foldl((func(BM, Size) = Size + num_bits(BM)), BMs, 0),
!:BM = init(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) :-
unsafe_copy_bits(0, ThisBM, 0, !.Index, num_bits(ThisBM), !BM),
!:Index = !.Index + num_bits(ThisBM).
%---------------------------------------------------------------------------%
copy_bits(SrcBM, SrcStartBit, DestBM0, DestStartBit, NumBits) = DestBM :-
copy_bits(0, SrcBM, SrcStartBit, DestStartBit, NumBits, DestBM0, DestBM).
copy_bits_in_bitmap(SrcBM, SrcStartBit, DestStartBit, NumBits) = DestBM :-
copy_bits(1, SrcBM, SrcStartBit, DestStartBit, NumBits, SrcBM, DestBM).
:- pred copy_bits(int, bitmap, bit_index,
bit_index, num_bits, bitmap, bitmap).
% :- mode copy_bits(in, bitmap_ui, in, in, in, bitmap_di, bitmap_uo) is det.
:- mode copy_bits(in, in, in, in, in, bitmap_di, bitmap_uo) is det.
copy_bits(SameBM, SrcBM, SrcStartBit, DestStartBit, NumBits, !DestBM) :-
( if
NumBits >= 0,
SrcStartBit >= 0,
DestStartBit >= 0,
in_range_rexcl(SrcBM, SrcStartBit + NumBits),
in_range_rexcl(!.DestBM, DestStartBit + NumBits)
then
unsafe_copy_bits(SameBM, SrcBM, SrcStartBit, DestStartBit, NumBits,
!DestBM)
else
( if
( NumBits < 0
; SrcStartBit < 0
; not in_range(SrcBM, SrcStartBit + NumBits - 1)
)
then
throw_bounds_error(SrcBM, "copy_bits (source)",
SrcStartBit, NumBits)
else if
( DestStartBit < 0
; not 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")
)
).
:- pred unsafe_copy_bits(int, bitmap, bit_index, bit_index, num_bits,
bitmap, bitmap).
% :- mode unsafe_copy_bits(in, bitmap_ui, in, in, in, bitmap_di, bitmap_uo)
% is det.
:- mode unsafe_copy_bits(in, in, in, in, in, bitmap_di, bitmap_uo) is det.
unsafe_copy_bits(SameBM, SrcBM, SrcStartBit, DestStartBit,
!.NumBits, !DestBM) :-
SrcStartIndex = bit_index_in_byte(SrcStartBit),
DestStartIndex = bit_index_in_byte(DestStartBit),
( if !.NumBits < 2 * bits_per_byte then
% The alternatives below don't handle ranges that don't span
% a byte boundary.
Bits = unsafe_get_bits(SrcBM, SrcStartBit, !.NumBits),
unsafe_set_bits(DestStartBit, !.NumBits, Bits, !DestBM)
else if SrcStartIndex = DestStartIndex then
% Handle the common case where the bits to be moved have
% the same offsets in each byte, so we can do a block byte copy.
StartIndex = SrcStartIndex,
SrcEndBit = SrcStartBit + !.NumBits - 1,
EndIndex = bit_index_in_byte(SrcEndBit),
( if
StartIndex = 0,
EndIndex = bits_per_byte - 1
then
% It's an aligned block of bytes, move it.
NumBytes = !.NumBits `unchecked_quotient` bits_per_byte,
SrcStartByteIndex = SrcStartBit `unchecked_quotient` bits_per_byte,
DestStartByteIndex =
DestStartBit `unchecked_quotient` bits_per_byte,
unsafe_copy_bytes(SameBM, SrcBM, SrcStartByteIndex,
DestStartByteIndex, NumBytes, !DestBM)
else
% Grab the odd bits at each end of the block to move,
% leaving a block of aligned bytes to move.
( if StartIndex = 0 then
NumBitsAtStart = 0,
StartBitsToSet = 0
else
NumBitsAtStart = bits_per_byte - StartIndex,
SrcPartialStartByteIndex = byte_index_for_bit(SrcStartBit),
PartialStartByte =
unsafe_get_byte(SrcBM, SrcPartialStartByteIndex),
StartBitsToSet = extract_bits_from_byte(PartialStartByte,
StartIndex, NumBitsAtStart),
!:NumBits = !.NumBits - NumBitsAtStart
),
( if EndIndex = bits_per_byte - 1 then
NumBitsAtEnd = 0,
EndBitsToSet = 0
else
NumBitsAtEnd = EndIndex + 1,
SrcPartialEndByteIndex = byte_index_for_bit(SrcEndBit),
PartialEndByte =
unsafe_get_byte(SrcBM, SrcPartialEndByteIndex),
EndBitsToSet = extract_bits_from_byte(PartialEndByte,
0, NumBitsAtEnd),
!:NumBits = !.NumBits - NumBitsAtEnd
),
% Do the block copy.
NumBytes = !.NumBits `unchecked_quotient` bits_per_byte,
SrcStartByteIndex = (SrcStartBit + NumBitsAtStart)
`unchecked_quotient` bits_per_byte,
DestStartByteIndex = (DestStartBit + NumBitsAtStart)
`unchecked_quotient` bits_per_byte,
unsafe_copy_bytes(SameBM, SrcBM, SrcStartByteIndex,
DestStartByteIndex, NumBytes, !DestBM),
% Fill in the partial bytes at the start and end of the range.
( if NumBitsAtStart = 0 then
true
else
DestPartialStartByteIndex = DestStartByteIndex - 1,
StartByte0 =
unsafe_get_byte(!.DestBM, DestPartialStartByteIndex),
set_bits_in_byte(StartIndex, NumBitsAtStart, StartBitsToSet,
StartByte0, StartByte),
unsafe_set_byte(DestPartialStartByteIndex, StartByte, !DestBM)
),
( if NumBitsAtEnd = 0 then
true
else
DestPartialEndByteIndex = DestStartByteIndex + NumBytes,
EndByte0 = unsafe_get_byte(!.DestBM, DestPartialEndByteIndex),
set_bits_in_byte(0, NumBitsAtEnd, EndBitsToSet,
EndByte0, EndByte),
unsafe_set_byte(DestPartialEndByteIndex, EndByte, !DestBM)
)
)
else
unsafe_copy_unaligned_bits(SameBM, SrcBM, SrcStartBit,
DestStartBit, !.NumBits, !DestBM)
).
copy_bytes(SrcBM, SrcStartByteIndex, DestBM0, DestStartByteIndex, NumBytes)
= DestBM :-
do_copy_bytes(0, SrcBM, SrcStartByteIndex,
DestStartByteIndex, NumBytes, DestBM0, DestBM).
copy_bytes_in_bitmap(SrcBM, SrcStartByteIndex, DestStartByteIndex, NumBytes)
= DestBM :-
do_copy_bytes(1, SrcBM, SrcStartByteIndex,
DestStartByteIndex, NumBytes, SrcBM, DestBM).
% The SameBM parameter is 1 if we are copying within the same bitmap.
% We use an `int' rather than a `bool' for easier interfacing with C.
%
:- pred do_copy_bytes(int, bitmap, bit_index,
bit_index, num_bits, bitmap, bitmap).
% :- mode copy_bytes(in, bitmap_ui, in, in, in, bitmap_di, bitmap_uo) is det.
:- mode do_copy_bytes(in, in, in, in, in, bitmap_di, bitmap_uo) is det.
do_copy_bytes(SameBM, SrcBM, SrcStartByte, DestStartByte, NumBytes, !DestBM) :-
( if
NumBytes = 0
then
true
else if
NumBytes > 0,
SrcStartByte >= 0,
byte_in_range(SrcBM, SrcStartByte + NumBytes - 1),
DestStartByte >= 0,
byte_in_range(!.DestBM, DestStartByte + NumBytes - 1)
then
unsafe_copy_bytes(SameBM, SrcBM, SrcStartByte, DestStartByte, NumBytes,
!DestBM)
else
throw_bitmap_error("bitmap.copy_bytes: out of range")
).
:- pred unsafe_copy_bytes(int, bitmap, byte_index, byte_index, num_bytes,
bitmap, bitmap).
% :- mode unsafe_copy_bytes(in, bitmap_ui, in, in, in, bitmap_di, bitmap_uo)
% is det.
:- mode unsafe_copy_bytes(in, in, in, in, in, bitmap_di, bitmap_uo) is det.
:- pragma foreign_proc("C",
unsafe_copy_bytes(SameBM::in, SrcBM::in, SrcFirstByteIndex::in,
DestFirstByteIndex::in, NumBytes::in,
DestBM0::bitmap_di, DestBM::bitmap_uo),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
DestBM = DestBM0;
if (SameBM) {
memmove(DestBM->elements + DestFirstByteIndex,
SrcBM->elements + SrcFirstByteIndex, NumBytes);
} else {
MR_memcpy(DestBM->elements + DestFirstByteIndex,
SrcBM->elements + SrcFirstByteIndex, NumBytes);
}
").
:- pragma foreign_proc("C#",
unsafe_copy_bytes(_SameBM::in, SrcBM::in, SrcFirstByteIndex::in,
DestFirstByteIndex::in, NumBytes::in,
DestBM0::bitmap_di, DestBM::bitmap_uo),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
DestBM = DestBM0;
System.Array.Copy(SrcBM.elements, SrcFirstByteIndex,
DestBM.elements, DestFirstByteIndex, NumBytes);
").
:- pragma foreign_proc("Java",
unsafe_copy_bytes(_SameBM::in, SrcBM::in, SrcFirstByteIndex::in,
DestFirstByteIndex::in, NumBytes::in,
DestBM0::bitmap_di, DestBM::bitmap_uo),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
DestBM = DestBM0;
System.arraycopy(SrcBM.elements, SrcFirstByteIndex,
DestBM.elements, DestFirstByteIndex, NumBytes);
").
unsafe_copy_bytes(SameBM, SrcBM, SrcFirstByteIndex,
DestFirstByteIndex, NumBytes, !DestBM) :-
Direction = choose_copy_direction(SameBM, SrcFirstByteIndex,
DestFirstByteIndex),
(
Direction = left_to_right,
unsafe_do_copy_bytes(SrcBM, SrcFirstByteIndex,
DestFirstByteIndex, NumBytes, 1, !DestBM)
;
Direction = right_to_left,
unsafe_do_copy_bytes(SrcBM, SrcFirstByteIndex + NumBytes - 1,
DestFirstByteIndex + NumBytes - 1, NumBytes, -1, !DestBM)
).
:- pred unsafe_do_copy_bytes(bitmap, byte_index, byte_index,
num_bytes, num_bytes, bitmap, bitmap).
% :- mode unsafe_do_copy_bytes(bitmap_ui, in, in, in, in,
% bitmap_di, bitmap_uo) is det.
:- mode unsafe_do_copy_bytes(in, in, in, in, in, bitmap_di, bitmap_uo) is det.
:- pragma consider_used(pred(unsafe_do_copy_bytes/7)).
unsafe_do_copy_bytes(SrcBM, SrcByteIndex, DestByteIndex,
NumBytes, AddForNext, !DestBM) :-
( if NumBytes = 0 then
true
else
Byte = unsafe_get_byte(SrcBM, SrcByteIndex),
unsafe_set_byte(DestByteIndex, Byte, !DestBM),
unsafe_do_copy_bytes(SrcBM, SrcByteIndex + AddForNext,
DestByteIndex + AddForNext, NumBytes - 1, AddForNext, !DestBM)
).
% General case. Reduce the number of writes by aligning to the next
% byte boundary in the destination bitmap so each byte is written once.
%
:- pred unsafe_copy_unaligned_bits(int, bitmap, bit_index, bit_index, num_bits,
bitmap, bitmap).
% :- mode unsafe_copy_unaligned_bits(in, bitmap_ui, in, in, in,
% bitmap_di, bitmap_uo) is det.
:- mode unsafe_copy_unaligned_bits(in, in, in, in, in, bitmap_di, bitmap_uo)
is det.
unsafe_copy_unaligned_bits(SameBM, SrcBM, SrcStartBit, DestStartBit,
!.NumBits, !DestBM) :-
% Grab the odd bits at each end of the block in the destination,
% leaving a block of aligned bytes to copy.
DestStartIndex = bit_index_in_byte(DestStartBit),
DestEndBit = DestStartBit + !.NumBits - 1,
( if DestStartIndex = 0 then
NumBitsAtStart = 0,
StartBits = 0
else
NumBitsAtStart = bits_per_byte - DestStartIndex,
StartBits = unsafe_get_bits(SrcBM, SrcStartBit, NumBitsAtStart),
!:NumBits = !.NumBits - NumBitsAtStart
),
NewSrcStartBit = (SrcStartBit + NumBitsAtStart),
NewDestStartBit = (DestStartBit + NumBitsAtStart),
DestEndIndex = bit_index_in_byte(DestEndBit),
( if DestEndIndex = bits_per_byte - 1 then
NumBitsAtEnd = 0,
EndBits = 0
else
NumBitsAtEnd = DestEndIndex + 1,
SrcEndBit = NewSrcStartBit + !.NumBits - 1,
EndBits =
unsafe_get_bits(SrcBM, SrcEndBit - NumBitsAtEnd + 1, NumBitsAtEnd),
!:NumBits = !.NumBits - NumBitsAtEnd
),
% Do the block copy.
NumBytes = !.NumBits `unchecked_quotient` bits_per_byte,
Direction = choose_copy_direction(SameBM, NewSrcStartBit, NewDestStartBit),
SrcBitIndex = bit_index_in_byte(NewSrcStartBit),
(
Direction = left_to_right,
SrcStartByteIndex = det_byte_index_for_bit(NewSrcStartBit),
DestStartByteIndex = det_byte_index_for_bit(NewDestStartBit),
SrcByte = unsafe_get_byte(SrcBM, SrcStartByteIndex),
unsafe_copy_unaligned_bytes_ltor(SrcBM,
SrcStartByteIndex + 1, SrcBitIndex, SrcByte,
DestStartByteIndex, NumBytes, !DestBM)
;
Direction = right_to_left,
SrcStartByteIndex =
det_byte_index_for_bit(NewSrcStartBit + !.NumBits - 1),
DestStartByteIndex =
det_byte_index_for_bit(NewDestStartBit + !.NumBits - 1),
SrcByte = unsafe_get_byte(SrcBM, SrcStartByteIndex),
unsafe_copy_unaligned_bytes_rtol(SrcBM,
SrcStartByteIndex - 1, SrcBitIndex, SrcByte,
DestStartByteIndex, NumBytes, !DestBM)
),
% Fill in the partial bytes at the start and end of the range.
( if NumBitsAtStart = 0 then
true
else
PartialDestStartByteIndex = byte_index_for_bit(DestStartBit),
StartByte0 = unsafe_get_byte(!.DestBM, PartialDestStartByteIndex),
set_bits_in_byte(DestStartIndex, NumBitsAtStart, StartBits,
StartByte0, StartByte),
unsafe_set_byte(PartialDestStartByteIndex, StartByte, !DestBM)
),
( if NumBitsAtEnd = 0 then
true
else
PartialDestEndByteIndex = byte_index_for_bit(DestEndBit),
EndByte0 = unsafe_get_byte(!.DestBM, PartialDestEndByteIndex),
set_bits_in_byte(0, NumBitsAtEnd, EndBits, EndByte0, EndByte),
unsafe_set_byte(PartialDestEndByteIndex, EndByte, !DestBM)
).
:- pred unsafe_copy_unaligned_bytes_ltor(bitmap, byte_index, bit_index_in_byte,
byte, byte_index, num_bytes, bitmap, bitmap).
% :- mode unsafe_copy_unaligned_bytes_ltor(bitmap_ui, in, in, in, in, in,
% bitmap_di, bitmap_uo) is det.
:- mode unsafe_copy_unaligned_bytes_ltor(in, in, in, in, in, in,
bitmap_di, bitmap_uo) is det.
unsafe_copy_unaligned_bytes_ltor(SrcBM, SrcByteIndex, SrcBitIndex,
PrevSrcByteBits, DestByteIndex, NumBytes, !DestBM) :-
( if NumBytes =< 0 then
true
else
% Combine parts of two adjacent bytes in the source bitmap
% into one byte of the destination.
%
% For example, for the call to `unsafe_copy_unaligned_bytes_ltor'
% that would result from a call:
% `unsafe_copy_bits(SrcBM, 1, DestBM, 0, 8)',
% we construct the first byte in the destination by pasting
% together the last seven bits of `SrcBM ^ byte(0)'
% (from PrevSrcByteBits) with the first bit of `SrcBM ^ byte(1)'.
% SrcBM: |0 1234567|0 1234567|01234567|...
% | \/ |
% DestBM: |0123456 7|...
%
% PrevSrcByteBits will contain the initial contents of `Src ^ byte(0)'
% (we can't look it up here because in the general case it may be
% overwritten by previous recursive calls).
SrcByteBits = unsafe_get_byte(SrcBM, SrcByteIndex),
DestByteBits = (PrevSrcByteBits `unchecked_left_shift` SrcBitIndex)
\/ (SrcByteBits `unchecked_right_shift`
(bits_per_byte - SrcBitIndex)),
unsafe_set_byte(DestByteIndex, DestByteBits, !DestBM),
unsafe_copy_unaligned_bytes_ltor(SrcBM, SrcByteIndex + 1, SrcBitIndex,
SrcByteBits, DestByteIndex + 1, NumBytes - 1, !DestBM)
).
:- pred unsafe_copy_unaligned_bytes_rtol(bitmap, byte_index, bit_index_in_byte,
byte, byte_index, num_bytes, bitmap, bitmap).
% :- mode unsafe_copy_unaligned_bytes_rtol(bitmap_ui, in, in, in, in, in,
% bitmap_di, bitmap_uo) is det.
:- mode unsafe_copy_unaligned_bytes_rtol(in, in, in, in, in, in,
bitmap_di, bitmap_uo) is det.
unsafe_copy_unaligned_bytes_rtol(SrcBM, SrcByteIndex, SrcBitIndex,
PrevSrcByteBits, DestByteIndex, NumBytes, !DestBM) :-
( if NumBytes =< 0 then
true
else
% Combine parts of two adjacent bytes in the source bitmap
% into one byte of the destination.
%
% For example, for the first call to `unsafe_copy_unaligned_bytes_ltor'
% resulting from a call `unsafe_copy_bits_in_bitmap(SrcBM, 7, 8, 8)'
% we construct the second byte in the destination by pasting together
% the last bit of `SrcBM ^ byte(0)' with the first seven bits of
% `SrcBM ^ byte(1)' (from PrevSrcByteBits).
% SrcBM: |0123456 7|0123456 7|01234567|
% | \/ |
% DestBM: |01234567|0 1234567|
%
% PrevSrcByteBits will contain the initial contents of `Src ^ byte(1)'
% (we can't look it up here because in the general case it may be
% overwritten by previous recursive calls).
SrcByteBits = unsafe_get_byte(SrcBM, SrcByteIndex),
DestByteBits = (SrcByteBits `unchecked_left_shift` SrcBitIndex)
\/ (PrevSrcByteBits `unchecked_right_shift`
(bits_per_byte - SrcBitIndex)),
unsafe_set_byte(DestByteIndex, DestByteBits, !DestBM),
unsafe_copy_unaligned_bytes_rtol(SrcBM, SrcByteIndex - 1,
SrcBitIndex, SrcByteBits, DestByteIndex - 1, NumBytes - 1, !DestBM)
).
:- type copy_direction
---> left_to_right
; right_to_left.
% choose_copy_direction(SameBM, SrcStartBit, DestStartBit)
%
% Choose a direction that will avoid overwriting data
% before it has been copied.
% Where it doesn't matter, prefer left_to_right for better performance.
%
:- func choose_copy_direction(int, bit_index, bit_index) = copy_direction.
choose_copy_direction(SameBM, SrcStartBit, DestStartBit) =
( if SameBM = 1, SrcStartBit < DestStartBit then
right_to_left
else
left_to_right
).
%---------------------------------------------------------------------------%
hash(BM) = HashVal :-
% NOTE: bitmap.hash is also defined as MR_hash_bitmap in
% runtime/mercury_bitmap.h. The two definitions must be kept identical.
NumBits = num_bits(BM),
NumBytes0 = NumBits `unchecked_quotient` bits_per_byte,
( if NumBits `unchecked_rem` bits_per_byte = 0 then
NumBytes = NumBytes0
else
NumBytes = NumBytes0 + 1
),
hash_loop(BM, 0, NumBytes, 0, HashVal0),
HashVal = HashVal0 `xor` NumBits.
:- pred hash_loop(bitmap::in, byte_index::in, int::in, int::in, int::out)
is det.
hash_loop(BM, Index, Length, !HashVal) :-
( if Index < Length then
combine_hash(unsafe_get_byte(BM, Index), !HashVal),
hash_loop(BM, Index + 1, Length, !HashVal)
else
true
).
:- pred combine_hash(int::in, int::in, int::out) is det.
combine_hash(X, H0, H) :-
H1 = H0 `xor` (H0 << 5),
H = H1 `xor` X.
%---------------------------------------------------------------------------%
to_string(BM) = Str :-
% Note: this should be kept in sync with MR_bitmap_to_string in
% runtime/mercury_bitmap.c.
NumBits = num_bits(BM),
to_string_chars(byte_index_for_bit(NumBits - 1), BM, ['>'], BitChars),
LenChars = to_char_list(int_to_string(NumBits)),
Chars = ['<' | LenChars] ++ [':' | BitChars],
Str = string.from_char_list(Chars).
:- pred to_string_chars(int, bitmap, list(char), list(char)).
% :- mode to_string_chars(in, bitmap_ui, in, out) is det.
:- mode to_string_chars(in, in, in, out) is det.
to_string_chars(Index, BM, !Chars) :-
( if Index < 0 then
true
else
Byte = unsafe_get_byte(BM, Index),
Mask = n_bit_mask(4),
( if
char.int_to_hex_digit((Byte `unchecked_right_shift` 4) /\ Mask,
HighChar),
char.int_to_hex_digit(Byte /\ Mask, LowChar)
then
!:Chars = [HighChar, LowChar | !.Chars],
to_string_chars(Index - 1, BM, !Chars)
else
throw(software_error("bitmap.to_string: internal error"))
)
).
from_string(Str) = BM :-
from_string(Str, BM).
from_string(Str, BM) :-
string.unsafe_index_next(Str, 0, Start, '<'),
string.unsafe_index(Str, Start, Char),
char.is_digit(Char),
string.unsafe_prev_index(Str, length(Str), End, '>'),
string.sub_string_search_start(Str, ":", Start, Colon),
SizeStr = string.unsafe_between(Str, Start, Colon),
string.to_int(SizeStr, Size),
( if Size >= 0 then
BM0 = allocate_bitmap(Size),
string.unsafe_index_next(Str, Colon, AfterColon, _),
hex_chars_to_bitmap(Str, AfterColon, End, 0, BM0, BM)
else
fail
).
det_from_string(Str) =
( if from_string(Str, BM) then
BM
else
unexpected($pred, "bitmap.from_string failed")
).
:- pred hex_chars_to_bitmap(string::in, int::in, int::in, byte_index::in,
bitmap::bitmap_di, bitmap::bitmap_uo) is semidet.
hex_chars_to_bitmap(Str, Index, End, ByteIndex, !BM) :-
( if Index = End then
true
else if Index + 1 = End then
% Each byte of the bitmap should have mapped to a pair of characters.
fail
else
char.hex_digit_to_int(unsafe_index(Str, Index), HighNibble),
char.hex_digit_to_int(unsafe_index(Str, Index + 1), LowNibble),
Byte = (HighNibble `unchecked_left_shift` 4) \/ LowNibble,
unsafe_set_byte(ByteIndex, Byte, !BM),
hex_chars_to_bitmap(Str, Index + 2, End, ByteIndex + 1, !BM)
).
%---------------------------------------------------------------------------%
to_byte_string(BM) = string.join_list(".", bitmap_to_byte_strings(BM)).
:- func bitmap_to_byte_strings(bitmap) = list(string).
% :- mode bitmap_to_byte_strings(bitmap_ui) = out is det.
:- mode bitmap_to_byte_strings(in) = out is det.
bitmap_to_byte_strings(BM) = Strs :-
NumBits = num_bits(BM),
Strs = bitmap_to_byte_strings(BM, NumBits, []).
:- func bitmap_to_byte_strings(bitmap, int, list(string)) = list(string).
% :- mode bitmap_to_byte_strings(bitmap_ui, in, in) = out is det.
:- mode bitmap_to_byte_strings(in, in, in) = out is det.
bitmap_to_byte_strings(BM, NumBits, !.Strs) = !:Strs :-
( if NumBits =< 0 then
true
else
ThisByte0 =
unsafe_get_byte(BM, det_byte_index_for_bit(NumBits - 1)),
LastBitIndex = bit_index_in_byte(NumBits - 1),
( if LastBitIndex = bits_per_byte - 1 then
BitsThisByte = bits_per_byte,
ThisByte = ThisByte0
else
BitsThisByte = LastBitIndex + 1,
ThisByte = ThisByte0 `unchecked_right_shift`
(bits_per_byte - BitsThisByte)
),
ThisByteStr = string.pad_left(string.int_to_base_string(ThisByte, 2),
'0', BitsThisByte),
!:Strs = [ThisByteStr | !.Strs],
!:Strs = bitmap_to_byte_strings(BM, NumBits - BitsThisByte, !.Strs)
).
%---------------------------------------------------------------------------%
%
% Bitmap input and output predicates.
%
% The modules io.m and bit_buffer.read.m also contain code
% for reading in bitmaps. The read_binary_file_as_bitmap predicate in io.m
% calls read_bitmap_range below for all of the actual I/O, while the
% get_bitmap predicate in bit_buffer.read.m duplicates much of the logic
% of read_bitmap_range.
%
read_bitmap(!Bitmap, BytesRead, Result, !IO) :-
binary_input_stream(Stream, !IO),
bitmap.read_bitmap(Stream, !Bitmap, BytesRead, Result, !IO).
read_bitmap(Stream, !Bitmap, BytesRead, Result, !IO) :-
NumBytes = det_num_bytes(!.Bitmap),
bitmap.read_bitmap_range(Stream, 0, NumBytes, !Bitmap,
BytesRead, Result, !IO).
read_bitmap_range(StartByte, NumBytes, !Bitmap, BytesRead, Result, !IO) :-
binary_input_stream(Stream, !IO),
bitmap.read_bitmap_range(Stream, StartByte, NumBytes, !Bitmap,
BytesRead, Result, !IO).
read_bitmap_range(InputStream, Start, NumBytes, !Bitmap,
BytesRead, Result, !IO) :-
% The overall logic of this predicate is also followed by get_bitmap/8
% in bit_buffer.m.
( if
NumBytes > 0,
byte_in_range(!.Bitmap, Start),
byte_in_range(!.Bitmap, Start + NumBytes - 1)
then
Stream = binary_input_stream_get_stream(InputStream),
do_read_bitmap_range(Stream, Start, NumBytes,
!Bitmap, 0, BytesRead, Error, !IO),
is_error(Error, "read failed: ", MaybeIOError, !IO),
(
MaybeIOError = yes(IOError),
Result = error(IOError)
;
MaybeIOError = no,
Result = ok
)
else if
NumBytes = 0,
byte_in_range(!.Bitmap, Start)
then
Result = ok,
BytesRead = 0
else
bitmap.throw_bounds_error(!.Bitmap, "bitmap.read_bitmap",
Start * bits_per_byte, NumBytes * bits_per_byte)
).
:- pred do_read_bitmap_range(stream::in, byte_index::in, num_bytes::in,
bitmap::bitmap_di, bitmap::bitmap_uo, num_bytes::in, num_bytes::out,
system_error::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
do_read_bitmap_range(Stream::in, StartByte::in, NumBytes::in,
Bitmap0::bitmap_di, Bitmap::bitmap_uo, BytesRead0::in, BytesRead::out,
Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
size_t nread;
Bitmap = Bitmap0;
nread = MR_READ(*Stream, Bitmap->elements + StartByte, NumBytes);
BytesRead = BytesRead0 + nread;
if (nread < NumBytes && MR_FERROR(*Stream)) {
Error = errno;
} else {
Error = 0;
}
").
:- pragma foreign_proc("C#",
do_read_bitmap_range(Stream::in, StartByte::in, NumBytes::in,
Bitmap0::bitmap_di, Bitmap::bitmap_uo, BytesRead0::in, BytesRead::out,
Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
mercury.io__stream_ops.MR_MercuryFileStruct mf = Stream;
Bitmap = Bitmap0;
BytesRead = BytesRead0;
if (mf.putback != -1) {
Bitmap.elements[StartByte] = (byte) mf.putback;
BytesRead++;
StartByte++;
NumBytes--;
mf.putback = -1;
}
try {
BytesRead += mf.stream.Read(Bitmap.elements, StartByte, NumBytes);
Error = null;
} catch (System.Exception e) {
Error = e;
}
").
:- pragma foreign_proc("Java",
do_read_bitmap_range(Stream::in, StartByte::in, NumBytes::in,
Bitmap0::bitmap_di, Bitmap::bitmap_uo, BytesRead0::in, BytesRead::out,
Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
jmercury.io__stream_ops.MR_BinaryInputFile mf =
(jmercury.io__stream_ops.MR_BinaryInputFile) Stream;
Bitmap = Bitmap0;
BytesRead = BytesRead0;
final int nread = mf.read_pushback(Bitmap.elements, StartByte, NumBytes);
BytesRead += nread;
StartByte += nread;
NumBytes -= nread;
try {
BytesRead +=
mf.read_non_pushback(Bitmap.elements, StartByte, NumBytes);
Error = null;
} catch (java.lang.Exception e) {
Error = e;
}
").
% Default implementation.
% XXX This has been unused since the deletion of the Erlang backend.
%
do_read_bitmap_range(Stream, Start, NumBytes, !Bitmap, !BytesRead,
Error, !IO) :-
( if NumBytes > 0 then
read_byte_val(text_input_stream(Stream), ResultCode, Byte,
Error0, !IO),
(
ResultCode = result_code_ok,
unsafe_set_byte(Start, Byte, !Bitmap),
!:BytesRead = !.BytesRead + 1,
do_read_bitmap_range(Stream, Start + 1, NumBytes - 1,
!Bitmap, !BytesRead, Error, !IO)
;
ResultCode = result_code_eof,
Error = Error0
;
ResultCode = result_code_error,
Error = Error0
)
else
Error = no_error
).
%---------------------%
write_bitmap(Bitmap, !IO) :-
binary_output_stream(Stream, !IO),
bitmap.write_bitmap(Stream, Bitmap, !IO).
write_bitmap(OutputStream, Bitmap, !IO) :-
NumBytes = det_num_bytes(Bitmap),
Stream = binary_output_stream_get_stream(OutputStream),
do_write_bitmap_range(Stream, Bitmap, 0, NumBytes, Error, !IO),
throw_on_output_error(Error, !IO).
write_bitmap_range(Bitmap, Start, NumBytes, !IO) :-
binary_output_stream(Stream, !IO),
bitmap.write_bitmap_range(Stream, Bitmap, Start, NumBytes, !IO).
write_bitmap_range(OutputStream, Bitmap, Start, NumBytes, !IO) :-
( if NumBytes = 0 then
true
else if
NumBytes > 0,
byte_in_range(Bitmap, Start),
byte_in_range(Bitmap, Start + NumBytes - 1)
then
Stream = binary_output_stream_get_stream(OutputStream),
do_write_bitmap_range(Stream, Bitmap, Start, NumBytes, Error, !IO),
throw_on_output_error(Error, !IO)
else
bitmap.throw_bounds_error(Bitmap, "bitmap.write_bitmap",
Start * bits_per_byte, NumBytes * bits_per_byte)
).
:- pred do_write_bitmap_range(stream, bitmap, int, int, system_error, io, io).
%:- mode do_write_bitmap(in, bitmap_ui, in, in, out, di, uo) is det.
:- mode do_write_bitmap_range(in, in, in, in, out, di, uo) is det.
:- pragma foreign_proc("C",
do_write_bitmap_range(Stream::in, Bitmap::in, Start::in, Length::in,
Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
no_sharing],
"
MR_Integer bytes_written =
(MR_Integer) MR_WRITE(*Stream, Bitmap->elements + Start, Length);
if (bytes_written != Length) {
Error = errno;
} else {
Error = 0;
}
").
:- pragma foreign_proc("C#",
do_write_bitmap_range(Stream::in, Bitmap::in, Start::in, Length::in,
Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
no_sharing],
"
try {
Stream.stream.Write(Bitmap.elements, Start, Length);
Error = null;
} catch (System.Exception e) {
Error = e;
}
").
:- pragma foreign_proc("Java",
do_write_bitmap_range(Stream::in, Bitmap::in, Start::in, Length::in,
Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
no_sharing],
"
try {
((jmercury.io__stream_ops.MR_BinaryOutputFile) Stream).write(
Bitmap.elements, Start, Length);
Error = null;
} catch (java.io.IOException e) {
Error = e;
}
").
%---------------------------------------------------------------------------%
%
% A bitmap is represented in C as a size (in bits) and an array of bytes.
%
% NOTE: the `filler' bits in the last element of the array *must* be clear
% (i.e. zero). This makes the unification, comparison and the set operations
% simpler to implement.
%
:- pragma foreign_decl("C", "
#include ""mercury_types.h""
#include ""mercury_bitmap.h""
#include ""mercury_type_info.h""
").
:- pragma foreign_decl("Java", "
import jmercury.runtime.MercuryBitmap;
").
:- pragma foreign_type("C", bitmap, "MR_BitmapPtr",
[can_pass_as_mercury_type])
where equality is bitmap_equal, comparison is bitmap_compare.
:- pragma foreign_type("Java", bitmap, "jmercury.runtime.MercuryBitmap")
where equality is bitmap_equal, comparison is bitmap_compare.
:- pragma foreign_type("C#", bitmap, "mercury.runtime.MercuryBitmap")
where equality is bitmap_equal, comparison is bitmap_compare.
:- pred bitmap_equal(bitmap::in, bitmap::in) is semidet.
:- pragma terminates(pred(bitmap_equal/2)).
:- pragma foreign_proc("C",
bitmap_equal(BM1::in, BM2::in),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
SUCCESS_INDICATOR = MR_bitmap_eq(BM1, BM2);
").
:- pragma foreign_proc("C#",
bitmap_equal(BM1::in, BM2::in),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
SUCCESS_INDICATOR = BM1.Equals(BM2);
").
:- pragma foreign_proc("Java",
bitmap_equal(BM1::in, BM2::in),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
SUCCESS_INDICATOR = BM1.equals(BM2);
").
bitmap_equal(BM_A, BM_B) :-
num_bits(BM_A) = num_bits(BM_B) @ NumBits,
bytes_equal(0, byte_index_for_bit(NumBits), BM_A, BM_B).
:- pred bytes_equal(byte_index::in, byte_index::in,
bitmap::in, bitmap::in) is semidet.
:- pragma consider_used(pred(bytes_equal/4)).
bytes_equal(Index, MaxIndex, BM_A, BM_B) :-
( if Index =< MaxIndex then
unsafe_get_byte(BM_A, Index) = unsafe_get_byte(BM_B, Index),
bytes_equal(Index + 1, MaxIndex, BM_A, BM_B)
else
true
).
:- pred bitmap_compare(comparison_result::uo, bitmap::in, bitmap::in) is det.
:- pragma terminates(pred(bitmap_compare/3)).
:- pragma foreign_proc("C",
bitmap_compare(Result::uo, BM1::in, BM2::in),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
MR_Integer res;
res = MR_bitmap_cmp(BM1, BM2);
Result = ((res < 0) ? MR_COMPARE_LESS
: (res == 0) ? MR_COMPARE_EQUAL
: MR_COMPARE_GREATER);
").
:- pragma foreign_proc("Java",
bitmap_compare(Result::uo, BM1::in, BM2::in),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail,
may_not_duplicate],
"
if (BM1.num_bits < BM2.num_bits) {
Result = builtin.COMPARE_LESS;
} else if (BM1.num_bits > BM2.num_bits) {
Result = builtin.COMPARE_GREATER;
} else {
Result = builtin.COMPARE_EQUAL;
for (int i = 0; i < BM1.elements.length; i++) {
// Mask off sign bits.
int b1 = ((int) BM1.elements[i]) & 0xff;
int b2 = ((int) BM2.elements[i]) & 0xff;
if (b1 < b2) {
Result = builtin.COMPARE_LESS;
break;
}
if (b1 > b2) {
Result = builtin.COMPARE_GREATER;
break;
}
}
}
").
:- pragma foreign_proc("C#",
bitmap_compare(Result::uo, BM1::in, BM2::in),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail,
may_not_duplicate],
"
if (BM1.num_bits < BM2.num_bits) {
Result = builtin.COMPARE_LESS;
} else if (BM1.num_bits > BM2.num_bits) {
Result = builtin.COMPARE_GREATER;
} else {
Result = builtin.COMPARE_EQUAL;
for (int i = 0; i < BM1.elements.Length; i++) {
// Mask off sign bits.
int b1 = ((int) BM1.elements[i]) & 0xff;
int b2 = ((int) BM2.elements[i]) & 0xff;
if (b1 < b2) {
Result = builtin.COMPARE_LESS;
break;
}
if (b1 > b2) {
Result = builtin.COMPARE_GREATER;
break;
}
}
}
").
bitmap_compare(Result, BM1, BM2) :-
NumBits1 = num_bits(BM1),
NumBits2 = num_bits(BM2),
compare(Result0, NumBits1, NumBits2),
(
Result0 = (=),
MaxIndex = byte_index_for_bit(NumBits2),
bytes_compare(Result, 0, MaxIndex, BM1, BM2)
;
( Result0 = (<)
; Result0 = (>)
),
Result = Result0
).
:- pred bytes_compare(comparison_result::uo, byte_index::in, byte_index::in,
bitmap::in, bitmap::in) is det.
:- pragma consider_used(pred(bytes_compare/5)).
bytes_compare(Result, Index, MaxIndex, BM1, BM2) :-
( if Index =< MaxIndex then
Byte1 = unsafe_get_byte(BM1, Index),
Byte2 = unsafe_get_byte(BM2, Index),
compare(Result0, Byte1, Byte2),
(
Result0 = (=),
bytes_compare(Result, Index + 1, MaxIndex, BM1, BM2)
;
( Result0 = (<)
; Result0 = (>)
),
Result = Result0
)
else
Result = (=)
).
%---------------------------------------------------------------------------%
:- func allocate_bitmap(num_bits) = bitmap.
:- mode allocate_bitmap(in) = bitmap_uo is det.
:- pragma foreign_proc("C",
allocate_bitmap(N::in) = (BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
MR_allocate_bitmap_msg(BM, N, MR_ALLOC_ID);
").
:- pragma foreign_proc("Java",
allocate_bitmap(N::in) = (BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
BM = new jmercury.runtime.MercuryBitmap(N);
").
:- pragma foreign_proc("C#",
allocate_bitmap(N::in) = (BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
BM = new mercury.runtime.MercuryBitmap(N);
").
:- func resize_bitmap(bitmap, num_bits) = bitmap.
:- mode resize_bitmap(bitmap_di, in) = bitmap_uo is det.
resize_bitmap(OldBM, N) =
copy_bits(OldBM, 0, allocate_bitmap(N), 0, int.min(num_bits(OldBM), N)).
%---------------------------------------------------------------------------%
% The byte index containing the given bit.
%
:- func byte_index_for_bit(bit_index) = byte_index.
byte_index_for_bit(I) = ByteIndex :-
( if I < 0 then
ByteIndex = -1
else
ByteIndex = unchecked_quotient(I, bits_per_byte)
).
% The byte index containing the given bit.
%
:- func det_byte_index_for_bit(bit_index) = byte_index.
det_byte_index_for_bit(I) = ByteIndex :-
( if I < 0 then
unexpected($pred, "I < 0")
else
ByteIndex = unchecked_quotient(I, bits_per_byte)
).
%---------------------------------------------------------------------------%
:- type bit_index_in_byte == int.
% Convert a bit index for a bitmap into a bit index into a byte
% in the bitmap.
%
:- func bit_index_in_byte(bit_index) = bit_index_in_byte.
bit_index_in_byte(I) = I `unchecked_rem` bits_per_byte.
%---------------------------------------------------------------------------%
% Construct the bitmask for a given bit in a byte. Bits are numbered
% from most significant to least significant (starting at zero).
%
% E.g. assuming bits_per_byte = 8 and I = 3 then
% bitmask(I) = 2'00010000
%
:- func bitmask(bit_index_in_byte) = byte.
bitmask(I) = 1 `unchecked_left_shift`
(bits_per_byte - 1 - bit_index_in_byte(I)).
%---------------------------------------------------------------------------%
% Construct a bitmask containing the N least significant bits set.
%
% E.g. assuming bits_per_byte = 8 and I = 4 then
% n_bit_mask(I) = 2'00001111
%
:- func n_bit_mask(num_bits) = byte.
n_bit_mask(N) = BitsMask :-
BitMask = 1 `unchecked_left_shift` (N - 1),
BitsMask = BitMask \/ (BitMask - 1).
%---------------------------------------------------------------------------%
% extract_bits_from_byte(Byte, FirstBit, NumBits):
%
% Return an integer whose NumBits least significant bits contain
% bits FirstBit, FirstBit + 1, ... FirstBit + NumBits - 1,
% in order from most significant to least significant.
%
:- func extract_bits_from_byte(byte, bit_index_in_byte, num_bits) = byte.
extract_bits_from_byte(Byte, FirstBit, NumBits) = Bits :-
% Shift the last bit in the selected bit range
% to the least significant position.
LastBit = FirstBit + NumBits - 1,
Shift = bits_per_byte - 1 - LastBit,
Bits = (Byte `unchecked_right_shift` Shift) /\ n_bit_mask(NumBits).
% set_bits_in_byte(FirstBit, NumBits, Bits, Byte0, Byte):
%
% Replace bits FirstBit, FirstBit + 1, ... FirstBit + NumBits - 1,
% with the NumBits least significant bits of Bits, replacing FirstBit
% with the most significant of those bits.
%
:- pred set_bits_in_byte(byte::in, bit_index_in_byte::in, num_bits::in,
byte::in, byte::out) is det.
set_bits_in_byte(FirstBit, NumBits, Bits, Byte0, Byte) :-
LastBit = FirstBit + NumBits - 1,
Shift = bits_per_byte - 1 - LastBit,
Mask = n_bit_mask(NumBits),
BitsToSet = Mask /\ Bits,
Byte = (Byte0 /\ \ (Mask `unchecked_left_shift` Shift))
\/ (BitsToSet `unchecked_left_shift` Shift).
%---------------------------------------------------------------------------%
% throw_bit_bounds_error(BM, PredName, BitIndex):
%
:- pred throw_bit_bounds_error(bitmap::in, string::in, bit_index::in)
is erroneous.
throw_bit_bounds_error(BM, Pred, BitIndex) :-
string.format(
"%s: bit index %d is out of bounds [0, %d).",
[s(Pred), i(BitIndex), i(num_bits(BM))], Msg),
throw_bitmap_error(Msg).
% throw_byte_bounds_error(BM, PredName, ByteIndex):
%
:- pred throw_byte_bounds_error(bitmap::in, string::in, byte_index::in)
is erroneous.
throw_byte_bounds_error(BM, Pred, ByteIndex) :-
string.format(
"%s: byte index %d is out of bounds [0, %d).",
[s(Pred), i(ByteIndex), i(num_bits(BM) / bits_per_byte)], Msg),
throw_bitmap_error(Msg).
throw_bounds_error(BM, Pred, Index, NumBits) :-
( if NumBits < 0 then
string.format("%s: negative number of bits: %d.",
[s(Pred), i(NumBits)], Msg)
else
string.format(
"%s: %d bits starting at bit %d is out of bounds [0, %d).",
[s(Pred), i(NumBits), i(Index), i(num_bits(BM))], Msg)
),
throw_bitmap_error(Msg).
:- pred throw_bitmap_error(string::in) is erroneous.
throw_bitmap_error(Msg) :-
throw(bitmap_error(Msg)).
%---------------------------------------------------------------------------%
:- instance stream.bulk_reader(io.binary_input_stream, int, bitmap, io,
io.error)
where
[
pred(bulk_get/9) is bitmap.stream_bulk_get
].
:- instance stream.writer(io.binary_output_stream, bitmap, io)
where
[
pred(put/4) is bitmap.write_bitmap
].
:- instance stream.writer(io.binary_output_stream, bitmap.slice, io)
where
[
pred(put/4) is bitmap.stream_put
].
%---------------------------------------------------------------------------%
:- pred stream_bulk_get(io.binary_input_stream::in, int::in, int::in,
bitmap::bulk_get_di, bitmap::bulk_get_uo, int::out,
stream.res(io.error)::out, io::di, io::uo) is det.
stream_bulk_get(Stream, Index, Int, !Store, NumRead, Result, !IO) :-
bitmap.read_bitmap_range(Stream, Index, Int, !Store, NumRead,
Result0, !IO),
Result = res_to_stream_res(Result0).
:- func res_to_stream_res(io.res) = stream.res(io.error).
res_to_stream_res(ok) = ok.
res_to_stream_res(error(E)) = error(E).
:- pred stream_put(io.binary_output_stream::in, bitmap.slice::in,
io::di, io::uo) is det.
stream_put(Stream, Slice, !IO) :-
bitmap.write_bitmap_range(Stream, Slice ^ slice_bitmap,
Slice ^ slice_start_byte_index, Slice ^ slice_num_bytes, !IO).
%---------------------------------------------------------------------------%
:- end_module bitmap.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink