simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-05 19:00:31 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge pull request #394 from c-cube/ccbv_bytes2

Browse source 
(continued) use bytes for CCBV
This commit is contained in:
Simon Cruanes 2022-07-06 16:41:21 -04:00 • committed by GitHub
commit 484aa3a1e7
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
12 changed files with 969 additions and 248 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile
View file

@ -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

14
src/core/CCInt32.ml
View file

@ -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

4
src/core/CCInt32.mli
View file

@ -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].

15
src/core/CCInt64.ml
View file

@ -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

4
src/core/CCInt64.mli
View file

@ -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].

396
src/data/CCBV.ml
View file

@ -1,186 +1,271 @@
(** {2 Imperative Bitvectors} *)
let width_ = 8
(* TODO: move to [bytes] and replace all [mod] and [/] with bitshifts
because width_=8 *)
(* Helper functions *)
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
least significant bit. We create masks to zero out the most significant
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
(* [lsb_mask_ n] is [0b111111] with [n] ones. *)
let[@inline] __lsb_mask n = (1 lsl n) - 1
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 *)
let count_bits_ n =
let rec recurse count n =
if n = 0 then
count
else
recurse (count + 1) (n land (n - 1))
in
recurse 0 n
//This uses fewer arithmetic operations than any other known
//implementation on machines with slow multiplication.
//It uses 17 arithmetic operations.
int popcount_2(uint64_t x) {
x -= (x >> 1) & m1; //put count of each 2 bits into those 2 bits
x = (x & m2) + ((x >> 2) & m2); //put count of each 4 bits into those 4 bits
x = (x + (x >> 4)) & m4; //put count of each 8 bits into those 8 bits
(* Can I access the "private" members in testing? $Q
(Q.int_bound (Sys.word_size - 1)) (fun i -> count_bits_ lsb_masks_.(i) = i)
// not necessary for int8
// 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 =
if size mod width_ = 0 then
size / width_
let bytes_length_of_size size =
if mod_ size = 0 then
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 a =
let n = bytes_length_of_size size in
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
if default && r <> 0 then Array.unsafe_set a (n - 1) lsb_masks_.(r);
{ a; size }
let r = mod_ size in
if default && r <> 0 then unsafe_set_ b (n - 1) (__lsb_mask r);
{ b; size }
)
let copy bv = { bv with a = Array.copy bv.a }
let capacity bv = width_ * Array.length bv.a
let copy bv = { bv with b = Bytes.sub bv.b 0 (bytes_length_of_size bv.size) }
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
n := !n + count_bits_ bv.a.(i) (* MSB of last element are all 0 *)
done;
iter_bytes_ bv ~f:(fun _ _ b -> n := !n + __popcount8 b);
!n
)
let really_resize_ bv ~desired ~current size =
let a' = Array.make desired 0 in
Array.blit bv.a 0 a' 0 current;
bv.a <- a';
bv.size <- size
bv.size <- size;
if desired <> current then (
let b = Bytes.make desired zero in
Bytes.blit bv.b 0 b 0 (min desired current);
bv.b <- b
)
let grow_ bv size =
if size <= capacity bv (* within capacity *) then
(* set bits above [n] to 0 *)
let[@inline never] clear_bits_above_ bv top =
let n = div_ top in
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 current = Bytes.length bv.b 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 (
(* beyond capacity *)
let desired = array_length_of_size size in
let current = Array.length bv.a in
assert (desired > current);
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
grow_ bv size
else if size > bv.size then
grow_to_at_least_ bv size
let is_empty bv =
bv.size = 0
||
try
for i = 0 to Array.length bv.a - 1 do
if bv.a.(i) <> 0 then raise Exit (* MSB of last element are all 0 *)
for i = 0 to bytes_length_of_size bv.size - 1 do
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 i = i mod width_ in
if n < Array.length bv.a then
Array.unsafe_get bv.a n land (1 lsl i) <> 0
let idx_bucket = div_ i in
let idx_in_byte = mod_ i in
if idx_bucket < Bytes.length bv.b then
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 j = i mod width_ in
if i >= bv.size then grow_ bv (i + 1);
Array.unsafe_set bv.a n (Array.unsafe_get bv.a n lor (1 lsl j))
let idx_bucket = div_ i in
let idx_in_byte = mod_ i in
if i >= bv.size then grow_to_at_least_ bv (i + 1);
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 j = i mod width_ in
if i >= bv.size then grow_ bv (i + 1);
Array.unsafe_set bv.a n (Array.unsafe_get bv.a n land lnot (1 lsl j))
let n = div_ i in
let j = mod_ i in
if i >= bv.size then grow_to_at_least_ bv (i + 1);
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 j = i mod width_ in
if i >= bv.size then grow_ bv (i + 1);
Array.unsafe_set bv.a n (Array.unsafe_get bv.a n lxor (1 lsl j))
let n = div_ i in
let j = mod_ i in
if i >= bv.size then grow_to_at_least_ bv (i + 1);
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 equal x y : bool = x.size = y.size && x.a = y.a
let clear bv = Bytes.fill bv.b 0 (Bytes.length bv.b) zero
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
assert (len <= Array.length bv.a);
for n = 0 to len - 2 do
let j = width_ * n in
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
)
iter_bytes_ bv ~f:(fun off width_n word_n ->
for i = 0 to width_n - 1 do
f (off + i) (word_n 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 len = Array.length b.a in
for n = 0 to len - 1 do
Array.unsafe_set b.a n (lnot (Array.unsafe_get b.a n))
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 negate a =
let b = copy a in
negate_self b;
b
let union_into_no_resize_ ~into bv =
assert (Array.length into.a >= Array.length bv.a);
for i = 0 to Array.length bv.a - 1 do
Array.unsafe_set into.a i
(Array.unsafe_get into.a i lor Array.unsafe_get bv.a i)
assert (Bytes.length into.b >= bytes_length_of_size bv.size);
for i = 0 to bytes_length_of_size bv.size - 1 do
unsafe_set_ into.b i (unsafe_get_ into.b i lor unsafe_get_ bv.b 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);
for i = 0 to Array.length into.a - 1 do
Array.unsafe_set into.a i
(Array.unsafe_get into.a i land Array.unsafe_get bv.a i)
assert (into.size <= bv.size);
for i = 0 to bytes_length_of_size into.size - 1 do
unsafe_set_ into.b i (unsafe_get_ into.b i land unsafe_get_ bv.b 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
it's size! *)
(* Underlying size depends on the [in_] set for diff, so we don't change
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
(Array.unsafe_get into.a i land lnot (Array.unsafe_get bv.a i))
unsafe_set_ into.b i (unsafe_get_ into.b i land lnot (unsafe_get_ bv.b 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

69
src/data/CCBV.mli
View file

@ -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
the underlying bitvector.
(** Resize the BV so that it has the specified length. This can grow
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
(**/**)

106
src/testlib/containers_testlib.ml
View file

@ -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 ->
if f () then
Ok ()
else
Error "failed: returns false"
| T { prop } ->
let fail msg = Error (spf "%sfailed: %s" what msg) in
(match prop () with
| 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"
| Some p -> spf "failed: not equal:\nlhs=%s\nrhs=%s" (p lhs) (p rhs)
| None -> spf "%sfailed: not equal" what
| 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@]"
(Printexc.to_string exn) pp_cex instance backtrace
Format.asprintf "@[<v2>%sraised %s@ on instance %a@ :backtrace %s@]"
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 eq : ?cmp:'a eq -> ?printer:'a print -> 'a -> 'a -> unit
val t : ?name:string -> (unit -> bool) -> 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 =
add_ @@ mk @@ Test.Eq { eq = cmp; print = printer; lhs; rhs }
let eq ?name ?cmp ?printer lhs rhs : unit =
add_ @@ mk ?name @@ Test.Eq { eq = cmp; print = printer; lhs; rhs }
let q ?count ?long_factor arb prop : unit =
add_ @@ mk @@ Test.Q { arb; prop; count; long_factor }
let q ?name ?count ?long_factor ?max_gen ?max_fail ?if_assumptions_fail arb
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);

18
src/testlib/containers_testlib.mli
View file

@ -8,11 +8,19 @@ end
module type S = sig
module Q = QCheck
val t : (unit -> bool) -> unit
val eq : ?cmp:'a eq -> ?printer:'a print -> 'a -> 'a -> unit
val t : ?name:string -> (unit -> bool) -> 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

18
tests/core/t_int32.ml
View file

@ -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)

9
tests/core/t_int64.ml
View file

@ -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)

562
tests/data/t_bv.ml
View file

@ -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 @@ fun () -> create ~size:132 true |> cardinal = 132;;
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:17 true |> cardinal = 17
;;
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 @@ fun () -> equal (empty ()) (empty ());;
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 ~name:(spf "line %d" __LINE__) @@ fun () ->
equal (of_list [ 1; 3; 4 ]) (of_list [ 1; 3; 4 ])
;;
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 @@ fun () -> of_list [ 1; 32; 64 ] |> CCFun.flip get 32;;
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 ~name:(spf "line %d" __LINE__) @@ fun () ->
of_list [ 1; 32; 64 ] |> CCFun.flip get 64
;;
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)