[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