[m-rev.] for review: improvements to bitmap.m [1]
Simon Taylor
staylr at gmail.com
Sun Feb 11 12:01:29 AEDT 2007
For review by Ralph.
Estimated hours taken: 80
Branches: main
Improvements for bitmap.m, to make it more useable as a general container
for binary data.
library/bitmap.m:
runtime/mercury_bitmap.c:
runtime/mercury_bitmap.h:
Specialize the representation of bitmaps to an array of unsigned
bytes defined as a foreign type.
This is better than building on top of array(int) because it:
- is better for interfacing with foreign code
- has a more sensible machine-independent comparison order
(same as array(bool))
- avoids storing the size twice
- has more efficient copying, unification, comparison and tabling
(although we should probably specialize the handling of array(int)
and isomorphic types as well)
- uses GC_MALLOC_ATOMIC to avoid problems with bit patterns that look
like pointers (although we should do that for array(int) as well)
XXX The code for the Java and IL backends is untested.
Building the library in grade Java with Sun JDK 1.6 failed (but
at least passed error checking), and I don't have access to a
copy of MSVS.NET. The foreign code that needs to be tested is
trivial.
Add fields `bit', `bits' and `byte' to get/set a single bit,
multiple bits (from an int) or an 8 bit byte.
Add functions for converting bitmaps to hex strings and back,
for use by stream.string_writer.write and deconstruct.functor/4.
bitmap.intersect was buggy in the case where the input bitmaps
had a different size. Given that bitmaps are implemented with
a fixed domain (lookups out of range throw an exception), it
makes more sense to throw an exception in that case anyway,
so all of the set operations do that now.
The difference operation actually performed xor. Fix it and
add an xor function.
library/version_bitmap.m:
This hasn't been fully updated to be the same as bitmap.m.
The payoff would be much less because foreign code can't
really do anything with version_bitmaps.
Add a `bit' field.
Deprecate the `get/2' function in favour of the `bit' field.
Fix the union, difference, intersection and xor functions
as for bitmap.m.
Fix comparison of version_arrays so that it uses the same
method as array.m: compare size then elements in order.
The old code found version_arrays to be equal if one was
a suffix of the other.
library/char.m:
Add predicates for converting between hex digits and integers.
library/io.m:
library/stream.string_writer.m:
library/term.m:
Read and write bitmaps.
runtime/mercury_type_info.h:
runtime/mercury_deep_copy_body.h:
runtime/mercury_mcpp.h:
runtime/mercury_table_type_body.h:
runtime/mercury_tabling_macros.h:
runtime/mercury_unify_compare_body.h:
runtime/mercury_construct.c:
runtime/mercury_deconstruct.c:
runtime/mercury_term_size.c:
runtime/mercury_string.h:
library/construct.m:
library/deconstruct.m
compiler/prog_type.m:
compiler/mlds_to_gcc.m:
compiler/rtti.m:
Add a MR_TypeCtorRep for bitmaps, and handle it in the library
and runtinme.
library/Mercury.options:
Compile bitmap.m with `--no-warn-insts-without-matching-type'.
runtime/mercury_type_info.h:
Bump MR_RTTI_VERSION.
NEWS:
Document the changes.
tests/hard_coded/Mmakefile:
tests/hard_coded/bitmap_test.m:
tests/hard_coded/bitmap_simple.m:
tests/hard_coded/bitmap_tester.m:
tests/hard_coded/bitmap_test.exp:
tests/tabling/Mmakefile:
tests/tabling/expand_bitmap.m:
tests/tabling/expand_bitmap.exp:
tests/hard_coded/version_array_test.m:
tests/hard_coded/version_array_test.exp:
Test cases.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.442
diff -u -u -r1.442 NEWS
--- NEWS 5 Feb 2007 03:12:50 -0000 1.442
+++ NEWS 8 Feb 2007 12:37:20 -0000
@@ -54,6 +54,43 @@
* We have added string.c_pointer_to_string/{1,2} and string.from_c_pointer/1
to convert c_pointers to a human readable form.
+* The bitmap module has been modified and extended to make it more suitable
+ 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
+ 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:
+ 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}.
+
+* The operations in bitmap.m and version_bitmap.m which treat bitmaps
+ as sets have been modified to throw an exception when the input
+ bitmaps are not the same size. Before this change bitmap.intersect/2
+ computed the wrong answer when the input bitmaps were of different sizes.
+
+* bitmap.difference/2 and version_bitmap.difference/2 now compute difference,
+ not xor.
+
+* bitmap.xor/2 and version_bitmap.xor/2 have been added.
+
+* Comparison of version_arrays is now the same as for arrays.
+
+* We have added predicates char.is_hex_digit/2 and char.int_to_hex_char/2.
+
* We have changed term.variable so that it records the context where
the variable was used. This required the backward mode of
term.var_list_to_term_list to be removed. The backwards mode is
Index: library/bitmap.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/bitmap.m,v
retrieving revision 1.14
diff -u -u -r1.14 bitmap.m
--- library/bitmap.m 27 Sep 2006 06:16:37 -0000 1.14
+++ library/bitmap.m 10 Feb 2007 11:11:50 -0000
@@ -1,13 +1,13 @@
%-----------------------------------------------------------------------------%
% vim: ts=4 sw=4 et tw=0 wm=0 ft=mercury
%-----------------------------------------------------------------------------%
-% Copyright (C) 2001-2002, 2004-2006 The University of Melbourne
+% Copyright (C) 2001-2002, 2004-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: bitmap.m.
-% Main author: rafe.
+% Main author: rafe, stayl.
% Stability: low.
%
% Efficient bitmap implementation.
@@ -26,243 +26,611 @@
:- interface.
-:- import_module array.
:- import_module bool.
%-----------------------------------------------------------------------------%
+ % Type `bitmap' is equivalent to `array(bool)', but is implemented much
+ % more efficiently. Accessing bitmaps as if they are 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 size is equal
+ % then each bit in turn is compared starting from bit zero.
+ %
:- type bitmap.
-:- inst bitmap == array.
-:- inst uniq_bitmap == uniq_array.
-:- mode bitmap_ui == array_ui.
-:- mode bitmap_di == array_di.
-:- mode bitmap_uo == array_uo.
+:- 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.
+
+%-----------------------------------------------------------------------------%
% new(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 new(int, bool) = bitmap.
+:- func new(num_bits, bool) = bitmap.
:- mode new(in, in) = bitmap_uo is det.
+ % 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.
+
+ % 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.
+
% Returns the number of bits in a bitmap.
%
-:- func num_bits(bitmap) = int.
-:- mode num_bits(bitmap_ui) = out is det.
+:- func num_bits(bitmap) = num_bits.
+%:- mode num_bits(bitmap_ui) = out is det.
:- mode num_bits(in) = out is det.
- % set(BM, I), clear(BM, I) and flip(BM, I) set, clear and flip
- % bit I in BM respectively.
+ % Returns the number of bytes in a bitmap, failing if the bitmap
+ % has a partial final byte.
%
-:- func set(bitmap, int) = bitmap.
-:- mode set(bitmap_di, in) = bitmap_uo is det.
+:- func num_bytes(bitmap) = num_bytes.
+%:- mode num_bytes(bitmap_ui) = out is semidet.
+:- mode num_bytes(in) = out is semidet.
-:- func clear(bitmap, int) = bitmap.
-:- mode clear(bitmap_di, in) = bitmap_uo is det.
+ % 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.
-:- func flip(bitmap, int) = bitmap.
-:- mode flip(bitmap_di, in) = bitmap_uo is det.
+ % Return the number of bits in a byte (always 8).
+ %
+:- func bits_per_byte = int.
-:- pred set(int, bitmap, bitmap).
-:- mode set(in, bitmap_di, bitmap_uo) is det.
+%-----------------------------------------------------------------------------%
-:- pred clear(int, bitmap, bitmap).
-:- mode clear(in, bitmap_di, bitmap_uo) is det.
+ %
+ % Get or set the given bit.
+ % The unsafe versions do not check whether the bit is in range.
+ %
-:- pred flip(int, bitmap, bitmap).
-:- mode flip(in, bitmap_di, bitmap_uo) is det.
+:- func bitmap ^ bit(bit_index) = bool.
+%:- mode bitmap_ui ^ bit(in) = out is det.
+:- mode in ^ bit(in) = out is det.
+
+:- func bitmap ^ unsafe_bit(bit_index) = bool.
+%:- mode bitmap_ui ^ unsafe_bit(in) = out is det.
+:- mode in ^ unsafe_bit(in) = out is det.
+
+:- func (bitmap ^ bit(bit_index) := bool) = bitmap.
+:- mode (bitmap_di ^ bit(in) := in) = bitmap_uo is det.
+
+:- func (bitmap ^ unsafe_bit(bit_index) := bool) = bitmap.
+:- mode (bitmap_di ^ unsafe_bit(in) := in) = bitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
- % 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_set(bitmap, int) = bitmap.
-:- mode unsafe_set(bitmap_di, in) = bitmap_uo is det.
+ % Bitmap ^ bits(OffSet, NumBits) = Word.
+ % The low order bits of Word contain the NumBits bits of BitMap
+ % starting at OffSet.
+ % 0 =< NumBits =< int.bits_per_int.
+ %
+
+:- func bitmap ^ bits(bit_index, num_bits) = word.
+%:- mode bitmap_ui ^ bits(in, in) = out is det.
+:- mode in ^ bits(in, in) = out is det.
+
+:- func bitmap ^ unsafe_bits(bit_index, num_bits) = word.
+%:- mode bitmap_ui ^ unsafe_bits(in, in) = out is det.
+:- mode in ^ unsafe_bits(in, in) = out is det.
+
+:- func (bitmap ^ bits(bit_index, num_bits) := word) = bitmap.
+:- mode (bitmap_di ^ bits(in, in) := in) = bitmap_uo is det.
+
+:- func (bitmap ^ unsafe_bits(bit_index, num_bits) := word) = bitmap.
+:- mode (bitmap_di ^ unsafe_bits(in, in) := in) = bitmap_uo
+ is det.
-:- func unsafe_clear(bitmap, int) = bitmap.
-:- mode unsafe_clear(bitmap_di, in) = bitmap_uo is det.
+%-----------------------------------------------------------------------------%
+
+ %
+ % BM ^ byte(ByteNumber)
+ % Get or set the given numbered byte (multiply ByteNumber by
+ % bits_per_int to get the bit index of the start of the byte).
+ %
+ % The bits are stored in or taken from the least significant bits
+ % of the integer.
+ % The unsafe versions do not check whether the byte is in range.
+ %
+
+:- func bitmap ^ byte(byte_index) = byte.
+%:- mode bitmap_ui ^ byte(in) = out is det.
+:- mode in ^ byte(in) = out is det.
+
+:- func bitmap ^ unsafe_byte(byte_index) = byte.
+%:- mode bitmap_ui ^ unsafe_byte(in) = out is det.
+:- mode in ^ unsafe_byte(in) = out is det.
+
+:- func (bitmap ^ byte(byte_index) := byte) = bitmap.
+:- mode (bitmap_di ^ byte(in) := in) = bitmap_uo is det.
-:- func unsafe_flip(bitmap, int) = bitmap.
+:- func (bitmap ^ unsafe_byte(byte_index) := byte) = bitmap.
+:- mode (bitmap_di ^ unsafe_byte(in) := in) = bitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Flip the given bit.
+ %
+:- func flip(bitmap, bit_index) = bitmap.
+:- mode flip(bitmap_di, in) = bitmap_uo is det.
+
+:- func unsafe_flip(bitmap, bit_index) = bitmap.
:- mode unsafe_flip(bitmap_di, in) = bitmap_uo is det.
-:- pred unsafe_set(int, bitmap, bitmap).
-:- mode unsafe_set(in, bitmap_di, bitmap_uo) is det.
+%-----------------------------------------------------------------------------%
-:- pred unsafe_clear(int, bitmap, bitmap).
-:- mode unsafe_clear(in, bitmap_di, bitmap_uo) is det.
+ %
+ % Set operations; for binary operations the second argument is altered
+ % in all cases. The input bitmaps must have the same size.
+ %
-:- pred unsafe_flip(int, bitmap, bitmap).
-:- mode unsafe_flip(in, bitmap_di, bitmap_uo) is det.
+:- 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.
+
+%-----------------------------------------------------------------------------%
+
+ %
+ % 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.
+
+%-----------------------------------------------------------------------------%
+
+ % 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.
+ %
+:- func from_string(string) = bitmap.
+:- mode from_string(in) = bitmap_uo is semidet.
+
+ % 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.
+
+%-----------------------------------------------------------------------------%
+
+ % Compute a hash function for a bitmap.
+ %
+:- func hash(bitmap) = int.
+%:- mode hash(bitmap_ui) = out is det.
+:- mode hash(in) = out 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.
+
+:- func clear(bitmap, bit_index) = bitmap.
+:- mode clear(bitmap_di, in) = bitmap_uo is det.
% is_set(BM, I) and is_clear(BM, I) succeed iff bit I in BM
% is set or clear respectively.
%
-:- pred is_set(bitmap, int).
-:- mode is_set(bitmap_ui, in) is semidet.
+:- pred is_set(bitmap, bit_index).
+%:- mode is_set(bitmap_ui, in) is semidet.
:- mode is_set(in, in) is semidet.
-:- pred is_clear(bitmap, int).
-:- mode is_clear(bitmap_ui, in) is semidet.
+:- 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.
%
-:- pred unsafe_is_set(bitmap, int).
-:- mode unsafe_is_set(bitmap_ui, in) is semidet.
+
+:- func unsafe_set(bitmap, bit_index) = bitmap.
+:- mode unsafe_set(bitmap_di, in) = bitmap_uo is det.
+
+:- func unsafe_clear(bitmap, bit_index) = bitmap.
+:- mode unsafe_clear(bitmap_di, in) = bitmap_uo is det.
+
+:- pred unsafe_set(bit_index, bitmap, bitmap).
+:- mode unsafe_set(in, bitmap_di, bitmap_uo) is det.
+
+:- pred unsafe_clear(bit_index, bitmap, bitmap).
+:- mode unsafe_clear(in, bitmap_di, bitmap_uo) is det.
+
+:- pred unsafe_flip(bit_index, bitmap, bitmap).
+:- mode unsafe_flip(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, int).
-:- mode unsafe_is_clear(bitmap_ui, 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.
- % get(BM, I) returns `yes' if is_set(BM, I) and `no' otherwise.
%
-:- func get(bitmap, int) = bool.
-:- mode get(bitmap_ui, in) = out is det.
-:- mode get(in, in) = out is det.
-
- % Unsafe versions of the above: if the index is out of range
- % then behaviour is undefined and bad things are likely to happen.
+ % Predicate versions, for use with state variables.
%
-:- func unsafe_get(bitmap, int) = bool.
-:- mode unsafe_get(bitmap_ui, in) = out is det.
-:- mode unsafe_get(in, in) = out is det.
- % Create a new copy of a bitmap.
- %
-:- func copy(bitmap) = bitmap.
-:- mode copy(bitmap_ui) = bitmap_uo is det.
+:- pred set(bit_index, bitmap, bitmap).
+:- mode set(in, bitmap_di, bitmap_uo) is det.
- % Set operations; the second argument is altered in all cases.
- %
-:- func complement(bitmap) = bitmap.
-:- mode complement(bitmap_di) = bitmap_uo is det.
+:- pred clear(bit_index, bitmap, bitmap).
+:- mode clear(in, bitmap_di, bitmap_uo) is det.
-:- func union(bitmap, bitmap) = bitmap.
-:- mode union(bitmap_ui, bitmap_di) = bitmap_uo is det.
+:- pred flip(bit_index, bitmap, bitmap).
+:- mode flip(in, bitmap_di, bitmap_uo) is det.
-:- func intersect(bitmap, bitmap) = bitmap.
-:- mode intersect(bitmap_ui, bitmap_di) = bitmap_uo is det.
+%-----------------------------------------------------------------------------%
-:- func difference(bitmap, bitmap) = bitmap.
-:- mode difference(bitmap_ui, bitmap_di) = bitmap_uo is det.
+:- implementation.
+:- interface.
- % 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.
+ % Replaced by BM ^ bits(I).
+
+ % get(BM, I) returns `yes' if is_set(BM, I) and `no' otherwise.
%
-:- func resize(bitmap, int, bool) = bitmap.
-:- mode resize(bitmap_di, in, in) = bitmap_uo is det.
+:- func get(bitmap, int) = bool.
+%:- mode get(bitmap_ui, in) = out is det.
+:- mode get(in, in) = out is det.
+:- pragma obsolete(get/2).
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
+ % Unsafe version of the above: if the index is out of range
+ % then behaviour is undefined and bad things are likely to happen.
+ %
+:- func unsafe_get(bitmap, int) = bool.
+%:- mode unsafe_get(bitmap_ui, in) = out is det.
+:- mode unsafe_get(in, in) = out is det.
+:- pragma obsolete(unsafe_get/2).
+%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module char.
:- import_module exception.
:- import_module int.
+:- import_module list.
:- import_module require.
+:- import_module string.
- % A bitmap is represented as an array of ints where each int stores
- % int.bits_per_int bits. The first element of the array (index 0)
- % is used to hold the number of bits in the bitmap. This avoids
- % having to create a new bitmap cell on each update.
- %
- % NOTE: the `filler' bits in the last element of the array *must*
- % be clear (i.e. zero). This makes the set operations simpler to
- % implement.
-
-:- type bitmap == array(int).
-
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
new(N, B) = BM :-
( if N < 0 then
- throw(software_error("bitmap.new: negative size"))
+ throw_bitmap_error("bitmap.new: negative size") = _ : int
else
X = initializer(B),
- BM0 = (array.init(num_ints_required(N), X) ^ elem(0) := N),
+ BM0 = initialize_bitmap(allocate_bitmap(N), N, X),
BM = clear_filler_bits(BM0)
).
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
-resize(BM0, N, B) = BM :-
- ( if N =< 0 then
- BM = new(N, B)
+resize(!.BM, NewSize, InitializerBit) = !:BM :-
+ ( if NewSize =< 0 then
+ !:BM = new(NewSize, InitializerBit)
else
- X = initializer(B),
- NumInts = num_ints_required(N),
- BM1 = array.resize(BM0, NumInts, X),
-
- % Now we need to ensure that bits N, N+1, N+2, ... up to
- % the word boundary are initialized properly.
- %
- int.min(num_bits(BM0), N, M),
- Offset = int_offset(M - 1),
- Mask = bitsmask(M - 1), % For bits we need to preserve.
- Bits = \(Mask) /\ X, % Bits we need to fill in.
- BM2 = (( BM1
- ^ elem(0) := N )
- ^ elem(Offset) := (BM1 ^ elem(Offset) /\ Mask) \/ Bits),
- BM = clear_filler_bits(BM2)
+ 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.
+ !:BM = set_trailing_bits_in_byte(!.BM, OldSize - 1,
+ InitializerByte),
+ OldLastByte = byte_index_for_bit(OldSize - 1),
+ NewLastByte = byte_index_for_bit(NewSize - 1),
+ ( if NewLastByte > OldLastByte then
+ !:BM = initialize_bitmap_bytes(!.BM, OldLastByte + 1,
+ NewLastByte, InitializerByte)
+ else
+ true
+ )
+ else
+ true
+ ),
+ !:BM = clear_filler_bits(!.BM)
).
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
:- func clear_filler_bits(bitmap) = bitmap.
:- mode clear_filler_bits(bitmap_di) = bitmap_uo is det.
-clear_filler_bits(BM0) = BM :-
- N = num_bits(BM0),
- ( if N > 0 then
- Last = int_offset(N - 1), % Offset of last bit.
- Ksam = bitsmask(N - 1), % Masks off the filler bits.
- BM = BM0 ^ elem(Last) := BM0 ^ elem(Last) /\ Ksam
+clear_filler_bits(BM) = set_trailing_bits_in_byte(BM, num_bits(BM) - 1, 0).
+
+:- func set_trailing_bits_in_byte(bitmap, bit_index, byte) = bitmap.
+:- mode set_trailing_bits_in_byte(bitmap_di, in, in) = bitmap_uo is det.
+
+set_trailing_bits_in_byte(!.BM, Bit, Initializer) = !:BM :-
+ FirstTrailingBit = Bit + 1,
+ FirstTrailingBitIndex = bit_index_in_byte(FirstTrailingBit),
+ ( if FirstTrailingBitIndex \= 0 then
+ ByteIndex = byte_index_for_bit(FirstTrailingBit),
+ NumBitsToSet = bits_per_byte - FirstTrailingBitIndex,
+ !:BM = !.BM ^ unsafe_byte(ByteIndex) :=
+ set_bits_in_byte(!.BM ^ unsafe_byte(ByteIndex),
+ FirstTrailingBitIndex, NumBitsToSet, Initializer)
else
- BM = BM0
+ true
).
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
-:- func initializer(bool) = int.
+:- func initializer(bool) = byte.
initializer(no) = 0.
-initializer(yes) = \(0).
+initializer(yes) = \0.
-% ---------------------------------------------------------------------------- %
+:- func initialize_bitmap(bitmap, num_bits, byte) = bitmap.
+:- mode initialize_bitmap(bitmap_di, in, in) = bitmap_uo is det.
-num_bits(BM) = BM ^ elem(0).
+initialize_bitmap(Bitmap, N, Init) =
+ initialize_bitmap_bytes(Bitmap, 0, byte_index_for_bit(N - 1), Init).
-% ---------------------------------------------------------------------------- %
+:- func initialize_bitmap_bytes(bitmap, byte_index, byte_index,
+ byte) = bitmap.
+:- mode initialize_bitmap_bytes(bitmap_di, in, in, in) = bitmap_uo is det.
+
+initialize_bitmap_bytes(BM, Byte, LastByte, Init) =
+ ( Byte > LastByte ->
+ BM
+ ;
+ initialize_bitmap_bytes(BM ^ unsafe_byte(Byte) := Init,
+ Byte + 1, LastByte, Init)
+ ).
-:- pred in_range(bitmap, int).
-:- mode in_range(bitmap_ui, in) is semidet.
-:- mode in_range(in, in) is semidet.
+%-----------------------------------------------------------------------------%
in_range(BM, I) :- 0 =< I, I < num_bits(BM).
-% ---------------------------------------------------------------------------- %
+byte_in_range(BM, I) :-
+ in_range(BM, I * bits_per_byte + bits_per_byte - 1).
+
+%-----------------------------------------------------------------------------%
+
+BM ^ bit(I) =
+ ( if in_range(BM, I)
+ then BM ^ unsafe_bit(I)
+ else throw_bitmap_error("bitmap.bit: out of range")
+ ).
+
+BM ^ unsafe_bit(I) =
+ ( if unsafe_is_set(BM, I) then yes else no ).
-set(BM, I) =
+(BM ^ bit(I) := B) =
( if in_range(BM, I)
- then BM ^ elem(int_offset(I)) := BM ^ elem(int_offset(I)) \/ bitmask(I)
- else throw(software_error("bitmap.set: out of range"))
+ then BM ^ unsafe_bit(I) := B
+ else throw_bitmap_error("bitmap.'bit :=': out of range")
+ ).
+
+(BM ^ unsafe_bit(I) := yes) = unsafe_set(BM, I).
+(BM ^ unsafe_bit(I) := no) = unsafe_clear(BM, I).
+
+%-----------------------------------------------------------------------------%
+
+BM ^ bits(FirstBit, NumBits) =
+ ( if
+ FirstBit >= 0,
+ in_range(BM, FirstBit + NumBits - 1),
+ NumBits >= 0,
+ NumBits =< int.bits_per_int
+ then
+ BM ^ unsafe_bits(FirstBit, NumBits)
+ else
+ throw_bitmap_error("bitmap.bits: out of range")
+ ).
+
+BM ^ unsafe_bits(FirstBit, NumBits) = Bits :-
+ FirstByte = byte_index_for_bit(FirstBit),
+ FirstBitIndex = bit_index_in_byte(FirstBit),
+ extract_bits_from_bytes(FirstByte, FirstBitIndex,
+ NumBits, BM, 0, Bits).
+
+ % 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(FirstByte, FirstBitIndex, NumBits, BM, !Bits) :-
+ RemainingBitsInByte = bits_per_byte - FirstBitIndex,
+ ( NumBits > RemainingBitsInByte ->
+ NumBitsThisByte = RemainingBitsInByte,
+ extract_bits_from_byte_index(FirstByte, FirstBitIndex,
+ NumBitsThisByte, BM, !Bits),
+ extract_bits_from_bytes(FirstByte + 1, 0,
+ NumBits - NumBitsThisByte, BM, !Bits)
+ ; NumBits > 0 ->
+ extract_bits_from_byte_index(FirstByte, FirstBitIndex,
+ NumBits, BM, !Bits)
+ ;
+ 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(BM ^ unsafe_byte(ByteIndex),
+ FirstBitIndex, NumBitsThisByte),
+ !:Bits = (!.Bits `unchecked_left_shift` NumBitsThisByte) \/ BitsThisByte.
+
+%-----------------------------------------------------------------------------%
+
+(BM ^ bits(FirstBit, NumBits) := Bits) =
+ ( if
+ FirstBit >= 0,
+ in_range(BM, FirstBit + NumBits - 1),
+ NumBits >= 0,
+ NumBits =< int.bits_per_int
+ then
+ BM ^ unsafe_bits(FirstBit, NumBits) := Bits
+ else
+ throw_bitmap_error("bitmap.'bits :=': out of range")
+ ).
+
+(BM0 ^ unsafe_bits(FirstBit, NumBits) := Bits) = BM :-
+ LastBit = FirstBit + NumBits - 1,
+ LastByte = byte_index_for_bit(LastBit),
+ LastBitIndex = bit_index_in_byte(LastBit),
+ set_bits_in_bytes(LastByte, LastBitIndex, NumBits, Bits, BM0, 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(LastByte, LastBitIndex, NumBits, Bits, !BM) :-
+ RemainingBitsInByte = LastBitIndex + 1,
+ ( NumBits > RemainingBitsInByte ->
+ NumBitsThisByte = RemainingBitsInByte,
+ set_bits_in_byte_index(LastByte, LastBitIndex, NumBitsThisByte,
+ Bits, !BM),
+ set_bits_in_bytes(LastByte - 1, bits_per_byte - 1,
+ NumBits - NumBitsThisByte,
+ Bits `unchecked_right_shift` NumBitsThisByte, !BM)
+ ; NumBits > 0 ->
+ set_bits_in_byte_index(LastByte, LastBitIndex, NumBits, Bits, !BM)
+ ;
+ true
+ ).
+
+:- pred set_bits_in_byte_index(byte_index, bit_index_in_byte, num_bits,
+ word, bitmap, bitmap).
+:- mode set_bits_in_byte_index(in, in, in, in, bitmap_di, bitmap_uo) is det.
+
+set_bits_in_byte_index(ByteIndex, LastBitIndex,
+ NumBitsThisByte, Bits, !BM) :-
+ FirstBitInByte = LastBitIndex - NumBitsThisByte + 1,
+ !:BM = !.BM ^ unsafe_byte(ByteIndex) :=
+ set_bits_in_byte(!.BM ^ unsafe_byte(ByteIndex),
+ FirstBitInByte, NumBitsThisByte, Bits).
+
+%-----------------------------------------------------------------------------%
+
+set(BM, I) =
+ ( if in_range(BM, I)
+ then unsafe_set(BM, I)
+ else throw_bitmap_error("bitmap.set: out of range")
).
clear(BM, I) =
( if in_range(BM, I)
- then BM ^ elem(int_offset(I)) := BM ^ elem(int_offset(I)) /\ \bitmask(I)
- else throw(software_error("bitmap.clear: out of range"))
+ then unsafe_clear(BM, I)
+ else throw_bitmap_error("bitmap.clear: out of range")
).
flip(BM, I) =
( if in_range(BM, I)
- then BM ^ elem(int_offset(I)) := BM ^ elem(int_offset(I)) `xor` bitmask(I)
- else throw(software_error("bitmap.flip: out of range"))
+ then unsafe_flip(BM, I)
+ else throw_bitmap_error("bitmap.flip: out of range")
).
set(I, BM, set(BM, I)).
@@ -271,16 +639,19 @@
flip(I, BM, flip(BM, I)).
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
-unsafe_set(BM, I) =
- BM ^ elem(int_offset(I)) := BM ^ elem(int_offset(I)) \/ bitmask(I).
+unsafe_set(BM, I) =
+ BM ^ unsafe_byte(byte_index_for_bit(I)) :=
+ BM ^ unsafe_byte(byte_index_for_bit(I)) \/ bitmask(I).
unsafe_clear(BM, I) =
- BM ^ elem(int_offset(I)) := BM ^ elem(int_offset(I)) /\ \bitmask(I).
+ BM ^ unsafe_byte(byte_index_for_bit(I)) :=
+ BM ^ unsafe_byte(byte_index_for_bit(I)) /\ \bitmask(I).
unsafe_flip(BM, I) =
- BM ^ elem(int_offset(I)) := BM ^ elem(int_offset(I)) `xor` bitmask(I).
+ BM ^ unsafe_byte(byte_index_for_bit(I)) :=
+ BM ^ unsafe_byte(byte_index_for_bit(I)) `xor` bitmask(I).
unsafe_set(I, BM, unsafe_set(BM, I)).
@@ -288,148 +659,1105 @@
unsafe_flip(I, BM, unsafe_flip(BM, I)).
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
is_set(BM, I) :-
( if in_range(BM, I)
- then BM ^ elem(int_offset(I)) /\ bitmask(I) \= 0
- else throw(software_error("bitmap.is_set: out of range"))
+ then unsafe_is_set(BM, I)
+ else throw_bitmap_error("bitmap.is_set: out of range") = _ : int
).
is_clear(BM, I) :-
( if in_range(BM, I)
- then BM ^ elem(int_offset(I)) /\ bitmask(I) = 0
- else throw(software_error("bitmap.is_clear: out of range"))
+ then unsafe_is_clear(BM, I)
+ else throw_bitmap_error("bitmap.is_clear: out of range") = _ : int
).
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
unsafe_is_set(BM, I) :-
- BM ^ elem(int_offset(I)) /\ bitmask(I) \= 0.
+ \+ unsafe_is_clear(BM, I).
unsafe_is_clear(BM, I) :-
- BM ^ elem(int_offset(I)) /\ bitmask(I) = 0.
+ BM ^ unsafe_byte(byte_index_for_bit(I)) /\ bitmask(I) = 0.
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
-get(BM, I) = ( if is_clear(BM, I) then no else yes ).
+get(BM, I) = BM ^ bit(I).
%------------------------------------------------------------------------------%
-unsafe_get(BM, I) = ( if unsafe_is_clear(BM, I) then no else yes ).
-
-% ---------------------------------------------------------------------------- %
+unsafe_get(BM, I) = BM ^ unsafe_bit(I).
-copy(BM) = array.copy(BM).
-
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
complement(BM) =
- clear_filler_bits(complement_2(BM ^ elem(0) - 1, BM)).
+ clear_filler_bits(complement_2(byte_index_for_bit(num_bits(BM) - 1), BM)).
:- func complement_2(int, bitmap) = bitmap.
:- mode complement_2(in, bitmap_di) = bitmap_uo is det.
-complement_2(WordI, BM) =
- ( if WordI =< 0
+complement_2(ByteI, BM) =
+ ( if ByteI < 0
then BM
- else complement_2(WordI - 1, BM ^ elem(WordI) := \(BM ^ elem(WordI)))
+ else complement_2(ByteI - 1,
+ BM ^ unsafe_byte(ByteI) := \ (BM ^ unsafe_byte(ByteI)))
).
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
union(BMa, BMb) =
- ( if num_bits(BMa) > num_bits(BMb) then
- zip(int_offset(num_bits(BMb) - 1), (\/), BMb, bitmap.copy(BMa))
+ ( if num_bits(BMa) = num_bits(BMb) then
+ zip((\/), BMa, BMb)
else
- zip(int_offset(num_bits(BMa) - 1), (\/), BMa, BMb)
+ throw_bitmap_error("bitmap.union: bitmaps not the same size")
).
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
intersect(BMa, BMb) =
- ( if num_bits(BMa) > num_bits(BMb) then
- zip(int_offset(num_bits(BMb) - 1), (/\), BMb, bitmap.copy(BMa))
+ ( if num_bits(BMa) = num_bits(BMb) then
+ zip((/\), BMa, BMb)
else
- zip(int_offset(num_bits(BMa) - 1), (/\), BMa, BMb)
+ throw_bitmap_error("bitmap.intersect: bitmaps not the same size")
).
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
difference(BMa, BMb) =
- ( if num_bits(BMa) > num_bits(BMb) then
- zip(int_offset(num_bits(BMb) - 1), Xor, BMb, bitmap.copy(BMa))
+ ( if num_bits(BMa) = num_bits(BMb) then
+ zip((func(X, Y) = (X /\ \Y)), BMa, BMb)
else
- zip(int_offset(num_bits(BMa) - 1), Xor, BMa, BMb)
- )
- :-
- Xor = ( func(X, Y) = (X `xor` Y) ).
+ throw_bitmap_error("bitmap.difference: bitmaps not the same size")
+ ).
+
+%-----------------------------------------------------------------------------%
-% ---------------------------------------------------------------------------- %
+xor(BMa, BMb) =
+ ( if num_bits(BMa) = num_bits(BMb) then
+ zip((func(X, Y) = (X `xor` Y)), BMa, BMb)
+ else
+ throw_bitmap_error("bitmap.xor: bitmaps not the same size")
+ ).
+
+%-----------------------------------------------------------------------------%
% Applies a function to every corresponding element between +ve I
- % and 1 inclusive, destructively updating the second bitmap.
+ % and 0 inclusive, destructively updating the second bitmap.
%
-:- func zip(int, func(int, int) = int, bitmap, bitmap) = bitmap.
-:- mode zip(in, func(in, in) = out is det, bitmap_ui, bitmap_di) = bitmap_uo
- is det.
-
-zip(I, Fn, BMa, BMb) =
- ( if I > 0 then
- zip(I - 1, Fn, BMa, BMb ^ elem(I) := Fn(BMb ^ elem(I), BMa ^ elem(I)))
+:- func zip(func(byte, byte) = byte,
+ bitmap, bitmap) = bitmap.
+%:- mode zip(func(in, in) = out is det,
+% bitmap_ui, bitmap_di) = bitmap_uo is det.
+:- mode zip(func(in, in) = out is det,
+ in, bitmap_di) = bitmap_uo is det.
+
+zip(Fn, BMa, BMb) =
+ ( if num_bits(BMb) = 0 then BMb
+ else zip2(byte_index_for_bit(num_bits(BMb) - 1), Fn, BMa, BMb)
+ ).
+
+:- func zip2(int, func(byte, byte) = byte,
+ bitmap, bitmap) = bitmap.
+%:- mode zip2(in, func(in, in) = out is det,
+% bitmap_ui, bitmap_di) = bitmap_uo is det.
+:- mode zip2(in, func(in, in) = out is det,
+ in, bitmap_di) = bitmap_uo is det.
+
+zip2(I, Fn, BMa, BMb) =
+ ( if I >= 0 then
+ zip2(I - 1, Fn, BMa,
+ BMb ^ unsafe_byte(I) :=
+ Fn(BMa ^ unsafe_byte(I), BMb ^ unsafe_byte(I)))
else
BMb
).
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
+
+copy_bits(SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits) =
+ copy_bits(0, SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits).
+
+copy_bits_in_bitmap(SrcBM, SrcStartBit, DestStartBit, NumBits) =
+ copy_bits(1, SrcBM, SrcStartBit, SrcBM, DestStartBit, NumBits).
+
+:- func copy_bits(int, bitmap, bit_index,
+ bitmap, bit_index, num_bits) = bitmap.
+%:- mode copy_bits(in, bitmap_ui, in, bitmap_di, in, in) = bitmap_uo is det.
+:- mode copy_bits(in, in, in, bitmap_di, in, in) = bitmap_uo is det.
+
+copy_bits(SameBM, SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits) =
+ (
+ NumBits >= 0,
+ in_range(SrcBM, SrcStartBit),
+ in_range(SrcBM, SrcStartBit + NumBits - 1),
+ in_range(DestBM, DestStartBit),
+ in_range(DestBM, DestStartBit + NumBits - 1)
+ ->
+ unsafe_copy_bits(SameBM, SrcBM, SrcStartBit,
+ DestBM, DestStartBit, NumBits)
+ ;
+ throw_bitmap_error(
+ "bitmap.copy_bits_in_bitmap: out of range")
+ ).
+
+:- func unsafe_copy_bits(int, bitmap, bit_index,
+ bitmap, bit_index, num_bits) = bitmap.
+%:- mode unsafe_copy_bits(in, bitmap_ui, in,
+% bitmap_di, in, in) = bitmap_uo is det.
+:- mode unsafe_copy_bits(in, in, in,
+ bitmap_di, in, in) = bitmap_uo is det.
+
+unsafe_copy_bits(SameBM, SrcBM, SrcStartBit, !.DestBM, DestStartBit,
+ !.NumBits) = !:DestBM :-
+ SrcStartIndex = bit_index_in_byte(SrcStartBit),
+ DestStartIndex = bit_index_in_byte(DestStartBit),
+ (
+ !.NumBits < 2 * bits_per_byte
+ ->
+ %
+ % The alternatives below don't handle ranges that don't
+ % span a byte boundary.
+ %
+ !:DestBM = !.DestBM ^ unsafe_bits(DestStartBit, !.NumBits) :=
+ SrcBM ^ unsafe_bits(SrcStartBit, !.NumBits)
+ ;
+ SrcStartIndex = DestStartIndex
+ ->
+ %
+ % 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),
+ (
+ StartIndex = 0,
+ EndIndex = bits_per_byte - 1
+ ->
+ %
+ % It's an aligned block of bytes, move it.
+ %
+ NumBytes = !.NumBits `unchecked_quotient` bits_per_byte,
+ SrcStartByte = SrcStartBit `unchecked_quotient` bits_per_byte,
+ DestStartByte = DestStartBit `unchecked_quotient` bits_per_byte,
+ !:DestBM = unsafe_copy_bytes(SameBM, SrcBM, SrcStartByte,
+ !.DestBM, DestStartByte, NumBytes)
+ ;
+ %
+ % Grab the odd bits at each end of the block to move,
+ % leaving a block of aligned bytes to move.
+ %
+ ( StartIndex = 0 ->
+ NumBitsAtStart = 0,
+ StartBitsToSet = 0
+ ;
+ NumBitsAtStart = bits_per_byte - StartIndex,
+ SrcPartialStartByte = byte_index_for_bit(SrcStartBit),
+ StartBitsToSet =
+ extract_bits_from_byte(
+ SrcBM ^ unsafe_byte(SrcPartialStartByte),
+ StartIndex, NumBitsAtStart),
+
+ !:NumBits = !.NumBits - NumBitsAtStart
+ ),
+
+ ( EndIndex = bits_per_byte - 1 ->
+ NumBitsAtEnd = 0,
+ EndBitsToSet = 0
+ ;
+ NumBitsAtEnd = EndIndex + 1,
+ SrcPartialEndByte = byte_index_for_bit(SrcEndBit),
+ EndBitsToSet =
+ extract_bits_from_byte(
+ SrcBM ^ unsafe_byte(SrcPartialEndByte),
+ 0, NumBitsAtEnd),
+
+ !:NumBits = !.NumBits - NumBitsAtEnd
+ ),
+
+ %
+ % Do the block copy.
+ %
+ NumBytes = !.NumBits `unchecked_quotient` bits_per_byte,
+ SrcStartByte = (SrcStartBit + NumBitsAtStart)
+ `unchecked_quotient` bits_per_byte,
+ DestStartByte = (DestStartBit + NumBitsAtStart)
+ `unchecked_quotient` bits_per_byte,
+ !:DestBM = unsafe_copy_bytes(SameBM, SrcBM, SrcStartByte,
+ !.DestBM, DestStartByte, NumBytes),
+
+ %
+ % Fill in the partial bytes at the start and end of the range.
+ %
+ ( NumBitsAtStart \= 0 ->
+ DestPartialStartByte = DestStartByte - 1,
+ !:DestBM =
+ !.DestBM ^ unsafe_byte(DestPartialStartByte) :=
+ set_bits_in_byte(
+ !.DestBM ^ unsafe_byte(DestPartialStartByte),
+ StartIndex, NumBitsAtStart, StartBitsToSet)
+ ;
+ true
+ ),
+
+ ( NumBitsAtEnd \= 0 ->
+ DestPartialEndByte = DestStartByte + NumBytes,
+ !:DestBM =
+ !.DestBM ^ unsafe_byte(DestPartialEndByte) :=
+ set_bits_in_byte(
+ !.DestBM ^ unsafe_byte(DestPartialEndByte),
+ 0, NumBitsAtEnd, EndBitsToSet)
+ ;
+ true
+ )
+ )
+ ;
+ !:DestBM = unsafe_copy_unaligned_bits(SameBM, SrcBM, SrcStartBit,
+ !.DestBM, DestStartBit, !.NumBits)
+ ).
+
+copy_bytes(SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes) =
+ copy_bytes(0, SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes).
+
+copy_bytes_in_bitmap(SrcBM, SrcStartByte, DestStartByte, NumBytes) =
+ copy_bytes(1, SrcBM, SrcStartByte, SrcBM, DestStartByte, NumBytes).
+
+ % The SameBM parameter is 1 if we are copying within the same bitmap
+ % bitmap. We use an `int' rather than a `bool' for easier interfacing
+ % with C.
+:- func copy_bytes(int, bitmap, bit_index,
+ bitmap, bit_index, num_bits) = bitmap.
+%:- mode copy_bytes(in, bitmap_ui, in,
+% bitmap_di, in, in) = bitmap_uo is det.
+:- mode copy_bytes(in, in, in,
+ bitmap_di, in, in) = bitmap_uo is det.
+
+copy_bytes(SameBM, SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes) =
+ (
+ NumBytes >= 0,
+ byte_in_range(SrcBM, SrcStartByte),
+ byte_in_range(SrcBM, SrcStartByte + NumBytes - 1),
+ byte_in_range(DestBM, DestStartByte),
+ byte_in_range(DestBM, DestStartByte + NumBytes - 1)
+ ->
+ unsafe_copy_bytes(SameBM, SrcBM, SrcStartByte, DestBM,
+ DestStartByte, NumBytes)
+ ;
+ throw_bitmap_error("bitmap.copy_bytes: out of range")
+ ).
+
+:- func unsafe_copy_bytes(int, bitmap, byte_index,
+ bitmap, byte_index, num_bytes) = bitmap.
+%:- mode unsafe_copy_bytes(in, bitmap_ui, in,
+% bitmap_di, in, in) = bitmap_uo is det.
+:- mode unsafe_copy_bytes(in, in, in,
+ bitmap_di, in, in) = bitmap_uo is det.
+
+:- pragma foreign_proc("C",
+ unsafe_copy_bytes(SameBM::in, SrcBM::in, SrcFirstByte::in,
+ DestBM0::bitmap_di, DestFirstByte::in,
+ NumBytes::in) = (DestBM::bitmap_uo),
+ [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
+"
+ DestBM = DestBM0;
+ if (SameBM) {
+ memmove(DestBM->elements + DestFirstByte,
+ SrcBM->elements + SrcFirstByte, NumBytes);
+ } else {
+ memcpy(DestBM->elements + DestFirstByte,
+ SrcBM->elements + SrcFirstByte, NumBytes);
+ }
+
+").
+
+unsafe_copy_bytes(SameBM, SrcBM, SrcFirstByte,
+ !.DestBM, DestFirstByte, NumBytes) = !:DestBM :-
+ Direction = choose_copy_direction(SameBM, SrcFirstByte, DestFirstByte),
+ (
+ Direction = left_to_right,
+ !:DestBM = unsafe_do_copy_bytes(SrcBM, SrcFirstByte,
+ !.DestBM, DestFirstByte, NumBytes, 1)
+ ;
+ Direction = right_to_left,
+ !:DestBM = unsafe_do_copy_bytes(SrcBM, SrcFirstByte + NumBytes - 1,
+ !.DestBM, DestFirstByte + NumBytes - 1, NumBytes, -1)
+ ).
+
+:- func unsafe_do_copy_bytes(bitmap, byte_index,
+ bitmap, byte_index, num_bytes, num_bytes) = bitmap.
+%:- mode unsafe_do_copy_bytes(bitmap_ui, in,
+% bitmap_di, in, in, in) = bitmap_uo is det.
+:- mode unsafe_do_copy_bytes(in, in,
+ bitmap_di, in, in, in) = bitmap_uo is det.
+
+unsafe_do_copy_bytes(SrcBM, SrcByteNo, DestBM, DestByteNo,
+ NumBytes, AddForNext) =
+ ( NumBytes = 0 ->
+ DestBM
+ ;
+ unsafe_do_copy_bytes(SrcBM, SrcByteNo + AddForNext,
+ DestBM ^ unsafe_byte(DestByteNo) := SrcBM ^ unsafe_byte(SrcByteNo),
+ DestByteNo + AddForNext, NumBytes - 1, AddForNext)
+ ).
+
+ %
+ % General case. Reduce the number of writes by aligning to the next
+ % byte boundary in the destination bitmap so each byte is written once.
+ %
+:- func unsafe_copy_unaligned_bits(int, bitmap, bit_index,
+ bitmap, bit_index, num_bits) = bitmap.
+%:- mode unsafe_copy_unaligned_bits(in, bitmap_ui, in,
+% bitmap_di, in, in) = bitmap_uo is det.
+:- mode unsafe_copy_unaligned_bits(in, in, in,
+ bitmap_di, in, in) = bitmap_uo is det.
+
+unsafe_copy_unaligned_bits(SameBM, SrcBM, SrcStartBit,
+ !.DestBM, 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,
+ ( DestStartIndex = 0 ->
+ NumBitsAtStart = 0,
+ StartBits = 0
+ ;
+ NumBitsAtStart = bits_per_byte - DestStartIndex,
+ StartBits = SrcBM ^ unsafe_bits(SrcStartBit, NumBitsAtStart),
+ !:NumBits = !.NumBits - NumBitsAtStart
+ ),
+
+ NewSrcStartBit = (SrcStartBit + NumBitsAtStart),
+ NewDestStartBit = (DestStartBit + NumBitsAtStart),
+
+ DestEndIndex = bit_index_in_byte(DestEndBit),
+ ( DestEndIndex = bits_per_byte - 1 ->
+ NumBitsAtEnd = 0,
+ EndBits = 0
+ ;
+ NumBitsAtEnd = DestEndIndex + 1,
+ SrcEndBit = NewSrcStartBit + !.NumBits - 1,
+ EndBits =
+ SrcBM ^ unsafe_bits(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,
+ SrcStartByte = byte_index_for_bit(NewSrcStartBit),
+ DestStartByte = byte_index_for_bit(NewDestStartBit),
+ !:DestBM = unsafe_copy_unaligned_bytes_ltor(SrcBM,
+ SrcStartByte + 1, SrcBitIndex,
+ SrcBM ^ unsafe_byte(SrcStartByte),
+ !.DestBM, DestStartByte, NumBytes)
+ ;
+ Direction = right_to_left,
+ SrcStartByte = byte_index_for_bit(NewSrcStartBit + !.NumBits - 1),
+ DestStartByte = byte_index_for_bit(NewDestStartBit + !.NumBits - 1),
+ !:DestBM = unsafe_copy_unaligned_bytes_rtol(SrcBM,
+ SrcStartByte - 1, SrcBitIndex,
+ SrcBM ^ unsafe_byte(SrcStartByte),
+ !.DestBM, DestStartByte, NumBytes)
+ ),
+
+ %
+ % Fill in the partial bytes at the start and end of the range.
+ %
+ ( NumBitsAtStart \= 0 ->
+ PartialDestStartByte = byte_index_for_bit(DestStartBit),
+ !:DestBM =
+ !.DestBM ^ unsafe_byte(PartialDestStartByte) :=
+ set_bits_in_byte(!.DestBM ^ unsafe_byte(PartialDestStartByte),
+ DestStartIndex, NumBitsAtStart, StartBits)
+ ;
+ true
+ ),
+
+ ( NumBitsAtEnd \= 0 ->
+ PartialDestEndByte = byte_index_for_bit(DestEndBit),
+ !:DestBM =
+ !.DestBM ^ unsafe_byte(PartialDestEndByte) :=
+ set_bits_in_byte(!.DestBM ^ unsafe_byte(PartialDestEndByte),
+ 0, NumBitsAtEnd, EndBits)
+ ;
+ true
+ ).
+
+:- func unsafe_copy_unaligned_bytes_ltor(bitmap, byte_index, bit_index_in_byte,
+ byte, bitmap, byte_index, num_bytes) = bitmap.
+:- mode unsafe_copy_unaligned_bytes_ltor(in, in, in, in,
+ bitmap_di, in, in) = bitmap_uo is det.
+%:- mode unsafe_copy_unaligned_bytes_ltor(bitmap_ui, in, in, in,
+% bitmap_di, in, in) = bitmap_uo is det.
+
+unsafe_copy_unaligned_bytes_ltor(SrcBM, SrcByteIndex, SrcBitIndex,
+ PrevSrcByteBits, !.DestBM, DestByteIndex, NumBytes) = !:DestBM :-
+ ( NumBytes =< 0 ->
+ true
+ ;
+ %
+ % 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 = SrcBM ^ unsafe_byte(SrcByteIndex),
+ DestByteBits =
+ (PrevSrcByteBits `unchecked_left_shift` SrcBitIndex)
+ \/ (SrcByteBits `unchecked_right_shift`
+ (bits_per_byte - SrcBitIndex)),
+ !:DestBM = !.DestBM ^ unsafe_byte(DestByteIndex) := DestByteBits,
+
+ unsafe_copy_unaligned_bytes_ltor(SrcBM, SrcByteIndex + 1, SrcBitIndex,
+ SrcByteBits, !.DestBM, DestByteIndex + 1, NumBytes - 1) = !:DestBM
+ ).
+
+:- func unsafe_copy_unaligned_bytes_rtol(bitmap, byte_index, bit_index_in_byte,
+ byte, bitmap, byte_index, num_bytes) = bitmap.
+:- mode unsafe_copy_unaligned_bytes_rtol(in, in, in, in,
+ bitmap_di, in, in) = bitmap_uo is det.
+%:- mode unsafe_copy_unaligned_bytes_rtol(bitmap_ui, in, in, in,
+% bitmap_di, in, in) = bitmap_uo is det.
+
+unsafe_copy_unaligned_bytes_rtol(SrcBM, SrcByteIndex, SrcBitIndex,
+ PrevSrcByteBits, !.DestBM, DestByteIndex, NumBytes) = !:DestBM :-
+ ( NumBytes =< 0 ->
+ true
+ ;
+ %
+ % 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 = SrcBM ^ unsafe_byte(SrcByteIndex),
+ DestByteBits =
+ (SrcByteBits `unchecked_left_shift` SrcBitIndex)
+ \/ (PrevSrcByteBits `unchecked_right_shift`
+ (bits_per_byte - SrcBitIndex)),
+ !:DestBM = !.DestBM ^ unsafe_byte(DestByteIndex) := DestByteBits,
+
+ !:DestBM = unsafe_copy_unaligned_bytes_rtol(SrcBM, SrcByteIndex - 1,
+ SrcBitIndex, SrcByteBits, !.DestBM,
+ DestByteIndex - 1, NumBytes - 1)
+ ).
+
+:- 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) =
+ (
+ SameBM = 1,
+ SrcStartBit < DestStartBit
+ ->
+ right_to_left
+ ;
+ left_to_right
+ ).
- % The size of the array required to hold an N-bit bitmap.
+%-----------------------------------------------------------------------------%
+
+ % Note: this should be kept in sync with MR_bitmap_to_string in
+ % runtime/mercury_bitmap.c.
%
-:- func num_ints_required(int) = int.
+to_string(BM) = Str :-
+ NumBits = BM ^ num_bits,
+ to_string_chars(byte_index_for_bit(NumBits - 1), BM,
+ [('>')], Chars),
+ Str = string.from_char_list(
+ [('<') | to_char_list(int_to_string(NumBits))] ++ [(':') | 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) :-
+ ( Index < 0 ->
+ true
+ ;
+ Byte = BM ^ unsafe_byte(Index),
+ Mask = n_bit_mask(4),
+ (
+ char.int_to_hex_char((Byte `unchecked_right_shift` 4) /\ Mask,
+ HighChar),
+ char.int_to_hex_char(Byte /\ Mask, LowChar)
+ ->
+ !:Chars = [HighChar, LowChar | !.Chars],
+ to_string_chars(Index - 1, BM, !Chars)
+ ;
+ error("bitmap.to_string: internal error")
+ )
+ ).
+
+from_string(Str) = BM :-
+ Len = length(Str),
+ ( Len >= 4 ->
+ Str ^ unsafe_elem(0) = ('<'),
+ char.is_digit(Str ^ unsafe_elem(1)),
+ Str ^ unsafe_elem(Len - 1) = ('>'),
+ string.sub_string_search(Str, ":", Colon),
+ SizeStr = string.unsafe_substring(Str, 1, Colon - 1),
+ string.to_int(SizeStr, Size),
+ ( Size >= 0 ->
+ BM0 = allocate_bitmap(Size),
+ hex_chars_to_bitmap(Str, Colon + 1, Len - 1, 0, BM0, BM)
+ ;
+ fail
+ )
+ ;
+ fail
+ ).
+
+:- 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) :-
+ ( Index = End ->
+ true
+ ; Index + 1 = End ->
+ % Each byte of the bitmap should have mapped to a pair of characters.
+ fail
+ ;
+ char.is_hex_digit(Str ^ unsafe_elem(Index), HighNibble),
+ char.is_hex_digit(Str ^ unsafe_elem(Index + 1), LowNibble),
+ Byte = (HighNibble `unchecked_left_shift` 4) \/ LowNibble,
+ !:BM = !.BM ^ unsafe_byte(ByteIndex) := Byte,
+ hex_chars_to_bitmap(Str, Index + 2, End, ByteIndex + 1, !BM)
+ ).
+
+%-----------------------------------------------------------------------------%
- % We add the 1 on because arrays of size N are indexed 0 .. N - 1.
+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 = BM ^ num_bits,
+ 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 :-
+ ( NumBits =< 0 ->
+ true
+ ;
+ ThisByte0 = BM ^ unsafe_byte(byte_index_for_bit(NumBits - 1)),
+ LastBitIndex = bit_index_in_byte(NumBits - 1),
+ ( LastBitIndex = bits_per_byte - 1 ->
+ BitsThisByte = bits_per_byte,
+ ThisByte = ThisByte0
+ ;
+ 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)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % NOTE: bitmap.hash is also defined as MR_hash_bitmap in
+ % runtime/mercury_bitmap.h. The two definitions must be kept identical.
%
-num_ints_required(N) = 1 + ( if N > 0 then int_offset(N) else 0 ).
+hash(BM) = HashVal :-
+ NumBits = BM ^ num_bits,
+ NumBytes0 = NumBits `unchecked_quotient` bits_per_byte,
+ ( NumBits `unchecked_rem` bits_per_byte = 0 ->
+ NumBytes = NumBytes0
+ ;
+ NumBytes = NumBytes0 + 1
+ ),
+ hash_2(BM, 0, NumBytes, 0, HashVal0),
+ HashVal = HashVal0 `xor` NumBits.
+
+:- pred hash_2(bitmap::in, int::in, int::in, int::in, int::out) is det.
+
+hash_2(BM, Index, Length, !HashVal) :-
+ ( Index < Length ->
+ combine_hash(BM ^ unsafe_byte(Index), !HashVal),
+ hash_2(BM, Index + 1, Length, !HashVal)
+ ;
+ 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.
+
+%-----------------------------------------------------------------------------%
- % The array index containing the given bit.
%
-:- func int_offset(int) = int.
+ % 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_code("Java", "
+public static class MercuryBitmap {
+ int num_bits;
+ byte[] elements;
+
+ MercuryBitmap(int numBits) {
+ num_bits = numBits;
+ elements = new byte[numBits / 8 + (((numBits % 8) != 0) ? 1 : 0)];
+ }
+}
+").
+
+/* XXX UNTESTED
+:- pragma foreign_code("C#", "
+namespace mercury {
+ namespace bitmap__csharp_code {
+
+ public class MercuryBitmap {
+ int num_bits;
+ byte[] elements;
+
+ MercuryBitmap(int numBits) {
+ num_bits = numBits;
+ elements = new byte[numBits / 8 + (((numBits % 8) != 0) ? 1: 0)];
+ }
+ }
+ }
+}
+").
+*/
+
+:- pragma foreign_type("C", bitmap, "MR_BitmapPtr")
+ where equality is bitmap_equal, comparison is bitmap_compare.
+:- pragma foreign_type("Java", bitmap, "mercury.bitmap.MercuryBitmap")
+ where equality is bitmap_equal, comparison is bitmap_compare.
+/* XXX UNTESTED
+:- pragma foreign_type("IL", bitmap,
+ "class [mercury]mercury.bitmap__csharp_code.MercuryBitmap")
+ where equality is bitmap_equal, comparison is bitmap_compare.
+*/
+
+:- pred bitmap_equal(bitmap, bitmap).
+:- mode bitmap_equal(in, in) is semidet.
+
+:- 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);
+}").
+
+bitmap_equal(BM1, BM2) :-
+ BM1 ^ num_bits = (BM2 ^ num_bits) @ NumBits,
+ bytes_equal(0, byte_index_for_bit(NumBits), BM1, BM2).
+
+:- pred bytes_equal(byte_index, byte_index, bitmap, bitmap).
+:- mode bytes_equal(in, in, in, in) is semidet.
+
+bytes_equal(Index, MaxIndex, BM1, BM2) :-
+ ( Index =< MaxIndex ->
+ BM1 ^ unsafe_byte(Index) = BM2 ^ unsafe_byte(Index),
+ bytes_equal(Index + 1, MaxIndex, BM1, BM2)
+ ;
+ true
+ ).
+
+:- pred bitmap_compare(comparison_result, bitmap, bitmap).
+:- mode bitmap_compare(uo, in, in) is det.
+
+:- pragma foreign_proc("C",
+ bitmap_compare(Result::uo, BM1::in, BM2::in),
+ [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
+"{
+ int res;
+ res = MR_bitmap_cmp(BM1, BM2);
+ Result = ((res < 0) ? MR_COMPARE_LESS
+ : (res == 0) ? MR_COMPARE_EQUAL
+ : MR_COMPARE_GREATER);
+}").
+
+bitmap_compare(Result, BM1, BM2) :-
+ compare(Result0, BM1 ^ num_bits, (BM2 ^ num_bits) @ NumBits),
+ ( Result0 = (=) ->
+ bytes_compare(Result, 0, byte_index_for_bit(NumBits), BM1, BM2)
+ ;
+ Result = Result0
+ ).
+
+:- pred bytes_compare(comparison_result, byte_index, byte_index,
+ bitmap, bitmap).
+:- mode bytes_compare(uo, in, in, in, in) is det.
+
+bytes_compare(Result, Index, MaxIndex, BM1, BM2) :-
+ ( Index =< MaxIndex ->
+ compare(Result0, BM1 ^ unsafe_byte(Index), BM2 ^ unsafe_byte(Index)),
+ ( Result0 = (=) ->
+ bytes_compare(Result, Index + 1, MaxIndex, BM1, BM2)
+ ;
+ Result = Result0
+ )
+ ;
+ Result = (=)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+num_bytes(BM) = Bytes :-
+ NumBits = BM ^ num_bits,
+ NumBits `unchecked_rem` bits_per_byte = 0,
+ Bytes = NumBits `unchecked_quotient` bits_per_byte.
+
+det_num_bytes(BM) = Bytes :-
+ ( Bytes0 = num_bytes(BM) ->
+ Bytes = Bytes0
+ ;
+ throw_bitmap_error("det_num_bytes: bitmap has a partial final byte")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+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;
+").
+
+/* XXX UNTESTED
+:- 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;
+").
+*/
+
+%-----------------------------------------------------------------------------%
+
+:- func 'num_bits :='(bitmap, num_bits) = bitmap.
+:- mode 'num_bits :='(bitmap_di, in) = bitmap_uo is det.
+
+'num_bits :='(_, _) = _ :- private_builtin.sorry("bitmap.'num_bits :='").
+:- pragma foreign_proc("C",
+ 'num_bits :='(BM0::bitmap_di, NumBits::in) = (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",
+ 'num_bits :='(BM0::bitmap_di, NumBits::in) = (BM::bitmap_uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
+"
+ BM = BM0;
+ BM.num_bits = NumBits;
+").
+/* XXX UNTESTED
+:- pragma foreign_proc("C#",
+ 'num_bits :='(BM0::bitmap_di, NumBits::in) = (BM::bitmap_uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
+"
+ BM = BM0;
+ BM.num_bits = NumBits;
+").
+*/
+
+%-----------------------------------------------------------------------------%
- % We add the extra 1 on because elem(0) is used to store the number
- % of bits in the bitmap; the data are stored in the following elements.
+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")
+ ).
+
+_ ^ unsafe_byte(_) = _ :- private_builtin.sorry("bitmap.unsafe_byte").
+:- pragma foreign_proc("C",
+ unsafe_byte(N::in, BM::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_byte(N::in, BM::in) = (Byte::out),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
+"
+ // Mask off sign bits.
+ Byte = ((int) BM.elements[N]) & 0xff;
+").
+
+/* XXX UNTESTED
+:- pragma foreign_proc("C#",
+ unsafe_byte(N::in, BM::in) = (Byte::out),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
+"
+ Byte = BM.elements[N];
+").
+*/
+
+%-----------------------------------------------------------------------------%
+
+(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")
+ ).
+
+:- pragma promise_pure('unsafe_byte :='/3).
+(_ ^ unsafe_byte(_) := _) = _ :-
+ private_builtin.sorry("bitmap.'unsafe_byte :='").
+
+:- pragma foreign_proc("C",
+ 'unsafe_byte :='(N::in, BM0::bitmap_di, Byte::in) = (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_byte :='(N::in, BM0::bitmap_di, Byte::in) = (BM::bitmap_uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
+"
+ BM = BM0;
+ BM.elements[N] = (byte) Byte;
+").
+
+/* XXX UNTESTED
+:- pragma foreign_proc("C#",
+ 'unsafe_byte :='(N::in, BM0::bitmap_di, Byte::in) = (BM::bitmap_uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
+"
+ BM = BM0;
+ BM.elements[N] = (byte) Byte;
+").
+*/
+
+%-----------------------------------------------------------------------------%
+
+:- 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_PROC_LABEL);
+").
+
+:- 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 mercury.bitmap.MercuryBitmap(N);
+").
+
+/* XXX UNTESTED
+:- 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]mercury.bitmap__csharp_code.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(OldBM ^ num_bits, N)).
+
+:- pragma promise_pure(copy/1).
+:- 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_PROC_LABEL);
+ MR_copy_bitmap(BM, BM0);
+").
+
+copy(BM0) = BM :-
+ NumBits = BM0 ^ num_bits,
+ BM = clear_filler_bits(
+ unsafe_copy_bits(0, BM0, 0, allocate_bitmap(NumBits), 0, NumBits)).
+
+%-----------------------------------------------------------------------------%
+
+bits_per_byte = 8.
+
+%-----------------------------------------------------------------------------%
+
+ % The byte index containing the given bit.
%
-int_offset(I) = 1 + int.quot_bits_per_int(I).
+:- func byte_index_for_bit(bit_index) = byte_index.
+
+byte_index_for_bit(I) = unchecked_quotient(I, bits_per_byte).
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
- % Construct the bitmask for a given bit in a word.
+ % Return the bit number in the bitmap of the first bit in the
+ % same byte as the given bit.
%
- % E.g. assuming int.bits_per_int = 8 and I = 11 then
- % bitmask(I) = 2'00001000
+:- func first_bit_in_same_byte(bit_index) = bit_index.
+
+first_bit_in_same_byte(I) = floor_to_multiple_of_bits_per_byte(I).
+
+:- func floor_to_multiple_of_bits_per_byte(int) = int.
+
+floor_to_multiple_of_bits_per_byte(X) = Floor :-
+ Trunc = unchecked_quotient(X, bits_per_byte),
+ Floor0 = Trunc * bits_per_byte,
+ ( Floor0 > X ->
+ Floor = Floor0 - bits_per_byte
+ ;
+ Floor = Floor0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- type bit_index_in_byte == int.
+
+ % Convert a bit index for a bitmap into a bit index into a
+ % byte in the bitmap.
%
-:- func bitmask(int) = int.
+:- func bit_index_in_byte(bit_index) = bit_index_in_byte.
+
+bit_index_in_byte(I) = I `unchecked_rem` bits_per_byte.
- % NOTE: it would be nicer to use /\ with a bitmask here rather
- % than rem. Do modern back-ends do the decent thing here if
- % int.bits_per_int is the expected power of two?
+%-----------------------------------------------------------------------------%
+
+ % 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.
+ %
+ % E.g. assuming bits_per_byte = 8 and I = 3 then
+ % bitmask(I) = 2'00010000
%
-bitmask(I) = 1 `unchecked_left_shift` int.rem_bits_per_int(I).
+:- func bitmask(bit_index_in_byte) = byte.
-% ---------------------------------------------------------------------------- %
+bitmask(I) = 1 `unchecked_left_shift`
+ (bits_per_byte - 1 - bit_index_in_byte(I)).
- % Construct the bitmask for all the bits up to and including
- % the given bit in a word.
+%-----------------------------------------------------------------------------%
+
+ % Construct a bitmask containing the N least significant bits set.
%
- % E.g. assuming int.bits_per_int = 8 and I = 11 then
- % bitmask(I) = 2'00001111
+ % E.g. assuming bits_per_byte = 8 and I = 4 then
+ % n_bit_mask(I) = 2'00001111
%
-:- func bitsmask(int) = int.
+:- func n_bit_mask(num_bits) = byte.
-bitsmask(I) = BitsMask :-
- BitMask = bitmask(I),
+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(Byte, FirstBit, NumBits, Bits)
+ %
+ % 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.
+:- func set_bits_in_byte(byte, bit_index_in_byte, num_bits, byte) = byte.
+
+set_bits_in_byte(Byte0, FirstBit, NumBits, Bits) = 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).
+
+%-----------------------------------------------------------------------------%
+
+:- func throw_bitmap_error(string) = _ is erroneous.
+
+throw_bitmap_error(Msg) = _ :-
+ throw_bitmap_error(Msg).
+
+:- pred throw_bitmap_error(string::in) is erroneous.
+
+throw_bitmap_error(Msg) :- throw(bitmap_error(Msg)).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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