mercury/library/bitmap.m

%-----------------------------------------------------------------------------%
% vim: ts=4 sw=4 et tw=0 wm=0 ft=mercury
%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2002, 2004-2007 The University of Melbourne
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%-----------------------------------------------------------------------------%
% 
% File: bitmap.m.
% Main author: rafe, stayl.
% Stability: low.
% 
% Efficient bitmap implementation.
%
% CAVEAT: the user is referred to the documentation in the header
% of array.m regarding programming with unique objects (the compiler
% does not currently recognise them, hence we are forced to use
% non-unique modes until the situation is rectified; this places
% a small burden on the programmer to ensure the correctness of his
% code that would otherwise be assured by the compiler.)
% 
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- module bitmap.
:- interface.

:- import_module bool.
:- import_module list.

%-----------------------------------------------------------------------------%

    % Type `bitmap' is equivalent to `array(bool)', but is implemented much
    % more efficiently.  Accessing bitmaps as if they are an array of
    % eight bit bytes is especially efficient.
    %
    % See runtime/mercury_types.h for the definition of MR_BitmapPtr for
    % use in foreign code.
    %
    % Comparison of bitmaps first compares the size, if the size is equal
    % then each bit in turn is compared starting from bit zero.
    %
:- type bitmap.

:- inst bitmap == ground.
:- inst uniq_bitmap == bitmap.  % XXX should be unique
:- mode bitmap_di == in(uniq_bitmap). % XXX should be di
:- mode bitmap_uo == out(uniq_bitmap).
:- mode bitmap_ui == in(uniq_bitmap).

    % The exception thrown for any error.
    %
:- type bitmap_error
    --->    bitmap_error(string).

%-----------------------------------------------------------------------------%

:- type bit_index == int.
:- type byte_index == int.
:- type num_bits == int.
:- type num_bytes == int.
  
    % 8 bits stored in the least significant bits of the integer.
    %
:- type byte == int.

    % An integer interpreted as a vector of int.bits_per_int bits.
    %
:- type word == int.

%-----------------------------------------------------------------------------%

    % new(N, B) creates a bitmap of size N (indexed 0 .. N-1)
    % setting each bit if B = yes and clearing each bit if B = no.
    % An exception is thrown if N is negative.
    %
:- func new(num_bits, bool) = bitmap.
:- mode new(in, in) = bitmap_uo is det.

    % Same as new(N, no).
    %
:- func new(num_bits) = bitmap.
:- mode new(in) = bitmap_uo is det.

    % Create a new copy of a bitmap.
    %
:- func copy(bitmap) = bitmap.
%:- mode copy(bitmap_ui) = bitmap_uo is det.
:- mode copy(in) = bitmap_uo is det.

    % resize(BM, N, B) resizes bitmap BM to have N bits; if N is
    % smaller than the current number of bits in BM then the excess
    % are discarded.  If N is larger than the current number of bits
    % in BM then the new bits are set if B = yes and cleared if
    % B = no.
    %
:- func resize(bitmap, num_bits, bool) = bitmap.
:- mode resize(bitmap_di, in, in) = bitmap_uo is det.

    % Shrink a bitmap without copying it into a smaller memory allocation.
    %
:- func shrink_without_copying(bitmap, num_bits) = bitmap.
:- mode shrink_without_copying(bitmap_di, in) = bitmap_uo is det.

    % Is the given bit number in range.
    %
:- pred in_range(bitmap, bit_index).
%:- mode in_range(bitmap_ui, in) is semidet.
:- mode in_range(in, in) is semidet.

    % Is the given byte number in range.
    %
:- pred byte_in_range(bitmap, byte_index).
%:- mode byte_in_range(bitmap_ui, in) is semidet.
:- mode byte_in_range(in, in) is semidet.

    % Returns the number of bits in a bitmap.
    %
:- func num_bits(bitmap) = num_bits.
%:- mode num_bits(bitmap_ui) = out is det.
:- mode num_bits(in) = out is det.

    % Returns the number of bytes in a bitmap, failing if the bitmap
    % has a partial final byte.
    %
:- func num_bytes(bitmap) = num_bytes.
%:- mode num_bytes(bitmap_ui) = out is semidet.
:- mode num_bytes(in) = out is semidet.

    % As above, but throw an exception if the bitmap has a partial final byte.
    %
:- func det_num_bytes(bitmap) = num_bytes.
%:- mode det_num_bytes(bitmap_ui) = out is det.
:- mode det_num_bytes(in) = out is det.

    % Return the number of bits in a byte (always 8).
    %
:- func bits_per_byte = int.

%-----------------------------------------------------------------------------%

    %
    % Get or set the given bit.
    % The unsafe versions do not check whether the bit is in range.
    %

:- func bitmap      ^ bit(bit_index)    = bool.
%:- mode bitmap_ui  ^ bit(in)           = out is det.
:- mode in          ^ bit(in)           = out is det.

:- func bitmap      ^ unsafe_bit(bit_index) = bool.
%:- mode bitmap_ui  ^ unsafe_bit(in)        = out is det.
:- mode in          ^ unsafe_bit(in)        = out is det.

:- func (bitmap     ^ bit(bit_index)    := bool)    = bitmap.
:- mode (bitmap_di  ^ bit(in)           := in)      = bitmap_uo is det.

:- func (bitmap     ^ unsafe_bit(bit_index) := bool) = bitmap.
:- mode (bitmap_di  ^ unsafe_bit(in)        := in)   = bitmap_uo is det.

%-----------------------------------------------------------------------------%

    %
    % Bitmap ^ bits(OffSet, NumBits) = Word.
    % The low order bits of Word contain the NumBits bits of BitMap
    % starting at OffSet.
    % 0 =< NumBits =< int.bits_per_int.
    %

:- func bitmap      ^ bits(bit_index, num_bits) = word.
%:- mode bitmap_ui  ^ bits(in, in)              = out is det.
:- mode in          ^ bits(in, in)              = out is det.

:- func bitmap      ^ unsafe_bits(bit_index, num_bits)  = word.
%:- mode bitmap_ui  ^ unsafe_bits(in, in)               = out is det.
:- mode in          ^ unsafe_bits(in, in)               = out is det.

:- func (bitmap     ^ bits(bit_index, num_bits) := word) = bitmap.
:- mode (bitmap_di  ^ bits(in, in)              := in)   = bitmap_uo is det.

:- func (bitmap     ^ unsafe_bits(bit_index, num_bits) := word) = bitmap.
:- mode (bitmap_di  ^ unsafe_bits(in, in)              := in)   = bitmap_uo
    is det.

%-----------------------------------------------------------------------------%

    %
    % BM ^ byte(ByteNumber)
    % Get or set the given numbered byte (multiply ByteNumber by
    % bits_per_byte to get the bit index of the start of the byte).
    %
    % The bits are stored in or taken from the least significant bits
    % of the integer.
    % The unsafe versions do not check whether the byte is in range.
    %

:- func bitmap      ^ byte(byte_index) = byte.
%:- mode bitmap_ui  ^ byte(in) = out is det.
:- mode in          ^ byte(in) = out is det.

:- func bitmap      ^ unsafe_byte(byte_index)   = byte.
%:- mode bitmap_ui  ^ unsafe_byte(in)           = out is det.
:- mode in          ^ unsafe_byte(in)           = out is det.

:- func (bitmap     ^ byte(byte_index)  := byte) = bitmap.
:- mode (bitmap_di  ^ byte(in)          := in)   = bitmap_uo is det.

:- func (bitmap     ^ unsafe_byte(byte_index)   := byte) = bitmap.
:- mode (bitmap_di  ^ unsafe_byte(in)           := in)   = bitmap_uo is det.

%-----------------------------------------------------------------------------%

    % Slice = bitmap.slice(BM, StartIndex, NumBits)
    %
    % A bitmap slice represents the sub-range of a bitmap of NumBits bits
    % starting at bit index StartIndex.  Throws an exception if the slice
    % is not within the bounds of the bitmap.
    %
:- type bitmap.slice.
:- func bitmap.slice(bitmap, bit_index, num_bits) = bitmap.slice.

    % As above, but use byte indices.
    %
:- func bitmap.byte_slice(bitmap, byte_index, num_bytes) = bitmap.slice.

    % Access functions for slices.
    % 
:- func slice ^ slice_bitmap = bitmap.
:- func slice ^ slice_start_bit_index = bit_index.
:- func slice ^ slice_num_bits = num_bits.

    % As above, but return byte indices, throwing an exception if
    % the slice doesn't start and end on a byte boundary.
    %
:- func slice ^ slice_start_byte_index = byte_index.
:- func slice ^ slice_num_bytes = num_bytes.

%-----------------------------------------------------------------------------%

    % Flip the given bit.
    %
:- func flip(bitmap, bit_index) = bitmap.
:- mode flip(bitmap_di, in) = bitmap_uo is det.

:- func unsafe_flip(bitmap, bit_index) = bitmap.
:- mode unsafe_flip(bitmap_di, in) = bitmap_uo is det.

%-----------------------------------------------------------------------------%

    %
    % Set operations; for binary operations the second argument is altered
    % in all cases.  The input bitmaps must have the same size.
    %

:- func complement(bitmap) = bitmap.
:- mode complement(bitmap_di) = bitmap_uo is det.

:- func union(bitmap, bitmap) = bitmap.
%:- mode union(bitmap_ui, bitmap_di) = bitmap_uo is det.
:- mode union(in, bitmap_di) = bitmap_uo is det.

:- func intersect(bitmap, bitmap) = bitmap.
%:- mode intersect(bitmap_ui, bitmap_di) = bitmap_uo is det.
:- mode intersect(in, bitmap_di) = bitmap_uo is det.

:- func difference(bitmap, bitmap) = bitmap.
%:- mode difference(bitmap_ui, bitmap_di) = bitmap_uo is det.
:- mode difference(in, bitmap_di) = bitmap_uo is det.

:- func xor(bitmap, bitmap) = bitmap.
%:- mode xor(bitmap_ui, bitmap_di) = bitmap_uo is det.
:- mode xor(in, bitmap_di) = bitmap_uo is det.

%-----------------------------------------------------------------------------%

    % Condense a list of bitmaps into a single bitmap.
:- func append_list(list(bitmap)) = bitmap.
:- mode append_list(in) = bitmap_uo is det.

%-----------------------------------------------------------------------------%

    %
    % Operations to copy part of a bitmap.
    %

    % copy_bits(SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits)
    %
    % Overwrite NumBits bits in DestBM starting at DestStartBit with
    % the NumBits bits starting at SrcStartBit in SrcBM.
    %
:- func copy_bits(bitmap, bit_index, bitmap, bit_index, num_bits) = bitmap.
%:- mode copy_bits(bitmap_ui, in, bitmap_di, in, in) = bitmap_uo is det.
:- mode copy_bits(in, in, bitmap_di, in, in) = bitmap_uo is det.

    % copy_bits_in_bitmap(BM, SrcStartBit, DestStartBit, NumBits)
    %
    % Overwrite NumBits bits starting at DestStartBit with the NumBits
    % bits starting at SrcStartBit in the same bitmap.
    %
:- func copy_bits_in_bitmap(bitmap, bit_index, bit_index, num_bits) = bitmap.
:- mode copy_bits_in_bitmap(bitmap_di, in, in, in) = bitmap_uo is det.

    % copy_bytes(SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes)
    %
    % Overwrite NumBytes bytes in DestBM starting at DestStartByte with
    % the NumBytes bytes starting at SrcStartByte in SrcBM.
    %
:- func copy_bytes(bitmap, byte_index, bitmap, byte_index, num_bytes) = bitmap.
%:- mode copy_bytes(bitmap_ui, in, bitmap_di, in, in) = bitmap_uo is det.
:- mode copy_bytes(in, in, bitmap_di, in, in) = bitmap_uo is det.

    % copy_bytes_in_bitmap(BM, SrcStartByte, DestStartByte, NumBytes)
    %
    % Overwrite NumBytes bytes starting at DestStartByte with the NumBytes
    % bytes starting at SrcStartByte in the same bitmap.
    %
:- func copy_bytes_in_bitmap(bitmap, byte_index,
    byte_index, num_bytes) = bitmap.
:- mode copy_bytes_in_bitmap(bitmap_di, in, in, in) = bitmap_uo is det.

%-----------------------------------------------------------------------------%

    % Convert a bitmap to a string of the form "<length:hex digits>",
    % e.g. "<24:10AFBD>".
    %
:- func to_string(bitmap) = string.
%:- mode to_string(bitmap_ui) = out is det.
:- mode to_string(in) = out is det.

    % Convert a string created by to_string back into a bitmap.
    %
:- func from_string(string) = bitmap.
:- mode from_string(in) = bitmap_uo is semidet.

    % Convert a bitmap to a string of `1' and `0' characters, where
    % the bytes are separated by `.'.
    %
:- func to_byte_string(bitmap) = string.
%:- mode to_byte_string(bitmap_ui) = out is det.
:- mode to_byte_string(in) = out is det.

%-----------------------------------------------------------------------------%

    % Compute a hash function for a bitmap.
    %
:- func hash(bitmap) = int.
%:- mode hash(bitmap_ui) = out is det.
:- mode hash(in) = out is det.

%-----------------------------------------------------------------------------%

    %
    % Variations that might be slightly more efficient by not
    % converting bits to bool.
    %

:- func set(bitmap, bit_index) = bitmap.
:- mode set(bitmap_di, in) = bitmap_uo is det.

:- func clear(bitmap, bit_index) = bitmap.
:- mode clear(bitmap_di, in) = bitmap_uo is det.

    % is_set(BM, I) and is_clear(BM, I) succeed iff bit I in BM
    % is set or clear respectively.
    %
:- pred is_set(bitmap, bit_index).
%:- mode is_set(bitmap_ui, in) is semidet.
:- mode is_set(in, in) is semidet.

:- pred is_clear(bitmap, bit_index).
%:- mode is_clear(bitmap_ui, in) is semidet.
:- mode is_clear(in, in) is semidet.

    %
    % Unsafe versions of the above: if the index is out of range
    % then behaviour is undefined and bad things are likely to happen.
    %

:- func unsafe_set(bitmap, bit_index) = bitmap.
:- mode unsafe_set(bitmap_di, in) = bitmap_uo is det.

:- func unsafe_clear(bitmap, bit_index) = bitmap.
:- mode unsafe_clear(bitmap_di, in) = bitmap_uo is det.

:- pred unsafe_set(bit_index, bitmap, bitmap).
:- mode unsafe_set(in, bitmap_di, bitmap_uo) is det.

:- pred unsafe_clear(bit_index, bitmap, bitmap).
:- mode unsafe_clear(in, bitmap_di, bitmap_uo) is det.

:- pred unsafe_flip(bit_index, bitmap, bitmap).
:- mode unsafe_flip(in, bitmap_di, bitmap_uo) is det.

:- pred unsafe_is_set(bitmap, bit_index).
%:- mode unsafe_is_set(bitmap_ui, in) is semidet.
:- mode unsafe_is_set(in, in) is semidet.

:- pred unsafe_is_clear(bitmap, bit_index).
%:- mode unsafe_is_clear(bitmap_ui, in) is semidet.
:- mode unsafe_is_clear(in, in) is semidet.

    %
    % Predicate versions, for use with state variables.
    %

:- pred set(bit_index, bitmap, bitmap).
:- mode set(in, bitmap_di, bitmap_uo) is det.

:- pred clear(bit_index, bitmap, bitmap).
:- mode clear(in, bitmap_di, bitmap_uo) is det.

:- pred flip(bit_index, bitmap, bitmap).
:- mode flip(in, bitmap_di, bitmap_uo) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.
:- interface.

    % Used by io.m.

    % throw_bounds_error(BM, PredName, Index, NumBits)
    %
:- pred throw_bounds_error(bitmap::in, string::in, bit_index::in, num_bits::in)
    is erroneous.

    % Replaced by BM ^ bits(I).

    % get(BM, I) returns `yes' if is_set(BM, I) and `no' otherwise.
    %
:- func get(bitmap, int) = bool.
%:- mode get(bitmap_ui, in) = out is det.
:- mode get(in, in) = out is det.
:- pragma obsolete(get/2).

    % Unsafe version of the above: if the index is out of range
    % then behaviour is undefined and bad things are likely to happen.
    %
:- func unsafe_get(bitmap, int) = bool.
%:- mode unsafe_get(bitmap_ui, in) = out is det.
:- mode unsafe_get(in, in) = out is det.
:- pragma obsolete(unsafe_get/2).

%-----------------------------------------------------------------------------%

:- implementation.

:- import_module char.
:- import_module exception.
:- import_module int.
:- import_module string.

%-----------------------------------------------------------------------------%

new(N) = new(N, no).

new(N, B) = BM :-
    ( if N < 0 then
        throw_bitmap_error("bitmap.new: negative size") = _ : int
      else
        X    = initializer(B),
        BM0  = initialize_bitmap(allocate_bitmap(N), N, X),
        BM   = clear_filler_bits(BM0)
    ).

%-----------------------------------------------------------------------------%

resize(!.BM, NewSize, InitializerBit) = !:BM :-
    ( if NewSize =< 0 then
        !:BM = new(NewSize, InitializerBit)
      else
        OldSize = num_bits(!.BM),
        InitializerByte = initializer(InitializerBit),
        !:BM = resize_bitmap(!.BM, NewSize),
        ( if NewSize > OldSize then
            % Fill in the trailing bits in the previous final byte.
            !:BM = set_trailing_bits_in_byte(!.BM, OldSize - 1,
                        InitializerByte),
            OldLastByteIndex = byte_index_for_bit(OldSize - 1),
            NewLastByteIndex = byte_index_for_bit(NewSize - 1),
            ( if NewLastByteIndex > OldLastByteIndex then
                !:BM = initialize_bitmap_bytes(!.BM, OldLastByteIndex + 1,
                            NewLastByteIndex, InitializerByte)
              else
                true
            )
          else
            true
        ),
        !:BM = clear_filler_bits(!.BM)
    ).

%-----------------------------------------------------------------------------%

shrink_without_copying(!.BM, NewSize) = !:BM :-
    ( if 0 =< NewSize, NewSize =< !.BM ^ num_bits then
        !:BM = !.BM ^ num_bits := NewSize     
      else 
        throw_bounds_error(!.BM,
            "bitmap.shrink_without_copying", NewSize) = _ : int
    ).

%-----------------------------------------------------------------------------%

:- func clear_filler_bits(bitmap) = bitmap.
:- mode clear_filler_bits(bitmap_di) = bitmap_uo is det.

clear_filler_bits(BM) = set_trailing_bits_in_byte(BM, num_bits(BM) - 1, 0).

:- func set_trailing_bits_in_byte(bitmap, bit_index, byte) = bitmap.
:- mode set_trailing_bits_in_byte(bitmap_di, in, in) = bitmap_uo is det.

set_trailing_bits_in_byte(!.BM, Bit, Initializer) = !:BM :-
    FirstTrailingBit = Bit + 1,
    FirstTrailingBitIndex = bit_index_in_byte(FirstTrailingBit),
    ( if FirstTrailingBitIndex \= 0 then
        ByteIndex = byte_index_for_bit(FirstTrailingBit),
        NumBitsToSet = bits_per_byte - FirstTrailingBitIndex,
        !:BM = !.BM ^ unsafe_byte(ByteIndex) :=
                set_bits_in_byte(!.BM ^ unsafe_byte(ByteIndex),
                    FirstTrailingBitIndex, NumBitsToSet, Initializer)
      else
        true
    ).

%-----------------------------------------------------------------------------%

:- func initializer(bool) = byte.

initializer(no)  = 0.
initializer(yes) = \0.

:- func initialize_bitmap(bitmap, num_bits, byte) = bitmap.
:- mode initialize_bitmap(bitmap_di, in, in) = bitmap_uo is det.

initialize_bitmap(Bitmap, N, Init) =
    initialize_bitmap_bytes(Bitmap, 0, byte_index_for_bit(N - 1), Init).

:- func initialize_bitmap_bytes(bitmap, byte_index, byte_index,
    byte) = bitmap.
:- mode initialize_bitmap_bytes(bitmap_di, in, in, in) = bitmap_uo is det.

initialize_bitmap_bytes(BM, ByteIndex, LastByteIndex, Init) =
    ( if ByteIndex > LastByteIndex then
        BM
      else
        initialize_bitmap_bytes(BM ^ unsafe_byte(ByteIndex) := Init,
            ByteIndex + 1, LastByteIndex, Init)
    ).

%-----------------------------------------------------------------------------%

in_range(BM, I) :- 0 =< I, I < num_bits(BM).

byte_in_range(BM, I) :-
    in_range(BM, I * bits_per_byte + bits_per_byte - 1).

%-----------------------------------------------------------------------------%

BM ^ bit(I) =
    ( if in_range(BM, I)
      then BM ^ unsafe_bit(I)
      else throw_bounds_error(BM, "bitmap.bit", I)
    ).

BM ^ unsafe_bit(I) =
    ( if unsafe_is_set(BM, I) then yes else no ).

(BM ^ bit(I) := B) =
    ( if in_range(BM, I)
      then BM ^ unsafe_bit(I) := B
      else throw_bounds_error(BM, "bitmap.'bit :='", I)
    ).

(BM ^ unsafe_bit(I) := yes) = unsafe_set(BM, I).
(BM ^ unsafe_bit(I) := no) = unsafe_clear(BM, I).

%-----------------------------------------------------------------------------%

BM ^ bits(FirstBit, NumBits) =
    ( if
        FirstBit >= 0,
        in_range(BM, FirstBit + NumBits - 1),
        NumBits >= 0,
        NumBits =< int.bits_per_int
      then
        BM ^ unsafe_bits(FirstBit, NumBits)
      else if
        ( NumBits < 0
        ; NumBits > int.bits_per_int
        )
      then
        throw_bitmap_error(
    "bitmap.bits: number of bits must be between 0 and `int.bits_per_int'.")
      else
        throw_bounds_error(BM, "bitmap.bits", FirstBit)
    ).

BM ^ unsafe_bits(FirstBit, NumBits) = Bits :-
    FirstByteIndex = byte_index_for_bit(FirstBit),
    FirstBitIndex = bit_index_in_byte(FirstBit),
    extract_bits_from_bytes(FirstByteIndex, FirstBitIndex,
        NumBits, BM, 0, Bits).

    % Extract the given number of bits starting at the most significant.
:- pred extract_bits_from_bytes(byte_index, bit_index_in_byte, num_bits,
    bitmap, word, word).
%:- mode extract_bits_from_bytes(in, in, in, bitmap_ui, in, out) is det.
:- mode extract_bits_from_bytes(in, in, in, in, in, out) is det.

extract_bits_from_bytes(FirstByteIndex, FirstBitIndex, NumBits, BM, !Bits) :-
    RemainingBitsInByte = bits_per_byte - FirstBitIndex,
    ( if
        NumBits > RemainingBitsInByte
      then
        NumBitsThisByte = RemainingBitsInByte,
        extract_bits_from_byte_index(FirstByteIndex, FirstBitIndex,
            NumBitsThisByte, BM, !Bits),
        extract_bits_from_bytes(FirstByteIndex + 1, 0,
            NumBits - NumBitsThisByte, BM, !Bits)
      else if
        NumBits > 0
      then
        extract_bits_from_byte_index(FirstByteIndex, FirstBitIndex,
            NumBits, BM, !Bits)
      else
        true
    ).

:- pred extract_bits_from_byte_index(byte_index, bit_index_in_byte, num_bits,
    bitmap, word, word).
%:- mode extract_bits_from_byte_index(in, in, in, bitmap_ui, in, out) is det.
:- mode extract_bits_from_byte_index(in, in, in, in, in, out) is det.

extract_bits_from_byte_index(ByteIndex, FirstBitIndex,
        NumBitsThisByte, BM, !Bits) :-
    BitsThisByte = extract_bits_from_byte(BM ^ unsafe_byte(ByteIndex),
                        FirstBitIndex, NumBitsThisByte),
    !:Bits = (!.Bits `unchecked_left_shift` NumBitsThisByte) \/ BitsThisByte.

%-----------------------------------------------------------------------------%

(BM ^ bits(FirstBit, NumBits) := Bits) =
    ( if
        FirstBit >= 0,
        (
            NumBits >= 0,
            NumBits =< int.bits_per_int,
            in_range(BM, FirstBit + NumBits - 1)
        ;
            NumBits = 0,
            in_range(BM, FirstBit)
        )
      then
        BM ^ unsafe_bits(FirstBit, NumBits) := Bits
      else if
        ( NumBits < 0
        ; NumBits > int.bits_per_int
        )
      then
        throw_bitmap_error(
                "bitmap.'bits :=': number of bits must be between " ++
                "0 and `int.bits_per_int'.")
      else
        throw_bounds_error(BM, "bitmap.'bits :='", FirstBit)
    ).

(BM0 ^ unsafe_bits(FirstBit, NumBits) := Bits) = BM :-
    LastBit = FirstBit + NumBits - 1,
    LastByteIndex = byte_index_for_bit(LastBit),
    LastBitIndex = bit_index_in_byte(LastBit),
    set_bits_in_bytes(LastByteIndex, LastBitIndex, NumBits, Bits, BM0, BM).

    % Set the given number of bits starting at the least significant.
:- pred set_bits_in_bytes(byte_index, bit_index_in_byte, num_bits,
    word, bitmap, bitmap).
:- mode set_bits_in_bytes(in, in, in, in, bitmap_di, bitmap_uo) is det.

set_bits_in_bytes(LastByteIndex, LastBitIndex, NumBits, Bits, !BM) :-
    RemainingBitsInByte = LastBitIndex + 1,
    ( if NumBits > RemainingBitsInByte then
        NumBitsThisByte = RemainingBitsInByte,
        set_bits_in_byte_index(LastByteIndex, LastBitIndex, NumBitsThisByte,
            Bits, !BM),
        set_bits_in_bytes(LastByteIndex - 1, bits_per_byte - 1,
            NumBits - NumBitsThisByte,
            Bits `unchecked_right_shift` NumBitsThisByte, !BM)
      else if NumBits > 0 then
        set_bits_in_byte_index(LastByteIndex, LastBitIndex, NumBits, Bits, !BM)
      else
        true
    ).

:- pred set_bits_in_byte_index(byte_index, bit_index_in_byte, num_bits,
    word, bitmap, bitmap).
:- mode set_bits_in_byte_index(in, in, in, in, bitmap_di, bitmap_uo) is det.

set_bits_in_byte_index(ByteIndex, LastBitIndex,
        NumBitsThisByte, Bits, !BM) :-
    FirstBitInByte = LastBitIndex - NumBitsThisByte + 1,
    !:BM = !.BM ^ unsafe_byte(ByteIndex) :=
                set_bits_in_byte(!.BM ^ unsafe_byte(ByteIndex),
                    FirstBitInByte, NumBitsThisByte, Bits).

%-----------------------------------------------------------------------------%

:- type bitmap.slice
    ---> bitmap.slice_ctor(
            slice_bitmap_field :: bitmap,
            slice_start_bit_index_field :: bit_index,
            slice_num_bits_field :: num_bits
    ).

slice(BM, StartBit, NumBits) = Slice :-
    ( if
        NumBits >= 0,
        StartBit >= 0,
        ( in_range(BM, StartBit + NumBits - 1)
        ; NumBits = 0, in_range(BM, StartBit)
        )
      then
        Slice = bitmap.slice_ctor(BM, StartBit, NumBits)
      else
        throw_bounds_error(BM, "bitmap.slice", StartBit, NumBits)
    ).

Slice ^ slice_bitmap = Slice ^ slice_bitmap_field.
Slice ^ slice_start_bit_index  = Slice ^ slice_start_bit_index_field.
Slice ^ slice_num_bits = Slice ^ slice_num_bits_field.

byte_slice(BM, StartByte, NumBytes) =
    slice(BM, StartByte * bits_per_byte, NumBytes * bits_per_byte).

Slice ^ slice_start_byte_index =
        quotient_bits_per_byte_with_rem_zero("bitmap.slice_start_byte_index",
            Slice ^ slice_start_bit_index).
Slice ^ slice_num_bytes =
        quotient_bits_per_byte_with_rem_zero("bitmap.slice_num_bytes",
            Slice ^ slice_num_bits).

:- func quotient_bits_per_byte_with_rem_zero(string, int) = int is det.

quotient_bits_per_byte_with_rem_zero(Pred, Int) =
            Int `unchecked_quotient` bits_per_byte :-
    ( Int `unchecked_rem` bits_per_byte = 0 ->
        true
    ;
        throw_bitmap_error(Pred ++ ": not a byte slice.")
    ).

%-----------------------------------------------------------------------------%

set(BM, I) = 
    ( if in_range(BM, I)
      then unsafe_set(BM, I)
      else throw_bounds_error(BM, "bitmap.set", I)
    ).

clear(BM, I) =
    ( if in_range(BM, I)
      then unsafe_clear(BM, I)
      else throw_bounds_error(BM, "bitmap.clear", I)
    ).

flip(BM, I) =
    ( if in_range(BM, I)
      then unsafe_flip(BM, I)
      else throw_bounds_error(BM, "bitmap.flip", I)
    ).

set(I, BM, set(BM, I)).

clear(I, BM, clear(BM, I)).

flip(I, BM, flip(BM, I)).

%-----------------------------------------------------------------------------%

unsafe_set(BM, I) = 
    BM ^ unsafe_byte(byte_index_for_bit(I)) :=
        BM ^ unsafe_byte(byte_index_for_bit(I)) \/ bitmask(I).

unsafe_clear(BM, I) =
    BM ^ unsafe_byte(byte_index_for_bit(I)) :=
        BM ^ unsafe_byte(byte_index_for_bit(I)) /\ \bitmask(I).

unsafe_flip(BM, I) =
    BM ^ unsafe_byte(byte_index_for_bit(I)) :=
        BM ^ unsafe_byte(byte_index_for_bit(I)) `xor` bitmask(I).

unsafe_set(I, BM, unsafe_set(BM, I)).

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_bounds_error(BM, "bitmap.is_set", I) = _ : int
    ).

is_clear(BM, I) :-
    ( if in_range(BM, I)
      then unsafe_is_clear(BM, I)
      else throw_bounds_error(BM, "bitmap.is_clear", I) = _ : int
    ).

%-----------------------------------------------------------------------------%

unsafe_is_set(BM, I) :-
    \+ unsafe_is_clear(BM, I).

unsafe_is_clear(BM, I) :-
    BM ^ unsafe_byte(byte_index_for_bit(I)) /\ bitmask(I) = 0.

%-----------------------------------------------------------------------------%

get(BM, I) = BM ^ bit(I).

%------------------------------------------------------------------------------%

unsafe_get(BM, I) = BM ^ unsafe_bit(I).

%-----------------------------------------------------------------------------%

complement(BM) =
    clear_filler_bits(complement_2(byte_index_for_bit(num_bits(BM) - 1), BM)).

:- func complement_2(int, bitmap) = bitmap.
:- mode complement_2(in, bitmap_di) = bitmap_uo is det.

complement_2(ByteI, BM) =
    ( if ByteI < 0
      then BM
      else complement_2(ByteI - 1,
            BM ^ unsafe_byte(ByteI) := \ (BM ^ unsafe_byte(ByteI)))
    ).

%-----------------------------------------------------------------------------%

union(BMa, BMb) =
    ( if num_bits(BMa) = num_bits(BMb) then
        zip((\/), BMa, BMb)
      else
        throw_bitmap_error("bitmap.union: bitmaps not the same size")
    ).

%-----------------------------------------------------------------------------%

intersect(BMa, BMb) =
    ( if num_bits(BMa) = num_bits(BMb) then
        zip((/\), BMa, BMb)
      else
        throw_bitmap_error("bitmap.intersect: bitmaps not the same size")
    ).

%-----------------------------------------------------------------------------%

difference(BMa, BMb) =
    ( if num_bits(BMa) = num_bits(BMb) then
        zip((func(X, Y) = (X /\ \Y)), BMa, BMb)
      else
        throw_bitmap_error("bitmap.difference: bitmaps not the same size")
    ).

%-----------------------------------------------------------------------------%

xor(BMa, BMb) =
    ( if num_bits(BMa) = num_bits(BMb) then
        zip((func(X, Y) = (X `xor` Y)), BMa, BMb)
      else
        throw_bitmap_error("bitmap.xor: bitmaps not the same size")
    ).

%-----------------------------------------------------------------------------%

    % Applies a function to every corresponding element between +ve I
    % and 0 inclusive, destructively updating the second bitmap.
    %
:- func zip(func(byte, byte) = byte,
    bitmap, bitmap) = bitmap.
%:- mode zip(func(in, in) = out is det,
%    bitmap_ui, bitmap_di) = bitmap_uo is det.
:- mode zip(func(in, in) = out is det,
    in, bitmap_di) = bitmap_uo is det.  

zip(Fn, BMa, BMb) =
    ( if num_bits(BMb) = 0 then BMb
      else zip2(byte_index_for_bit(num_bits(BMb) - 1), Fn, BMa, BMb)
    ).

:- func zip2(byte_index, func(byte, byte) = byte,
    bitmap, bitmap) = bitmap.
%:- mode zip2(in, func(in, in) = out is det,
%    bitmap_ui, bitmap_di) = bitmap_uo is det.
:- mode zip2(in, func(in, in) = out is det,
    in, bitmap_di) = bitmap_uo is det.

zip2(I, Fn, BMa, BMb) =
    ( if I >= 0 then
        zip2(I - 1, Fn, BMa,
            BMb ^ unsafe_byte(I) :=
                Fn(BMa ^ unsafe_byte(I), BMb ^ unsafe_byte(I)))
      else
        BMb
    ).

%-----------------------------------------------------------------------------%

append_list(BMs) = !:BM :-
    BMSize = list.foldl((func(BM, Size) = Size + BM ^ num_bits), BMs, 0),
    !:BM = new(BMSize),
    list.foldl2(copy_bitmap_into_place, BMs, 0, _, !BM).

:- pred copy_bitmap_into_place(bitmap::in, int::in, int::out,
    bitmap::bitmap_di, bitmap::bitmap_uo) is det.

copy_bitmap_into_place(ThisBM, !Index, !BM) :-
    !:BM = unsafe_copy_bits(0, ThisBM, 0, !.BM, !.Index, ThisBM ^ num_bits),
    !:Index = !.Index + ThisBM ^ num_bits.

%-----------------------------------------------------------------------------%

copy_bits(SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits) =
    copy_bits(0, SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits).

copy_bits_in_bitmap(SrcBM, SrcStartBit, DestStartBit, NumBits) =
    copy_bits(1, SrcBM, SrcStartBit, SrcBM, DestStartBit, NumBits).

:- func copy_bits(int, bitmap, bit_index,
    bitmap, bit_index, num_bits) = bitmap.
%:- mode copy_bits(in, bitmap_ui, in, bitmap_di, in, in) = bitmap_uo is det.
:- mode copy_bits(in, in, in, bitmap_di, in, in) = bitmap_uo is det.

copy_bits(SameBM, SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits) =
    ( if
        NumBits >= 0,
        SrcStartBit >= 0,
        DestStartBit >= 0,
        ( in_range(SrcBM, SrcStartBit + NumBits - 1)
        ; NumBits = 0, in_range(SrcBM, SrcStartBit)
        ),
        ( in_range(DestBM, DestStartBit + NumBits - 1)
        ; NumBits = 0, in_range(DestBM, DestStartBit)
        )
      then
        unsafe_copy_bits(SameBM, SrcBM, SrcStartBit,
            DestBM, DestStartBit, NumBits)
      else
        ( if
            ( NumBits < 0
            ; SrcStartBit < 0
            ; \+ in_range(SrcBM, SrcStartBit + NumBits - 1)
            )
          then
            throw_bounds_error(SrcBM, "copy_bits (source)",
                SrcStartBit, NumBits)
          else if
            ( DestStartBit < 0
            ; \+ in_range(DestBM, DestStartBit + NumBits - 1)
            )
          then
            throw_bounds_error(DestBM, "copy_bits (destination)",
                DestStartBit, NumBits)
          else  
            throw_bitmap_error("bitmap.copy_bits: failed to diagnose error")
        )
    ).

:- func unsafe_copy_bits(int, bitmap, bit_index,
    bitmap, bit_index, num_bits) = bitmap.
%:- mode unsafe_copy_bits(in, bitmap_ui, in,
%    bitmap_di, in, in) = bitmap_uo is det.
:- mode unsafe_copy_bits(in, in, in,
    bitmap_di, in, in) = bitmap_uo is det.

unsafe_copy_bits(SameBM, SrcBM, SrcStartBit, !.DestBM, DestStartBit,
        !.NumBits) = !:DestBM :-
    SrcStartIndex = bit_index_in_byte(SrcStartBit),
    DestStartIndex = bit_index_in_byte(DestStartBit),
    ( if !.NumBits < 2 * bits_per_byte then
        %
        % The alternatives below don't handle ranges that don't
        % span a byte boundary.
        % 
        !:DestBM = !.DestBM ^ unsafe_bits(DestStartBit, !.NumBits) :=
                        SrcBM ^ unsafe_bits(SrcStartBit, !.NumBits)
      else if SrcStartIndex = DestStartIndex then
        %
        % Handle the common case where the bits to be moved
        % have the same offsets in each byte, so we can do a
        % block byte copy.
        %

        StartIndex = SrcStartIndex,
        SrcEndBit = SrcStartBit + !.NumBits - 1,
        EndIndex = bit_index_in_byte(SrcEndBit),
        ( if
            StartIndex = 0,
            EndIndex = bits_per_byte - 1
         then
            %
            % It's an aligned block of bytes, move it.
            %
            NumBytes = !.NumBits `unchecked_quotient` bits_per_byte,
            SrcStartByteIndex = SrcStartBit `unchecked_quotient` bits_per_byte,
            DestStartByteIndex =
                DestStartBit `unchecked_quotient` bits_per_byte,
            !:DestBM = unsafe_copy_bytes(SameBM, SrcBM, SrcStartByteIndex,
                            !.DestBM, DestStartByteIndex, NumBytes)
         else
            % 
            % Grab the odd bits at each end of the block to move,
            % leaving a block of aligned bytes to move.
            %
            ( if StartIndex = 0 then
                NumBitsAtStart = 0,
                StartBitsToSet = 0
              else
                NumBitsAtStart = bits_per_byte - StartIndex,
                SrcPartialStartByteIndex = byte_index_for_bit(SrcStartBit),
                StartBitsToSet =
                    extract_bits_from_byte(
                        SrcBM ^ unsafe_byte(SrcPartialStartByteIndex),
                        StartIndex, NumBitsAtStart),

                !:NumBits = !.NumBits - NumBitsAtStart
            ),

            ( if EndIndex = bits_per_byte - 1 then 
                NumBitsAtEnd = 0,
                EndBitsToSet = 0
              else
                NumBitsAtEnd = EndIndex + 1,
                SrcPartialEndByteIndex = byte_index_for_bit(SrcEndBit),
                EndBitsToSet =
                    extract_bits_from_byte(
                        SrcBM ^ unsafe_byte(SrcPartialEndByteIndex),
                        0, NumBitsAtEnd),

                !:NumBits = !.NumBits - NumBitsAtEnd
            ),

            %
            % Do the block copy.
            %
            NumBytes = !.NumBits `unchecked_quotient` bits_per_byte,
            SrcStartByteIndex = (SrcStartBit + NumBitsAtStart)
                                `unchecked_quotient` bits_per_byte,
            DestStartByteIndex = (DestStartBit + NumBitsAtStart)
                                `unchecked_quotient` bits_per_byte,
            !:DestBM = unsafe_copy_bytes(SameBM, SrcBM, SrcStartByteIndex,
                            !.DestBM, DestStartByteIndex, NumBytes),

            %
            % Fill in the partial bytes at the start and end of the range.
            %
            ( if NumBitsAtStart \= 0 then
                DestPartialStartByteIndex = DestStartByteIndex - 1,
                !:DestBM =
                    !.DestBM ^ unsafe_byte(DestPartialStartByteIndex) :=
                        set_bits_in_byte(
                            !.DestBM ^ unsafe_byte(DestPartialStartByteIndex),
                            StartIndex, NumBitsAtStart, StartBitsToSet)
              else
                true
            ),

            ( if NumBitsAtEnd \= 0 then
                DestPartialEndByteIndex = DestStartByteIndex + NumBytes,
                !:DestBM =
                    !.DestBM ^ unsafe_byte(DestPartialEndByteIndex) :=
                        set_bits_in_byte(
                            !.DestBM ^ unsafe_byte(DestPartialEndByteIndex),
                            0, NumBitsAtEnd, EndBitsToSet)
              else
                true
            )
        )
      else
        !:DestBM = unsafe_copy_unaligned_bits(SameBM, SrcBM, SrcStartBit,
                        !.DestBM, DestStartBit, !.NumBits)
    ).

copy_bytes(SrcBM, SrcStartByteIndex, DestBM, DestStartByteIndex, NumBytes) =
    copy_bytes(0, SrcBM, SrcStartByteIndex,
        DestBM, DestStartByteIndex, NumBytes).

copy_bytes_in_bitmap(SrcBM, SrcStartByteIndex, DestStartByteIndex, NumBytes) =
    copy_bytes(1, SrcBM, SrcStartByteIndex,
        SrcBM, DestStartByteIndex, NumBytes).

    % The SameBM parameter is 1 if we are copying within the same bitmap
    % bitmap.  We use an `int' rather than a `bool' for easier interfacing
    % with C.
:- func copy_bytes(int, bitmap, bit_index,
    bitmap, bit_index, num_bits) = bitmap.
%:- mode copy_bytes(in, bitmap_ui, in,
%    bitmap_di, in, in) = bitmap_uo is det.
:- mode copy_bytes(in, in, in,
    bitmap_di, in, in) = bitmap_uo is det.

copy_bytes(SameBM, SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes) =
   ( if
        NumBytes >= 0,
        SrcStartByte >= 0,
        byte_in_range(SrcBM, SrcStartByte + NumBytes - 1),
        DestStartByte >= 0,
        byte_in_range(DestBM, DestStartByte + NumBytes - 1)
      then
        unsafe_copy_bytes(SameBM, SrcBM, SrcStartByte, DestBM,
            DestStartByte, NumBytes)
      else
        throw_bitmap_error("bitmap.copy_bytes: out of range")
    ).

:- func unsafe_copy_bytes(int, bitmap, byte_index,
    bitmap, byte_index, num_bytes) = bitmap.
%:- mode unsafe_copy_bytes(in, bitmap_ui, in,
%    bitmap_di, in, in) = bitmap_uo is det.
:- mode unsafe_copy_bytes(in, in, in,
    bitmap_di, in, in) = bitmap_uo is det.

:- pragma foreign_proc("C",
    unsafe_copy_bytes(SameBM::in, SrcBM::in, SrcFirstByteIndex::in,
        DestBM0::bitmap_di, DestFirstByteIndex::in,
        NumBytes::in) = (DestBM::bitmap_uo),
    [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
    DestBM = DestBM0;
    if (SameBM) {
        memmove(DestBM->elements + DestFirstByteIndex,
            SrcBM->elements + SrcFirstByteIndex, NumBytes);
    } else {
        MR_memcpy(DestBM->elements + DestFirstByteIndex,
            SrcBM->elements + SrcFirstByteIndex, NumBytes);
    }

").

unsafe_copy_bytes(SameBM, SrcBM, SrcFirstByteIndex,
        !.DestBM, DestFirstByteIndex, NumBytes) = !:DestBM :-
    Direction = choose_copy_direction(SameBM, SrcFirstByteIndex,
                    DestFirstByteIndex),
    (
        Direction = left_to_right,
        !:DestBM = unsafe_do_copy_bytes(SrcBM, SrcFirstByteIndex,
            !.DestBM, DestFirstByteIndex, NumBytes, 1)
    ;
        Direction = right_to_left,
        !:DestBM = unsafe_do_copy_bytes(SrcBM,
            SrcFirstByteIndex + NumBytes - 1,
            !.DestBM, DestFirstByteIndex + NumBytes - 1, NumBytes, -1)
    ).

:- func unsafe_do_copy_bytes(bitmap, byte_index,
    bitmap, byte_index, num_bytes, num_bytes) = bitmap.
%:- mode unsafe_do_copy_bytes(bitmap_ui, in,
%    bitmap_di, in, in, in) = bitmap_uo is det.
:- mode unsafe_do_copy_bytes(in, in,
    bitmap_di, in, in, in) = bitmap_uo is det.

unsafe_do_copy_bytes(SrcBM, SrcByteIndex, DestBM, DestByteIndex,
        NumBytes, AddForNext) =
    ( if NumBytes = 0 then
        DestBM
      else
        unsafe_do_copy_bytes(SrcBM, SrcByteIndex + AddForNext, 
            DestBM ^ unsafe_byte(DestByteIndex) :=
                SrcBM ^ unsafe_byte(SrcByteIndex),
            DestByteIndex + AddForNext, NumBytes - 1, AddForNext)
    ).

    %
    % General case.  Reduce the number of writes by aligning to the next
    % byte boundary in the destination bitmap so each byte is written once.
    %
:- func unsafe_copy_unaligned_bits(int, bitmap, bit_index,
    bitmap, bit_index, num_bits) = bitmap.
%:- mode unsafe_copy_unaligned_bits(in, bitmap_ui, in,
%    bitmap_di, in, in) = bitmap_uo is det.
:- mode unsafe_copy_unaligned_bits(in, in, in,
    bitmap_di, in, in) = bitmap_uo is det.

unsafe_copy_unaligned_bits(SameBM, SrcBM, SrcStartBit,
        !.DestBM, DestStartBit, !.NumBits) = !:DestBM :-
    % 
    % Grab the odd bits at each end of the block in the destination,
    % leaving a block of aligned bytes to copy.
    %
    DestStartIndex = bit_index_in_byte(DestStartBit),
    DestEndBit = DestStartBit + !.NumBits - 1,
    ( if DestStartIndex = 0 then
        NumBitsAtStart = 0,
        StartBits = 0
      else
        NumBitsAtStart = bits_per_byte - DestStartIndex,
        StartBits = SrcBM ^ unsafe_bits(SrcStartBit, NumBitsAtStart),
        !:NumBits = !.NumBits - NumBitsAtStart
    ),

    NewSrcStartBit = (SrcStartBit + NumBitsAtStart),
    NewDestStartBit = (DestStartBit + NumBitsAtStart),

    DestEndIndex = bit_index_in_byte(DestEndBit),
    ( if DestEndIndex = bits_per_byte - 1 then
        NumBitsAtEnd = 0,
        EndBits = 0
      else
        NumBitsAtEnd = DestEndIndex + 1,
        SrcEndBit = NewSrcStartBit + !.NumBits - 1,
        EndBits =
            SrcBM ^ unsafe_bits(SrcEndBit - NumBitsAtEnd + 1, NumBitsAtEnd),
        !:NumBits = !.NumBits - NumBitsAtEnd
    ),

    %
    % Do the block copy.
    %
    NumBytes = !.NumBits `unchecked_quotient` bits_per_byte,
    Direction = choose_copy_direction(SameBM, NewSrcStartBit, NewDestStartBit),
    SrcBitIndex = bit_index_in_byte(NewSrcStartBit),

    (
        Direction = left_to_right,
        SrcStartByteIndex = byte_index_for_bit(NewSrcStartBit),
        DestStartByteIndex = byte_index_for_bit(NewDestStartBit),
        !:DestBM = unsafe_copy_unaligned_bytes_ltor(SrcBM,
                    SrcStartByteIndex + 1, SrcBitIndex,
                    SrcBM ^ unsafe_byte(SrcStartByteIndex),
                    !.DestBM, DestStartByteIndex, NumBytes)
    ;
        Direction = right_to_left,
        SrcStartByteIndex = byte_index_for_bit(NewSrcStartBit + !.NumBits - 1),
        DestStartByteIndex =
            byte_index_for_bit(NewDestStartBit + !.NumBits - 1),
        !:DestBM = unsafe_copy_unaligned_bytes_rtol(SrcBM,
                    SrcStartByteIndex - 1, SrcBitIndex,
                    SrcBM ^ unsafe_byte(SrcStartByteIndex),
                    !.DestBM, DestStartByteIndex, NumBytes)
    ),

    %
    % Fill in the partial bytes at the start and end of the range.
    %
    ( if NumBitsAtStart \= 0 then
        PartialDestStartByteIndex = byte_index_for_bit(DestStartBit),
        !:DestBM =
            !.DestBM ^ unsafe_byte(PartialDestStartByteIndex) :=
                set_bits_in_byte(
                    !.DestBM ^ unsafe_byte(PartialDestStartByteIndex),
                    DestStartIndex, NumBitsAtStart, StartBits)
      else
        true
    ),

    ( if NumBitsAtEnd \= 0 then
        PartialDestEndByteIndex = byte_index_for_bit(DestEndBit),
        !:DestBM =
            !.DestBM ^ unsafe_byte(PartialDestEndByteIndex) :=
                set_bits_in_byte(
                    !.DestBM ^ unsafe_byte(PartialDestEndByteIndex),
                    0, NumBitsAtEnd, EndBits)
      else
        true
    ).

:- func unsafe_copy_unaligned_bytes_ltor(bitmap, byte_index, bit_index_in_byte,
    byte, bitmap, byte_index, num_bytes) = bitmap.
:- mode unsafe_copy_unaligned_bytes_ltor(in, in, in, in,
    bitmap_di, in, in) = bitmap_uo is det.
%:- mode unsafe_copy_unaligned_bytes_ltor(bitmap_ui, in, in, in,
%    bitmap_di, in, in) = bitmap_uo is det.

unsafe_copy_unaligned_bytes_ltor(SrcBM, SrcByteIndex, SrcBitIndex,
        PrevSrcByteBits, !.DestBM, DestByteIndex, NumBytes) = !:DestBM :-
    ( if NumBytes =< 0 then
        true
      else
        %
        % Combine parts of two adjacent bytes in the source bitmap
        % into one byte of the destination.
        %
        % For example, for the call to `unsafe_copy_unaligned_bytes_ltor'
        % that would result from a call:
        % `unsafe_copy_bits(SrcBM, 1, DestBM, 0, 8)',
        % we construct the first byte in the destination by pasting
        % together the last seven bits of `SrcBM ^ byte(0)'
        % (from PrevSrcByteBits) with the first bit of `SrcBM ^ byte(1)'.
        % SrcBM: |0 1234567|0 1234567|01234567|...
        %          |   \/    |
        % DestBM:  |0123456 7|...
        %
        % PrevSrcByteBits will contain the initial contents of `Src ^ byte(0)'
        % (we can't look it up here because in the general case it may be
        % overwritten by previous recursive calls).
        %
        SrcByteBits = SrcBM ^ unsafe_byte(SrcByteIndex),
        DestByteBits =
            (PrevSrcByteBits `unchecked_left_shift` SrcBitIndex)
                \/ (SrcByteBits `unchecked_right_shift`
                            (bits_per_byte - SrcBitIndex)),
        !:DestBM = !.DestBM ^ unsafe_byte(DestByteIndex) := DestByteBits,

        unsafe_copy_unaligned_bytes_ltor(SrcBM, SrcByteIndex + 1, SrcBitIndex,
            SrcByteBits, !.DestBM, DestByteIndex + 1, NumBytes - 1) = !:DestBM
    ).

:- func unsafe_copy_unaligned_bytes_rtol(bitmap, byte_index, bit_index_in_byte,
    byte, bitmap, byte_index, num_bytes) = bitmap.
:- mode unsafe_copy_unaligned_bytes_rtol(in, in, in, in,
    bitmap_di, in, in) = bitmap_uo is det.
%:- mode unsafe_copy_unaligned_bytes_rtol(bitmap_ui, in, in, in,
%    bitmap_di, in, in) = bitmap_uo is det.

unsafe_copy_unaligned_bytes_rtol(SrcBM, SrcByteIndex, SrcBitIndex,
        PrevSrcByteBits, !.DestBM, DestByteIndex, NumBytes) = !:DestBM :-
    ( if NumBytes =< 0 then
        true
      else
        %
        % Combine parts of two adjacent bytes in the source bitmap
        % into one byte of the destination.
        %
        % For example, for the first call to `unsafe_copy_unaligned_bytes_ltor'
        % resulting from a call `unsafe_copy_bits_in_bitmap(SrcBM, 7, 8, 8)'
        % we construct the second byte in the destination by pasting together
        % the last bit of `SrcBM ^ byte(0)' with the first seven bits of
        % `SrcBM ^ byte(1)' (from PrevSrcByteBits).
        % SrcBM:     |0123456 7|0123456 7|01234567|
        %                    |   \/    |
        % DestBM:   |01234567|0 1234567|
        %
        % PrevSrcByteBits will contain the initial contents of `Src ^ byte(1)'
        % (we can't look it up here because in the general case it may be
        % overwritten by previous recursive calls).
        %
        SrcByteBits = SrcBM ^ unsafe_byte(SrcByteIndex),
        DestByteBits =
            (SrcByteBits `unchecked_left_shift` SrcBitIndex)
                \/ (PrevSrcByteBits `unchecked_right_shift`
                            (bits_per_byte - SrcBitIndex)),
        !:DestBM = !.DestBM ^ unsafe_byte(DestByteIndex) := DestByteBits,

        !:DestBM = unsafe_copy_unaligned_bytes_rtol(SrcBM, SrcByteIndex - 1,
            SrcBitIndex, SrcByteBits, !.DestBM,
            DestByteIndex - 1, NumBytes - 1)
    ).

:- type copy_direction
        --->    left_to_right
        ;       right_to_left
        .

    % choose_copy_direction(SameBM, SrcStartBit, DestStartBit)
    %
    % Choose a direction that will avoid overwriting data
    % before it has been copied.
    % Where it doesn't matter, prefer left_to_right for better performance.
    %
:- func choose_copy_direction(int, bit_index, bit_index) = copy_direction.

choose_copy_direction(SameBM, SrcStartBit, DestStartBit) =
    ( if SameBM = 1, SrcStartBit < DestStartBit
      then right_to_left
      else left_to_right
    ).

%-----------------------------------------------------------------------------%

    % Note: this should be kept in sync with MR_bitmap_to_string in
    % runtime/mercury_bitmap.c.
    %
to_string(BM) = Str :-
    NumBits = BM ^ num_bits,     
    to_string_chars(byte_index_for_bit(NumBits - 1), BM,
        [('>')], Chars),
    Str = string.from_char_list(
            [('<') | to_char_list(int_to_string(NumBits))] ++ [(':') | Chars]).

:- pred to_string_chars(int, bitmap, list(char), list(char)).
%:- mode to_string_chars(in, bitmap_ui, in, out) is det.
:- mode to_string_chars(in, in, in, out) is det.

to_string_chars(Index, BM, !Chars) :-
    ( if Index < 0 then
        true
      else
        Byte = BM ^ unsafe_byte(Index),
        Mask = n_bit_mask(4),
        ( if
            char.int_to_hex_char((Byte `unchecked_right_shift` 4) /\ Mask,
                HighChar),
            char.int_to_hex_char(Byte /\ Mask, LowChar)
          then
            !:Chars = [HighChar, LowChar | !.Chars],
            to_string_chars(Index - 1, BM, !Chars)
          else
            throw(software_error("bitmap.to_string: internal error"))
        )
    ).

from_string(Str) = BM :-
    Len = length(Str),
    ( if Len >= 4 then
        Str ^ unsafe_elem(0) = ('<'),
        char.is_digit(Str ^ unsafe_elem(1)),
        Str ^ unsafe_elem(Len - 1) = ('>'),
        string.sub_string_search(Str, ":", Colon),
        SizeStr = string.unsafe_substring(Str, 1, Colon - 1),
        string.to_int(SizeStr, Size),
        ( if Size >= 0 then
            BM0 = allocate_bitmap(Size),
            hex_chars_to_bitmap(Str, Colon + 1, Len - 1, 0, BM0, BM)
          else
            fail
        )
      else
        fail
    ).
    
:- pred hex_chars_to_bitmap(string::in, int::in, int::in, byte_index::in,
    bitmap::bitmap_di, bitmap::bitmap_uo) is semidet.

hex_chars_to_bitmap(Str, Index, End, ByteIndex, !BM) :-
    ( if Index = End then
        true
      else if Index + 1 = End then
        % Each byte of the bitmap should have mapped to a pair of characters.
        fail
      else    
        char.is_hex_digit(Str ^ unsafe_elem(Index), HighNibble),
        char.is_hex_digit(Str ^ unsafe_elem(Index + 1), LowNibble),
        Byte = (HighNibble `unchecked_left_shift` 4) \/ LowNibble,
        !:BM = !.BM ^ unsafe_byte(ByteIndex) := Byte,
        hex_chars_to_bitmap(Str, Index + 2, End, ByteIndex + 1, !BM)
    ).

%-----------------------------------------------------------------------------%

to_byte_string(BM) = string.join_list(".", bitmap_to_byte_strings(BM)).

:- func bitmap_to_byte_strings(bitmap) = list(string).
%:- mode bitmap_to_byte_strings(bitmap_ui) = out is det.
:- mode bitmap_to_byte_strings(in) = out is det.

bitmap_to_byte_strings(BM) = Strs :-
    NumBits = BM ^ num_bits,
    Strs = bitmap_to_byte_strings(BM, NumBits, []).

:- func bitmap_to_byte_strings(bitmap, int, list(string)) = list(string).
%:- mode bitmap_to_byte_strings(bitmap_ui, in, in) = out is det.
:- mode bitmap_to_byte_strings(in, in, in) = out is det.

bitmap_to_byte_strings(BM, NumBits, !.Strs) = !:Strs :-
    ( if NumBits =< 0 then
        true
      else
        ThisByte0 = BM ^ unsafe_byte(byte_index_for_bit(NumBits - 1)),
        LastBitIndex = bit_index_in_byte(NumBits - 1),
        ( if LastBitIndex = bits_per_byte - 1 then
            BitsThisByte = bits_per_byte,
            ThisByte = ThisByte0
         else
            BitsThisByte = LastBitIndex + 1,
            ThisByte = ThisByte0 `unchecked_right_shift`
                            (bits_per_byte - BitsThisByte)
        ),
        ThisByteStr =
            string.pad_left(string.int_to_base_string(ThisByte, 2),
                '0', BitsThisByte),
        !:Strs = [ThisByteStr | !.Strs],
        !:Strs = bitmap_to_byte_strings(BM, NumBits - BitsThisByte, !.Strs)
    ).

%-----------------------------------------------------------------------------%

    % NOTE: bitmap.hash is also defined as MR_hash_bitmap in
    % runtime/mercury_bitmap.h. The two definitions must be kept identical.
    %
hash(BM) = HashVal :-
    NumBits = BM ^ num_bits,
    NumBytes0 = NumBits `unchecked_quotient` bits_per_byte,
    ( if NumBits `unchecked_rem` bits_per_byte = 0 then
        NumBytes = NumBytes0
      else
        NumBytes = NumBytes0 + 1
    ),
    hash_2(BM, 0, NumBytes, 0, HashVal0),
    HashVal = HashVal0 `xor` NumBits.

:- pred hash_2(bitmap::in, byte_index::in, int::in, int::in, int::out) is det.

hash_2(BM, Index, Length, !HashVal) :-
    ( if Index < Length then
        combine_hash(BM ^ unsafe_byte(Index), !HashVal),
        hash_2(BM, Index + 1, Length, !HashVal)
      else
        true
    ).

:- pred combine_hash(int::in, int::in, int::out) is det.

combine_hash(X, H0, H) :-
    H1 = H0 `xor` (H0 << 5),
    H = H1 `xor` X.

%-----------------------------------------------------------------------------%

    %
    % A bitmap is represented in C as a size (in bits) and an array of bytes.
    %
    % NOTE: the `filler' bits in the last element of the array *must*
    % be clear (i.e. zero).  This makes the unification, comparison and
    % the set operations simpler to implement.
    %

:- pragma foreign_decl("C", "
#include ""mercury_types.h""
#include ""mercury_bitmap.h""
#include ""mercury_type_info.h""
").

:- pragma foreign_code("Java", "
public static class MercuryBitmap {
    public int num_bits;
    public byte[] elements;

    public MercuryBitmap(int numBits) {
        num_bits = numBits;
        elements = new byte[numBits / 8 + (((numBits % 8) != 0) ? 1 : 0)];
    }
}
").

:- pragma foreign_code("C#", "
public class MercuryBitmap {
    public int num_bits;
    public byte[] elements;

    public MercuryBitmap(int numBits) {
        num_bits = numBits;
        elements = new byte[numBits / 8 + (((numBits % 8) != 0) ? 1: 0)];
    }
}
").

:- pragma foreign_type("C", bitmap, "MR_BitmapPtr") 
    where equality is bitmap_equal, comparison is bitmap_compare.
:- pragma foreign_type("Java", bitmap, "mercury.bitmap.MercuryBitmap") 
    where equality is bitmap_equal, comparison is bitmap_compare.
:- pragma foreign_type("IL", bitmap,
    "class [mercury]mercury.bitmap__csharp_code.mercury_code.MercuryBitmap") 
    where equality is bitmap_equal, comparison is bitmap_compare.
:- pragma foreign_type("Erlang", bitmap, "")
    where equality is bitmap_equal, comparison is bitmap_compare.

:- pragma terminates(bitmap_equal/2).
:- pred bitmap_equal(bitmap, bitmap).
:- mode bitmap_equal(in, in) is semidet.

:- pragma foreign_proc("C",
    bitmap_equal(BM1::in, BM2::in),
    [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
    SUCCESS_INDICATOR = MR_bitmap_eq(BM1, BM2);
").

:- pragma foreign_proc("Erlang",
    bitmap_equal(BM1::in, BM2::in),
    [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
    SUCCESS_INDICATOR = (BM1 =:= BM2)
").

bitmap_equal(BM1, BM2) :-
    BM1 ^ num_bits = (BM2 ^ num_bits) @ NumBits,
    bytes_equal(0, byte_index_for_bit(NumBits), BM1, BM2).

:- pred bytes_equal(byte_index, byte_index, bitmap, bitmap).
:- mode bytes_equal(in, in, in, in) is semidet.

bytes_equal(Index, MaxIndex, BM1, BM2) :-
    ( if Index =< MaxIndex then
        BM1 ^ unsafe_byte(Index) = BM2 ^ unsafe_byte(Index),
        bytes_equal(Index + 1, MaxIndex, BM1, BM2)
      else
        true
    ).

:- pragma terminates(bitmap_compare/3).
:- pred bitmap_compare(comparison_result, bitmap, bitmap).
:- mode bitmap_compare(uo, in, in) is det.

:- pragma foreign_proc("C",
    bitmap_compare(Result::uo, BM1::in, BM2::in),
    [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
    int res;
    res = MR_bitmap_cmp(BM1, BM2);
    Result = ((res < 0) ? MR_COMPARE_LESS
                : (res == 0) ? MR_COMPARE_EQUAL
                : MR_COMPARE_GREATER);
").

:- pragma foreign_proc("Erlang",
    bitmap_compare(Result::uo, BM1::in, BM2::in),
    [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
"
    if
        BM1 =:= BM2 ->
            Result = {'='};
        BM1 < BM2 ->
            Result = {'<'};
        true ->
            Result = {'>'}
    end
").

bitmap_compare(Result, BM1, BM2) :-
    compare(Result0, BM1 ^ num_bits, (BM2 ^ num_bits) @ NumBits),
    ( if Result0 = (=) then
        bytes_compare(Result, 0, byte_index_for_bit(NumBits), BM1, BM2)
      else
        Result = Result0
    ).

:- pred bytes_compare(comparison_result, byte_index, byte_index,
    bitmap, bitmap).
:- mode bytes_compare(uo, in, in, in, in) is det.

bytes_compare(Result, Index, MaxIndex, BM1, BM2) :-
    ( if Index =< MaxIndex then
        compare(Result0, BM1 ^ unsafe_byte(Index), BM2 ^ unsafe_byte(Index)),
        ( if Result0 = (=) then
            bytes_compare(Result, Index + 1, MaxIndex, BM1, BM2)
          else
            Result = Result0
        )
      else
        Result = (=)
    ).

%-----------------------------------------------------------------------------%

num_bytes(BM) = Bytes :-
    NumBits = BM ^ num_bits,
    NumBits `unchecked_rem` bits_per_byte = 0,
    Bytes = NumBits `unchecked_quotient` bits_per_byte.

det_num_bytes(BM) = Bytes :-
    ( if Bytes0 = num_bytes(BM) then
        Bytes = Bytes0
      else
        throw_bitmap_error(
            "bitmap.det_num_bytes: bitmap has a partial final byte")
    ).

%-----------------------------------------------------------------------------%

num_bits(_) = _ :- private_builtin.sorry("bitmap.num_bits").
:- pragma foreign_proc("C",
    num_bits(BM::in) = (NumBits::out),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    NumBits = BM->num_bits;
").

:- pragma foreign_proc("Java",
    num_bits(BM::in) = (NumBits::out),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    NumBits = BM.num_bits;
").

:- pragma foreign_proc("C#",
    num_bits(BM::in) = (NumBits::out),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    NumBits = BM.num_bits;
").

:- pragma foreign_proc("Erlang",
    num_bits(BM::in) = (NumBits::out),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    {_, NumBits} = BM
").

%-----------------------------------------------------------------------------%

:- func 'num_bits :='(bitmap, num_bits) = bitmap.
:- mode 'num_bits :='(bitmap_di, in) = bitmap_uo is det.

'num_bits :='(_, _) = _ :- private_builtin.sorry("bitmap.'num_bits :='").
:- pragma foreign_proc("C",
    'num_bits :='(BM0::bitmap_di, NumBits::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    BM = BM0;
    BM->num_bits = NumBits;
").
:- pragma foreign_proc("Java",
    'num_bits :='(BM0::bitmap_di, NumBits::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    BM = BM0;
    BM.num_bits = NumBits;
").
:- pragma foreign_proc("C#",
    'num_bits :='(BM0::bitmap_di, NumBits::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    BM = BM0;
    BM.num_bits = NumBits;
").

:- pragma foreign_proc("Erlang",
    'num_bits :='(BM0::bitmap_di, NumBits::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    {Bin, _} = BM0,
    BM = {Bin, NumBits}
").

%-----------------------------------------------------------------------------%

BM ^ byte(N) = 
    ( if N >= 0, in_range(BM, N * bits_per_byte + bits_per_byte - 1)
      then BM ^ unsafe_byte(N)
      else throw_bounds_error(BM, "bitmap.byte", N)
    ).

_ ^ unsafe_byte(_) = _ :- private_builtin.sorry("bitmap.unsafe_byte").
:- pragma foreign_proc("C",
    unsafe_byte(N::in, BM::in) = (Byte::out),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    Byte = (MR_Integer) BM->elements[N];
").

:- pragma foreign_proc("Java",
    unsafe_byte(N::in, BM::in) = (Byte::out),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    // Mask off sign bits.
    Byte = ((int) BM.elements[N]) & 0xff;
").

:- pragma foreign_proc("C#",
    unsafe_byte(N::in, BM::in) = (Byte::out),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    Byte = BM.elements[N];
").

:- pragma foreign_proc("Erlang",
    unsafe_byte(N::in, BM::in) = (Byte::out),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    {Bin, _} = BM,
    <<_:N/binary, Byte/integer, _/binary>> = Bin
").

%-----------------------------------------------------------------------------%

(BM ^ byte(N) := Byte) =
    ( if N >= 0, in_range(BM, N * bits_per_byte + bits_per_byte - 1)
      then BM ^ unsafe_byte(N) := Byte
      else throw_bounds_error(BM, "bitmap.'byte :='", N)
    ).

(_ ^ unsafe_byte(_) := _) = _ :-
    private_builtin.sorry("bitmap.'unsafe_byte :='").

:- pragma foreign_proc("C",
    'unsafe_byte :='(N::in, BM0::bitmap_di, Byte::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    BM = BM0;
    BM->elements[N] = (MR_uint_least8_t) Byte;
").

:- pragma foreign_proc("Java",
    'unsafe_byte :='(N::in, BM0::bitmap_di, Byte::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    BM = BM0;
    BM.elements[N] = (byte) Byte;
").

:- pragma foreign_proc("C#",
    'unsafe_byte :='(N::in, BM0::bitmap_di, Byte::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    BM = BM0;
    BM.elements[N] = (byte) Byte;
").

:- pragma foreign_proc("Erlang",
    'unsafe_byte :='(N::in, BM0::bitmap_di, Byte::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    {Bin0, NumBits} = BM0,
    <<Left:N/binary, _/integer, Right/binary>> = Bin0,
    Bin = <<Left/binary, Byte/integer, Right/binary>>,
    BM = {Bin, NumBits}
").

%-----------------------------------------------------------------------------%

:- func allocate_bitmap(num_bits) = bitmap.
:- mode allocate_bitmap(in) = bitmap_uo is det.

:- pragma foreign_proc("C",
    allocate_bitmap(N::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    MR_allocate_bitmap_msg(BM, N, MR_PROC_LABEL);
").

:- pragma foreign_proc("Java",
    allocate_bitmap(N::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    BM = new mercury.bitmap.MercuryBitmap(N);
").

:- pragma foreign_proc("C#",
    allocate_bitmap(N::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    BM = new MercuryBitmap(N);
").

:- pragma foreign_proc("Erlang",
    allocate_bitmap(N::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    Roundup = 8 * ((N + 7) div 8),
    Bin = <<0:Roundup>>,
    BM = {Bin, N}
").

:- func resize_bitmap(bitmap, num_bits) = bitmap.
:- mode resize_bitmap(bitmap_di, in) = bitmap_uo is det.

resize_bitmap(OldBM, N) =
    copy_bits(OldBM, 0, allocate_bitmap(N), 0,
        int.min(OldBM ^ num_bits, N)).

:- pragma promise_pure(copy/1).
:- pragma foreign_proc("C",
    copy(BM0::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    MR_allocate_bitmap_msg(BM, BM0->num_bits, MR_PROC_LABEL);
    MR_copy_bitmap(BM, BM0);
").

:- pragma foreign_proc("Erlang",
    copy(BM0::in) = (BM::bitmap_uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    BM = BM0
").

copy(BM0) = BM :-
    NumBits = BM0 ^ num_bits,
    BM = clear_filler_bits(
            unsafe_copy_bits(0, BM0, 0, allocate_bitmap(NumBits), 0, NumBits)).
    
%-----------------------------------------------------------------------------%
   
bits_per_byte = 8.

%-----------------------------------------------------------------------------%

    % The byte index containing the given bit.
    %
:- func byte_index_for_bit(bit_index) = byte_index.

byte_index_for_bit(I) = unchecked_quotient(I, bits_per_byte).

%-----------------------------------------------------------------------------%

    % Return the bit number in the bitmap of the first bit in the
    % same byte as the given bit.
    %
:- func first_bit_in_same_byte(bit_index) = bit_index.

first_bit_in_same_byte(I) = floor_to_multiple_of_bits_per_byte(I).

:- func floor_to_multiple_of_bits_per_byte(int) = int.

floor_to_multiple_of_bits_per_byte(X) = Floor :-
    Trunc = unchecked_quotient(X, bits_per_byte),
    Floor0 = Trunc * bits_per_byte,
    ( if Floor0 > X then
        Floor = Floor0 - bits_per_byte
      else
        Floor = Floor0
    ).

%-----------------------------------------------------------------------------%

:- type bit_index_in_byte == int.

    % Convert a bit index for a bitmap into a bit index into a
    % byte in the bitmap.
    %
:- func bit_index_in_byte(bit_index) = bit_index_in_byte.

bit_index_in_byte(I) = I `unchecked_rem` bits_per_byte.

%-----------------------------------------------------------------------------%

    % Construct the bitmask for a given bit in a byte.  Bits are numbered
    % from most significant to least significant (starting at zero).
    %
    % E.g. assuming bits_per_byte = 8 and I = 3 then
    % bitmask(I) = 2'00010000
    %
:- func bitmask(bit_index_in_byte) = byte.

bitmask(I) = 1 `unchecked_left_shift`
                    (bits_per_byte - 1 - bit_index_in_byte(I)).

%-----------------------------------------------------------------------------%

    % Construct a bitmask containing the N least significant bits set.
    %
    % E.g. assuming bits_per_byte = 8 and I = 4 then
    % n_bit_mask(I) = 2'00001111
    %
:- func n_bit_mask(num_bits) = byte.

n_bit_mask(N) = BitsMask :-
    BitMask  = 1 `unchecked_left_shift` (N - 1),
    BitsMask = BitMask \/ (BitMask - 1).

%-----------------------------------------------------------------------------%

    % extract_bits_from_byte(Byte, FirstBit, NumBits)
    % Return an integer whose NumBits least significant bits contain
    % bits FirstBit, FirstBit + 1, ... FirstBit + NumBits - 1,
    % in order from most significant to least significant.
    %
:- func extract_bits_from_byte(byte, bit_index_in_byte, num_bits) = byte.

extract_bits_from_byte(Byte, FirstBit, NumBits) = Bits :-
    % Shift the last bit in the selected bit range
    % to the least significant position.
    LastBit = FirstBit + NumBits - 1,
    Shift = bits_per_byte - 1 - LastBit,
    Bits = (Byte `unchecked_right_shift` Shift) /\ n_bit_mask(NumBits).

    % set_bits_in_byte(Byte, FirstBit, NumBits, Bits)
    %
    % Replace bits FirstBit, FirstBit + 1, ... FirstBit + NumBits - 1,
    % with the NumBits least significant bits of Bits, replacing FirstBit
    % with the most significant of those bits.
    %
:- func set_bits_in_byte(byte, bit_index_in_byte, num_bits, byte) = byte.

set_bits_in_byte(Byte0, FirstBit, NumBits, Bits) = Byte :-
    LastBit = FirstBit + NumBits - 1,
    Shift = bits_per_byte - 1 - LastBit,
    Mask = n_bit_mask(NumBits),
    BitsToSet = Mask /\ Bits,
    Byte = (Byte0 /\ \ (Mask `unchecked_left_shift` Shift))
            \/ (BitsToSet `unchecked_left_shift` Shift).

%-----------------------------------------------------------------------------%

    % throw_bounds_error(BM, PredName, Index)
    %
:- func throw_bounds_error(bitmap, string, bit_index) = _ is erroneous.

throw_bounds_error(BM, Pred, Index) =
        throw_bitmap_error(
            string.append_list([
                Pred, ": index ",
                string.int_to_string(Index),
                " is out of bounds [0 - ",
                string.int_to_string(BM ^ num_bits),
                ")."])).

    % throw_bounds_error(BM, PredName, Index, NumBits)
    %
:- func throw_bounds_error(bitmap, string, bit_index, num_bits) = _
    is erroneous.

throw_bounds_error(BM, Pred, Index, NumBits) = _ :-
    throw_bounds_error(BM, Pred, Index, NumBits).

throw_bounds_error(BM, Pred, Index, NumBits) :-
    ( NumBits < 0 ->
        Msg = string.append_list([
                    Pred, ": negative number of bits: ",
                    string.int_to_string(NumBits), "."])
    ;
        Msg = string.append_list([
                    Pred, ": ",
                    string.int_to_string(NumBits),
                    " bits starting at bit ",
                    string.int_to_string(Index),
                    " is out of bounds [0, ",
                    string.int_to_string(BM ^ num_bits),
                    ")."])
    ),
    throw_bitmap_error(Msg).

:- func throw_bitmap_error(string) = _ is erroneous.

throw_bitmap_error(Msg) = _ :-
    throw_bitmap_error(Msg).

:- pred throw_bitmap_error(string::in) is erroneous.

throw_bitmap_error(Msg) :-
    throw(bitmap_error(Msg)).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%