Merge pull request #394 from c-cube/ccbv_bytes2

(continued) use bytes for CCBV

Makefile

@@ -6,7 +6,7 @@ build:
 	dune build @install -p $(PACKAGES)
 
 test: build
-	dune runtest --cache=disabled --no-buffer --force
+	dune runtest --display=quiet --cache=disabled --no-buffer --force
 
 clean:
 	dune clean

src/core/CCInt32.ml

@@ -27,6 +27,20 @@ let pow a b =
     raise (Invalid_argument "pow: can't raise int to negative power")
   | b -> aux a b
 
+(* see {!CCInt.popcount} for more details *)
+let[@inline] popcount (b : t) : int =
+  let m1 = 0x55555555l in
+  let m2 = 0x33333333l in
+  let m4 = 0x0f0f0f0fl in
+
+  let b = sub b (logand (shift_right_logical b 1) m1) in
+  let b = add (logand b m2) (logand (shift_right_logical b 2) m2) in
+  let b = logand (add b (shift_right_logical b 4)) m4 in
+  let b = add b (shift_right_logical b 8) in
+  let b = add b (shift_right_logical b 16) in
+  let b = logand b 0x7fl in
+  to_int b
+
 let floor_div a n =
   if compare a 0l < 0 && compare n 0l >= 0 then
     sub (div (add a 1l) n) 1l

src/core/CCInt32.mli

@@ -41,6 +41,10 @@ val pow : t -> t -> t
     Raises [Invalid_argument] if [x = y = 0] or [y] < 0.
     @since 0.11 *)
 
+val popcount : t -> int
+(** Number of bits set to 1.
+    @since NEXT_RELEASE *)
+
 val floor_div : t -> t -> t
 (** [floor_div x n] is integer division rounding towards negative infinity.
     It satisfies [x = m * floor_div x n + rem x n].

src/core/CCInt64.ml

@@ -8,6 +8,21 @@ let max : t -> t -> t = Stdlib.max
 let hash x = Stdlib.abs (to_int x)
 let sign i = compare i zero
 
+(* see {!CCInt.popcount} for more details *)
+let[@inline] popcount (b : t) : int =
+  let m1 = 0x5555555555555555L in
+  let m2 = 0x3333333333333333L in
+  let m4 = 0x0f0f0f0f0f0f0f0fL in
+
+  let b = sub b (logand (shift_right_logical b 1) m1) in
+  let b = add (logand b m2) (logand (shift_right_logical b 2) m2) in
+  let b = logand (add b (shift_right_logical b 4)) m4 in
+  let b = add b (shift_right_logical b 8) in
+  let b = add b (shift_right_logical b 16) in
+  let b = add b (shift_right_logical b 32) in
+  let b = logand b 0x7fL in
+  to_int b
+
 let pow a b =
   let rec aux acc = function
     | 1L -> acc

src/core/CCInt64.mli

@@ -30,6 +30,10 @@ val hash : t -> int
 (** [hash x] computes the hash of [x].
     Like {!Stdlib.abs (to_int x)}. *)
 
+val popcount : t -> int
+(** Number of bits set to 1.
+    @since NEXT_RELEASE *)
+
 val sign : t -> int
 (** [sign x] return [0] if [x = 0], [-1] if [x < 0] and [1] if [x > 0].
     Same as [compare x zero].

src/data/CCBV.ml

@@ -1,186 +1,271 @@
-(** {2 Imperative Bitvectors} *)
+let width_ = 8
 
-(* TODO: move to [bytes] and replace all [mod] and [/] with bitshifts
+(* Helper functions *)
-   because width_=8 *)
+let[@inline] get_ b i = Char.code (Bytes.get b i)
+let[@inline] unsafe_get_ b i = Char.code (Bytes.unsafe_get b i)
+let[@inline] set_ b i v = Bytes.set b i (Char.unsafe_chr v)
+let[@inline] unsafe_set_ b i v = Bytes.unsafe_set b i (Char.unsafe_chr v)
+let[@inline] mod_ n = n land 0b111
+let[@inline] div_ n = n lsr 3
+let[@inline] mul_ n = n lsl 3
+let zero = Char.unsafe_chr 0
 
-let width_ = Sys.word_size - 1
+(* 0b11111111 *)
+let all_ones_ = Char.unsafe_chr ((1 lsl width_) - 1)
+let () = assert (all_ones_ = Char.chr 0b1111_1111)
 
-(** We use OCamls ints to store the bits. We index them from the
+(* [lsb_mask_ n] is [0b111111] with [n] ones. *)
-    least significant bit. We create masks to zero out the most significant
+let[@inline] __lsb_mask n = (1 lsl n) - 1
-    bits that aren't used to store values. This is necessary when we are
-    constructing or negating a bit vector. *)
-let lsb_masks_ =
-  let a = Array.make (width_ + 1) 0 in
-  for i = 1 to width_ do
-    a.(i) <- a.(i - 1) lor (1 lsl (i - 1))
-  done;
-  a
 
-let all_ones_ = lsb_masks_.(width_)
+(*
+  from https://en.wikipedia.org/wiki/Hamming_weight
 
-(* count the 1 bits in [n]. See https://en.wikipedia.org/wiki/Hamming_weight *)
+  //This uses fewer arithmetic operations than any other known
-let count_bits_ n =
+  //implementation on machines with slow multiplication.
-  let rec recurse count n =
+  //It uses 17 arithmetic operations.
-    if n = 0 then
+  int popcount_2(uint64_t x) {
-      count
+    x -= (x >> 1) & m1;             //put count of each 2 bits into those 2 bits
-    else
+    x = (x & m2) + ((x >> 2) & m2); //put count of each 4 bits into those 4 bits
-      recurse (count + 1) (n land (n - 1))
+    x = (x + (x >> 4)) & m4;        //put count of each 8 bits into those 8 bits
-  in
-  recurse 0 n
 
-(* Can I access the "private" members in testing? $Q
+   // not necessary for int8
-   (Q.int_bound (Sys.word_size - 1)) (fun i -> count_bits_ lsb_masks_.(i) = i)
+    // x += x >>  8;  //put count of each 16 bits into their lowest 8 bits
+    // x += x >> 16;  //put count of each 32 bits into their lowest 8 bits
+    // x += x >> 32;  //put count of each 64 bits into their lowest 8 bits
+
+    return x & 0x7f;
+  }
+
+   m1 = 0x5555555555555555
+   m2 = 0x3333333333333333
+   m4 = 0x0f0f0f0f0f0f0f0f
 *)
+let[@inline] __popcount8 (b : int) : int =
+  let m1 = 0x55 in
+  let m2 = 0x33 in
+  let m4 = 0x0f in
 
-type t = { mutable a: int array; mutable size: int }
+  let b = b - ((b lsr 1) land m1) in
+  let b = (b land m2) + ((b lsr 2) land m2) in
+  let b = (b + (b lsr 4)) land m4 in
+  b land 0x7f
+
+(*
+  invariants for [v:t]:
+
+  - [Bytes.length v.b >= div_ v.size] (enough storage)
+  - all bits above [size] are 0 in [v.b]
+*)
+type t = { mutable b: bytes; mutable size: int }
 
 let length t = t.size
-let empty () = { a = [||]; size = 0 }
+let empty () = { b = Bytes.empty; size = 0 }
 
-let array_length_of_size size =
+let bytes_length_of_size size =
-  if size mod width_ = 0 then
+  if mod_ size = 0 then
-    size / width_
+    div_ size
   else
-    (size / width_) + 1
+    div_ size + 1
 
-let create ~size default =
+let create ~size default : t =
   if size = 0 then
-    { a = [||]; size }
+    empty ()
   else (
-    let n = array_length_of_size size in
+    let n = bytes_length_of_size size in
-    let a =
+    let b =
       if default then
-        Array.make n all_ones_
+        Bytes.make n all_ones_
       else
-        Array.make n 0
+        Bytes.make n zero
     in
     (* adjust last bits *)
-    let r = size mod width_ in
+    let r = mod_ size in
-    if default && r <> 0 then Array.unsafe_set a (n - 1) lsb_masks_.(r);
+    if default && r <> 0 then unsafe_set_ b (n - 1) (__lsb_mask r);
-    { a; size }
+    { b; size }
   )
 
-let copy bv = { bv with a = Array.copy bv.a }
+let copy bv = { bv with b = Bytes.sub bv.b 0 (bytes_length_of_size bv.size) }
-let capacity bv = width_ * Array.length bv.a
+let[@inline] capacity bv = mul_ (Bytes.length bv.b)
+
+(* call [f i width(byte[i]) (byte[i])] on each byte.
+   The last byte might have a width of less than 8. *)
+let iter_bytes_ (b : t) ~f : unit =
+  for n = 0 to div_ b.size - 1 do
+    f (mul_ n) width_ (unsafe_get_ b.b n)
+  done;
+  let r = mod_ b.size in
+  if r <> 0 then (
+    let last = div_ b.size in
+    f (mul_ last) r (__lsb_mask r land unsafe_get_ b.b last)
+  )
+
+(* set [byte[i]] to [f(byte[i])] *)
+let map_bytes_ (b : t) ~f : unit =
+  for n = 0 to div_ b.size - 1 do
+    unsafe_set_ b.b n (f (unsafe_get_ b.b n))
+  done;
+  let r = mod_ b.size in
+  if r <> 0 then (
+    let last = div_ b.size in
+    let mask = __lsb_mask r in
+    unsafe_set_ b.b last (mask land f (mask land unsafe_get_ b.b last))
+  )
 
 let cardinal bv =
   if bv.size = 0 then
     0
   else (
     let n = ref 0 in
-    for i = 0 to Array.length bv.a - 1 do
+    iter_bytes_ bv ~f:(fun _ _ b -> n := !n + __popcount8 b);
-      n := !n + count_bits_ bv.a.(i) (* MSB of last element are all 0 *)
-    done;
     !n
   )
 
 let really_resize_ bv ~desired ~current size =
-  let a' = Array.make desired 0 in
+  bv.size <- size;
-  Array.blit bv.a 0 a' 0 current;
+  if desired <> current then (
-  bv.a <- a';
+    let b = Bytes.make desired zero in
-  bv.size <- size
+    Bytes.blit bv.b 0 b 0 (min desired current);
+    bv.b <- b
+  )
 
-let grow_ bv size =
+(* set bits above [n] to 0 *)
-  if size <= capacity bv (* within capacity *) then
+let[@inline never] clear_bits_above_ bv top =
-    bv.size <- size
+  let n = div_ top in
-  else (
+  let j = mod_ top in
+  Bytes.fill bv.b (n + 1)
+    (bytes_length_of_size bv.size - n - 1)
+    (Char.unsafe_chr 0);
+  unsafe_set_ bv.b n (unsafe_get_ bv.b n land __lsb_mask j)
+
+let[@inline never] grow_to_at_least_real_ bv size =
   (* beyond capacity *)
-    let desired = array_length_of_size size in
+  let current = Bytes.length bv.b in
-    let current = Array.length bv.a in
+  let desired = bytes_length_of_size size in
+  let desired =
+    min Sys.max_string_length (max desired (current + (current / 2)))
+  in
   assert (desired > current);
   really_resize_ bv ~desired ~current size
+
+let grow_to_at_least_ bv size =
+  if size <= capacity bv then
+    (* within capacity *)
+    bv.size <- size
+  else
+    (* resize. This is a separate function so it's easier to
+       inline the happy path. *)
+    grow_to_at_least_real_ bv size
+
+let shrink_ bv size =
+  assert (size <= bv.size);
+  if size < bv.size then (
+    let desired = bytes_length_of_size size in
+    let current = Bytes.length bv.b in
+    clear_bits_above_ bv size;
+    really_resize_ bv ~desired ~current size
   )
 
-let shrink_ bv size =
-  let desired = array_length_of_size size in
-  let current = Array.length bv.a in
-  really_resize_ bv ~desired ~current size
-
 let resize bv size =
   if size < 0 then invalid_arg "resize: negative size";
-  if size < bv.size (* shrink *) then
+  if size < bv.size then (
+    clear_bits_above_ bv size;
+    bv.size <- size
+  ) else if size > bv.size then
+    grow_to_at_least_ bv size
+
+let resize_minimize_memory bv size =
+  if size < 0 then invalid_arg "resize: negative size";
+  if size < bv.size then
     shrink_ bv size
-  else if size = bv.size then
+  else if size > bv.size then
-    ()
+    grow_to_at_least_ bv size
-  else
-    grow_ bv size
 
 let is_empty bv =
+  bv.size = 0
+  ||
   try
-    for i = 0 to Array.length bv.a - 1 do
+    for i = 0 to bytes_length_of_size bv.size - 1 do
-      if bv.a.(i) <> 0 then raise Exit (* MSB of last element are all 0 *)
+      if unsafe_get_ bv.b i <> 0 then raise_notrace Exit
     done;
     true
   with Exit -> false
 
-let get bv i =
+let[@inline] get bv i =
   if i < 0 then invalid_arg "get: negative index";
-  let n = i / width_ in
+  let idx_bucket = div_ i in
-  let i = i mod width_ in
+  let idx_in_byte = mod_ i in
-  if n < Array.length bv.a then
+  if idx_bucket < Bytes.length bv.b then
-    Array.unsafe_get bv.a n land (1 lsl i) <> 0
+    unsafe_get_ bv.b idx_bucket land (1 lsl idx_in_byte) <> 0
   else
     false
 
-let set bv i =
+let[@inline] set bv i =
   if i < 0 then
     invalid_arg "set: negative index"
   else (
-    let n = i / width_ in
+    let idx_bucket = div_ i in
-    let j = i mod width_ in
+    let idx_in_byte = mod_ i in
-    if i >= bv.size then grow_ bv (i + 1);
+    if i >= bv.size then grow_to_at_least_ bv (i + 1);
-    Array.unsafe_set bv.a n (Array.unsafe_get bv.a n lor (1 lsl j))
+    unsafe_set_ bv.b idx_bucket
+      (unsafe_get_ bv.b idx_bucket lor (1 lsl idx_in_byte))
   )
 
-let reset bv i =
+let init size f : t =
+  let v = create ~size false in
+  for i = 0 to size - 1 do
+    if f i then set v i
+  done;
+  v
+
+let[@inline] reset bv i =
   if i < 0 then
     invalid_arg "reset: negative index"
   else (
-    let n = i / width_ in
+    let n = div_ i in
-    let j = i mod width_ in
+    let j = mod_ i in
-    if i >= bv.size then grow_ bv (i + 1);
+    if i >= bv.size then grow_to_at_least_ bv (i + 1);
-    Array.unsafe_set bv.a n (Array.unsafe_get bv.a n land lnot (1 lsl j))
+    unsafe_set_ bv.b n (unsafe_get_ bv.b n land lnot (1 lsl j))
   )
 
+let[@inline] set_bool bv i b =
+  if b then
+    set bv i
+  else
+    reset bv i
+
 let flip bv i =
   if i < 0 then
     invalid_arg "reset: negative index"
   else (
-    let n = i / width_ in
+    let n = div_ i in
-    let j = i mod width_ in
+    let j = mod_ i in
-    if i >= bv.size then grow_ bv (i + 1);
+    if i >= bv.size then grow_to_at_least_ bv (i + 1);
-    Array.unsafe_set bv.a n (Array.unsafe_get bv.a n lxor (1 lsl j))
+    unsafe_set_ bv.b n (unsafe_get_ bv.b n lxor (1 lsl j))
   )
 
-let clear bv = Array.fill bv.a 0 (Array.length bv.a) 0
+let clear bv = Bytes.fill bv.b 0 (Bytes.length bv.b) zero
-let equal x y : bool = x.size = y.size && x.a = y.a
+
+let clear_and_shrink bv =
+  clear bv;
+  bv.size <- 0
+
+let equal_bytes_ size b1 b2 =
+  try
+    for i = 0 to bytes_length_of_size size - 1 do
+      if Bytes.get b1 i <> Bytes.get b2 i then raise_notrace Exit
+    done;
+    true
+  with Exit -> false
+
+let equal x y : bool = x.size = y.size && equal_bytes_ x.size x.b y.b
 
 let iter bv f =
-  let len = array_length_of_size bv.size in
+  iter_bytes_ bv ~f:(fun off width_n word_n ->
-  assert (len <= Array.length bv.a);
+      for i = 0 to width_n - 1 do
-  for n = 0 to len - 2 do
+        f (off + i) (word_n land (1 lsl i) <> 0)
-    let j = width_ * n in
+      done)
-    let word_n = Array.unsafe_get bv.a n in
-    for i = 0 to width_ - 1 do
-      f (j + i) (word_n land (1 lsl i) <> 0)
-    done
-  done;
-  if bv.size > 0 then (
-    let j = width_ * (len - 1) in
-    let r = bv.size mod width_ in
-    let final_length =
-      if r = 0 then
-        width_
-      else
-        r
-    in
-    let final_word = Array.unsafe_get bv.a (len - 1) in
-    for i = 0 to final_length - 1 do
-      f (j + i) (final_word land (1 lsl i) <> 0)
-    done
-  )
 
-let[@inline] iter_true bv f =
+let iter_true bv f =
   iter bv (fun i b ->
       if b then
         f i
@@ -196,7 +281,11 @@ let to_sorted_list bv = List.rev (to_list bv)
 
 (* Interpret these as indices. *)
 let of_list l =
-  let size = List.fold_left max 0 l + 1 in
+  let size =
+    match l with
+    | [] -> 0
+    | _ -> List.fold_left max 0 l + 1
+  in
   let bv = create ~size false in
   List.iter (fun i -> set bv i) l;
   bv
@@ -205,43 +294,28 @@ exception FoundFirst of int
 
 let first_exn bv =
   try
-    iter_true bv (fun i -> raise (FoundFirst i));
+    iter_true bv (fun i -> raise_notrace (FoundFirst i));
     raise Not_found
   with FoundFirst i -> i
 
 let first bv = try Some (first_exn bv) with Not_found -> None
 let filter bv p = iter_true bv (fun i -> if not (p i) then reset bv i)
+let negate_self bv = map_bytes_ bv ~f:(fun b -> lnot b)
 
-let negate_self b =
+let negate a =
-  let len = Array.length b.a in
+  let b = copy a in
-  for n = 0 to len - 1 do
+  negate_self b;
-    Array.unsafe_set b.a n (lnot (Array.unsafe_get b.a n))
+  b
-  done;
-  let r = b.size mod width_ in
-  if r <> 0 then (
-    let l = Array.length b.a - 1 in
-    Array.unsafe_set b.a l (lsb_masks_.(r) land Array.unsafe_get b.a l)
-  )
-
-let negate b =
-  let a = Array.map lnot b.a in
-  let r = b.size mod width_ in
-  if r <> 0 then (
-    let l = Array.length b.a - 1 in
-    Array.unsafe_set a l (lsb_masks_.(r) land Array.unsafe_get a l)
-  );
-  { a; size = b.size }
 
 let union_into_no_resize_ ~into bv =
-  assert (Array.length into.a >= Array.length bv.a);
+  assert (Bytes.length into.b >= bytes_length_of_size bv.size);
-  for i = 0 to Array.length bv.a - 1 do
+  for i = 0 to bytes_length_of_size bv.size - 1 do
-    Array.unsafe_set into.a i
+    unsafe_set_ into.b i (unsafe_get_ into.b i lor unsafe_get_ bv.b i)
-      (Array.unsafe_get into.a i lor Array.unsafe_get bv.a i)
   done
 
 (* Underlying size grows for union. *)
 let union_into ~into bv =
-  if into.size < bv.size then grow_ into bv.size;
+  if into.size < bv.size then grow_to_at_least_ into bv.size;
   union_into_no_resize_ ~into bv
 
 (* To avoid potentially 2 passes, figure out what we need to copy. *)
@@ -257,10 +331,9 @@ let union b1 b2 =
   )
 
 let inter_into_no_resize_ ~into bv =
-  assert (Array.length into.a <= Array.length bv.a);
+  assert (into.size <= bv.size);
-  for i = 0 to Array.length into.a - 1 do
+  for i = 0 to bytes_length_of_size into.size - 1 do
-    Array.unsafe_set into.a i
+    unsafe_set_ into.b i (unsafe_get_ into.b i land unsafe_get_ bv.b i)
-      (Array.unsafe_get into.a i land Array.unsafe_get bv.a i)
   done
 
 (* Underlying size shrinks for inter. *)
@@ -279,13 +352,12 @@ let inter b1 b2 =
     into
   )
 
-(* Underlying size depends on the 'in_' set for diff, so we don't change
+(* Underlying size depends on the [in_] set for diff, so we don't change
-   it's size! *)
+   its size! *)
 let diff_into ~into bv =
-  let n = min (Array.length into.a) (Array.length bv.a) in
+  let n = min (Bytes.length into.b) (Bytes.length bv.b) in
   for i = 0 to n - 1 do
-    Array.unsafe_set into.a i
+    unsafe_set_ into.b i (unsafe_get_ into.b i land lnot (unsafe_get_ bv.b i))
-      (Array.unsafe_get into.a i land lnot (Array.unsafe_get bv.a i))
   done
 
 let diff in_ not_in =
@@ -298,7 +370,7 @@ let select bv arr =
   (try
      iter_true bv (fun i ->
          if i >= Array.length arr then
-           raise Exit
+           raise_notrace Exit
          else
            l := arr.(i) :: !l)
    with Exit -> ());
@@ -309,7 +381,7 @@ let selecti bv arr =
   (try
      iter_true bv (fun i ->
          if i >= Array.length arr then
-           raise Exit
+           raise_notrace Exit
          else
            l := (arr.(i), i) :: !l)
    with Exit -> ());
@@ -338,4 +410,24 @@ let pp out bv =
           '0'));
   Format.pp_print_string out "}"
 
-let __to_word_l bv = Array.to_list bv.a
+module Internal_ = struct
+  let __to_word_l bv =
+    let l = ref [] in
+    Bytes.iter (fun c -> l := c :: !l) bv.b;
+    List.rev !l
+
+  let __popcount8 = __popcount8
+  let __lsb_mask = __lsb_mask
+
+  let __check_invariant self =
+    let n = div_ self.size in
+    let j = mod_ self.size in
+    assert (Bytes.length self.b >= n);
+    if j > 0 then
+      assert (
+        let c = get_ self.b n in
+        c land __lsb_mask j = c);
+    for i = n + 1 to Bytes.length self.b - 1 do
+      assert (get_ self.b i = 0)
+    done
+end

src/data/CCBV.mli

@@ -1,6 +1,8 @@
-(* This file is free software, part of containers. See file "license" for more details. *)
+(** Imperative Bitvectors.
 
-(** Imperative Bitvectors
+    A bitvector is stored in some form of internal array (on the heap).
+    Is it a bit similar to a more storage-efficient version of [bool
+    CCVector.vector], with additional operations.
 
     {b BREAKING CHANGES} since 1.2:
     size is now stored along with the bitvector. Some functions have
@@ -15,10 +17,16 @@ type t
 (** A resizable bitvector *)
 
 val empty : unit -> t
-(** Empty bitvector. *)
+(** Empty bitvector. Length is 0. *)
 
 val create : size:int -> bool -> t
-(** Create a bitvector of given size, with given default value. *)
+(** Create a bitvector of given size, with given default value.
+    Length of result is [size]. *)
+
+val init : int -> (int -> bool) -> t
+(** [init len f] initializes a bitvector of length [len], where bit [i]
+    is true iff [f i] is.
+    @since NEXT_RELEASE *)
 
 val copy : t -> t
 (** Copy of bitvector. *)
@@ -38,10 +46,16 @@ val capacity : t -> int
     @since 1.2 *)
 
 val resize : t -> int -> unit
-(** Resize the BV so that it has the specified length. This can grow or shrink
+(** Resize the BV so that it has the specified length. This can grow
-    the underlying bitvector.
+    the underlying array, but it will not shrink it, to minimize
+    memory traffic.
+    @raise Invalid_argument on negative sizes. *)
 
-    @raise Invalid_arg on negative sizes. *)
+val resize_minimize_memory : t -> int -> unit
+(** Same as {!resize}, but this can also shrink the underlying
+    array if this reduces the size.
+    @raise Invalid_argument on negative sizes.
+    @since NEXT_RELEASE *)
 
 val is_empty : t -> bool
 (** Are there any true bits? *)
@@ -55,11 +69,19 @@ val get : t -> int -> bool
 val reset : t -> int -> unit
 (** Set i-th bit to 0, extending the bitvector if needed. *)
 
+val set_bool : t -> int -> bool -> unit
+(** Set or reset [i]-th bit.
+    @since NEXT_RELEASE *)
+
 val flip : t -> int -> unit
 (** Flip i-th bit, extending the bitvector if needed. *)
 
 val clear : t -> unit
-(** Set every bit to 0. *)
+(** Set every bit to 0. Does not change the length. *)
+
+val clear_and_shrink : t -> unit
+(** Set every bit to 0, and set length to 0.
+    @since NEXT_RELEASE *)
 
 val iter : t -> (int -> bool -> unit) -> unit
 (** Iterate on all bits. *)
@@ -92,15 +114,17 @@ val first_exn : t -> int
 
 val filter : t -> (int -> bool) -> unit
 (** [filter bv p] only keeps the true bits of [bv] whose [index]
-    satisfies [p index]. *)
+    satisfies [p index].
+    Length is unchanged. *)
 
 val negate_self : t -> unit
-(** [negate_self t] flips all of the bits in [t].
+(** [negate_self t] flips all of the bits in [t]. Length is unchanged.
 
     @since 1.2 *)
 
 val negate : t -> t
-(** [negate t] returns a copy of [t] with all of the bits flipped. *)
+(** [negate t] returns a copy of [t] with all of the bits flipped.
+    Length is unchanged. *)
 
 val union_into : into:t -> t -> unit
 (** [union_into ~into bv] sets [into] to the union of itself and [bv].
@@ -108,13 +132,20 @@ val union_into : into:t -> t -> unit
 
 val inter_into : into:t -> t -> unit
 (** [inter_into ~into bv] sets [into] to the intersection of itself and [bv].
-    Also updates the length of [into] to be at most [length bv]. *)
+    Also updates the length of [into] to be at most [length bv].
+
+    After executing:
+    - [length ~into' = min (length into) (length bv)].
+    - [for all i: get into' ==> get into i /\ get bv i]
+  *)
 
 val union : t -> t -> t
-(** [union bv1 bv2] returns the union of the two sets. *)
+(** [union bv1 bv2] returns the union of the two sets. The length
+     of the result is the max of the inputs' lengths. *)
 
 val inter : t -> t -> t
-(** [inter bv1 bv2] returns the intersection of the two sets. *)
+(** [inter bv1 bv2] returns the intersection of the two sets. The length
+    of the result is the min of the inputs' lengths. *)
 
 val diff_into : into:t -> t -> unit
 (** [diff_into ~into t] modifies [into] with only the bits set but not in [t].
@@ -142,7 +173,10 @@ val equal : t -> t -> bool
 type 'a iter = ('a -> unit) -> unit
 
 val to_iter : t -> int iter
+(** Iterate over the true bits. *)
+
 val of_iter : int iter -> t
+(** Build from true bits. *)
 
 val pp : Format.formatter -> t -> unit
 (** Print the bitvector as a string of bits.
@@ -150,6 +184,11 @@ val pp : Format.formatter -> t -> unit
 
 (**/**)
 
-val __to_word_l : t -> int list
+module Internal_ : sig
+  val __to_word_l : t -> char list
+  val __popcount8 : int -> int
+  val __lsb_mask : int -> int
+  val __check_invariant : t -> unit
+end
 
 (**/**)

src/testlib/containers_testlib.ml

@@ -7,21 +7,29 @@ type 'a print = 'a -> string
 
 module Test = struct
   type run =
-    | T of (unit -> bool)
+    | T of { prop: unit -> bool }
     | Eq : { eq: 'a eq option; print: 'a print option; lhs: 'a; rhs: 'a } -> run
     | Q : {
         count: int option;
         arb: 'a Q.arbitrary;
         prop: 'a -> bool;
         long_factor: int option;
+        max_gen: int option;
+        max_fail: int option;
+        if_assumptions_fail: ([ `Fatal | `Warning ] * float) option;
       }
         -> run
 
-  type t = { run: run; __FILE__: string; n: int }
+  type t = { name: string option; run: run; __FILE__: string; n: int }
 
   (** Location for this test *)
   let str_loc (self : t) : string =
-    Printf.sprintf "(test :file '%s' :n %d)" self.__FILE__ self.n
+    let what =
+      match self.name with
+      | None -> ""
+      | Some f -> spf " :name %S" f
+    in
+    Printf.sprintf "(test :file '%s'%s :n %d)" self.__FILE__ what self.n
 
   [@@@ifge 4.08]
 
@@ -36,14 +44,17 @@ module Test = struct
 
   [@@@endif]
 
-  let run ~seed (self : t) : _ result =
+  let run ?(long = false) ~seed (self : t) : _ result =
     match
+      let what = CCOption.map_or ~default:"" (fun s -> s ^ " ") self.name in
       match self.run with
-      | T f ->
+      | T { prop } ->
-        if f () then
+        let fail msg = Error (spf "%sfailed: %s" what msg) in
-          Ok ()
+
-        else
+        (match prop () with
-          Error "failed: returns false"
+        | exception e -> fail (spf "raised %s" (Printexc.to_string e))
+        | true -> Ok ()
+        | false -> fail "returns false")
       | Eq { eq; print; lhs; rhs } ->
         let eq =
           match eq with
@@ -55,12 +66,22 @@ module Test = struct
         else (
           let msg =
             match print with
-            | None -> "failed: not equal"
+            | None -> spf "%sfailed: not equal" what
-            | Some p -> spf "failed: not equal:\nlhs=%s\nrhs=%s" (p lhs) (p rhs)
+            | Some p ->
+              spf "%s failed: not equal:\nlhs=%s\nrhs=%s" what (p lhs) (p rhs)
           in
           Error msg
         )
-      | Q { count; arb; prop; long_factor } ->
+      | Q
+          {
+            count;
+            arb;
+            prop;
+            long_factor;
+            max_fail;
+            max_gen;
+            if_assumptions_fail;
+          } ->
         (* create a random state from the seed *)
         let rand =
           let bits =
@@ -71,7 +92,8 @@ module Test = struct
 
         let module Fmt = CCFormat in
         let cell =
-          Q.Test.make_cell ?count ?long_factor ~name:(str_loc self) arb prop
+          Q.Test.make_cell ?if_assumptions_fail ?max_gen ?max_fail ?count
+            ?long_factor ~name:(str_loc self) arb prop
         in
 
         let pp_cex out (cx : _ Q.TestResult.counter_ex) =
@@ -91,24 +113,24 @@ module Test = struct
         in
 
         (* TODO: if verbose, print stats, etc. *)
-        let res = Q.Test.check_cell ~rand cell in
+        let res = Q.Test.check_cell ~long ~rand cell in
 
         (match get_state res with
         | QCheck.TestResult.Success -> Ok ()
         | QCheck.TestResult.Failed { instances } ->
           let msg =
-            Format.asprintf "@[<v2>failed on instances:@ %a@]"
+            Format.asprintf "@[<v2>%sfailed on instances:@ %a@]" what
               (Fmt.list ~sep:(Fmt.return ";@ ") pp_cex)
               instances
           in
           Error msg
         | QCheck.TestResult.Failed_other { msg } ->
-          let msg = spf "failed: %s" msg in
+          let msg = spf "%sfailed: %s" what msg in
           Error msg
         | QCheck.TestResult.Error { instance; exn; backtrace } ->
           let msg =
-            Format.asprintf "@[<v2>raised %s@ on instance %a@ :backtrace %s@]"
+            Format.asprintf "@[<v2>%sraised %s@ on instance %a@ :backtrace %s@]"
-              (Printexc.to_string exn) pp_cex instance backtrace
+              what (Printexc.to_string exn) pp_cex instance backtrace
           in
           Error msg)
     with
@@ -119,11 +141,19 @@ end
 module type S = sig
   module Q = QCheck
 
-  val t : (unit -> bool) -> unit
+  val t : ?name:string -> (unit -> bool) -> unit
-  val eq : ?cmp:'a eq -> ?printer:'a print -> 'a -> 'a -> unit
+  val eq : ?name:string -> ?cmp:'a eq -> ?printer:'a print -> 'a -> 'a -> unit
 
   val q :
-    ?count:int -> ?long_factor:int -> 'a Q.arbitrary -> ('a -> bool) -> unit
+    ?name:string ->
+    ?count:int ->
+    ?long_factor:int ->
+    ?max_gen:int ->
+    ?max_fail:int ->
+    ?if_assumptions_fail:[ `Fatal | `Warning ] * float ->
+    'a Q.arbitrary ->
+    ('a -> bool) ->
+    unit
 
   val assert_equal :
     ?printer:('a -> string) -> ?cmp:('a -> 'a -> bool) -> 'a -> 'a -> unit
@@ -144,18 +174,29 @@ struct
   let add_ t = all_ := t :: !all_
   let n_ = ref 0
 
-  let mk run : Test.t =
+  let mk ?name run : Test.t =
     let n = !n_ in
     incr n_;
-    { __FILE__ = X.file; n; run }
+    { __FILE__ = X.file; name; n; run }
 
-  let t f : unit = add_ @@ mk @@ Test.T f
+  let t ?name f : unit = add_ @@ mk ?name @@ Test.T { prop = f }
 
-  let eq ?cmp ?printer lhs rhs : unit =
+  let eq ?name ?cmp ?printer lhs rhs : unit =
-    add_ @@ mk @@ Test.Eq { eq = cmp; print = printer; lhs; rhs }
+    add_ @@ mk ?name @@ Test.Eq { eq = cmp; print = printer; lhs; rhs }
 
-  let q ?count ?long_factor arb prop : unit =
+  let q ?name ?count ?long_factor ?max_gen ?max_fail ?if_assumptions_fail arb
-    add_ @@ mk @@ Test.Q { arb; prop; count; long_factor }
+      prop : unit =
+    add_ @@ mk ?name
+    @@ Test.Q
+         {
+           arb;
+           prop;
+           count;
+           long_factor;
+           max_gen;
+           max_fail;
+           if_assumptions_fail;
+         }
 
   let assert_equal ?printer ?(cmp = ( = )) x y : unit =
     if not @@ cmp x y then (
@@ -188,7 +229,12 @@ let make ~__FILE__ () : (module S) =
 
 let getenv_opt s = try Some (Sys.getenv s) with _ -> None
 
-let run_all ?seed:seed_hex ~descr (l : Test.t list list) : unit =
+let long =
+  match getenv_opt "LONG" with
+  | Some ("true" | "1") -> true
+  | _ -> false
+
+let run_all ?seed:seed_hex ?(long = long) ~descr (l : Test.t list list) : unit =
   let start = Unix.gettimeofday () in
 
   (* generate or parse seed *)
@@ -223,7 +269,7 @@ let run_all ?seed:seed_hex ~descr (l : Test.t list list) : unit =
       NOTE: we probably want this to be silent?
       Format.printf "> run %s@." (Test.str_loc t);
       *)
-      match Test.run ~seed t with
+      match Test.run ~long ~seed t with
       | Ok () -> ()
       | Error msg ->
         Format.printf "FAILED: %s@." (Test.str_loc t);

src/testlib/containers_testlib.mli

@@ -8,11 +8,19 @@ end
 module type S = sig
   module Q = QCheck
 
-  val t : (unit -> bool) -> unit
+  val t : ?name:string -> (unit -> bool) -> unit
-  val eq : ?cmp:'a eq -> ?printer:'a print -> 'a -> 'a -> unit
+  val eq : ?name:string -> ?cmp:'a eq -> ?printer:'a print -> 'a -> 'a -> unit
 
   val q :
-    ?count:int -> ?long_factor:int -> 'a Q.arbitrary -> ('a -> bool) -> unit
+    ?name:string ->
+    ?count:int ->
+    ?long_factor:int ->
+    ?max_gen:int ->
+    ?max_fail:int ->
+    ?if_assumptions_fail:[ `Fatal | `Warning ] * float ->
+    'a Q.arbitrary ->
+    ('a -> bool) ->
+    unit
 
   val assert_equal :
     ?printer:('a -> string) -> ?cmp:('a -> 'a -> bool) -> 'a -> 'a -> unit
@@ -24,4 +32,6 @@ module type S = sig
 end
 
 val make : __FILE__:string -> unit -> (module S)
-val run_all : ?seed:string -> descr:string -> Test.t list list -> unit
+
+val run_all :
+  ?seed:string -> ?long:bool -> descr:string -> Test.t list list -> unit

tests/core/t_int32.ml

@@ -83,4 +83,20 @@ q
 
 eq ~printer:CCFun.id "0b111" (to_string_binary 7l);;
 eq ~printer:CCFun.id "-0b111" (to_string_binary (-7l));;
-eq ~printer:CCFun.id "0b0" (to_string_binary 0l)
+eq ~printer:CCFun.id "0b0" (to_string_binary 0l);;
+
+q
+  Q.(0 -- (Int32.max_int |> Int32.to_int))
+  (fun i ->
+    let n1 = CCInt.popcount i in
+    let n2 = CCInt32.popcount (Int32.of_int i) in
+    CCInt.(n1 = n2))
+
+let eq' = eq ~printer:CCInt.to_string;;
+
+eq' 0 (popcount 0l);;
+eq' 1 (popcount 1l);;
+eq' 31 (popcount max_int);;
+eq' 1 (popcount min_int);;
+eq' 10 (popcount 0b1110010110110001010l);;
+eq' 5 (popcount 0b1101110000000000l)

tests/core/t_int64.ml

@@ -92,3 +92,12 @@ q
 eq ~printer:CCFun.id "0b111" (to_string_binary 7L);;
 eq ~printer:CCFun.id "-0b111" (to_string_binary (-7L));;
 eq ~printer:CCFun.id "0b0" (to_string_binary 0L)
+
+let eq' = eq ~printer:CCInt.to_string;;
+
+eq' 0 (popcount 0L);;
+eq' 1 (popcount 1L);;
+eq' 63 (popcount max_int);;
+eq' 1 (popcount min_int);;
+eq' 10 (popcount 0b1110010110110001010L);;
+eq' 5 (popcount 0b1101110000000000L)

tests/data/t_bv.ml

@@ -1,16 +1,35 @@
 module Test = (val Containers_testlib.make ~__FILE__ ())
 open Test
 open CCBV
+open Internal_
 
-let ppli = CCFormat.(Dump.list int);;
+let spf = Printf.sprintf
+let ppli = CCFormat.(Dump.list int)
+
+module Intset = CCSet.Make (CCInt);;
 
 q (Q.pair Q.small_int Q.bool) (fun (size, b) -> create ~size b |> length = size)
 ;;
-t @@ fun () -> create ~size:17 true |> cardinal = 17;;
+
-t @@ fun () -> create ~size:32 true |> cardinal = 32;;
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
-t @@ fun () -> create ~size:132 true |> cardinal = 132;;
+create ~size:17 true |> cardinal = 17
-t @@ fun () -> create ~size:200 false |> cardinal = 0;;
+;;
-t @@ fun () -> create ~size:29 true |> to_sorted_list = CCList.range 0 28;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
+create ~size:32 true |> cardinal = 32
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
+create ~size:132 true |> cardinal = 132
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
+create ~size:200 false |> cardinal = 0
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
+create ~size:29 true |> to_sorted_list = CCList.range 0 28
+;;
 
 q (Q.list Q.small_int) (fun l ->
     let bv = of_list l in
@@ -19,7 +38,11 @@ q (Q.list Q.small_int) (fun l ->
 
 q Q.small_int (fun size -> create ~size true |> cardinal = size);;
 
-t @@ fun () ->
+q Q.small_int (fun size ->
+    create ~size true |> to_sorted_list = CCList.init size CCFun.id)
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv1 = CCBV.create ~size:87 true in
 assert_equal ~printer:string_of_int 87 (CCBV.cardinal bv1);
 true
@@ -27,7 +50,7 @@ true
 
 q Q.small_int (fun n -> CCBV.cardinal (CCBV.create ~size:n true) = n);;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv = CCBV.create ~size:99 false in
 assert_bool "32 must be false" (not (CCBV.get bv 32));
 assert_bool "88 must be false" (not (CCBV.get bv 88));
@@ -44,26 +67,26 @@ assert_bool "1 must be false" (not (CCBV.get bv 1));
 true
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv = create ~size:3 false in
 set bv 0;
 get bv 0
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv = create ~size:3 false in
 set bv 1;
 not (get bv 0)
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv = create ~size:3 false in
 set bv 0;
 reset bv 0;
 not (get bv 0)
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv = of_list [ 1; 10; 11; 30 ] in
 flip bv 10;
 assert_equal ~printer:Q.Print.(list int) [ 1; 11; 30 ] (to_sorted_list bv);
@@ -83,7 +106,7 @@ assert_equal ~printer:Q.Print.bool true (get bv 100);
 true
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv = create ~size:37 true in
 cardinal bv = 37
 &&
@@ -91,7 +114,7 @@ cardinal bv = 37
  cardinal bv = 0)
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv = CCBV.of_list [ 1; 5; 200 ] in
 assert_equal ~printer:string_of_int 3 (CCBV.cardinal bv);
 CCBV.clear bv;
@@ -100,13 +123,25 @@ assert_bool "must be empty" (CCBV.is_empty bv);
 true
 ;;
 
-t @@ fun () -> equal (of_list [ 1; 3; 4 ]) (of_list [ 1; 3; 4 ]);;
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
-t @@ fun () -> equal (empty ()) (empty ());;
+equal (of_list [ 1; 3; 4 ]) (of_list [ 1; 3; 4 ])
-t @@ fun () -> not (equal (empty ()) (of_list [ 1 ]));;
+;;
-t @@ fun () -> not (equal (empty ()) (of_list [ 2; 5 ]));;
-t @@ fun () -> not (equal (of_list [ 1; 3 ]) (of_list [ 2; 3 ]));;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () -> equal (empty ()) (empty ());;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
+not (equal (empty ()) (of_list [ 1 ]))
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
+not (equal (empty ()) (of_list [ 2; 5 ]))
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
+not (equal (of_list [ 1; 3 ]) (of_list [ 2; 3 ]))
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 List.iter
   (fun size ->
     let bv = create ~size false in
@@ -142,7 +177,7 @@ q
     List.length l = n && List.for_all (fun (_, b) -> b) l)
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 of_list [ 1; 5; 7 ]
 |> iter_true |> Iter.to_list |> List.sort CCOrd.poly = [ 1; 5; 7 ]
 
@@ -157,7 +192,7 @@ q gen_bv (fun bv ->
     CCBV.cardinal bv = CCBV.cardinal bv')
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv = CCBV.of_list [ 1; 5; 156; 0; 222 ] in
 assert_equal ~printer:string_of_int 5 (CCBV.cardinal bv);
 CCBV.set bv 201;
@@ -190,7 +225,7 @@ q
     let l1 = bv |> to_sorted_list in
     let l2 =
       CCList.init (length bv) (get bv)
-      |> List.mapi (fun i b -> i, b)
+      |> CCList.mapi (fun i b -> i, b)
       |> CCList.filter_map (function
            | i, true -> Some i
            | _ -> None)
@@ -208,12 +243,23 @@ eq ~cmp:equal ~printer:(CCFormat.to_string pp)
    bv)
 ;;
 
-t @@ fun () -> of_list [ 1; 32; 64 ] |> CCFun.flip get 64;;
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
-t @@ fun () -> of_list [ 1; 32; 64 ] |> CCFun.flip get 32;;
+of_list [ 1; 32; 64 ] |> CCFun.flip get 64
-t @@ fun () -> of_list [ 1; 31; 63 ] |> CCFun.flip get 63;;
+;;
-t @@ fun () -> of_list [ 50; 10; 17; 22; 3; 12 ] |> first = Some 3;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
+of_list [ 1; 32; 64 ] |> CCFun.flip get 32
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
+of_list [ 1; 31; 63 ] |> CCFun.flip get 63
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
+of_list [ 50; 10; 17; 22; 3; 12 ] |> first = Some 3
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv = of_list [ 1; 2; 3; 4; 5; 6; 7 ] in
 filter bv (fun x -> x mod 2 = 0);
 to_sorted_list bv = [ 2; 4; 6 ]
@@ -227,7 +273,7 @@ eq ~printer:(CCFormat.to_string ppli) [ 0; 3; 4; 6 ]
 
 q Q.small_int (fun size -> create ~size false |> negate |> cardinal = size);;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv1 = CCBV.of_list [ 1; 2; 3; 4 ] in
 let bv2 = CCBV.of_list [ 4; 200; 3 ] in
 let bv = CCBV.union bv1 bv2 in
@@ -236,7 +282,20 @@ assert_equal ~printer:CCFormat.(to_string (Dump.list int)) [ 1; 2; 3; 4; 200 ] l
 true
 ;;
 
-t @@ fun () ->
+q ~name:"union"
+  Q.(pair (small_list small_nat) (small_list small_nat))
+  (fun (l1, l2) ->
+    let bv1 = of_list l1 in
+    let bv2 = of_list l2 in
+    let l' = CCList.sort_uniq ~cmp:CCInt.compare (l1 @ l2) in
+    let bv = union bv1 bv2 in
+    let bv' = of_list l' in
+    if not (equal bv bv') then
+      Q.Test.fail_reportf "union (%a, %a) <> %a" ppli l1 ppli l2 ppli l';
+    true)
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv1 = CCBV.of_list [ 1; 2; 3; 4; 64; 130 ] in
 let bv2 = CCBV.of_list [ 4; 64; 3; 120 ] in
 let bv = CCBV.union bv1 bv2 in
@@ -246,7 +305,7 @@ assert_equal ~cmp:equal ~printer:(CCFormat.to_string pp)
 true
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv1 = CCBV.of_list [ 1; 2; 3; 4 ] in
 let bv2 = CCBV.of_list [ 4; 200; 3 ] in
 let bv = CCBV.union bv1 bv2 in
@@ -256,7 +315,7 @@ assert_equal ~cmp:equal ~printer:(CCFormat.to_string pp)
 true
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let v1 = CCBV.empty () in
 let () = CCBV.set v1 64 in
 let v2 = CCBV.diff (CCBV.empty ()) (CCBV.empty ()) in
@@ -265,17 +324,17 @@ assert_equal ~printer:(CCFormat.to_string pp) ~cmp:CCBV.equal v1 v3;
 true
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 union (of_list [ 1; 2; 3; 4; 5 ]) (of_list [ 7; 3; 5; 6 ])
 |> to_sorted_list = CCList.range 1 7
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 inter (of_list [ 1; 2; 3; 4 ]) (of_list [ 2; 4; 6; 1 ])
 |> to_sorted_list = [ 1; 2; 4 ]
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv1 = CCBV.of_list [ 1; 2; 3; 4; 200; 201 ] in
 let bv2 = CCBV.of_list [ 4; 200; 3 ] in
 let bv = CCBV.inter bv1 bv2 in
@@ -284,7 +343,25 @@ assert_equal ~printer:CCFormat.(to_string (Dump.list int)) [ 3; 4; 200 ] l;
 true
 ;;
 
-t @@ fun () ->
+q ~name:"inter" ~count:10_000
+  Q.(pair (small_list small_nat) (small_list small_nat))
+  (fun (l1, l2) ->
+    let bv1 = of_list l1 in
+    let bv2 = of_list l2 in
+    let l' = CCList.inter ~eq:CCInt.equal l1 l2 in
+    let bv = inter bv1 bv2 in
+    let bv' = of_list l' in
+    (* make sure both are of the same length before comparing *)
+    let len = max (length bv) (length bv') in
+    resize bv len;
+    resize bv' len;
+    if not (equal bv bv') then
+      Q.Test.fail_reportf "inter (%a, %a) <> %a@ (@[<hv>bv= %a,@ bv'=%a@])" ppli
+        l1 ppli l2 ppli l' pp bv pp bv';
+    true)
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv1 = CCBV.of_list [ 1; 2; 3; 4 ] in
 let bv2 = CCBV.of_list [ 4; 200; 3 ] in
 CCBV.inter_into ~into:bv1 bv2;
@@ -293,33 +370,52 @@ assert_equal [ 3; 4 ] l;
 true
 ;;
 
-t @@ fun () -> diff (of_list [ 1; 2; 3 ]) (of_list [ 1; 2; 3 ]) |> to_list = []
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
+diff (of_list [ 1; 2; 3 ]) (of_list [ 1; 2; 3 ]) |> to_list = []
 ;;
 
-t @@ fun () ->
+q ~name:"diff" ~count:10_000
+  Q.(pair (small_list small_nat) (small_list small_nat))
+  (fun (l1, l2) ->
+    let bv1 = of_list l1 in
+    let bv2 = of_list l2 in
+    let bv = diff bv1 bv2 in
+    let l' = Intset.(diff (of_list l1) (of_list l2) |> to_list) in
+    let bv' = of_list l' in
+    (* make sure both are of the same length before comparing *)
+    let len = max (length bv) (length bv') in
+    resize bv len;
+    resize bv' len;
+    if not (equal bv bv') then
+      Q.Test.fail_reportf "idff (%a, %a) <> %a@ (@[<hv>bv= %a,@ bv'=%a@])" ppli
+        l1 ppli l2 ppli l' pp bv pp bv';
+    true)
+;;
+
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 diff (of_list [ 1; 2; 3 ]) (of_list [ 1; 2; 3; 4 ]) |> to_list = []
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 diff (of_list [ 1; 2; 3; 4 ]) (of_list [ 1; 2; 3 ]) |> to_list = [ 4 ]
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 diff (of_list [ 1; 2; 3 ]) (of_list [ 1; 2; 3; 400 ]) |> to_list = []
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 diff (of_list [ 1; 2; 3; 400 ]) (of_list [ 1; 2; 3 ]) |> to_list = [ 400 ]
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let v1 = CCBV.empty () in
 set v1 65;
 let v2 = CCBV.diff v1 v1 in
 CCBV.is_empty v2
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv = CCBV.of_list [ 1; 2; 5; 400 ] in
 let arr = [| "a"; "b"; "c"; "d"; "e"; "f" |] in
 let l = List.sort compare (CCBV.select bv arr) in
@@ -327,7 +423,7 @@ assert_equal [ "b"; "c"; "f" ] l;
 true
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 let bv = CCBV.of_list [ 1; 2; 5; 400 ] in
 let arr = [| "a"; "b"; "c"; "d"; "e"; "f" |] in
 let l = List.sort compare (CCBV.selecti bv arr) in
@@ -350,9 +446,385 @@ q
     i = (to_iter bv |> Iter.length))
 ;;
 
-t @@ fun () ->
+t ~name:(spf "line %d" __LINE__) @@ fun () ->
 CCList.range 0 10 |> CCList.to_iter |> of_iter |> to_iter |> CCList.of_iter
 |> List.sort CCOrd.poly = CCList.range 0 10
 ;;
 
 eq ~printer:CCFun.id "bv {00001}" (CCFormat.to_string pp (of_list [ 4 ]))
+
+let eq' = eq ~printer:CCInt.to_string;;
+
+eq' 0b0 (__lsb_mask 0);;
+eq' 0b1 (__lsb_mask 1);;
+eq' 0b11 (__lsb_mask 2);;
+eq' 0b111 (__lsb_mask 3);;
+eq' 0b1111 (__lsb_mask 4);;
+eq' 0b1_1111 (__lsb_mask 5);;
+eq' 0b11_1111 (__lsb_mask 6);;
+eq' 0b111_1111 (__lsb_mask 7);;
+eq' 0b1111_1111 (__lsb_mask 8)
+
+let popcount8_ref n =
+  let rec loop n =
+    if n = 0 then
+      0
+    else if n land 1 = 0 then
+      loop (n lsr 1)
+    else
+      1 + loop (n lsr 1)
+  in
+  loop n
+;;
+
+(* test __popcount8 just to be sure. *)
+t ~name:(spf "line %d" __LINE__) (fun () ->
+    for i = 0 to 255 do
+      let n = __popcount8 i in
+      let n2 = popcount8_ref i in
+      if n <> n2 then (
+        Printf.printf "bad: i=%d => %d,%d\n" i n n2;
+        assert false
+      )
+    done;
+    true)
+;;
+
+t ~name:(spf "line %d" __LINE__) (fun () ->
+    let b = create ~size:10 false in
+    assert_equal 10 (length b);
+    set b 9;
+    for i = 0 to 9 do
+      assert (i = 9 || not (get b i))
+    done;
+
+    resize b 42;
+    assert_equal 42 (length b);
+    for i = 0 to 41 do
+      assert (i = 9 || not (get b i))
+    done;
+    resize b 11;
+    assert_equal 11 (length b);
+    for i = 0 to 11 do
+      assert (i = 9 || not (get b i))
+    done;
+
+    true)
+;;
+
+t ~name:(spf "line %d" __LINE__) (fun () ->
+    let v = empty () in
+    resize v 9;
+    inter_into ~into:v (of_list []);
+    true)
+;;
+
+t ~name:(spf "line %d" __LINE__) (fun () ->
+    let l = [ 1; 3; 10; 29; 55 ] in
+    let v = init 120 (fun i -> List.mem i l) in
+    assert_equal ~printer:(CCFormat.to_string ppli) l (to_sorted_list v);
+    true)
+;;
+
+q ~name:(spf "line %d" __LINE__)
+  Q.(small_list small_nat)
+  (fun l ->
+    let l = CCList.sort_uniq ~cmp:CCInt.compare l in
+    let max = 1 + List.fold_left max 0 l in
+    let v = init max (fun i -> List.mem i l) in
+    assert_equal ~printer:(CCFormat.to_string ppli) l (to_sorted_list v);
+    true)
+;;
+
+t ~name:(spf "line %d" __LINE__) (fun () ->
+    let bv = empty () in
+    flip bv 0;
+    resize bv 0;
+    negate_self bv;
+    union_into ~into:bv (of_list [ 2 ]);
+    assert_equal ~printer:(CCFormat.to_string ppli) [ 2 ] (to_list bv);
+    true)
+;;
+
+t ~name:(spf "line %d" __LINE__) (fun () ->
+    let bv = empty () in
+    flip bv 0;
+    inter_into ~into:bv (of_list []);
+    negate_self bv;
+    assert_equal ~printer:(CCFormat.to_string ppli) [] (to_list bv);
+    true)
+;;
+
+t ~name:(spf "line %d" __LINE__) (fun () ->
+    let v = empty () in
+    union_into ~into:v (of_list [ 9; 16 ]);
+    resize_minimize_memory v 9;
+    Internal_.__check_invariant v;
+    is_empty v)
+
+module Op = struct
+  type t =
+    | Resize of int
+    | Resize_min_mem of int
+    | Set of int
+    | Reset of int
+    | Set_bool of int * bool
+    | Flip of int
+    | Clear
+    | Clear_and_shrink
+    | Filter_is_odd
+    | Negate
+    | Inter of int list
+    | Union of int list
+    | Diff of int list
+
+  let apply (self : CCBV.t) (op : t) : unit =
+    match op with
+    | Resize n -> resize self n
+    | Resize_min_mem n -> resize_minimize_memory self n
+    | Set i -> set self i
+    | Reset i -> reset self i
+    | Set_bool (i, b) -> set_bool self i b
+    | Flip i -> flip self i
+    | Clear -> clear self
+    | Clear_and_shrink -> clear_and_shrink self
+    | Filter_is_odd -> filter self (fun i -> i mod 2 = 1)
+    | Negate -> negate_self self
+    | Inter l ->
+      let bv' = of_list l in
+      inter_into ~into:self bv'
+    | Union l ->
+      let bv' = of_list l in
+      union_into ~into:self bv'
+    | Diff l ->
+      let bv' = of_list l in
+      diff_into ~into:self bv'
+
+  let post_size sz (self : t) =
+    match self with
+    | Resize i -> i
+    | Resize_min_mem i -> i
+    | Set j | Reset j | Set_bool (j, _) | Flip j -> max sz (j + 1)
+    | Clear -> sz
+    | Clear_and_shrink -> 0
+    | Filter_is_odd | Negate -> sz
+    | Diff _ -> sz
+    | Inter [] | Union [] -> sz
+    | Union l -> max sz (succ (List.fold_left max 0 l))
+    | Inter l -> min sz (succ (List.fold_left max 0 l))
+
+  let gen_ size : t Q.Gen.t =
+    let open Q.Gen in
+    let nonzero =
+      [
+        (3, 0 -- size >|= fun x -> Set x);
+        (3, 0 -- size >|= fun x -> Reset x);
+        ( 3,
+          0 -- size >>= fun x ->
+          bool >|= fun y -> Set_bool (x, y) );
+        (3, 0 -- size >|= fun x -> Flip x);
+      ]
+    in
+
+    (* random list of integers *)
+    let rand_list =
+      0 -- 200 >>= fun n st ->
+      CCList.init n (fun i ->
+          if bool st then
+            Some i
+          else
+            None)
+      |> CCList.keep_some
+    in
+
+    frequency
+    @@ List.flatten
+         [
+           (if size > 0 then
+             nonzero
+           else
+             []);
+           [
+             1, return Clear;
+             1, return Clear_and_shrink;
+             1, return Negate;
+             1, return Filter_is_odd;
+             (1, rand_list >|= fun l -> Inter l);
+             (1, rand_list >|= fun l -> Union l);
+             (1, rand_list >|= fun l -> Diff l);
+             (1, 0 -- 100 >|= fun x -> Resize x);
+             (1, 0 -- 100 >|= fun x -> Resize_min_mem x);
+           ];
+         ]
+
+  let shrink =
+    let open Q.Iter in
+    let module S = Q.Shrink in
+    function
+    | Resize i -> S.int i >|= fun i -> Resize i
+    | Resize_min_mem i -> S.int i >|= fun i -> Resize_min_mem i
+    | Set i -> S.int i >|= fun i -> Resize i
+    | Reset i -> S.int i >|= fun i -> Resize i
+    | Set_bool (i, b) ->
+      S.int i
+      >|= (fun i -> Set_bool (i, b))
+      <+>
+      if b then
+        return @@ Set_bool (i, b)
+      else
+        empty
+    | Flip i -> S.int i >|= fun i -> Flip i
+    | Clear | Clear_and_shrink | Filter_is_odd | Negate -> empty
+    | Inter l -> S.list ~shrink:S.int l >|= fun l -> Inter l
+    | Union l -> S.list ~shrink:S.int l >|= fun l -> Union l
+    | Diff l -> S.list ~shrink:S.int l >|= fun l -> Diff l
+
+  let pp out =
+    let fpf = Format.fprintf in
+    function
+    | Resize i -> fpf out "resize %d" i
+    | Resize_min_mem i -> fpf out "resize_minimize_memory %d" i
+    | Set i -> fpf out "set %d" i
+    | Reset i -> fpf out "reset %d" i
+    | Set_bool (i, b) -> fpf out "set_bool(%d,%b)" i b
+    | Flip i -> fpf out "flip %d" i
+    | Clear -> fpf out "clear"
+    | Clear_and_shrink -> fpf out "clear_and_shrink"
+    | Filter_is_odd -> fpf out "filter_is_odd"
+    | Negate -> fpf out "negate"
+    | Inter l -> fpf out "inter %a" ppli l
+    | Union l -> fpf out "union %a" ppli l
+    | Diff l -> fpf out "diff %a" ppli l
+
+  let arb_l =
+    let rec gen_l sz n =
+      let open Q.Gen in
+      if n = 0 then
+        return []
+      else
+        gen_ sz >>= fun op ->
+        let sz' = post_size sz op in
+        gen_l sz' (n - 1) >|= fun tl -> op :: tl
+    in
+
+    Q.make
+      ~print:CCFormat.(to_string @@ Dump.list pp)
+      ~shrink:(Q.Shrink.list ~shrink)
+      Q.Gen.(0 -- 30 >>= fun len -> gen_l 0 len)
+end
+
+module Ref_ = struct
+  type t = { mutable set: Intset.t; mutable size: int }
+
+  let empty () = { size = 0; set = Intset.empty }
+
+  let to_list self =
+    Intset.to_list self.set |> List.filter (fun x -> x < self.size)
+
+  let pp out (self : t) = ppli out (to_list self)
+
+  let equal_to_bv (self : t) (bv : CCBV.t) : bool =
+    to_list self = CCBV.to_sorted_list bv
+
+  let cardinal self : int =
+    Intset.filter (fun x -> x < self.size) self.set |> Intset.cardinal
+
+  let get (self : t) i = Intset.mem i self.set
+
+  let rec apply_op (self : t) (op : Op.t) =
+    match op with
+    | Resize n | Resize_min_mem n ->
+      self.set <- Intset.filter (fun x -> x < n) self.set;
+      self.size <- n
+    | Set i ->
+      self.size <- max self.size (i + 1);
+      self.set <- Intset.add i self.set
+    | Reset i ->
+      self.size <- max self.size (i + 1);
+      self.set <- Intset.remove i self.set
+    | Set_bool (i, b) ->
+      apply_op self
+        (if b then
+          Set i
+        else
+          Reset i)
+    | Flip i ->
+      self.size <- max self.size (i + 1);
+      apply_op self
+        (if Intset.mem i self.set then
+          Reset i
+        else
+          Set i)
+    | Clear -> self.set <- Intset.empty
+    | Clear_and_shrink ->
+      self.set <- Intset.empty;
+      self.size <- 0
+    | Filter_is_odd -> self.set <- Intset.filter (fun x -> x mod 2 = 1) self.set
+    | Negate ->
+      let l' =
+        CCList.init self.size (fun x -> x)
+        |> List.filter (fun x -> not (Intset.mem x self.set))
+      in
+      self.set <- Intset.of_list l'
+    | Inter l ->
+      let s' = Intset.of_list l in
+      let sz' = List.fold_left (fun s x -> max s (x + 1)) 0 l in
+      self.size <- min self.size sz';
+      self.set <- Intset.inter self.set s'
+    | Union l ->
+      let s' = Intset.of_list l in
+      self.size <- List.fold_left (fun s x -> max s (x + 1)) self.size l;
+      self.set <- Intset.union self.set s'
+    | Diff l ->
+      let s' = Intset.of_list l in
+      self.set <- Intset.diff self.set s'
+end
+;;
+
+q ~name:"list ops: invariant" ~max_fail:1 ~long_factor:10 ~count:20_000 Op.arb_l
+  (fun ops ->
+    let bv = empty () in
+
+    Internal_.__check_invariant bv;
+    List.iter
+      (fun op ->
+        Op.apply bv op;
+        Internal_.__check_invariant bv)
+      ops;
+    true)
+;;
+
+q ~name:"list ops: compare to ref" ~max_fail:1 ~long_factor:10 ~count:2_000
+  Op.arb_l (fun ops ->
+    let bv = empty () in
+    let bv' = Ref_.empty () in
+
+    List.iter
+      (fun op ->
+        Op.apply bv op;
+        Ref_.apply_op bv' op;
+
+        if cardinal bv <> Ref_.cardinal bv' then
+          Q.Test.fail_reportf
+            "@[<v2>different cardinal:@ actual=%a@ ref=%a@ @[<v2>actual.card \
+             %d@]@ @[<v2>ref.cardinal %d@]@]"
+            pp bv Ref_.pp bv' (cardinal bv) (Ref_.cardinal bv');
+
+        let bad_idx =
+          Iter.(0 -- CCBV.length bv)
+          |> Iter.find_pred (fun i -> get bv i <> Ref_.get bv' i)
+        in
+        (match bad_idx with
+        | None -> ()
+        | Some idx ->
+          Q.Test.fail_reportf
+            "at idx %d, not same `get`@ actual.get=%b,@ ref.get=%b" idx
+            (get bv idx) (Ref_.get bv' idx));
+
+        if not (Ref_.equal_to_bv bv' bv) then
+          Q.Test.fail_reportf
+            "@[<v2>not equal:@ actual=%a@ ref=%a@ @[<v2>actual.to_list@ %a@]@ \
+             @[<v2>ref.to_list@ %a@]@]"
+            pp bv Ref_.pp bv' ppli (to_sorted_list bv) ppli (Ref_.to_list bv'))
+      ops;
+    true)