QCaml/common/bitstring.org

• Bit string
  • Single-integer implementation
  • Zarith implementation
  • Type
  • Tests header
  • General implementation
    • of_int
    • of_z
    • zero
    • numbits
    • is_zero
    • neg
    • shift_left
    • shift_right
    • shift_left_one
    • testbit
    • logor
    • logxor
    • logand
    • lognot
    • minus_one
    • plus_one
    • trailing_zeros
    • hamdist
    • popcount
    • to_list
    • permutations
  • Printers
  • Tests

(setq pwd (file-name-directory buffer-file-name))
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
(setq lib (concat pwd "lib/"))
(setq testdir (concat pwd "test/"))
(setq mli (concat lib name ".mli"))
(setq ml  (concat lib name ".ml"))
(setq test-ml  (concat testdir name ".ml"))
(org-babel-tangle)

Bit string

We define here a data type to handle bit strings efficiently. When the bit string contains less than 64 bits, it is stored internally in a 63-bit integer and uses bitwise instructions. When more than 63 bits are required, the zarith library is used to consider the bit string as a multi-precision integer.

Single-integer implementation

module One = struct

let of_int x =
 assert (x > 0); x

let numbits _ = 63
let zero = 0
let is_zero x = x = 0
let shift_left x i = x lsl i
let shift_right x i = x lsr i
let shift_left_one i = 1 lsl i
let testbit x i = ( (x lsr i) land 1 ) = 1  
let logor a b = a lor b
let neg a = - a 
let logxor a b = a lxor b
let logand a b = a land b
let lognot a = lnot a
let minus_one a = a - 1
let plus_one a = a + 1

let popcount = function
 | 0 -> 0
 | r  -> Util.popcnt (Int64.of_int r) 

let trailing_zeros r = 
 Util.trailz (Int64.of_int r) 

let hamdist a b =
 a lxor b
 |> popcount 

let pp ppf s = 
 Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring 64) 
   (Z.of_int s)

end

Zarith implementation

module Many = struct

let of_z x = x
let zero = Z.zero
let is_zero x = x = Z.zero
let shift_left = Z.shift_left 
let shift_right = Z.shift_right
let shift_left_one i = Z.shift_left Z.one i
let testbit = Z.testbit
let logor = Z.logor
let logxor = Z.logxor
let logand = Z.logand
let lognot = Z.lognot
let neg = Z.neg
let minus_one = Z.pred
let plus_one = Z.succ
let trailing_zeros = Z.trailing_zeros
let hamdist = Z.hamdist
let numbits i = max (Z.numbits i) 64

let popcount z = 
 if z = Z.zero then 0 else Z.popcount z

let pp ppf s = 
 Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring (Z.numbits s))  s

end

Type

type t

type t =
| One of int
| Many of Z.t

Tests header

open Common.Bitstring
let check msg x = Alcotest.(check bool) msg true x
let test_all () =
 let x = 8745687 in
 let one_x  = of_int x in
 let z = Z.shift_left (Z.of_int x) 64 in
 let many_x = of_z z in

General implementation

of_int

Creates a bit string from an int.

val of_int : int -> t

let of_int x =
One (One.of_int x)

Alcotest.(check bool) "of_x" true (one_x = (of_int x));

of_z

Creates a bit string from an Z.t multi-precision integer.

val of_z : Z.t -> t

let of_z x =
if Z.numbits x < 64 then One (Z.to_int x) else Many (Many.of_z x)

Alcotest.(check bool) "of_z" true (one_x = (of_z (Z.of_int x)));

zero

zero n creates a zero bit string with n bits.

val zero : int -> t

let zero = function
| n when n < 64 -> One (One.zero)
| _ -> Many (Many.zero)

numbits

Returns the number of bits used to represent the bit string.

val numbits : t -> int

let numbits = function
| One x -> One.numbits x
| Many x -> Many.numbits x

is_zero

True if all the bits of the bit string are zero.

val is_zero : t -> bool

let is_zero = function
| One x -> One.is_zero x
| Many x -> Many.is_zero x

neg

Returns the negative of the integer interpretation of the bit string.

neg (of_int x) = neg (of_int (-x))

val neg : t -> t

let neg = function
| One x -> One (One.neg x)
| Many x -> Many (Many.neg x)

shift_left

shift_left t n returns a new bit strings with all the bits shifted n positions to the left.

val shift_left : t -> int -> t

let shift_left x i = match x with
| One x -> One (One.shift_left x i)
| Many x -> Many (Many.shift_left x i)

Alcotest.(check bool) "shift_left1" true (of_int (x lsl 3) = shift_left one_x 3);
Alcotest.(check bool) "shift_left2" true (of_z (Z.shift_left z 3) = shift_left many_x 3);
Alcotest.(check bool) "shift_left3" true (of_z (Z.shift_left z 100) = shift_left many_x 100);

shift_right

shift_right t n returns a new bit strings with all the bits shifted n positions to the right.

val shift_right : t -> int -> t

let shift_right x i = match x with
| One x -> One (One.shift_right x i)
| Many x -> Many (Many.shift_right x i)

Alcotest.(check bool) "shift_right1" true (of_int (x lsr 3) = shift_right one_x 3);
Alcotest.(check bool) "shift_right2" true (of_z (Z.shift_right z 3) = shift_right many_x 3);

shift_left_one

shift_left_one size n returns a new bit strings with the n-th bit set to one. It is equivalent as shifting 1 by n bits to the left. size is the total number of bits of the bit string.

val shift_left_one : int -> int -> t

let shift_left_one = function
| n when n < 64 -> fun i -> One (One.shift_left_one i)
| _ -> fun i -> Many (Many.shift_left_one i)

Alcotest.(check bool) "shift_left_one1" true (of_int (1 lsl 3) = shift_left_one 4 3);
Alcotest.(check bool) "shift_left_one2" true (of_z (Z.shift_left Z.one 200) = shift_left_one 300 200);

testbit

testbit t n is true if the n-th bit of the bit string t is set to 1.

val testbit : t -> int -> bool

let testbit = function
| One x -> One.testbit x
| Many x -> Many.testbit x

Alcotest.(check bool) "testbit1" true  (testbit (of_int 8) 3);
Alcotest.(check bool) "testbit2" false (testbit (of_int 8) 2);
Alcotest.(check bool) "testbit3" false (testbit (of_int 8) 4);
Alcotest.(check bool) "testbit4" true  (testbit (of_z (Z.of_int 8)) 3);
Alcotest.(check bool) "testbit5" false (testbit (of_z (Z.of_int 8)) 2);
Alcotest.(check bool) "testbit6" false (testbit (of_z (Z.of_int 8)) 4);

logor

Bitwise logical or.

val logor : t -> t -> t

let logor a b = 
match a,b with
| One a, One b -> One (One.logor a b)
| Many a, Many b -> Many (Many.logor a b)
| _ -> invalid_arg "Bitstring.logor"

Alcotest.(check bool) "logor1" true (of_int (1 lor 2) = logor (of_int 1) (of_int 2));
Alcotest.(check bool) "logor2" true (of_z (Z.of_int (1 lor 2)) = logor (of_z Z.one) (of_z (Z.of_int 2)));

logxor

Bitwise logical exclusive or.

val logxor : t -> t -> t

let logxor a b = 
match a,b with
| One a, One b -> One (One.logxor a b)
| Many a, Many b -> Many (Many.logxor a b)
| _ -> invalid_arg "Bitstring.logxor"

Alcotest.(check bool) "logxor1" true (of_int (1 lxor 2) = logxor (of_int 1) (of_int 2));
Alcotest.(check bool) "logxor2" true (of_z (Z.of_int (1 lxor 2)) = logxor (of_z Z.one) (of_z (Z.of_int 2)));

logand

Bitwise logical and.

val logand : t -> t -> t

let logand a b = 
match a,b with
| One a, One b -> One (One.logand a b)
| Many a, Many b -> Many (Many.logand a b)
| _ -> invalid_arg "Bitstring.logand"

Alcotest.(check bool) "logand1" true (of_int (1 land 3) = logand (of_int 1) (of_int 3));
Alcotest.(check bool) "logand2" true (of_z (Z.of_int (1 land 3)) = logand (of_z Z.one) (of_z (Z.of_int 3)));

lognot

Bitwise logical negation.

val lognot : t -> t

let lognot = function
| One x -> One (One.lognot x)
| Many x -> Many (Many.lognot x)

minus_one

Takes the integer representation of the bit string and removes one.

minus_one (of_int 10) = of_int 9

val minus_one : t -> t

let minus_one = function
| One x -> One (One.minus_one x)
| Many x -> Many (Many.minus_one x)

plus_one

Takes the integer representation of the bit string and adds one.

plus_one (of_int 10) = of_int 11

val plus_one : t -> t

let plus_one = function
| One x -> One (One.plus_one x)
| Many x -> Many (Many.plus_one x)

trailing_zeros

Returns the number of trailing zeros in the bit string.

val trailing_zeros : t -> int

let trailing_zeros = function
| One x -> One.trailing_zeros x
| Many x -> Many.trailing_zeros x

hamdist

Returns the Hamming distance, i.e. the number of bits differing between two bit strings.

val hamdist : t -> t -> int

let hamdist a b = match a, b with
| One a, One b -> One.hamdist a b
| Many a, Many b -> Many.hamdist a b
| _ -> invalid_arg "Bitstring.hamdist"

popcount

Returns the number of bits set to one in the bit string.

val popcount : t -> int

let popcount = function
| One x -> One.popcount x
| Many x -> Many.popcount x

to_list

Converts a bit string into a list of integers indicating the positions where the bits are set to 1. The first value for the position is not 0 but 1.

Bitstring.to_list (of_int 5);;
- : int list = [1; 3]

val to_list : ?accu:(int list) -> t -> int list

let rec to_list ?(accu=[]) = function
| t when (is_zero t) -> List.rev accu
| t -> let newlist =
       (trailing_zeros t + 1)::accu
     in
     logand t @@ minus_one t
     |> (to_list [@tailcall]) ~accu:newlist

 Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (of_int 45)));

permutations

permutations m n generates the list of all possible n-bit strings with m bits set to 1. Algorithm adapted from Bit twiddling hacks.

Bitstring.permutations 2 4
|> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
- : string list =
["++--------------------------------------------------------------";
"+-+-------------------------------------------------------------";
"-++-------------------------------------------------------------";
"+--+------------------------------------------------------------";
"-+-+------------------------------------------------------------";
"--++------------------------------------------------------------"]

val permutations : int -> int -> t list

let permutations m n =                                                                   

let rec aux k u rest =
if k=1 then
  List.rev (u :: rest)
else
  let t   = logor u @@ minus_one u in
  let t'  = plus_one t in
  let not_t = lognot t in
  let neg_not_t = neg not_t in
  let t'' = shift_right (minus_one @@ logand not_t neg_not_t) (trailing_zeros u + 1) in
  (*
  let t'' = shift_right (minus_one (logand (lognot t) t')) (trailing_zeros u + 1) in
  ,*)
  (aux [@tailcall]) (k-1) (logor t' t'') (u :: rest)
in
aux (Util.binom n m) (minus_one (shift_left_one n m)) []

check "permutations"
(permutations 2 4 = List.map of_int
 [ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ]);

Printers

Printers can print as a string (pp_string) or as an integer (pp_int).

val pp : Format.formatter -> t -> unit

let pp ppf = function
| One x -> One.pp ppf x
| Many x -> Many.pp ppf x

Tests

()

let tests = [
 "all", `Quick, test_all;
]