[m-rev.] for review: improvements to bitmap.m [3]
Simon Taylor
staylr at gmail.com
Sun Feb 11 12:06:06 AEDT 2007
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.307
diff -u -u -r1.307 Mmakefile
--- tests/hard_coded/Mmakefile 8 Feb 2007 01:08:11 -0000 1.307
+++ tests/hard_coded/Mmakefile 10 Feb 2007 11:21:44 -0000
@@ -12,6 +12,7 @@
any_free_unify \
backquoted_qualified_ops \
bidirectional \
+ bitmap_test \
boyer \
brace \
builtin_inst_rename \
@@ -705,6 +706,7 @@
clean_local:
rm -f target_mlobjs_c.o
+ rm -f bitmap_test_output bitmap_test_output2
realclean_local:
rm -f Mercury.modules
Index: tests/hard_coded/bitmap_simple.m
===================================================================
RCS file: tests/hard_coded/bitmap_simple.m
diff -N tests/hard_coded/bitmap_simple.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/bitmap_simple.m 10 Feb 2007 11:20:57 -0000
@@ -0,0 +1,703 @@
+% vim: ts=4 sw=4 et tw=0 wm=0 ft=mercury
+% Very inefficient, but simple sbitmap implementation,
+% used for testing bitmap.m.
+:- module bitmap_simple.
+
+:- interface.
+
+:- import_module version_array, bool.
+
+:- type sbitmap == version_array(bool).
+
+:- inst sbitmap == ground.
+:- inst uniq_sbitmap == sbitmap. % XXX should be unique
+:- mode sbitmap_di == di(uniq_sbitmap). % XXX should be di
+:- mode sbitmap_uo == out(uniq_sbitmap).
+:- mode sbitmap_ui == in(uniq_sbitmap).
+
+ % The exception thrown for any error.
+:- type sbitmap_error
+ ---> sbitmap_error(string).
+
+%-----------------------------------------------------------------------------%
+
+ % new(N, B) creates a sbitmap 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) = sbitmap.
+:- mode new(in, in) = sbitmap_uo is det.
+
+ % Create a new copy of a sbitmap.
+ %
+:- func copy(sbitmap) = sbitmap.
+:- mode copy(sbitmap_ui) = sbitmap_uo is det.
+%:- mode copy(in) = sbitmap_uo is det.
+
+ % resize(BM, N, B) resizes sbitmap 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(sbitmap, int, bool) = sbitmap.
+:- mode resize(sbitmap_di, in, in) = sbitmap_uo is det.
+
+ % Is the given bit number in range.
+ %
+:- pred in_range(sbitmap, int).
+:- mode in_range(sbitmap_ui, in) is semidet.
+%:- mode in_range(in, in) is semidet.
+
+ % Is the given byte number in range.
+ %
+:- pred byte_in_range(sbitmap, int).
+:- mode byte_in_range(sbitmap_ui, in) is semidet.
+%:- mode byte_in_range(in, in) is semidet.
+
+ % Returns the number of bits in a sbitmap.
+ %
+:- func num_bits(sbitmap) = int.
+:- mode num_bits(sbitmap_ui) = out is det.
+%:- mode num_bits(in) = out is det.
+
+ % Returns the number of bytes in a sbitmap, failing if the sbitmap
+ % has a partial final byte.
+ %
+:- func num_bytes(sbitmap) = int.
+:- mode num_bytes(sbitmap_ui) = out is semidet.
+%:- mode num_bytes(in) = out is semidet.
+
+ % As above, but throw an exception if the sbitmap has a partial final byte.
+:- func det_num_bytes(sbitmap) = int.
+:- mode det_num_bytes(sbitmap_ui) = out is det.
+%:- mode det_num_bytes(in) = out is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Get or set the given bit.
+ % The unsafe versions do not check whether the bit is in range.
+ %
+:- func bit(int, sbitmap) = bool.
+:- mode bit(in, sbitmap_ui) = out is det.
+%:- mode bit(in, in) = out is det.
+
+:- func unsafe_bit(int, sbitmap) = bool.
+:- mode unsafe_bit(in, sbitmap_ui) = out is det.
+%:- mode unsafe_bit(in, in) = out is det.
+
+:- func 'bit :='(int, sbitmap, bool) = sbitmap.
+:- mode 'bit :='(in, sbitmap_di, in) = sbitmap_uo is det.
+
+:- func 'unsafe_bit :='(int, sbitmap, bool) = sbitmap.
+:- mode 'unsafe_bit :='(in, sbitmap_di, in) = sbitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Bitmap ^ bits(OffSet, NumBits) = Word.
+ % The low order bits of Word contain the NumBits bits of BitMap
+ % starting at OffSet.
+ % NumBits must be less than int.bits_per_int.
+ %
+:- func bits(int, int, sbitmap) = int.
+:- mode bits(in, in, sbitmap_ui) = out is det.
+%:- mode bits(in, in, in) = out is det.
+
+:- func unsafe_bits(int, int, sbitmap) = int.
+:- mode unsafe_bits(in, in, sbitmap_ui) = out is det.
+%:- mode unsafe_bits(in, in, in) = out is det.
+
+:- func 'bits :='(int, int, sbitmap, int) = sbitmap.
+:- mode 'bits :='(in, in, sbitmap_di, in) = sbitmap_uo is det.
+
+:- func 'unsafe_bits :='(int, int, sbitmap, int) = sbitmap.
+:- mode 'unsafe_bits :='(in, in, sbitmap_di, in) = sbitmap_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 byte(int, sbitmap) = int.
+:- mode byte(in, sbitmap_ui) = out is det.
+%:- mode byte(in, in) = out is det.
+
+:- func unsafe_byte(int, sbitmap) = int.
+:- mode unsafe_byte(in, sbitmap_ui) = out is det.
+%:- mode unsafe_byte(in, in) = out is det.
+
+:- func 'byte :='(int, sbitmap, int) = sbitmap.
+:- mode 'byte :='(in, sbitmap_di, in) = sbitmap_uo is det.
+
+:- func 'unsafe_byte :='(int, sbitmap, int) = sbitmap.
+:- mode 'unsafe_byte :='(in, sbitmap_di, in) = sbitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Flip the given bit.
+ %
+:- func flip(sbitmap, int) = sbitmap.
+:- mode flip(sbitmap_di, in) = sbitmap_uo is det.
+
+:- func unsafe_flip(sbitmap, int) = sbitmap.
+:- mode unsafe_flip(sbitmap_di, in) = sbitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Set operations; for binary operations the second argument is altered
+ % in all cases. The input sbitmaps must have the same size.
+ %
+
+:- func complement(sbitmap) = sbitmap.
+:- mode complement(sbitmap_di) = sbitmap_uo is det.
+
+:- func union(sbitmap, sbitmap) = sbitmap.
+:- mode union(sbitmap_ui, sbitmap_di) = sbitmap_uo is det.
+%:- mode union(in, sbitmap_di) = sbitmap_uo is det.
+
+:- func intersect(sbitmap, sbitmap) = sbitmap.
+:- mode intersect(sbitmap_ui, sbitmap_di) = sbitmap_uo is det.
+%:- mode intersect(in, sbitmap_di) = sbitmap_uo is det.
+
+:- func difference(sbitmap, sbitmap) = sbitmap.
+:- mode difference(sbitmap_ui, sbitmap_di) = sbitmap_uo is det.
+%:- mode difference(in, sbitmap_di) = sbitmap_uo is det.
+
+:- func xor(sbitmap, sbitmap) = sbitmap.
+:- mode xor(sbitmap_ui, sbitmap_di) = sbitmap_uo is det.
+%:- mode xor(in, sbitmap_di) = sbitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+ % 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(sbitmap, int, sbitmap, int, int) = sbitmap.
+:- mode copy_bits(sbitmap_ui, in, sbitmap_di, in, in) = sbitmap_uo is det.
+%:- mode copy_bits(in, in, sbitmap_di, in, in) = sbitmap_uo is det.
+
+ % copy_bits_in_sbitmap(BM, SrcStartBit, DestStartBit, NumBits)
+ %
+ % Overwrite NumBits bits starting at DestStartBit with the NumBits
+ % bits starting at SrcStartBit in the same sbitmap.
+ %
+:- func copy_bits_in_bitmap(sbitmap, int, int, int) = sbitmap.
+:- mode copy_bits_in_bitmap(sbitmap_di, in, in, in) = sbitmap_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(sbitmap, int, sbitmap, int, int) = sbitmap.
+:- mode copy_bytes(sbitmap_ui, in, sbitmap_di, in, in) = sbitmap_uo is det.
+%:- mode copy_bytes(in, in, sbitmap_di, in, in) = sbitmap_uo is det.
+
+ % copy_bytes_in_sbitmap(BM, SrcStartByte, DestStartByte, NumBytes)
+ %
+ % Overwrite NumBytes bytes starting at DestStartByte with the NumBytes
+ % bytes starting at SrcStartByte in the same sbitmap.
+ %
+:- func copy_bytes_in_bitmap(sbitmap, int, int, int) = sbitmap.
+:- mode copy_bytes_in_bitmap(sbitmap_di, in, in, in) = sbitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Variations that might be slightly more efficient by not
+ % converting bits to bool.
+ %
+
+:- func set(sbitmap, int) = sbitmap.
+:- mode set(sbitmap_di, in) = sbitmap_uo is det.
+
+:- func clear(sbitmap, int) = sbitmap.
+:- mode clear(sbitmap_di, in) = sbitmap_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(sbitmap, int).
+:- mode is_set(sbitmap_ui, in) is semidet.
+%:- mode is_set(in, in) is semidet.
+
+:- pred is_clear(sbitmap, int).
+:- mode is_clear(sbitmap_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_set(sbitmap, int) = sbitmap.
+:- mode unsafe_set(sbitmap_di, in) = sbitmap_uo is det.
+
+:- func unsafe_clear(sbitmap, int) = sbitmap.
+:- mode unsafe_clear(sbitmap_di, in) = sbitmap_uo is det.
+
+:- pred unsafe_set(int, sbitmap, sbitmap).
+:- mode unsafe_set(in, sbitmap_di, sbitmap_uo) is det.
+
+:- pred unsafe_clear(int, sbitmap, sbitmap).
+:- mode unsafe_clear(in, sbitmap_di, sbitmap_uo) is det.
+
+:- pred unsafe_flip(int, sbitmap, sbitmap).
+:- mode unsafe_flip(in, sbitmap_di, sbitmap_uo) is det.
+
+:- pred unsafe_is_set(sbitmap, int).
+:- mode unsafe_is_set(sbitmap_ui, in) is semidet.
+%:- mode unsafe_is_set(in, in) is semidet.
+
+:- pred unsafe_is_clear(sbitmap, int).
+:- mode unsafe_is_clear(sbitmap_ui, in) is semidet.
+%:- mode unsafe_is_clear(in, in) is semidet.
+
+ % Predicate versions, for use with state variables.
+ %
+
+:- pred set(int, sbitmap, sbitmap).
+:- mode set(in, sbitmap_di, sbitmap_uo) is det.
+
+:- pred clear(int, sbitmap, sbitmap).
+:- mode clear(in, sbitmap_di, sbitmap_uo) is det.
+
+:- pred flip(int, sbitmap, sbitmap).
+:- mode flip(in, sbitmap_di, sbitmap_uo) is det.
+
+:- func to_byte_string(sbitmap) = string.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module char.
+:- import_module enum.
+:- import_module exception.
+:- import_module int.
+:- import_module list.
+:- import_module require.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+new(N, B) = BM :-
+ ( if N < 0 then
+ throw_sbitmap_error("sbitmap.new: negative size") = _ : int
+ else
+ BM = version_array.init(N, B)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+resize(BM, NewSize, InitializerBit) =
+ ( if NewSize =< 0 then
+ bitmap_simple.new(NewSize, InitializerBit)
+ else
+ version_array.resize(BM, NewSize, InitializerBit)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+in_range(BM, I) :- 0 =< I, I < num_bits(BM).
+
+byte_in_range(BM, I) :-
+ in_range(BM, I * bits_per_int + bits_per_int - 1).
+
+%-----------------------------------------------------------------------------%
+
+bit(I, BM) =
+ ( if in_range(BM, I)
+ then BM ^ unsafe_bit(I)
+ else throw_sbitmap_error("sbitmap.bit: out of range")
+ ).
+
+unsafe_bit(I, BM) =
+ ( if unsafe_is_set(BM, I) then yes else no ).
+
+'bit :='(I, BM, B) =
+ ( if in_range(BM, I)
+ then BM ^ unsafe_bit(I) := B
+ else throw_sbitmap_error("sbitmap.'bit :=': out of range")
+ ).
+
+'unsafe_bit :='(I, BM, yes) = unsafe_set(BM, I).
+'unsafe_bit :='(I, BM, no) = unsafe_clear(BM, I).
+
+%-----------------------------------------------------------------------------%
+
+bits(FirstBit, NumBits, BM) =
+ ( if FirstBit >= 0, in_range(BM, FirstBit + NumBits - 1)
+ then BM ^ unsafe_bits(FirstBit, NumBits)
+ else throw_sbitmap_error("sbitmap.bits: out of range")
+ ).
+
+unsafe_bits(FirstBit, NumBits, BM) = Bits :-
+ extract_bits(FirstBit, NumBits, BM, 0, Bits).
+
+ % Extract the given number of bits starting at the most significant.
+:- pred extract_bits(int, int, sbitmap, int, int).
+:- mode extract_bits(in, in, sbitmap_ui, in, out) is det.
+%:- mode extract_bits(in, in, in, in, out) is det.
+
+extract_bits(FirstBit, NumBits, BM, !Bits) :-
+ ( NumBits =< 0 ->
+ true
+ ;
+ !:Bits = (!.Bits `unchecked_left_shift` 1)
+ \/ to_int(BM ^ elem(FirstBit)),
+ extract_bits(FirstBit + 1, NumBits - 1, BM, !Bits)
+ ).
+
+'bits :='(FirstBit, NumBits, BM, Bits) =
+ ( if FirstBit >= 0, in_range(BM, FirstBit + NumBits - 1)
+ then BM ^ unsafe_bits(FirstBit, NumBits) := Bits
+ else throw_sbitmap_error("sbitmap.bits: out of range")
+ ).
+
+'unsafe_bits :='(FirstBit, NumBits, BM0, Bits) = BM :-
+ LastBit = FirstBit + NumBits - 1,
+ set_bits(LastBit, NumBits, Bits, BM0, BM).
+
+ % Set the given number of bits starting at the least significant
+:- pred set_bits(int, int, int, sbitmap, sbitmap).
+:- mode set_bits(in, in, in, sbitmap_di, sbitmap_uo) is det.
+
+set_bits(LastBit, NumBits, Bits, !BM) :-
+ ( NumBits =< 0 ->
+ true
+ ;
+ !:BM = !.BM ^ elem(LastBit) := det_from_int(Bits /\ 1),
+ set_bits(LastBit - 1, NumBits - 1,
+ Bits `unchecked_right_shift` 1, !BM)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+set(BM, I) =
+ ( if in_range(BM, I)
+ then unsafe_set(BM, I)
+ else throw_sbitmap_error("sbitmap.set: out of range")
+ ).
+
+clear(BM, I) =
+ ( if in_range(BM, I)
+ then unsafe_clear(BM, I)
+ else throw_sbitmap_error("sbitmap.clear: out of range")
+ ).
+
+flip(BM, I) =
+ ( if in_range(BM, I)
+ then unsafe_flip(BM, I)
+ else throw_sbitmap_error("sbitmap.flip: out of range")
+ ).
+
+set(I, BM, set(BM, I)).
+
+clear(I, BM, clear(BM, I)).
+
+flip(I, BM, flip(BM, I)).
+
+%-----------------------------------------------------------------------------%
+
+unsafe_set(BM, I) =
+ BM ^ elem(I) := yes.
+
+unsafe_clear(BM, I) =
+ BM ^ elem(I) := no.
+
+unsafe_flip(BM, I) =
+ BM ^ elem(I) := bool.not(BM ^ elem(I)).
+
+unsafe_set(I, BM, unsafe_set(BM, I)).
+
+unsafe_clear(I, BM, unsafe_clear(BM, I)).
+
+unsafe_flip(I, BM, unsafe_flip(BM, I)).
+
+%-----------------------------------------------------------------------------%
+
+is_set(BM, I) :-
+ ( if in_range(BM, I)
+ then unsafe_is_set(BM, I)
+ else throw_sbitmap_error("sbitmap.is_set: out of range") = _ : int
+ ).
+
+is_clear(BM, I) :-
+ ( if in_range(BM, I)
+ then unsafe_is_clear(BM, I)
+ else throw_sbitmap_error("sbitmap.is_clear: out of range") = _ : int
+ ).
+
+%-----------------------------------------------------------------------------%
+
+unsafe_is_set(BM, I) :-
+ BM ^ elem(I) = yes.
+
+unsafe_is_clear(BM, I) :-
+ BM ^ elem(I) = no.
+
+%-----------------------------------------------------------------------------%
+
+complement(BM) = from_list(map(not, to_list(BM))).
+
+%-----------------------------------------------------------------------------%
+
+union(BMa, BMb) =
+ ( if num_bits(BMa) = num_bits(BMb) then
+ zip(or, BMa, BMb)
+ else
+ throw_sbitmap_error("sbitmap.union: sbitmaps not the same size")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+intersect(BMa, BMb) =
+ ( if num_bits(BMa) = num_bits(BMb) then
+ zip(and, BMa, BMb)
+ else
+ throw_sbitmap_error("sbitmap.intersect: sbitmaps not the same size")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+difference(BMa, BMb) =
+ ( if num_bits(BMa) = num_bits(BMb) then
+ zip((func(X, Y) = (X `and` not(Y))), BMa, BMb)
+ else
+ throw_sbitmap_error("sbitmap.difference: sbitmaps 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_sbitmap_error("sbitmap.xor: sbitmaps not the same size")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % Applies a function to every corresponding element between +ve I
+ % and 1 inclusive, destructively updating the second sbitmap.
+ %
+:- func zip(func(bool, bool) = bool, sbitmap, sbitmap) = sbitmap.
+:- mode zip(func(in, in) = out is det, sbitmap_ui, sbitmap_di) = sbitmap_uo
+ is det.
+%:- mode zip(func(in, in) = out is det, in, sbitmap_di) = sbitmap_uo is det.
+
+zip(Fn, BMa, BMb) =
+ ( if num_bits(BMb) = 0 then BMb
+ else zip2(num_bits(BMb) - 1, Fn, BMa, BMb)
+ ).
+
+:- func zip2(int, func(bool, bool) = bool, sbitmap, sbitmap) = sbitmap.
+:- mode zip2(in, func(in, in) = out is det, sbitmap_ui, sbitmap_di) = sbitmap_uo
+ is det.
+%:- mode zip2(in, func(in, in) = out is det, in, sbitmap_di) = sbitmap_uo
+% is det.
+
+zip2(I, Fn, BMa, BMb) =
+ ( if I >= 0 then
+ zip2(I - 1, Fn, BMa,
+ BMb ^ elem(I) := Fn(BMa ^ elem(I), BMb ^ elem(I)))
+ else
+ BMb
+ ).
+
+%-----------------------------------------------------------------------------%
+
+copy_bits(SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits) =
+ copy_bits(no, SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits).
+
+copy_bits_in_bitmap(BM, SrcStartBit, DestStartBit, NumBits) =
+ copy_bits(yes, BM, SrcStartBit, BM, DestStartBit, NumBits).
+
+:- func copy_bits(bool, sbitmap, int, sbitmap, int, int) = sbitmap.
+:- mode copy_bits(in, sbitmap_ui, in, sbitmap_di, in, in) = sbitmap_uo is det.
+%:- mode copy_bits(in, in, in, sbitmap_di, in, in) = sbitmap_uo is det.
+
+copy_bits(SameBM, SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits) =
+ (
+ 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_sbitmap_error(
+ "sbitmap.copy_bits: out of range")
+ ).
+
+:- func unsafe_copy_bits(bool, sbitmap, int, sbitmap, int, int) = sbitmap.
+:- mode unsafe_copy_bits(in, sbitmap_ui, in,
+ sbitmap_di, in, in) = sbitmap_uo is det.
+%:- mode unsafe_copy_bits(in, in, in, sbitmap_di, in, in) = sbitmap_uo is det.
+
+unsafe_copy_bits(SameBM, SrcBM, SrcStartBit, !.DestBM, DestStartBit,
+ NumBits) = !:DestBM :-
+ CopyDirection = choose_copy_direction(SameBM, SrcStartBit, DestStartBit),
+ (
+ CopyDirection = left_to_right,
+ AddForNextBit = 1,
+ SrcFirstBit = SrcStartBit,
+ DestFirstBit = DestStartBit
+ ;
+ CopyDirection = right_to_left,
+ AddForNextBit = -1,
+ SrcFirstBit = SrcStartBit + NumBits - 1,
+ DestFirstBit = DestStartBit + NumBits - 1
+ ),
+ !:DestBM = unsafe_do_copy_bits(SrcBM, SrcFirstBit,
+ !.DestBM, DestFirstBit, AddForNextBit, NumBits).
+
+:- func unsafe_do_copy_bits(sbitmap, int, sbitmap, int, int, int) = sbitmap.
+:- mode unsafe_do_copy_bits(sbitmap_ui, in,
+ sbitmap_di, in, in, in) = sbitmap_uo is det.
+%:- mode unsafe_do_copy_bits(in, in,
+% sbitmap_di, in, in, in) = sbitmap_uo is det.
+
+unsafe_do_copy_bits(SrcBM, SrcFirstBit, DestBM, DestFirstBit,
+ AddForNextBit, NumBits) =
+ ( NumBits =< 0 ->
+ DestBM
+ ;
+ unsafe_do_copy_bits(SrcBM, SrcFirstBit + AddForNextBit,
+ DestBM ^ elem(DestFirstBit) := SrcBM ^ elem(SrcFirstBit),
+ DestFirstBit + AddForNextBit,
+ AddForNextBit, NumBits - 1)
+ ).
+
+copy_bytes(SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes) =
+ copy_bits(SrcBM, SrcStartByte * bits_per_byte,
+ DestBM, DestStartByte * bits_per_byte, NumBytes * bits_per_byte).
+
+copy_bytes_in_bitmap(BM, SrcStartByte, DestStartByte, NumBytes) =
+ copy_bits_in_bitmap(BM, SrcStartByte * bits_per_byte,
+ DestStartByte * bits_per_byte, NumBytes * bits_per_byte).
+
+:- 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.
+:- func choose_copy_direction(bool, int, int) = copy_direction.
+
+choose_copy_direction(yes, SrcStartBit, DestStartBit) =
+ ( SrcStartBit < DestStartBit -> right_to_left ; left_to_right ).
+
+ % Doesn't matter for correctness, but performance is likely
+ % to be better left_to_right.
+choose_copy_direction(no, _, _) = left_to_right.
+
+%-----------------------------------------------------------------------------%
+
+num_bytes(BM) = Bytes :-
+ NumBits = BM ^ num_bits,
+ NumBits rem bits_per_byte = 0,
+ Bytes = NumBits `unchecked_quotient` bits_per_byte.
+
+det_num_bytes(BM) = Bytes :-
+ ( Bytes0 = num_bytes(BM) ->
+ Bytes = Bytes0
+ ;
+ throw_sbitmap_error("det_num_bytes: sbitmap has a partial final byte")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+num_bits(BM) = version_array.size(BM).
+
+%-----------------------------------------------------------------------------%
+
+byte(N, BM) =
+ ( if N >= 0, in_range(BM, N * bits_per_byte + bits_per_byte - 1)
+ then BM ^ unsafe_byte(N)
+ else throw_sbitmap_error("sbitmap.byte: out of range")
+ ).
+
+unsafe_byte(N, BM) = BM ^ bits(N * bits_per_byte, bits_per_byte).
+
+%-----------------------------------------------------------------------------%
+
+'byte :='(N, BM, Byte) =
+ ( if N >= 0, in_range(BM, N * bits_per_byte + bits_per_byte - 1)
+ then BM ^ unsafe_byte(N) := Byte
+ else throw_sbitmap_error("sbitmap.'byte :=': out of range")
+ ).
+
+'unsafe_byte :='(N, BM, Byte) =
+ BM ^ bits(N * bits_per_byte, bits_per_byte) := Byte.
+
+%-----------------------------------------------------------------------------%
+
+copy(BM) = version_array.copy(BM).
+
+%-----------------------------------------------------------------------------%
+
+ % Return the number of bits in a byte (always 8).
+ %
+:- func bits_per_byte = int.
+
+bits_per_byte = 8.
+
+%-----------------------------------------------------------------------------%
+
+:- func throw_sbitmap_error(string) = _ is erroneous.
+
+throw_sbitmap_error(Msg) = _ :-
+ throw_sbitmap_error(Msg).
+
+:- pred throw_sbitmap_error(string::in) is erroneous.
+
+throw_sbitmap_error(Msg) :- throw(sbitmap_error(Msg)).
+
+%-----------------------------------------------------------------------------%
+
+to_byte_string(BM) =
+ string.join_list(".", sbitmap_to_byte_strings(BM)).
+
+:- func sbitmap_to_byte_strings(sbitmap) = list(string).
+:- mode sbitmap_to_byte_strings(in) = out is det.
+
+sbitmap_to_byte_strings(BM) = Strs :-
+ NumBits = BM ^ num_bits,
+ Strs = sbitmap_to_byte_strings(BM, NumBits, []).
+
+:- func sbitmap_to_byte_strings(sbitmap, int, list(string)) = list(string).
+:- mode sbitmap_to_byte_strings(in, in, in) = out is det.
+
+sbitmap_to_byte_strings(BM, NumBits, !.Strs) = !:Strs :-
+ ( NumBits =< 0 ->
+ true
+ ;
+ % Check for the incomplete last byte.
+ NumBitsThisByte0 = NumBits rem bits_per_byte,
+ ( NumBitsThisByte0 = 0 ->
+ NumBitsThisByte = bits_per_byte
+ ;
+ NumBitsThisByte = NumBitsThisByte0
+ ),
+ ThisByte =
+ (BM ^ unsafe_bits(NumBits - NumBitsThisByte, NumBitsThisByte)),
+ ThisByteStr = string.pad_left(int_to_base_string(ThisByte, 2),
+ '0', NumBitsThisByte),
+ !:Strs = [ThisByteStr | !.Strs],
+ !:Strs = sbitmap_to_byte_strings(BM, NumBits - NumBitsThisByte, !.Strs)
+ ).
+
+:- func det_from_int(int) = bool.
+
+det_from_int(Int) =
+ ( B = from_int(Int) -> B ; throw("bitmap_simple: det_from_int failed") ).
Index: tests/hard_coded/bitmap_test.exp
===================================================================
RCS file: tests/hard_coded/bitmap_test.exp
diff -N tests/hard_coded/bitmap_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/bitmap_test.exp 10 Feb 2007 11:20:57 -0000
@@ -0,0 +1,175 @@
+Single byte bitmap
+1111
+yes
+1011
+no
+1001
+1001
+0101
+Multi-byte bitmap
+00000000.00000000.0000
+01000000.00000000.0000
+01010010.10101000.0100
+1010010101
+101010000100
+01010001.01010111.1000
+01010011.01010111.1000
+10101100.10101000.0111
+<32:ACA87FFF>
+"<32:ACA87FFF>"
+Longer bitmap
+10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+10111010.10111001.01111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+non-overlapping copy_bits
+10111010.10111001.01111001.01000110.10111001.01000110.10111001.01000110.10010111.10010100.01101011.10010100.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+testing builtin.copy
+10111010.10111001.01111001.01000110.10111001.01000110.10111001.01000110.10010111.10010100.01101011.10010100.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+Copy succeeded
+Test simple aligned byte block copy.
+Copy 8 64 32
+Copy to zeroed bitmap
+00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.01000110.10111001.01000110.10111001.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.0000000
+Copy to filled bitmap
+11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.01000110.10111001.01000110.10111001.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.1111111
+Copy to alternating bitmap
+10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.01000110.10111001.01000110.10111001.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.0101010
+Copy to same bitmap
+10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.01000110.10111001.01000110.10111001.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.0111001
+Test byte block copy with extra bits on ends.
+Copy 6 62 36
+Copy to zeroed bitmap
+00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000001.01000110.10111001.01000110.10111001.01000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.0000000
+Copy to filled bitmap
+11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111101.01000110.10111001.01000110.10111001.01111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.1111111
+Copy to alternating bitmap
+10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.01000110.10111001.01000110.10111001.01101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.0101010
+Copy to same bitmap
+10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000101.01000110.10111001.01000110.10111001.01111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.0111001
+Test unaligned copy.
+Copy 7 64 32
+Copy to zeroed bitmap
+00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.10100011.01011100.10100011.01011100.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.0000000
+Copy to filled bitmap
+11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.10100011.01011100.10100011.01011100.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.1111111
+Copy to alternating bitmap
+10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10100011.01011100.10100011.01011100.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.0101010
+Copy to same bitmap
+10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10100011.01011100.10100011.01011100.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.0111001
+Test unaligned copy with extra bits on ends.
+Copy 7 67 36
+Copy to zeroed bitmap
+00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00010100.01101011.10010100.01101011.10010100.00000000.00000000.00000000.00000000.00000000.00000000.00000000.0000000
+Copy to filled bitmap
+11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11110100.01101011.10010100.01101011.10010101.11111111.11111111.11111111.11111111.11111111.11111111.11111111.1111111
+Copy to alternating bitmap
+10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10110100.01101011.10010100.01101011.10010100.01010101.10101010.01010101.10101010.01010101.10101010.01010101.0101010
+Copy to same bitmap
+10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10110100.01101011.10010100.01101011.10010101.01000110.10111001.01000110.10111001.01000110.10111001.01000110.0111001
+Test overlapping aligned byte block copy.
+Copy 8 0 36
+Copy to zeroed bitmap
+01000110.10111001.01000110.10111001.01000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.0000000
+Copy to filled bitmap
+01000110.10111001.01000110.10111001.01001111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.1111111
+Copy to alternating bitmap
+01000110.10111001.01000110.10111001.01001010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.0101010
+Copy to same bitmap
+01000110.10111001.01000110.10111001.01001001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.0111001
+Test overlapping aligned byte block copy.
+Copy 0 8 36
+Copy to zeroed bitmap
+00000000.10111001.01000110.10111001.01000110.10110000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.0000000
+Copy to filled bitmap
+11111111.10111001.01000110.10111001.01000110.10111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.1111111
+Copy to alternating bitmap
+10101010.10111001.01000110.10111001.01000110.10110101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.0101010
+Copy to same bitmap
+10111001.10111001.01000110.10111001.01000110.10110110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.0111001
+Test overlapping unaligned copy.
+Copy 2 1 36
+Copy to zeroed bitmap
+01110010.10001101.01110010.10001101.01110000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.0000000
+Copy to filled bitmap
+11110010.10001101.01110010.10001101.01110111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.1111111
+Copy to alternating bitmap
+11110010.10001101.01110010.10001101.01110010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.0101010
+Copy to same bitmap
+11110010.10001101.01110010.10001101.01110001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.0111001
+Test overlapping unaligned copy.
+Copy 1 2 36
+Copy to zeroed bitmap
+00011100.10100011.01011100.10100011.01011100.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.0000000
+Copy to filled bitmap
+11011100.10100011.01011100.10100011.01011111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.1111111
+Copy to alternating bitmap
+10011100.10100011.01011100.10100011.01011110.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.0101010
+Copy to same bitmap
+10011100.10100011.01011100.10100011.01011101.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.0111001
+Test copy to same position.
+Copy 1 1 36
+Copy to zeroed bitmap
+00111001.01000110.10111001.01000110.10111000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000.0000000
+Copy to filled bitmap
+10111001.01000110.10111001.01000110.10111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111.1111111
+Copy to alternating bitmap
+10111001.01000110.10111001.01000110.10111010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101.0101010
+Copy to same bitmap
+10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110.0111001
+Test copy to end of bitmap.
+Copy 0 1 166
+Copy to zeroed bitmap
+01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.0011100
+Copy to filled bitmap
+11011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.0011100
+Copy to alternating bitmap
+11011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.0011100
+Copy to same bitmap
+11011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.01011100.10100011.0011100
+union(zeroes, pattern) = 10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+union(ones, pattern) = 11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111
+union(pattern, ones) = 11111111.11111111.11111111.11111111.11111111.11111111.11111111.11111111
+union(pattern, zeroes) = 10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+union(pattern, alternating) = 10111011.01010111.10111011.01010111.10111011.01010111.10111011.01010111
+union(pattern, pattern) = 10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+union(alternating, alternating) = 10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101
+intersect(zeroes, pattern) = 00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000
+intersect(ones, pattern) = 10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+intersect(pattern, ones) = 10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+intersect(pattern, zeroes) = 00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000
+intersect(pattern, alternating) = 10101000.01000100.10101000.01000100.10101000.01000100.10101000.01000100
+intersect(pattern, pattern) = 10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+intersect(alternating, alternating) = 10101010.01010101.10101010.01010101.10101010.01010101.10101010.01010101
+difference(zeroes, pattern) = 00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000
+difference(ones, pattern) = 01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001
+difference(pattern, ones) = 00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000
+difference(pattern, zeroes) = 10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+difference(pattern, alternating) = 00010001.00000010.00010001.00000010.00010001.00000010.00010001.00000010
+difference(pattern, pattern) = 00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000
+difference(alternating, alternating) = 00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000
+xor(zeroes, pattern) = 10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+xor(ones, pattern) = 01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001
+xor(pattern, ones) = 01000110.10111001.01000110.10111001.01000110.10111001.01000110.10111001
+xor(pattern, zeroes) = 10111001.01000110.10111001.01000110.10111001.01000110.10111001.01000110
+xor(pattern, alternating) = 00010011.00010011.00010011.00010011.00010011.00010011.00010011.00010011
+xor(pattern, pattern) = 00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000
+xor(alternating, alternating) = 00000000.00000000.00000000.00000000.00000000.00000000.00000000.00000000
+ordering(zeroes, pattern) = '<'
+ordering(ones, pattern) = '>'
+ordering(pattern, ones) = '<'
+ordering(pattern, zeroes) = '>'
+ordering(pattern, alternating) = '>'
+ordering(pattern, pattern) = '='
+ordering(alternating, alternating) = '='
+test_unify(zeroes, pattern) = no
+test_unify(ones, pattern) = no
+test_unify(pattern, ones) = no
+test_unify(pattern, zeroes) = no
+test_unify(pattern, alternating) = no
+test_unify(pattern, pattern) = yes
+test_unify(alternating, alternating) = yes
+BMa = "<64:FFFFFFFFB725FFFF>".
+BMb = "<47:FFF6B4BFFFFE>".
+First read succeeded
+Second read succeeded
+First read succeeded
+Second read succeeded
Index: tests/hard_coded/bitmap_test.m
===================================================================
RCS file: tests/hard_coded/bitmap_test.m
diff -N tests/hard_coded/bitmap_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/bitmap_test.m 10 Feb 2007 11:20:57 -0000
@@ -0,0 +1,489 @@
+%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ft=mercury
+%-----------------------------------------------------------------------------%
+:- module bitmap_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module bitmap.
+:- import_module bitmap_tester.
+:- import_module bitmap_simple.
+:- import_module bool.
+:- import_module deconstruct.
+:- import_module exception.
+:- import_module int.
+:- import_module list.
+:- import_module string.
+:- import_module univ.
+
+main(!IO) :-
+ try_io(run_test, Res, !IO),
+ (
+ Res = succeeded(_)
+ ;
+ Res = exception(Excp),
+ io.set_exit_status(1, !IO),
+ ( univ_to_type(Excp, BitmapResErr) ->
+ io.nl(!IO),
+ write_bitmap_result_error(BitmapResErr, !IO)
+ ;
+ rethrow(Res)
+ )
+ ).
+
+:- pred run_test({}::out, io::di, io::uo) is det.
+
+run_test({}, !IO) :-
+ some [!BM] (
+ io.write_string("Single byte bitmap\n", !IO),
+ !:BM = bitmap_tester.new(4, yes),
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+ write(!.BM ^ bit(0), !IO),
+ nl(!IO),
+ !:BM = !.BM ^ bit(1) := no,
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+ write(!.BM ^ bit(1), !IO),
+ nl(!IO),
+ !:BM = !.BM ^ bit(2) := no,
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+ write_binary_string(!.BM ^ bits(0, 4), !IO),
+ nl(!IO),
+ !:BM = !.BM ^ bits(0, 2) := \ (!.BM ^ bits(0, 2)),
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO)
+ ),
+ some [!BM] (
+ io.write_string("Multi-byte bitmap\n", !IO),
+ !:BM = bitmap_tester.new(20, no),
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+ !:BM = flip(!.BM, 1),
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+ !:BM = ((((((!.BM ^ bit(3) := yes)
+ ^ bit(6) := yes)
+ ^ bit(8) := yes)
+ ^ bit(10) := yes)
+ ^ bit(12) := yes)
+ ^ bit(17) := yes),
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+ write_binary_string(!.BM ^ bits(1, 10), !IO),
+ nl(!IO),
+ write_binary_string(!.BM ^ bits(8, 12), !IO),
+ nl(!IO),
+ !:BM = !.BM ^ bits(6, 12) := \ (!.BM ^ bits(6, 12)),
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+ !:BM = flip(!.BM, 6),
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+ !:BM = complement(!.BM),
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+ !:BM = resize(!.BM, 32, yes),
+ io.write_string(to_string(!.BM ^ fst), !IO),
+ nl(!IO),
+ functor(!.BM ^ fst, do_not_allow, Functor, _),
+ io.write_string(Functor, !IO),
+ nl(!IO)
+ ),
+ some [!BM] (
+ io.write_string("Longer bitmap\n", !IO),
+ !:BM = bitmap_tester.new(160, no),
+ BytePattern = 0b10111001,
+ fill_in_alternating_pattern(BytePattern, !BM),
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+ !:BM = !.BM ^ bits(6, 12) := \ (!.BM ^ bits(6, 12)),
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+ io.write_string("non-overlapping copy_bits\n", !IO),
+ !:BM = copy_bits_in_bitmap(!.BM, 12, 64, 32),
+ io.write_string(to_byte_string(!.BM), !IO),
+ nl(!IO),
+
+ io.write_string("testing builtin.copy\n", !IO),
+ builtin.copy(!.BM ^ fst, CopyBM),
+ io.write_string(to_byte_string(CopyBM), !IO),
+ nl(!IO),
+ ( CopyBM = !.BM ^ fst ->
+ io.write_string("Copy succeeded\n", !IO)
+ ;
+ io.write_string("Copy failed\n", !IO)
+ )
+ ),
+
+ io.write_string("Test simple aligned byte block copy.\n", !IO),
+ test_copy(8, 64, 32, !IO),
+
+ io.write_string("Test byte block copy with extra bits on ends.\n", !IO),
+ test_copy(6, 62, 36, !IO),
+
+ io.write_string("Test unaligned copy.\n", !IO),
+ test_copy(7, 64, 32, !IO),
+
+ io.write_string("Test unaligned copy with extra bits on ends.\n", !IO),
+ test_copy(7, 67, 36, !IO),
+
+ io.write_string("Test overlapping aligned byte block copy.\n", !IO),
+ test_copy(8, 0, 36, !IO),
+
+ io.write_string("Test overlapping aligned byte block copy.\n", !IO),
+ test_copy(0, 8, 36, !IO),
+
+ io.write_string("Test overlapping unaligned copy.\n", !IO),
+ test_copy(2, 1, 36, !IO),
+
+ io.write_string("Test overlapping unaligned copy.\n", !IO),
+ test_copy(1, 2, 36, !IO),
+
+ io.write_string("Test copy to same position.\n", !IO),
+ test_copy(1, 1, 36, !IO),
+
+ io.write_string("Test copy to end of bitmap.\n", !IO),
+ test_copy(0, 1, 166, !IO),
+
+ test_set_op("union", union, !IO),
+ test_set_op("intersect", intersect, !IO),
+ test_set_op("difference", difference, !IO),
+ test_set_op("xor", xor, !IO),
+
+ test_binary_op("ordering", bitmap_tester.ordering, !IO),
+ test_binary_op("test_unify", bitmap_tester.test_unify, !IO),
+
+ test_text_io(!IO),
+ test_binary_io(!IO).
+
+ % Do the copy tests to a few different bitmaps, to make sure
+ % correct results aren't a fluke of the original contents, and
+ % to check that the copy isn't disturbing bits outside the
+ % destination range.
+ %
+:- pred test_copy(bit_index::in, bit_index::in, num_bits::in,
+ io::di, io::uo) is det.
+
+test_copy(SrcStart, DestStart, NumBits, !IO) :-
+ BMLength = 167,
+ some [!DestBM, !SrcBM] (
+ io.format("Copy %i %i %i\n", [i(SrcStart), i(DestStart), i(NumBits)],
+ !IO),
+
+ !:SrcBM = bitmap_tester.new(BMLength, no),
+ BytePattern = 0b10111001,
+ fill_in_alternating_pattern(BytePattern, !SrcBM),
+
+ io.write_string("Copy to zeroed bitmap\n", !IO),
+ !:DestBM = bitmap_tester.new(BMLength, no),
+ !:DestBM = copy_bits(!.SrcBM, SrcStart, !.DestBM, DestStart, NumBits),
+ io.write_string(to_byte_string(!.DestBM), !IO),
+ nl(!IO),
+
+ io.write_string("Copy to filled bitmap\n", !IO),
+ !:DestBM = bitmap_tester.new(BMLength, yes),
+ !:DestBM = copy_bits(!.SrcBM, SrcStart, !.DestBM, DestStart, NumBits),
+ io.write_string(to_byte_string(!.DestBM), !IO),
+ nl(!IO),
+
+ io.write_string("Copy to alternating bitmap\n", !IO),
+ !:DestBM = bitmap_tester.new(BMLength, yes),
+ fill_in_alternating_pattern(0b10101010, !DestBM),
+ !:DestBM = copy_bits(!.SrcBM, SrcStart, !.DestBM, DestStart, NumBits),
+ io.write_string(to_byte_string(!.DestBM), !IO),
+ nl(!IO),
+
+ io.write_string("Copy to same bitmap\n", !IO),
+ !:DestBM = copy_bits_in_bitmap(!.SrcBM, SrcStart, DestStart, NumBits),
+ io.write_string(to_byte_string(!.DestBM), !IO),
+ nl(!IO)
+ ).
+
+:- pred test_set_op(string, (func(tbitmap, tbitmap) = tbitmap), io, io).
+:- mode test_set_op(in, (func(tbitmap_ui, tbitmap_di) = tbitmap_uo is det),
+ di, uo) is det.
+
+test_set_op(OpStr, Op, !IO) :-
+ test_binary_op(OpStr, Op,
+ (pred(TBM::in, !.IO::di, !:IO::uo) is det :-
+ io.write_string(to_byte_string(TBM ^ fst), !IO)
+ ), !IO).
+
+:- pred test_binary_op(string, (func(tbitmap, tbitmap) = T), io, io).
+:- mode test_binary_op(in, (func(tbitmap_ui, tbitmap_di) = out is det),
+ di, uo) is det.
+
+test_binary_op(OpStr, Op, !IO) :-
+ test_binary_op(OpStr, Op, io.write, !IO).
+
+:- pred test_binary_op(string, (func(tbitmap, tbitmap) = T),
+ pred(T, io, io), io, io).
+:- mode test_binary_op(in, (func(tbitmap_ui, tbitmap_di) = out is det),
+ (pred(in, di, uo) is det), di, uo) is det.
+
+test_binary_op(OpStr, Op, Writer, !IO) :-
+ BMLength = 64,
+
+ ZeroedBM = bitmap_tester.new(BMLength, no),
+ OnesBM = bitmap_tester.new(BMLength, yes),
+
+ PatternBM0 = bitmap_tester.new(BMLength, no),
+ BytePattern = 0b10111001,
+ fill_in_alternating_pattern(BytePattern, PatternBM0, PatternBM),
+
+ AlternatingBM0 = bitmap_tester.new(BMLength, yes),
+ fill_in_alternating_pattern(0b10101010, AlternatingBM0, AlternatingBM),
+
+ test_binary_op_2("zeroes", ZeroedBM, OpStr, Op,
+ "pattern", PatternBM, Writer, !IO),
+ test_binary_op_2("ones", OnesBM, OpStr, Op,
+ "pattern", PatternBM, Writer, !IO),
+ test_binary_op_2("pattern", PatternBM, OpStr, Op,
+ "ones", OnesBM, Writer, !IO),
+ test_binary_op_2("pattern", PatternBM, OpStr, Op,
+ "zeroes", ZeroedBM, Writer, !IO),
+ test_binary_op_2("pattern", PatternBM, OpStr, Op,
+ "alternating", AlternatingBM, Writer, !IO),
+ test_binary_op_2("pattern", PatternBM, OpStr, Op,
+ "pattern", PatternBM, Writer, !IO),
+ test_binary_op_2("alternating", AlternatingBM, OpStr, Op,
+ "alternating", AlternatingBM, Writer, !IO).
+
+:- pred test_binary_op_2(string, tbitmap, string, (func(tbitmap, tbitmap) = T),
+ string, tbitmap, pred(T, io, io), io, io).
+:- mode test_binary_op_2(in, tbitmap_ui,
+ in, (func(tbitmap_ui, tbitmap_di) = tbitmap_uo is det),
+ in, tbitmap_ui, (pred(in, di, uo) is det), di, uo) is det.
+
+test_binary_op_2(BMStr1, BM1, OpStr, Op, BMStr2, BM2, Writer, !IO) :-
+ io.write_string(OpStr, !IO),
+ io.write_string("(", !IO),
+ io.write_string(BMStr1, !IO),
+ io.write_string(", ", !IO),
+ io.write_string(BMStr2, !IO),
+ io.write_string(") = ", !IO),
+ Writer(BM1 `Op` copy(BM2), !IO),
+ io.nl(!IO).
+
+:- pred test_binary_io(io::di, io::uo) is det.
+
+test_binary_io(!IO) :-
+ FileName = "bitmap_test_output",
+ BMa0 = bitmap.new(64, yes),
+ BMa = BMa0 ^ bits(32, 16) := 0b1011011100100101,
+ BMb0 = bitmap.new(47, yes),
+ BMb = BMb0 ^ bits(11, 16) := 0b1011010110100101,
+ io.open_binary_output(FileName, OpenRes, !IO),
+ (
+ OpenRes = ok(Stream),
+ io.write_bitmap(Stream, BMa, !IO),
+ io.write_bitmap(Stream, BMb, 2, 3, !IO),
+ io.close_binary_output(Stream, !IO),
+ io.open_binary_input(FileName, OpenInputRes, !IO),
+ (
+ OpenInputRes = ok(IStream),
+ InputBMa0 = bitmap.new(64, no),
+ io.read_bitmap(IStream, InputBMa0, ReadResA, !IO),
+ ( ReadResA = ok({BMa, 8}) ->
+ io.write_string("First read succeeded\n", !IO)
+ ;
+ io.write_string("First read failed\n", !IO),
+ io.close_binary_input(IStream, !IO),
+ throw(ReadResA)
+ ),
+ InputBMb0 = bitmap.new(32, no),
+ io.read_bitmap(IStream, InputBMb0, ReadResB, !IO),
+ (
+ ReadResB = ok({InputBMb, 3}),
+ BMb ^ bits(16, 24) = InputBMb ^ bits(0, 24)
+ ->
+ io.write_string("Second read succeeded\n", !IO)
+ ;
+ io.write_string("Second read failed\n", !IO),
+ io.close_binary_input(IStream, !IO),
+ throw(ReadResB)
+ ),
+ io.close_binary_input(IStream, !IO),
+ io.remove_file(FileName, _, !IO)
+ ;
+ OpenInputRes = error(Error),
+ throw(Error)
+ )
+ ;
+ OpenRes = error(Error),
+ throw(Error)
+ ).
+
+:- pred test_text_io(io::di, io::uo) is det.
+
+test_text_io(!IO) :-
+ FileName = "bitmap_test_output2",
+ BMa0 = bitmap.new(64, yes),
+ BMa = BMa0 ^ bits(32, 16) := 0b1011011100100101,
+ BMb0 = bitmap.new(47, yes),
+ BMb = BMb0 ^ bits(11, 16) := 0b1011010110100101,
+ io.write_string("BMa = ", !IO),
+ io.write(BMa, !IO),
+ io.write_string(".\n", !IO),
+ io.write_string("BMb = ", !IO),
+ io.write(BMb, !IO),
+ io.write_string(".\n", !IO),
+ io.open_output(FileName, OpenRes, !IO),
+ (
+ OpenRes = ok(Stream),
+
+ io.write(Stream, BMa, !IO),
+ io.write_string(Stream, ".\n", !IO),
+ io.write(Stream, BMb, !IO),
+ io.write_string(Stream, ".\n", !IO),
+ io.close_output(Stream, !IO),
+ io.open_input(FileName, OpenInputRes, !IO),
+ (
+ OpenInputRes = ok(IStream),
+ io.read(IStream, ReadResA, !IO),
+ ( ReadResA = ok(BMa) ->
+ io.write_string("First read succeeded\n", !IO)
+ ;
+ io.write_string("First read failed\n", !IO),
+ io.close_input(IStream, !IO),
+ throw(ReadResA)
+ ),
+ io.read(IStream, ReadResB, !IO),
+ (
+ ReadResB = ok(BMb)
+ ->
+ io.write_string("Second read succeeded\n", !IO)
+ ;
+ io.write_string("Second read failed\n", !IO),
+ io.close_input(IStream, !IO),
+ throw(ReadResB)
+ ),
+ io.close_input(IStream, !IO),
+ io.remove_file(FileName, _, !IO)
+ ;
+ OpenInputRes = error(Error),
+ throw(Error)
+ )
+ ;
+ OpenRes = error(Error),
+ throw(Error)
+ ).
+
+
+:- pred fill_in_alternating_pattern(byte::in,
+ tbitmap::tbitmap_di, tbitmap::tbitmap_uo) is det.
+
+fill_in_alternating_pattern(Byte, !BM) :-
+ NumBits = !.BM ^ fst ^ num_bits,
+ NumBytes = NumBits / bits_per_byte,
+ fill_in_alternating_pattern(0, NumBytes, Byte, !BM),
+ LastByteNumBits = NumBits `rem` bits_per_byte,
+ ( LastByteNumBits \= 0 ->
+ !:BM = !.BM ^ bits(NumBytes * bits_per_byte, LastByteNumBits) := Byte
+ ;
+ true
+ ).
+
+:- pred fill_in_alternating_pattern(byte_index::in, num_bytes::in, byte::in,
+ tbitmap::tbitmap_di, tbitmap::tbitmap_uo) is det.
+
+fill_in_alternating_pattern(Index, NumBytes, Pattern, !BM) :-
+ ( Index >= NumBytes ->
+ true
+ ;
+ ( Index rem 2 = 0 ->
+ BytePattern = Pattern
+ ;
+ BytePattern = \Pattern
+ ),
+ !:BM = !.BM ^ byte(Index) := BytePattern,
+ fill_in_alternating_pattern(Index + 1, NumBytes, Pattern, !BM)
+ ).
+
+:- pred write_binary_string(word::in, io::di, io::uo) is det.
+
+write_binary_string(Int, !IO) :-
+ io.write_string(binary_string(Int), !IO).
+
+:- func binary_string(word) = string.
+
+binary_string(Int) = string.int_to_base_string(Int, 2).
+
+:- pred write_bitmap_result_error(bitmap_result_error::in,
+ io::di, io::uo) is det.
+
+write_bitmap_result_error(query(Op, Input, OtherArgs, Output), !IO) :-
+ io.write_string("Error in `", !IO),
+ io.write_string(Op, !IO),
+ io.write_string("(", !IO),
+ io.write(OtherArgs, !IO),
+ io.write_string(")'\ninput bitmap: ", !IO),
+ io.write_string(to_byte_string(Input), !IO),
+ io.nl(!IO),
+ io.write_string("output = ", !IO),
+ io.write(Output ^ fst, !IO),
+ io.nl(!IO),
+ io.write_string("expected output = ", !IO),
+ io.write(Output ^ snd, !IO),
+ io.nl(!IO).
+
+write_bitmap_result_error(binary_query(Op, Input1, Input2, OtherArgs, Output),
+ !IO) :-
+ io.write_string("Error in `", !IO),
+ io.write_string(Op, !IO),
+ io.write_string("(", !IO),
+ io.write(OtherArgs, !IO),
+ io.write_string(")'\ninput bitmap 1: ", !IO),
+ io.write_string(to_byte_string(Input1), !IO),
+ io.write_string("\ninput bitmap 2: ", !IO),
+ io.write_string(to_byte_string(Input2), !IO),
+ io.nl(!IO),
+ io.write_string("output = ", !IO),
+ io.write(Output ^ fst, !IO),
+ io.nl(!IO),
+ io.write_string("expected output = ", !IO),
+ io.write(Output ^ snd, !IO),
+ io.nl(!IO).
+
+write_bitmap_result_error(one_argument(Op, Input, OtherArgs, Output), !IO) :-
+ io.write_string("Error in `", !IO),
+ io.write_string(Op, !IO),
+ io.write_string("(", !IO),
+ io.write(OtherArgs, !IO),
+ io.write_string(")'\ninput bitmap: ", !IO),
+ io.write_string(to_byte_string(Input), !IO),
+ io.nl(!IO),
+ io.write_string("output = ", !IO),
+ io.write_string(to_byte_string(Output ^ fst), !IO),
+ io.nl(!IO),
+ io.write_string("expected output = ", !IO),
+ io.write_string(to_byte_string(Output ^ snd), !IO),
+ io.nl(!IO).
+
+write_bitmap_result_error(two_arguments(Op, Input1, Input2, OtherArgs, Output),
+ !IO) :-
+ io.write_string("Error in `", !IO),
+ io.write_string(Op, !IO),
+ io.write_string("(", !IO),
+ io.write(OtherArgs, !IO),
+ io.write_string(")'\ninput bitmap 1: ", !IO),
+ io.write_string(to_byte_string(Input1), !IO),
+ io.nl(!IO),
+ io.write_string("\ninput bitmap 2: ", !IO),
+ io.write_string(to_byte_string(Input2), !IO),
+ io.nl(!IO),
+ io.write_string("output = ", !IO),
+ io.write_string(to_byte_string(Output ^ fst), !IO),
+ io.nl(!IO),
+ io.write_string("expected output = ", !IO),
+ io.write_string(to_byte_string(Output ^ snd), !IO),
+ io.nl(!IO).
+
Index: tests/hard_coded/bitmap_tester.m
===================================================================
RCS file: tests/hard_coded/bitmap_tester.m
diff -N tests/hard_coded/bitmap_tester.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/bitmap_tester.m 10 Feb 2007 11:20:57 -0000
@@ -0,0 +1,443 @@
+%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ft=mercury
+%
+% Test bitmaps by checking the output against a simpler implementation.
+:- module bitmap_tester.
+
+:- interface.
+
+:- import_module bitmap.
+:- import_module bitmap_simple.
+:- import_module bool.
+
+%-----------------------------------------------------------------------------%
+
+:- type mypair(T, U) ---> (fst::T) - (snd::U).
+:- type tbitmap == mypair(bitmap, sbitmap).
+
+:- inst tbitmap == bound(bitmap - sbitmap).
+:- inst uniq_tbitmap == tbitmap. % XXX should be unique
+:- mode tbitmap_di == in(uniq_tbitmap). % XXX should be di
+:- mode tbitmap_uo == out(uniq_tbitmap).
+:- mode tbitmap_ui == in(uniq_tbitmap).
+
+:- type bitmap_result_error
+ ---> some [OtherArgs] one_argument(string, sbitmap, OtherArgs, tbitmap)
+ ; some [OtherArgs] two_arguments(string, sbitmap, sbitmap,
+ OtherArgs, tbitmap)
+ ; some [OtherArgs, Result] query(string, sbitmap, OtherArgs,
+ mypair(Result, Result))
+ ; some [OtherArgs, Result] binary_query(string, sbitmap, sbitmap,
+ OtherArgs, mypair(Result, Result))
+ .
+
+:- type bitmap_verify_error
+ ---> bitmap_verify_error(bitmap, bitmap_verify_error_type).
+
+:- type bitmap_verify_error_type
+ ---> hash
+ ; trailing_bits_not_empty
+ ; to_string(string, string)
+ .
+
+%-----------------------------------------------------------------------------%
+
+ % 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(num_bits, bool) = tbitmap.
+:- mode new(in, in) = tbitmap_uo is det.
+
+ % Create a new copy of a bitmap.
+ %
+:- func copy(tbitmap) = tbitmap.
+%:- mode copy(tbitmap_ui) = tbitmap_uo is det.
+:- mode copy(in) = tbitmap_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(tbitmap, num_bits, bool) = tbitmap.
+:- mode resize(tbitmap_di, in, in) = tbitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Get or set the given bit.
+ % The unsafe versions do not check whether the bit is in range.
+ %
+:- func bit(bit_index, tbitmap) = bool.
+%:- mode bit(in, tbitmap_ui) = out is det.
+:- mode bit(in, in) = out is det.
+
+:- func 'bit :='(bit_index, tbitmap, bool) = tbitmap.
+:- mode 'bit :='(in, tbitmap_di, in) = tbitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Bitmap ^ bits(OffSet, NumBits) = Word.
+ % The low order bits of Word contain the NumBits bits of BM
+ % starting at OffSet.
+ % NumBits must be less than int.bits_per_int.
+ %
+:- func bits(bit_index, num_bits, tbitmap) = word.
+%:- mode bits(in, in, tbitmap_ui) = out is det.
+:- mode bits(in, in, in) = out is det.
+
+:- func 'bits :='(bit_index, num_bits, tbitmap, word) = tbitmap.
+:- mode 'bits :='(in, in, tbitmap_di, in) = tbitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+:- func byte(int, tbitmap) = int.
+%:- mode byte(in, tbitmap_ui) = out is det.
+:- mode byte(in, in) = out is det.
+
+:- func 'byte :='(int, tbitmap, int) = tbitmap.
+:- mode 'byte :='(in, tbitmap_di, in) = tbitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Flip the given bit.
+ %
+:- func flip(tbitmap, bit_index) = tbitmap.
+:- mode flip(tbitmap_di, in) = tbitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Set operations; for binary operations the second argument is altered
+ % in all cases. The input bitmaps must have the same size.
+ %
+
+:- func complement(tbitmap) = tbitmap.
+:- mode complement(tbitmap_di) = tbitmap_uo is det.
+
+:- func union(tbitmap, tbitmap) = tbitmap.
+%:- mode union(tbitmap_ui, tbitmap_di) = tbitmap_uo is det.
+:- mode union(in, tbitmap_di) = tbitmap_uo is det.
+
+:- func intersect(tbitmap, tbitmap) = tbitmap.
+%:- mode intersect(tbitmap_ui, tbitmap_di) = tbitmap_uo is det.
+:- mode intersect(in, tbitmap_di) = tbitmap_uo is det.
+
+:- func difference(tbitmap, tbitmap) = tbitmap.
+%:- mode difference(tbitmap_ui, tbitmap_di) = tbitmap_uo is det.
+:- mode difference(in, tbitmap_di) = tbitmap_uo is det.
+
+:- func xor(tbitmap, tbitmap) = tbitmap.
+%:- mode xor(tbitmap_ui, tbitmap_di) = tbitmap_uo is det.
+:- mode xor(in, tbitmap_di) = tbitmap_uo is det.
+
+%-----------------------------------------------------------------------------%
+
+ % 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(tbitmap, bit_index, tbitmap, bit_index, num_bits) = tbitmap.
+%:- mode copy_bits(tbitmap_ui, in, tbitmap_di, in, in) = tbitmap_uo is det.
+:- mode copy_bits(in, in, tbitmap_di, in, in) = tbitmap_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(tbitmap, bit_index, bit_index, num_bits) = tbitmap.
+:- mode copy_bits_in_bitmap(tbitmap_di, in, in, in) = tbitmap_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(tbitmap, byte_index, tbitmap, byte_index,
+ num_bytes) = tbitmap.
+%:- mode copy_bytes(tbitmap_ui, in, tbitmap_di, in, in) = tbitmap_uo is det.
+:- mode copy_bytes(in, in, tbitmap_di, in, in) = tbitmap_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(tbitmap, byte_index, byte_index,
+ num_bytes) = tbitmap.
+:- mode copy_bytes_in_bitmap(tbitmap_di, in, in, in) = tbitmap_uo is det.
+
+:- func to_byte_string(tbitmap) = string.
+%:- mode to_byte_string(tbitmap_ui) = out is det.
+:- mode to_byte_string(in) = out is det.
+
+:- func ordering(tbitmap, tbitmap) = comparison_result.
+
+:- func test_unify(tbitmap, tbitmap) = bool.
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module char.
+:- import_module deconstruct.
+:- import_module enum.
+:- import_module exception.
+:- import_module int.
+:- import_module list.
+:- import_module require.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+new(N, B) = new(N, B) - new(N, B).
+
+%-----------------------------------------------------------------------------%
+
+resize(BM, NewSize, InitializerBit) =
+ check("resize", BM, {NewSize, InitializerBit},
+ resize(BM ^ fst, NewSize, InitializerBit)
+ - resize(BM ^ snd, NewSize, InitializerBit)).
+
+copy(BM) =
+ check("copy", BM, {}, copy(BM ^ fst) - copy(BM ^ snd)).
+
+%-----------------------------------------------------------------------------%
+
+bit(I, BM) =
+ check_query("bit", BM, I, BM ^ fst ^ bit(I) - BM ^ snd ^ bit(I)).
+
+'bit :='(I, BM, B) =
+ check("bit :=", BM, {I, B},
+ (BM ^ fst ^ bit(I) := B)
+ ^ snd ^ bit(I) := B).
+
+%-----------------------------------------------------------------------------%
+
+bits(FirstBit, NumBits, BM) =
+ check_query("bits", BM, {FirstBit, NumBits},
+ BM ^ fst ^ bits(FirstBit, NumBits) -
+ BM ^ snd ^ bits(FirstBit, NumBits)).
+
+'bits :='(FirstBit, NumBits, BM, Bits) =
+ check("bits :=", BM, {FirstBit, NumBits},
+ (BM ^ fst ^ bits(FirstBit, NumBits) := Bits)
+ ^ snd ^ bits(FirstBit, NumBits) := Bits).
+
+%-----------------------------------------------------------------------------%
+
+byte(I, BM) =
+ check_query("byte", BM, I, BM ^ fst ^ byte(I) - BM ^ snd ^ byte(I)).
+
+'byte :='(I, BM, B) =
+ check("byte :=", BM, {I, B},
+ (BM ^ fst ^ byte(I) := B)
+ ^ snd ^ byte(I) := B).
+
+%-----------------------------------------------------------------------------%
+
+flip(BM, I) =
+ check("bits :=", BM, I, flip(BM ^ fst, I) - flip(BM ^ snd, I)).
+
+%-----------------------------------------------------------------------------%
+
+complement(BM) =
+ check("complement", BM, {}, complement(BM ^ fst) - complement(BM ^ snd)).
+
+%-----------------------------------------------------------------------------%
+
+union(BMa, BMb) =
+ check2("union", BMa, BMb, {},
+ union(BMa ^ fst, BMb ^ fst)
+ - union(BMa ^ snd, BMb ^ snd)).
+
+%-----------------------------------------------------------------------------%
+
+intersect(BMa, BMb) =
+ check2("intersect", BMa, BMb, {},
+ intersect(BMa ^ fst, BMb ^ fst)
+ - intersect(BMa ^ snd, BMb ^ snd)).
+
+%-----------------------------------------------------------------------------%
+
+difference(BMa, BMb) =
+ check2("difference", BMa, BMb, {},
+ difference(BMa ^ fst, BMb ^ fst)
+ - difference(BMa ^ snd, BMb ^ snd)).
+
+%-----------------------------------------------------------------------------%
+
+xor(BMa, BMb) =
+ check2("xor", BMa, BMb, {},
+ xor(BMa ^ fst, BMb ^ fst)
+ - xor(BMa ^ snd, BMb ^ snd)).
+
+%-----------------------------------------------------------------------------%
+
+copy_bits(SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits) =
+ check2("copy_bits", SrcBM, DestBM, {SrcStartBit, DestStartBit, NumBits},
+ copy_bits(SrcBM ^ fst, SrcStartBit,
+ DestBM ^ fst, DestStartBit, NumBits) -
+ copy_bits(SrcBM ^ snd, SrcStartBit,
+ DestBM ^ snd, DestStartBit, NumBits)).
+
+copy_bits_in_bitmap(SrcBM, SrcStartBit, DestStartBit, NumBits) =
+ check("copy_bits_in_bitmap", SrcBM, {SrcStartBit, DestStartBit, NumBits},
+ copy_bits_in_bitmap(SrcBM ^ fst, SrcStartBit, DestStartBit, NumBits) -
+ copy_bits_in_bitmap(SrcBM ^ snd, SrcStartBit, DestStartBit, NumBits)).
+
+copy_bytes(SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes) =
+ check2("copy_bytes", SrcBM, DestBM,
+ {SrcStartByte, DestStartByte, NumBytes},
+ copy_bytes(SrcBM ^ fst, SrcStartByte,
+ DestBM ^ fst, DestStartByte, NumBytes) -
+ copy_bytes(SrcBM ^ snd, SrcStartByte,
+ DestBM ^ snd, DestStartByte, NumBytes)).
+
+copy_bytes_in_bitmap(SrcBM, SrcStartByte, DestStartByte, NumBytes) =
+ check("copy_bytes_in_bitmap", SrcBM,
+ {SrcStartByte, DestStartByte, NumBytes},
+ copy_bytes_in_bitmap(SrcBM ^ fst, SrcStartByte,
+ DestStartByte, NumBytes) -
+ copy_bytes_in_bitmap(SrcBM ^ snd, SrcStartByte,
+ DestStartByte, NumBytes)).
+
+%-----------------------------------------------------------------------------%
+
+ordering(BM1, BM2) =
+ check_query2("ordering", BM1, BM2, {},
+ builtin.ordering(BM1 ^ fst, BM2 ^ fst) -
+ builtin.ordering(BM1 ^ snd, BM2 ^ snd)).
+
+test_unify(BM1, BM2) =
+ check_query2("test_unify", BM1, BM2, {},
+ pred_to_bool(unify(BM1 ^ fst, BM2 ^ fst)) -
+ pred_to_bool(unify(BM1 ^ snd, BM2 ^ snd))).
+
+%-----------------------------------------------------------------------------%
+
+:- func check(string, tbitmap, OtherArgs, tbitmap) = tbitmap.
+%:- mode check(in, tbitmap_ui, in, tbitmap_di) = tbitmap_uo is det.
+:- mode check(in, in, in, tbitmap_di) = tbitmap_uo is det.
+
+check(Op, Tester0, OtherArgs, Tester) = Tester :-
+ Tester = BM - SBM,
+ BMArray = to_sbitmap(BM),
+ ( verify(BM), BMArray = SBM ->
+ true
+ ;
+ throw('new one_argument'(Op, Tester0 ^ snd, OtherArgs, Tester))
+ ).
+
+:- func check2(string, tbitmap, tbitmap, OtherArgs, tbitmap) = tbitmap.
+%:- mode check2(in, tbitmap_ui, tbitmap_ui, in, tbitmap_di) = tbitmap_uo is det.
+:- mode check2(in, in, in, in, tbitmap_di) = tbitmap_uo is det.
+
+check2(Op, Tester1, Tester2, OtherArgs, Tester) = Result :-
+ Tester = BM - SBM,
+ BMArray = to_sbitmap(BM),
+ ( verify(BM), SBM = BMArray ->
+ Result = Tester
+ ;
+ throw('new two_arguments'(Op, Tester1 ^ snd, Tester2 ^ snd,
+ OtherArgs, Tester))
+ ).
+
+:- func check_query(string, tbitmap, OtherArgs, mypair(T, T)) = T.
+%:- mode check_query(in, tbitmap_ui, in, in) = out is det.
+:- mode check_query(in, in, in, in) = out is det.
+
+check_query(Op, Tester1, OtherArgs, Res) = TheRes :-
+ Res = Res1 - Res2,
+ ( Res1 = Res2 ->
+ TheRes = Res1
+ ;
+ throw('new query'(Op, Tester1 ^ snd, OtherArgs, Res))
+ ).
+
+:- func check_query2(string, tbitmap, tbitmap,
+ OtherArgs, mypair(T, T)) = T.
+%:- mode check_query2(in, tbitmap_ui, tbitmap_ui, in, in) = out is det.
+:- mode check_query2(in, in, in, in, in) = out is det.
+
+check_query2(Op, Tester1, Tester2, OtherArgs, Res) = TheRes :-
+ Res = Res1 - Res2,
+ ( Res1 = Res2 ->
+ TheRes = Res1
+ ;
+ throw('new binary_query'(Op, Tester1 ^ snd, Tester2 ^ snd,
+ OtherArgs, Res))
+ ).
+
+:- func to_sbitmap(bitmap) = sbitmap.
+%:- mode to_sbitmap(bitmap_ui) = sbitmap_uo.
+:- mode to_sbitmap(in) = sbitmap_uo.
+
+to_sbitmap(BM) =
+ to_sbitmap_2(0, BM ^ num_bits, BM, new(BM ^ num_bits, no)).
+
+:- func to_sbitmap_2(int, int, bitmap, sbitmap) = sbitmap.
+%:- mode to_sbitmap_2(in, in, bitmap_ui, sbitmap_di) = sbitmap_uo.
+:- mode to_sbitmap_2(in, in, in, sbitmap_di) = sbitmap_uo.
+
+to_sbitmap_2(Index, NumBits, BM, SBM) =
+ ( Index < NumBits ->
+ to_sbitmap_2(Index + 1, NumBits, BM,
+ SBM ^ bit(Index) := BM ^ bit(Index))
+ ;
+ SBM
+ ).
+
+to_byte_string(BM) = to_byte_string(BM ^ fst).
+
+ % At each step we check that the output bitmap can be converted to
+ % and from a string, and that the hash produced by the Mercury code
+ % in bitmap.m matches that produced by the C code in mercury_bitmap.h.
+ % We also check that any trailing bits in the final byte are empty.
+:- pred verify(bitmap).
+%:- mode verify(bitmap_ui) is semidet.
+:- mode verify(in) is semidet.
+
+verify(BM) :-
+ % functor/4 uses MR_bitmap_to_string in runtime/mercury_bitmap.h.
+ functor(BM, do_not_allow, Functor, _Arity),
+ Str = bitmap.to_string(BM),
+ (
+ Functor = "\"" ++ Str ++ "\"",
+ BM = bitmap.from_string(Str)
+ ->
+ semidet_succeed
+ ;
+ throw(bitmap_verify_error(BM, to_string(Functor, Str)))
+ ),
+ ( bitmap.hash(BM) = foreign_hash(BM) ->
+ semidet_succeed
+ ;
+ throw(bitmap_verify_error(BM, hash))
+ ),
+ NumBits = BM ^ num_bits,
+ BitsInLastByte = NumBits `rem` bitmap.bits_per_byte,
+ ( BitsInLastByte = 0 ->
+ true
+ ; 0 = BM ^ unsafe_bits(NumBits, bitmap.bits_per_byte - BitsInLastByte) ->
+ true
+ ;
+ throw(bitmap_verify_error(BM, trailing_bits_not_empty))
+ ).
+
+:- pragma foreign_decl("C", "#include ""mercury_bitmap.h""").
+
+:- func foreign_hash(bitmap) = int.
+%:- mode foreign_hash(bitmap_ui) = out is det.
+:- mode foreign_hash(in) = out is det.
+:- pragma promise_pure(foreign_hash/1).
+
+foreign_hash(BM) = bitmap.hash(BM).
+
+:- pragma foreign_proc("C",
+ foreign_hash(BM::in) = (Hash::out),
+ [will_not_call_mercury, promise_pure],
+ "Hash = MR_hash_bitmap(BM);"
+).
+
Index: tests/hard_coded/version_array_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/version_array_test.exp,v
retrieving revision 1.1
diff -u -u -r1.1 version_array_test.exp
--- tests/hard_coded/version_array_test.exp 8 Oct 2004 07:01:29 -0000 1.1
+++ tests/hard_coded/version_array_test.exp 10 Feb 2007 15:00:39 -0000
@@ -1,3 +1,7 @@
+ordering(A1, A0) = '>'
+ordering(A0, A1) = '<'
+ordering(A1, A2) = '<'
+ordering(A2, A1) = '>'
(size 0)
0, 1, 2, 3, 4, 5, 6, 7, 8, 9 (size 10)
9, 8, 7, 6, 5, 4, 3, 2, 1, 0 (size 10)
Index: tests/hard_coded/version_array_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/version_array_test.m,v
retrieving revision 1.1
diff -u -u -r1.1 version_array_test.m
--- tests/hard_coded/version_array_test.m 8 Oct 2004 07:01:29 -0000 1.1
+++ tests/hard_coded/version_array_test.m 8 Feb 2007 12:18:04 -0000
@@ -29,6 +29,18 @@
A0 = version_array.empty,
A1 = version_array(0`..`9),
A2 = int.fold_up(func(I, A) = ( A ^ elem(I) := 9 - I ), 0, 9, A1),
+ io.write_string("ordering(A1, A0) = ", !IO),
+ io.write(ordering(A1, A0), !IO),
+ io.nl(!IO),
+ io.write_string("ordering(A0, A1) = ", !IO),
+ io.write(ordering(A0, A1), !IO),
+ io.nl(!IO),
+ io.write_string("ordering(A1, A2) = ", !IO),
+ io.write(ordering(A1, A2), !IO),
+ io.nl(!IO),
+ io.write_string("ordering(A2, A1) = ", !IO),
+ io.write(ordering(A2, A1), !IO),
+ io.nl(!IO),
io.write_list(to_list(A0), ", ", io.write_int, !IO),
io.format(" (size %d)\n", [i(size(A0))], !IO),
io.write_list(to_list(A1), ", ", io.write_int, !IO),
Index: tests/tabling/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/Mmakefile,v
retrieving revision 1.41
diff -u -u -r1.41 Mmakefile
--- tests/tabling/Mmakefile 8 Mar 2006 13:24:39 -0000 1.41
+++ tests/tabling/Mmakefile 10 Feb 2007 11:22:33 -0000
@@ -7,6 +7,7 @@
SIMPLE_NONLOOP_PROGS = \
boyer \
expand \
+ expand_bitmap \
expand_float \
expand_poly \
expand_tuple \
Index: tests/tabling/expand_bitmap.exp
===================================================================
RCS file: tests/tabling/expand_bitmap.exp
diff -N tests/tabling/expand_bitmap.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/expand_bitmap.exp 10 Feb 2007 11:25:17 -0000
@@ -0,0 +1,2 @@
+First test successful.
+Second test successful.
Index: tests/tabling/expand_bitmap.m
===================================================================
RCS file: tests/tabling/expand_bitmap.m
diff -N tests/tabling/expand_bitmap.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/expand_bitmap.m 10 Feb 2007 11:25:17 -0000
@@ -0,0 +1,84 @@
+% A test case to exercise the code for expanding hash tables,
+% and for tabling bitmaps.
+
+:- module expand_bitmap.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module bitmap, bool, int, list, std_util, random, require.
+
+:- type record(T1, T2) ---> record(T1, T1, T2).
+
+main(!IO) :-
+ random__init(0, RS0),
+ random__permutation(range(0, 1023), Perm, RS0, RS1),
+
+ BM1 = bitmap.new(45, yes) ^ bits(20, 8) := 0b10001001,
+ BM2 = bitmap.new(123, no) ^ bits(10, 8) := 0b10101010,
+ choose_signs_and_enter(Perm, BM1, Solns1, RS1, RS2),
+ ( test_tables(Solns1, yes) ->
+ io__write_string("First test successful.\n", !IO)
+ ;
+ io__write_string("First test unsuccessful.\n", !IO)
+ ),
+ choose_signs_and_enter(Perm, BM2, Solns2, RS2, _RS),
+ ( test_tables(Solns2, yes) ->
+ io__write_string("Second test successful.\n", !IO)
+ ;
+ io__write_string("Second test unsuccessful.\n", !IO)
+ ).
+ % io__report_tabling_stats(!IO).
+
+:- func range(int, int) = list(int).
+
+range(Min, Max) =
+ (if Min > Max then
+ []
+ else
+ [Min | range(Min + 1, Max)]
+ ).
+
+:- pred choose_signs_and_enter(list(int)::in, T::in, list(record(int, T))::out,
+ random__supply::mdi, random__supply::muo) is det.
+
+choose_signs_and_enter([], _, [], RS, RS).
+choose_signs_and_enter([N | Ns], A, [record(F, S, A) | ISs], RS0, RS) :-
+ random__random(Random, RS0, RS1),
+ ( Random mod 2 = 0 ->
+ F = N
+ ;
+ F = 0 - N
+ ),
+ sum(F, A, S),
+ choose_signs_and_enter(Ns, A, ISs, RS1, RS).
+
+:- pred test_tables(list(record(int, T))::in, bool::out) is det.
+
+test_tables([], yes).
+test_tables([record(I, S0, A) | Is], Correct) :-
+ sum(I, A, S1),
+ ( S0 = S1 ->
+ test_tables(Is, Correct)
+ ;
+ Correct = no
+ ).
+
+:- pred sum(int::in, T::in, int::out) is det.
+:- pragma memo(sum/3).
+
+sum(N, A, F) :-
+ ( N < 0 ->
+ sum(0 - N, A, NF),
+ F = 0 - NF
+ ; N = 1 ->
+ F = 1
+ ;
+ sum(N - 1, A, F1),
+ F = N + F1
+ ).
--------------------------------------------------------------------------
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