simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2026-01-21 16:56:39 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

refactor: finish migration to qtest

Browse source
This commit is contained in:
Simon Cruanes 2022-07-02 22:09:25 -04:00
parent 1111c0fa9a
commit 1e4a22fbf2
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
43 changed files with 2117 additions and 2403 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

170
src/data/CCFQueue.ml
View file

@ -7,10 +7,6 @@ type 'a iter = ('a -> unit) -> unit
type 'a equal = 'a -> 'a -> bool
type 'a printer = Format.formatter -> 'a -> unit
(*$inject
let pp_ilist = CCFormat.(to_string (list int))
*)
(** {2 Basics} *)
[@@@warning "-37"]
@ -34,11 +30,6 @@ type +'a t =
let empty : type a. a t = Shallow Zero
(*$R
let q = empty in
OUnit2.assert_bool "is_empty" (is_empty q)
*)
exception Empty
let _empty = Shallow Zero
@ -68,11 +59,6 @@ let rec cons : type a. a -> a t -> a t
| Deep (n,Three (y,z,z'), lazy q', tail) ->
_deep (n+1) (Two (x,y)) (lazy (cons (z,z') q')) tail
(*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
cons x (of_list l) |> to_list = x::l)
*)
let rec snoc : type a. a t -> a -> a t
= fun q x -> match q with
| Shallow Zero -> _single x
@ -85,19 +71,6 @@ let rec snoc : type a. a t -> a -> a t
| Deep (n,hd, lazy q', Three (y,z,z')) ->
_deep (n+1) hd (lazy (snoc q' (y,z))) (Two(z',x))
(*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
snoc (of_list l) x |> to_list = l @ [x])
*)
(*$R
let q = List.fold_left snoc empty [1;2;3;4;5] in
let q = tail q in
let q = List.fold_left snoc q [6;7;8] in
let l = Iter.to_list (to_iter q) in
OUnit2.assert_equal ~printer:pp_ilist [2;3;4;5;6;7;8] l
*)
let rec take_front_exn : 'a. 'a t -> ('a *'a t)
= fun q -> match q with
| Shallow Zero -> raise Empty
@ -115,30 +88,10 @@ let rec take_front_exn : 'a. 'a t -> ('a *'a t)
| Deep (n,Three (x,y,z), middle, tail) ->
x, _deep (n-1) (Two(y,z)) middle tail
(*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
let x', q = cons x (of_list l) |> take_front_exn in \
x'=x && to_list q = l)
*)
(*$R
let q = of_list [1;2;3;4] in
let x, q = take_front_exn q in
OUnit2.assert_equal 1 x;
let q = List.fold_left snoc q [5;6;7] in
OUnit2.assert_equal 2 (first_exn q);
let x, q = take_front_exn q in
OUnit2.assert_equal 2 x;
*)
let take_front q =
try Some (take_front_exn q)
with Empty -> None
(*$T
take_front empty = None
*)
let take_front_l n q =
if n<0 then (
invalid_arg "take_back_l: cannot take negative number of arguments"
@ -150,11 +103,6 @@ let take_front_l n q =
aux (x::acc) q' (n-1)
in aux [] q n
(*$T
let l, q = take_front_l 5 (1 -- 10) in \
l = [1;2;3;4;5] && to_list q = [6;7;8;9;10]
*)
let take_front_while p q =
let rec aux acc q =
if is_empty q then List.rev acc, q
@ -163,10 +111,6 @@ let take_front_while p q =
if p x then aux (x::acc) q' else List.rev acc, q
in aux [] q
(*$T
take_front_while (fun x-> x<5) (1 -- 10) |> fst = [1;2;3;4]
*)
let rec take_back_exn : 'a. 'a t -> 'a t * 'a
= fun q -> match q with
| Shallow Zero -> raise Empty
@ -182,20 +126,10 @@ let rec take_back_exn : 'a. 'a t -> 'a t * 'a
| Deep (n, hd, middle, Two(x,y)) -> _deep (n-1) hd middle (One x), y
| Deep (n, hd, middle, Three(x,y,z)) -> _deep (n-1) hd middle (Two (x,y)), z
(*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
let q,x' = snoc (of_list l) x |> take_back_exn in \
x'=x && to_list q = l)
*)
let take_back q =
try Some (take_back_exn q)
with Empty -> None
(*$T
take_back empty = None
*)
let take_back_l n q =
if n<0 then (
invalid_arg "take_back_l: cannot take negative number of arguments"
@ -240,11 +174,6 @@ let size : 'a. 'a t -> int
| Shallow d -> _size_digit d
| Deep (n, _, _, _) -> n
(*$Q
(Q.list Q.int) (fun l -> \
size (of_list l) = List.length l)
*)
let _nth_digit : type l. int -> ('a, l) digit -> 'a = fun i d -> match i, d with
| _, Zero -> raise Not_found
| 0, One x -> x
@ -278,51 +207,24 @@ let rec nth_exn : 'a. int -> 'a t -> 'a
else
_nth_digit (i'-2*size q') r
(*$T
let l = CCList.(0--100) in let q = of_list l in \
List.map (fun i->nth_exn i q) l = l
*)
let nth i q =
try Some (nth_exn i q)
with Failure _ -> None
(*$Q & ~count:30
(Q.list Q.int) (fun l -> \
let len = List.length l in let idx = CCList.(0 -- (len - 1)) in \
let q = of_list l in \
l = [] || List.for_all (fun i -> nth i q = Some (List.nth l i)) idx)
*)
let init q =
try fst (take_back_exn q)
with Empty -> q
(*$Q
(Q.list Q.int) (fun l -> \
l = [] || (of_list l |> init |> to_list = List.rev (List.tl (List.rev l))))
*)
let tail q =
try snd (take_front_exn q)
with Empty -> q
(*$Q
(Q.list Q.int) (fun l -> \
l = [] || (of_list l |> tail |> to_list = List.tl l))
*)
let add_iter_front seq q =
let l = ref [] in
(* reversed seq *)
seq (fun x -> l := x :: !l);
List.fold_left (fun q x -> cons x q) q !l
(*$Q
Q.(pair (list int) (list int)) (fun (l1, l2) -> \
add_iter_front (Iter.of_list l1) (of_list l2) |> to_list = l1 @ l2)
*)
let add_iter_back q seq =
let q = ref q in
seq (fun x -> q := snoc !q x);
@ -342,40 +244,17 @@ let rec to_iter : 'a. 'a t -> 'a iter
to_iter q' (fun (x,y) -> k x; k y);
_digit_to_iter tail k
(*$Q
(Q.list Q.int) (fun l -> \
of_list l |> to_iter |> Iter.to_list = l)
*)
let append q1 q2 =
match q1, q2 with
| Shallow Zero, _ -> q2
| _, Shallow Zero -> q1
| _ -> add_iter_back q1 (to_iter q2)
(*$Q
(Q.pair (Q.list Q.int)(Q.list Q.int)) (fun (l1,l2) -> \
append (of_list l1) (of_list l2) |> to_list = l1 @ l2)
*)
(*$R
let q1 = of_iter (Iter.of_list [1;2;3;4]) in
let q2 = of_iter (Iter.of_list [5;6;7;8]) in
let q = append q1 q2 in
let l = Iter.to_list (to_iter q) in
OUnit2.assert_equal ~printer:pp_ilist [1;2;3;4;5;6;7;8] l
*)
let add_seq_front seq q =
(* reversed seq *)
let l = Seq.fold_left (fun l elt -> elt::l ) [] seq in
List.fold_left (fun q x -> cons x q) q l
(*$Q
Q.(pair (list int) (list int)) (fun (l1, l2) -> \
add_seq_front (CCList.to_seq l1) (of_list l2) |> to_list = l1 @ l2)
*)
let add_seq_back q seq =
Seq.fold_left (fun q x -> snoc q x) q seq
@ -396,11 +275,6 @@ let rec to_seq : 'a. 'a t -> 'a Seq.t
let of_seq seq = add_seq_front seq empty
(*$Q
(Q.list Q.int) (fun l -> \
of_list l |> to_seq |> CCList.of_seq = l)
*)
let _map_digit : type l. ('a -> 'b) -> ('a, l) digit -> ('b, l) digit = fun f d -> match d with
| Zero -> Zero
| One x -> One (f x)
@ -414,11 +288,6 @@ let rec map : 'a 'b. ('a -> 'b) -> 'a t -> 'b t
let q'' = map (fun (x,y) -> f x, f y) q' in
_deep size (_map_digit f hd) (Lazy.from_val q'') (_map_digit f tl)
(*$Q
(Q.list Q.int) (fun l -> \
of_list l |> map string_of_int |> to_list = List.map string_of_int l)
*)
let (>|=) q f = map f q
let _fold_digit : type l. ('acc -> 'a -> 'acc) -> 'acc -> ('a, l) digit -> 'acc = fun f acc d -> match d with
@ -435,17 +304,6 @@ let rec fold : 'a 'b. ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
let acc = fold (fun acc (x,y) -> f (f acc x) y) acc q' in
_fold_digit f acc tl
(*$Q
(Q.list Q.int) (fun l -> \
of_list l |> fold (fun acc x->x::acc) [] = List.rev l)
*)
(*$R
let q = of_iter (Iter.of_list [1;2;3;4]) in
let n = fold (+) 0 q in
OUnit2.assert_equal 10 n;
*)
let iter f q = to_iter q f
let of_list l = List.fold_left snoc empty l
@ -457,21 +315,11 @@ let to_list q =
let of_iter seq = add_iter_front seq empty
(*$Q
(Q.list Q.int) (fun l -> \
Iter.of_list l |> of_iter |> to_list = l)
*)
let rev q =
let q' = ref empty in
iter (fun x -> q' := cons x !q') q;
!q'
(*$Q
(Q.list Q.int) (fun l -> \
of_list l |> rev |> to_list = List.rev l)
*)
let rec _equal_seq eq l1 l2 = match l1(), l2() with
| Seq.Nil, Seq.Nil -> true
| Seq.Nil, _
@ -481,11 +329,6 @@ let rec _equal_seq eq l1 l2 = match l1(), l2() with
let equal eq q1 q2 = _equal_seq eq (to_seq q1) (to_seq q2)
(*$T
let q1 = 1 -- 10 and q2 = append (1 -- 5) (6 -- 10) in \
equal (=) q1 q2
*)
let (--) a b =
let rec up_to q a b = if a = b
then snoc q a
@ -495,24 +338,11 @@ let (--) a b =
in
if a <= b then up_to empty a b else down_to empty a b
(*$T
1 -- 5 |> to_list = [1;2;3;4;5]
5 -- 1 |> to_list = [5;4;3;2;1]
0 -- 0 |> to_list = [0]
*)
let (--^) a b =
if a=b then empty
else if a<b then a -- (b-1)
else a -- (b+1)
(*$T
1 --^ 5 |> to_list = [1;2;3;4]
5 --^ 1 |> to_list = [5;4;3;2]
1 --^ 2 |> to_list = [1]
0 --^ 0 |> to_list = []
*)
let pp pp_x out d =
let first = ref true in
Format.fprintf out "@[<hov2>queue {";

84
src/data/CCFun_vec.ml
View file

@ -1,16 +1,5 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(*$inject
let _listuniq =
let g = Q.(small_list (pair small_int small_int)) in
Q.map_same_type
(fun l ->
CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a)(fst b)) l
) g
;;
*)
(** {1 Hash Tries} *)
type 'a iter = ('a -> unit) -> unit
@ -140,17 +129,8 @@ let empty = {size=0; leaves=A.empty; subs=A.empty}
let is_empty {size;_} = size=0
(*$T
is_empty empty
*)
let length {size;_} = size
(*$T
not (is_empty (return 2))
length (return 2) = 1
*)
let return x = {leaves=A.return x; subs=A.empty; size=1}
type idx_l =
@ -182,12 +162,6 @@ let get_ (i:int) (m:'a t) : 'a =
in
aux (split_idx i) m
(*$Q
_listuniq (fun l -> \
let m = of_list l in \
List.for_all (fun (i,y) -> get_exn i m = y) @@ List.mapi CCPair.make l)
*)
let get_exn i v =
if i >= 0 && i < length v then get_ i v else raise Not_found
@ -241,27 +215,6 @@ let pop_exn (v:'a t) : 'a * 'a t =
let pop (v:'a t) : ('a * 'a t) option =
if v.size=0 then None else Some (pop_ (v.size-1) v)
(* regression test for #298 *)
(*$R
let rec consume x = match CCFun_vec.pop x with
| None -> () | Some (_, x) -> consume x
in
consume (of_list (CCList.(1 -- 100)));
()
*)
(*$QR
Q.(pair int (small_list int)) (fun (x,l) ->
let q0 = of_list l in
let q = push x q0 in
assert_equal (length q) (length q0+1);
let y, q = pop_exn q in
assert_equal x y;
assert_equal (to_list q) (to_list q0);
true
)
*)
let iteri ~f (m : 'a t) : unit =
(* basically, a 32-way BFS traversal.
The queue contains subtrees to explore, along with their high_idx_ offsets *)
@ -306,34 +259,16 @@ let rec map f m : _ t =
size=m.size;
}
(*$QR
Q.(pair (fun1 Observable.int bool)(small_list int)) (fun (f,l) ->
let f = Q.Fn.apply f in
(List.map f l) = (of_list l |> map f |> to_list)
)
*)
let append a b =
if is_empty b then a
else fold ~f:(fun v x -> push x v) ~x:a b
(*$QR
Q.(pair (small_list int)(small_list int)) (fun (l1,l2) ->
(l1 @ l2) = (append (of_list l1)(of_list l2) |> to_list)
)
*)
let add_list v l = List.fold_left (fun v x -> push x v) v l
let of_list l = add_list empty l
let to_list m = fold_rev m ~f:(fun acc x -> x::acc) ~x:[]
(*$QR
Q.(small_list int) (fun l ->
l = to_list (of_list l))
*)
let add_iter v seq =
let v = ref v in
seq (fun x -> v := push x !v);
@ -343,13 +278,6 @@ let of_iter s = add_iter empty s
let to_iter m yield = iteri ~f:(fun _ v -> yield v) m
(*$Q
_listuniq (fun l -> \
(List.sort Stdlib.compare l) = \
(l |> Iter.of_list |> of_iter |> to_iter |> Iter.to_list \
|> List.sort Stdlib.compare) )
*)
let rec add_gen m g = match g() with
| None -> m
| Some x -> add_gen (push x m) g
@ -374,20 +302,8 @@ let to_gen m =
) else None
in next
(*$Q
_listuniq (fun l -> \
(List.sort Stdlib.compare l) = \
(l |> Gen.of_list |> of_gen |> to_gen |> Gen.to_list \
|> List.sort Stdlib.compare) )
*)
let choose m = to_gen m ()
(*$T
choose empty = None
choose (of_list [1,1; 2,2]) <> None
*)
let choose_exn m = match choose m with
| None -> raise Not_found
| Some (k,v) -> k, v

63
src/data/CCGraph.ml
View file

@ -290,22 +290,6 @@ module Traverse = struct
} in
dfs_tag ~eq ~tags ~graph iter
end
(*$R
let l =
let tbl = mk_table ~eq:CCInt.equal 128 in
Traverse.Event.dfs ~tbl ~eq:CCInt.equal ~graph:divisors_graph (Iter.return 345614)
|> Iter.to_list in
let expected =
[`Enter (345614, 0, []); `Edge (345614, (), 172807, `Forward);
`Enter (172807, 1, [(345614, (), 172807)]); `Edge (172807, (), 1, `Forward);
`Enter (1, 2, [(172807, (), 1); (345614, (), 172807)]); `Exit 1; `Exit 172807;
`Edge (345614, (), 2, `Forward); `Enter (2, 3, [(345614, (), 2)]);
`Edge (2, (), 1, `Cross); `Exit 2; `Edge (345614, (), 1, `Cross);
`Exit 345614]
in
assert_equal expected l
*)
end
(** {2 Cycles} *)
@ -343,23 +327,6 @@ let topo_sort ~eq ?rev ~tbl ~graph iter =
} in
topo_sort_tag ~eq ?rev ~tags ~graph iter
(*$T
let tbl = mk_table ~eq:CCInt.equal 128 in \
let l = topo_sort ~eq:CCInt.equal ~tbl ~graph:divisors_graph (Iter.return 42) in \
List.for_all (fun (i,j) -> \
let idx_i = CCList.find_idx ((=)i) l |> CCOption.get_exn |> fst in \
let idx_j = CCList.find_idx ((=)j) l |> CCOption.get_exn |> fst in \
idx_i < idx_j) \
[ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3]
let tbl = mk_table ~eq:CCInt.equal 128 in \
let l = topo_sort ~eq:CCInt.equal ~rev:true ~tbl ~graph:divisors_graph (Iter.return 42) in \
List.for_all (fun (i,j) -> \
let idx_i = CCList.find_idx ((=)i) l |> CCOption.get_exn |> fst in \
let idx_j = CCList.find_idx ((=)j) l |> CCOption.get_exn |> fst in \
idx_i > idx_j) \
[ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3]
*)
(** {2 Lazy Spanning Tree} *)
module Lazy_tree = struct
@ -491,36 +458,6 @@ type 'v scc_state = 'v SCC.state
let scc ~tbl ~graph iter = SCC.explore ~tbl ~graph iter
(* example from https://en.wikipedia.org/wiki/Strongly_connected_component *)
(*$R
let set_eq ?(eq=(=)) l1 l2 = CCList.subset ~eq l1 l2 && CCList.subset ~eq l2 l1 in
let graph = of_list ~eq:CCString.equal
[ "a", "b"
; "b", "e"
; "e", "a"
; "b", "f"
; "e", "f"
; "f", "g"
; "g", "f"
; "b", "c"
; "c", "g"
; "c", "d"
; "d", "c"
; "d", "h"
; "h", "d"
; "h", "g"
] in
let tbl = mk_table ~eq:CCString.equal 128 in
let res = scc ~tbl ~graph (Iter.return "a") |> Iter.to_list in
assert_bool "scc"
(set_eq ~eq:(set_eq ?eq:None) res
[ [ "a"; "b"; "e" ]
; [ "f"; "g" ]
; [ "c"; "d"; "h" ]
]
)
*)
(** {2 Pretty printing in the DOT (graphviz) format} *)
module Dot = struct

25
src/data/CCHashSet.ml
View file

@ -123,11 +123,6 @@ module Make(E : ELEMENT) : S with type elt = E.t = struct
let cardinal = Tbl.length
(*$T
let module IS = Make(CCInt) in \
IS.cardinal (IS.create 10) = 0
*)
let mem = Tbl.mem
let find_exn = Tbl.find
@ -136,11 +131,6 @@ module Make(E : ELEMENT) : S with type elt = E.t = struct
try Some (Tbl.find s x)
with Not_found -> None
(*$T
let module IS = Make(CCInt) in IS.find (IS.of_list [1;2;3]) 3 = Some 3
let module IS = Make(CCInt) in IS.find (IS.of_list [1;2;3]) 5 = None
*)
let iter f s = Tbl.iter (fun x _ -> f x) s
let fold f acc s = Tbl.fold (fun x _ acc -> f acc x) s acc
@ -150,11 +140,6 @@ module Make(E : ELEMENT) : S with type elt = E.t = struct
iter (fun x -> if mem a x then insert res x) b;
res
(*$T
let module IS = Make(CCInt) in \
IS.(equal (inter (of_list [1;2;3]) (of_list [2;5;4])) (of_list [2]))
*)
let inter_mut ~into a =
iter
(fun x ->
@ -166,11 +151,6 @@ module Make(E : ELEMENT) : S with type elt = E.t = struct
copy_into ~into:res b;
res
(*$T
let module IS = Make(CCInt) in \
IS.(equal (union (of_list [1;2;3]) (of_list [2;5;4])) (of_list [1;2;3;4;5]))
*)
let union_mut ~into a =
copy_into ~into a
@ -180,11 +160,6 @@ module Make(E : ELEMENT) : S with type elt = E.t = struct
(fun x -> remove res x) b;
res
(*$T
let module IS = Make(CCInt) in \
IS.(equal (diff (of_list [1;2;3]) (of_list [2;4;5])) (of_list [1;3]))
*)
exception FastExit
let for_all p s =

126
src/data/CCHashTrie.ml
View file

@ -1,17 +1,5 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(*$inject
module M = Make(CCInt) ;;
let _listuniq =
let g = Q.(list (pair small_int small_int)) in
Q.map_same_type
(fun l ->
CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a)(fst b)) l
) g
;;
*)
(** {1 Hash Tries} *)
type 'a iter = ('a -> unit) -> unit
@ -182,20 +170,6 @@ let popcount (b:I64.t) : int =
let b = b + (b lsr 32) in
Int64.to_int (b land 0x7fL)
(*$T
popcount 5L = 2
popcount 256L = 1
popcount 255L = 8
popcount 0xFFFFL = 16
popcount 0xFF1FL = 13
popcount 0xFFFFFFFFL = 32
popcount 0xFFFFFFFFFFFFFFFFL = 64
*)
(*$Q
Q.int (fun i -> let i = Int64.of_int i in popcount i <= 64)
*)
(* sparse array, using a bitfield and POPCOUNT *)
module A_SPARSE = struct
type 'a t = {
@ -364,19 +338,10 @@ module Make(Key : KEY)
| S _ | L _ | N _
-> false
(*$T
M.is_empty M.empty
*)
let leaf_ k v ~h = L (h, Cons(k,v,Nil))
let singleton k v = leaf_ k v ~h:(hash_ k)
(*$T
not (M.is_empty (M.singleton 1 2))
M.cardinal (M.singleton 1 2) = 1
*)
let rec get_exn_list_ k l = match l with
| Nil -> raise Not_found
| One (k', v') -> if Key.equal k k' then v' else raise Not_found
@ -401,12 +366,6 @@ module Make(Key : KEY)
let get_exn k m = get_exn_ k ~h:(hash_ k) m
(*$Q
_listuniq (fun l -> \
let m = M.of_list l in \
List.for_all (fun (x,y) -> M.get_exn x m = y) l)
*)
let get k m =
try Some (get_exn_ k ~h:(hash_ k) m)
with Not_found -> None
@ -485,30 +444,10 @@ module Make(Key : KEY)
let add k v m = add_ ~id:Transient.empty k v ~h:(hash_ k) m
(*$Q
_listuniq (fun l -> \
let m = List.fold_left (fun m (x,y) -> M.add x y m) M.empty l in \
List.for_all (fun (x,y) -> M.get_exn x m = y) l)
*)
let add_mut ~id k v m =
if Transient.frozen id then raise Transient.Frozen;
add_ ~id k v ~h:(hash_ k) m
(*$R
let lsort = List.sort Stdlib.compare in
let m = M.of_list [1, 1; 2, 2] in
let id = Transient.create() in
let m' = M.add_mut ~id 3 3 m in
let m' = M.add_mut ~id 4 4 m' in
assert_equal [1, 1; 2, 2] (M.to_list m |> lsort);
assert_equal [1, 1; 2, 2; 3,3; 4,4] (M.to_list m' |> lsort);
Transient.freeze id;
assert_bool "must raise"
(try ignore(M.add_mut ~id 5 5 m'); false with Transient.Frozen -> true)
*)
exception LocalExit
let is_empty_arr_ a =
@ -569,21 +508,6 @@ module Make(Key : KEY)
if Transient.frozen id then raise Transient.Frozen;
remove_rec_ ~id k ~h:(hash_ k) m
(*$QR
_listuniq (fun l ->
let m = M.of_list l in
List.for_all
(fun (x,_) ->
let m' = M.remove x m in
not (M.mem x m') &&
M.cardinal m' = M.cardinal m - 1 &&
List.for_all
(fun (y,v) -> y = x || M.get_exn y m' = v)
l
) l
)
*)
let update_ ~id k f m =
let h = hash_ k in
let opt_v = try Some (get_exn_ k ~h m) with Not_found -> None in
@ -600,17 +524,6 @@ module Make(Key : KEY)
if Transient.frozen id then raise Transient.Frozen;
update_ ~id k f m
(*$R
let m = M.of_list [1, 1; 2, 2; 5, 5] in
let m' = M.update 4
~f:(function
| None -> Some 4
| Some _ -> Some 0
) m
in
assert_equal [1,1; 2,2; 4,4; 5,5] (M.to_list m' |> List.sort Stdlib.compare);
*)
let iter ~f t =
let rec aux = function
| E -> ()
@ -639,13 +552,6 @@ module Make(Key : KEY)
in
aux acc t
(*$T
let l = CCList.(1 -- 10 |> map (fun x->x,x)) in \
M.of_list l \
|> M.fold ~f:(fun acc x y -> (x,y)::acc) ~x:[] \
|> List.sort Stdlib.compare = l
*)
let cardinal m = fold ~f:(fun n _ _ -> n+1) ~x:0 m
let to_list m = fold ~f:(fun acc k v -> (k,v)::acc) ~x:[] m
@ -670,13 +576,6 @@ module Make(Key : KEY)
let to_iter m yield = iter ~f:(fun k v -> yield (k,v)) m
(*$Q
_listuniq (fun l -> \
(List.sort Stdlib.compare l) = \
(l |> Iter.of_list |> M.of_iter |> M.to_iter |> Iter.to_list \
|> List.sort Stdlib.compare) )
*)
let rec add_gen_mut ~id m g = match g() with
| None -> m
| Some (k,v) -> add_gen_mut ~id (add_mut ~id k v m) g
@ -714,20 +613,8 @@ module Make(Key : KEY)
in
next
(*$Q
_listuniq (fun l -> \
(List.sort Stdlib.compare l) = \
(l |> Gen.of_list |> M.of_gen |> M.to_gen |> Gen.to_list \
|> List.sort Stdlib.compare) )
*)
let choose m = to_gen m ()
(*$T
M.choose M.empty = None
M.choose M.(of_list [1,1; 2,2]) <> None
*)
let choose_exn m = match choose m with
| None -> raise Not_found
| Some (k,v) -> k, v
@ -755,16 +642,3 @@ module Make(Key : KEY)
and array_as_tree_ a = A.fold (fun acc t -> as_tree t :: acc) [] a
end
(*$R
let m = M.of_list CCList.( (501 -- 1000) @ (500 -- 1) |> map (fun i->i,i)) in
assert_equal ~printer:CCInt.to_string 1000 (M.cardinal m);
assert_bool "check all get"
(Iter.for_all (fun i -> i = M.get_exn i m) Iter.(1 -- 1000));
let m = Iter.(501 -- 1000 |> fold (fun m i -> M.remove i m) m) in
assert_equal ~printer:CCInt.to_string 500 (M.cardinal m);
assert_bool "check all get after remove"
(Iter.for_all (fun i -> i = M.get_exn i m) Iter.(1 -- 500));
assert_bool "check all get after remove"
(Iter.for_all (fun i -> None = M.get i m) Iter.(501 -- 1000));
*)

33
src/data/CCHet.ml
View file

@ -3,37 +3,6 @@
(** {1 Associative containers with Heterogenerous Values} *)
(*$R
let k1 : int Key.t = Key.create() in
let k2 : int Key.t = Key.create() in
let k3 : string Key.t = Key.create() in
let k4 : float Key.t = Key.create() in
let tbl = Tbl.create () in
Tbl.add tbl k1 1;
Tbl.add tbl k2 2;
Tbl.add tbl k3 "k3";
assert_equal (Some 1) (Tbl.find tbl k1);
assert_equal (Some 2) (Tbl.find tbl k2);
assert_equal (Some "k3") (Tbl.find tbl k3);
assert_equal None (Tbl.find tbl k4);
assert_equal 3 (Tbl.length tbl);
Tbl.add tbl k1 10;
assert_equal (Some 10) (Tbl.find tbl k1);
assert_equal 3 (Tbl.length tbl);
assert_equal None (Tbl.find tbl k4);
Tbl.add tbl k4 0.0;
assert_equal (Some 0.0) (Tbl.find tbl k4);
()
*)
type 'a iter = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
@ -171,7 +140,7 @@ module Map = struct
let add (type a) (k : a Key.t) v t =
let module K = (val k) in
add_e_pair_ (E_pair (k, K.Store v)) t
let remove (type a) (k: a Key.t) t =
let module K = (val k) in
M.remove K.id t

56
src/data/CCImmutArray.ml
View file

@ -5,9 +5,6 @@
(* TODO: transient API? for batch modifications *)
(*$inject let print_array f a = to_list a |> Array.of_list |> Q.Print.(array f)
*)
type 'a t = 'a array
let empty = [| |]
@ -29,11 +26,6 @@ let set a n x =
a'.(n) <- x;
a'
(*$= set & ~printer:(print_array Q.Print.int)
(of_list [0]) (set (of_list [5]) 0 0)
(of_list [1; 3; 4; 5]) (set (of_list [1; 2; 4; 5]) 1 3)
*)
let sub = Array.sub (* Would this not be better implemented with CCArray_slice *)
let map = Array.map
@ -45,13 +37,6 @@ let append a b =
Array.init (na + length b)
(fun i -> if i < na then a.(i) else b.(i-na))
(*$= append & ~printer:(print_array Q.Print.int)
empty (append empty empty)
(of_list [1; 2; 3]) (append empty (of_list [1; 2; 3]))
(of_list [1; 2; 3]) (append (of_list [1; 2; 3]) empty)
(of_list [3; 1; 4; 1; 5]) (append (of_list [3; 1]) (of_list [4; 1; 5]))
*)
let iter = Array.iter
let iteri = Array.iteri
@ -67,10 +52,6 @@ let foldi f acc a =
acc)
acc a
(*$= foldi & ~printer:Q.Print.(list (pair int string))
([2, "baz"; 1, "bar"; 0, "foo"]) (foldi (fun l i a -> (i, a) :: l) [] (of_list ["foo"; "bar"; "baz"]))
*)
exception ExitNow
let for_all p a =
@ -79,37 +60,12 @@ let for_all p a =
true
with ExitNow -> false
(*$= for_all & ~printer:Q.Print.bool
true (for_all (fun _ -> false) empty)
false (for_all (fun _ -> false) (singleton 3))
true (for_all (fun n -> n mod 2 = 0) (of_list [2; 4; 8]))
false (for_all (fun n -> n mod 2 = 0) (of_list [2; 4; 5; 8]))
*)
let exists p a =
try
Array.iter (fun x -> if p x then raise ExitNow) a;
false
with ExitNow -> true
(*$= exists & ~printer:Q.Print.bool
false (exists (fun _ -> true) empty)
true (exists (fun _ -> true) (singleton 3))
false (exists (fun _ -> false) (singleton 3))
false (exists (fun n -> n mod 2 = 1) (of_list [2; 4; 8]))
true (exists (fun n -> n mod 2 = 1) (of_list [2; 4; 5; 8]))
*)
(*$Q
Q.(list bool) (fun l -> let a = of_list l in not @@ exists (fun b -> b) a = for_all not a)
Q.(list bool) (fun l -> let a = of_list l in not @@ for_all (fun b -> b) a = exists not a)
*)
(*$Q
Q.(list bool) (fun l -> exists (fun b -> b) (of_list l) = List.fold_left (||) false l)
Q.(list bool) (fun l -> for_all (fun b -> b) (of_list l) = List.fold_left (&&) true l)
*)
(** {2 Conversions} *)
type 'a iter = ('a -> unit) -> unit
@ -128,12 +84,6 @@ let of_iter s =
s (fun x -> l := x :: !l);
Array.of_list (List.rev !l)
(*$Q
Q.(list int) (fun l -> \
let g = Iter.of_list l in \
of_iter g |> to_iter |> Iter.to_list = l)
*)
let rec gen_to_list_ acc g = match g() with
| None -> List.rev acc
| Some x -> gen_to_list_ (x::acc) g
@ -151,12 +101,6 @@ let to_gen a =
Some x
) else None
(*$Q
Q.(list int) (fun l -> \
let g = Gen.of_list l in \
of_gen g |> to_gen |> Gen.to_list = l)
*)
(** {2 IO} *)
type 'a printer = Format.formatter -> 'a -> unit

451
src/data/CCIntMap.ml
View file

@ -1,7 +1,4 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Map specialized for Int keys} *)
(* "Fast Mergeable Integer Maps", Okasaki & Gill.
We use big-endian trees. *)
@ -57,26 +54,6 @@ end = struct
let equal_int : int -> int -> bool = Stdlib.(=)
end
(*$inject
let highest2 x : int =
let rec aux i =
if i=0 then i
else if 1 = (x lsr i) then 1 lsl i else aux (i-1)
in
if x<0 then min_int else aux (Sys.word_size-2)
*)
(*$QR & ~count:1_000
Q.int (fun x ->
if Bit.equal_int (highest2 x) (Bit.highest x) then true
else QCheck.Test.fail_reportf "x=%d, highest=%d, highest2=%d@." x
(Bit.highest x :> int) (highest2 x))
*)
(*$inject
let _list_uniq l = CCList.sort_uniq ~cmp:(fun a b-> Stdlib.compare (fst a)(fst b)) l
*)
type +'a t =
| E (* empty *)
| L of int * 'a (* leaf *)
@ -88,31 +65,9 @@ let[@inline] is_empty = function
| E -> true
| _ -> false
(*$Q
Q.(small_list (pair int int)) (fun l -> \
let m = of_list l in \
is_empty m = (cardinal m = 0))
*)
let[@inline] is_prefix_ ~prefix y ~bit =
prefix = Bit.mask y ~mask:bit
(*$Q
Q.int (fun i -> \
let b = Bit.highest i in \
((b:>int) land i = (b:>int)) && (i < 0 || ((b:>int) <= i && (i-(b:>int)) < (b:>int))))
Q.int (fun i -> (Bit.highest i = Bit.min_int) = (i < 0))
Q.int (fun i -> ((Bit.highest i:>int) < 0) = (Bit.highest i = Bit.min_int))
Q.int (fun i -> let j = (Bit.highest i :> int) in j land (j-1) = 0)
*)
(*$T
(Bit.highest min_int :> int) = min_int
(Bit.highest 2 :> int) = 2
(Bit.highest 17 :> int) = 16
(Bit.highest 300 :> int) = 256
*)
(* small endian: let branching_bit_ a _ b _ = lowest_bit_ (a lxor b) *)
let branching_bit_ a b = Bit.highest (a lxor b)
@ -137,11 +92,6 @@ let check_invariants t =
in
check_keys [] t
(*$Q
Q.(list (pair int bool)) (fun l -> \
check_invariants (of_list l))
*)
let rec find_exn k t = match t with
| E -> raise Not_found
| L (k', v) when k = k' -> v
@ -159,23 +109,10 @@ let find k t =
try Some (find_exn k t)
with Not_found -> None
(*$Q
Q.(list (pair int int)) (fun l -> \
let l = _list_uniq l in \
let m = of_list l in \
List.for_all (fun (k,v) -> find k m = Some v) l)
*)
let mem k t =
try ignore (find_exn k t); true
with Not_found -> false
(*$Q
Q.(list (pair int int)) (fun l -> \
let m = of_list l in \
List.for_all (fun (k,_) -> mem k m) l)
*)
let mk_node_ prefix switch l r = match l, r with
| E, o | o, E -> o
| _ -> N (prefix, switch, l, r)
@ -213,12 +150,6 @@ let rec insert_ c k v t = match t with
let add k v t = insert_ (fun ~old:_ v -> v) k v t
(*$Q & ~count:20
Q.(list (pair int int)) (fun l -> \
let l = _list_uniq l in let m = of_list l in \
List.for_all (fun (k,v) -> find_exn k m = v) l)
*)
let rec remove k t = match t with
| E -> E
| L (k', _) -> if k=k' then E else t
@ -231,12 +162,6 @@ let rec remove k t = match t with
t (* not present *)
)
(*$Q & ~count:20
Q.(list (pair int int)) (fun l -> \
let l = _list_uniq l in let m = of_list l in \
List.for_all (fun (k,_) -> mem k m && not (mem k (remove k m))) l)
*)
let update k f t =
try
let v = find_exn k t in
@ -249,13 +174,6 @@ let update k f t =
| None -> t
| Some v -> add k v t
(*$= & ~printer:Q.Print.(list (pair int int))
[1,1; 2, 22; 3, 3] \
(of_list [1,1;2,2;3,3] \
|> update 2 (function None -> assert false | Some _ -> Some 22) \
|> to_list |> List.sort Stdlib.compare)
*)
let doubleton k1 v1 k2 v2 = add k1 v1 (singleton k2 v2)
let rec equal ~eq a b =
@ -270,12 +188,6 @@ let rec equal ~eq a b =
| L _, _ -> false
end
(*$Q
Q.(list (pair int bool)) ( fun l -> \
CCList.sort_uniq ~cmp:CCOrd.compare l = CCList.sort CCOrd.compare l ==> \
equal ~eq:(=) (of_list l) (of_list (List.rev l)))
*)
let rec iter f t = match t with
| E -> ()
| L (k, v) -> f k v
@ -335,75 +247,6 @@ let rec union f t1 t2 =
join_ t1 p1 t2 p2
)
(* regression for #329 *)
(*$R
let minus m1 m2 =
union (fun _key v1 v2 -> v1 - v2) m1 m2 in
let key = 0 in
let m0 = singleton key 1 in (* a map of [key] to the value 1 *)
let m1 = minus m0 m0 in (* a map of [key] to the value 0 *)
let m2 = minus m0 m1 in (* a map of [key] to the value 1 *)
let observed = equal ~eq:(=) m2 m0 in (* [m0] and [m2] should be equal *)
assert_equal true observed
*)
(*$Q & ~small:(fun (a,b) -> List.length a + List.length b)
Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1,l2) -> \
check_invariants (union (fun _ _ x -> x) (of_list l1) (of_list l2)))
Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1,l2) -> \
check_invariants (inter (fun _ _ x -> x) (of_list l1) (of_list l2)))
*)
(* associativity of union *)
(*$Q & ~small:(fun (a,b,c) -> List.(length a + length b + length c))
Q.(let p = list (pair int int) in triple p p p) (fun (l1,l2,l3) -> \
let m1 = of_list l1 and m2 = of_list l2 and m3 = of_list l3 in \
let f _ x y = max x y in \
equal ~eq:(=) (union f (union f m1 m2) m3) (union f m1 (union f m2 m3)))
*)
(*$R
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp))
(of_list [1, "1"; 2, "2"; 3, "3"; 4, "4"])
(union (fun _ a b -> a)
(of_list [1, "1"; 3, "3"]) (of_list [2, "2"; 4, "4"]));
*)
(*$R
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp))
(of_list [1, "1"; 2, "2"; 3, "3"; 4, "4"])
(union (fun _ a b -> a)
(of_list [1, "1"; 2, "2"; 3, "3"]) (of_list [2, "2"; 4, "4"]))
*)
(*$Q
Q.(list (pair int bool)) (fun l -> \
equal ~eq:(=) (of_list l) (union (fun _ a _ -> a) (of_list l)(of_list l)))
*)
(*$inject
let union_l l1 l2 =
let l2' = List.filter (fun (x,_) -> not @@ List.mem_assoc x l1) l2 in
_list_uniq (l1 @ l2')
let inter_l l1 l2 =
let l2' = List.filter (fun (x,_) -> List.mem_assoc x l1) l2 in
_list_uniq l2'
*)
(*$QR
Q.(pair (small_list (pair small_int unit)) (small_list (pair small_int unit)))
(fun (l1,l2) ->
union_l l1 l2 = _list_uniq @@ to_list (union (fun _ _ _ ->())(of_list l1) (of_list l2)))
*)
(*$QR
Q.(pair (small_list (pair small_int unit)) (small_list (pair small_int unit)))
(fun (l1,l2) ->
inter_l l1 l2 = _list_uniq @@ to_list (inter (fun _ _ _ ->()) (of_list l1) (of_list l2)))
*)
let rec inter f a b =
match a, b with
| E, _ | _, E -> E
@ -432,26 +275,6 @@ let rec inter f a b =
else inter f a r2
) else E
(*$R
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp))
(singleton 2 "2")
(inter (fun _ a b -> a)
(of_list [1, "1"; 2, "2"; 3, "3"]) (of_list [2, "2"; 4, "4"]))
*)
(*$Q
Q.(list (pair int bool)) (fun l -> \
equal ~eq:(=) (of_list l) (inter (fun _ a _ -> a) (of_list l)(of_list l)))
*)
(* associativity of inter *)
(*$Q & ~small:(fun (a,b,c) -> List.(length a + length b + length c))
Q.(let p = list (pair int int) in triple p p p) (fun (l1,l2,l3) -> \
let m1 = of_list l1 and m2 = of_list l2 and m3 = of_list l3 in \
let f _ x y = max x y in \
equal ~eq:(=) (inter f (inter f m1 m2) m3) (inter f m1 (inter f m2 m3)))
*)
let rec disjoint_union_ t1 t2 : _ t = match t1, t2 with
| E, o | o, E -> o
| L (k,v), o
@ -478,14 +301,6 @@ let rec filter f m = match m with
| N (_,_,l,r) ->
disjoint_union_ (filter f l) (filter f r)
(*$QR
Q.(pair (fun2 Observable.int Observable.int bool) (small_list (pair int int))) (fun (f,l) ->
let QCheck.Fun(_,f) = f in
_list_uniq (List.filter (fun (x,y) -> f x y) l) =
(_list_uniq @@ to_list @@ filter f @@ of_list l)
)
*)
let rec filter_map f m = match m with
| E -> E
| L (k,v) ->
@ -496,14 +311,6 @@ let rec filter_map f m = match m with
| N (_,_,l,r) ->
disjoint_union_ (filter_map f l) (filter_map f r)
(*$QR
Q.(pair (fun2 Observable.int Observable.int @@ option bool) (small_list (pair int int))) (fun (f,l) ->
let QCheck.Fun(_,f) = f in
_list_uniq (CCList.filter_map (fun (x,y) -> CCOption.map (CCPair.make x) @@ f x y) l) =
(_list_uniq @@ to_list @@ filter_map f @@ of_list l)
)
*)
let rec merge ~f t1 t2 : _ t =
let merge1 t =
filter_map (fun k v -> f k (`Left v)) t
@ -541,42 +348,6 @@ let rec merge ~f t1 t2 : _ t =
join_ (merge1 t1) p1 (merge2 t2) p2
)
(*$inject
let merge_union _x o = match o with
| `Left v | `Right v | `Both (v,_) -> Some v
let merge_inter _x o = match o with
| `Left _ | `Right _ -> None
| `Both (v,_) -> Some v
*)
(*$QR
Q.(let p = small_list (pair small_int small_int) in pair p p) (fun (l1,l2) ->
check_invariants
(merge ~f:merge_union (of_list l1) (of_list l2)))
*)
(*$QR
Q.(let p = small_list (pair small_int small_int) in pair p p) (fun (l1,l2) ->
check_invariants
(merge ~f:merge_inter (of_list l1) (of_list l2)))
*)
(*$QR
Q.(let p = small_list (pair small_int unit) in pair p p) (fun (l1,l2) ->
let l1 = _list_uniq l1 and l2 = _list_uniq l2 in
equal ~eq:Stdlib.(=)
(union (fun _ v1 _ -> v1) (of_list l1) (of_list l2))
(merge ~f:merge_union (of_list l1) (of_list l2)))
*)
(*$QR
Q.(let p = small_list (pair small_int unit) in pair p p) (fun (l1,l2) ->
let l1 = _list_uniq l1 and l2 = _list_uniq l2 in
equal ~eq:Stdlib.(=)
(inter (fun _ v1 _ -> v1) (of_list l1) (of_list l2))
(merge ~f:merge_inter (of_list l1) (of_list l2)))
*)
(** {2 Conversions} *)
type 'a iter = ('a -> unit) -> unit
@ -588,25 +359,6 @@ let of_list l = add_list empty l
let to_list t = fold (fun k v l -> (k,v) :: l) t []
(*$Q
Q.(list (pair int int)) (fun l -> \
let l = List.map (fun (k,v) -> abs k,v) l in \
let rec is_sorted = function [] | [_] -> true \
| x::y::tail -> x <= y && is_sorted (y::tail) in \
of_list l |> to_list |> List.rev_map fst |> is_sorted)
*)
(*$Q
Q.(list (pair int int)) (fun l -> \
of_list l |> cardinal = List.length (l |> List.map fst |> CCList.sort_uniq ~cmp:CCInt.compare))
Q.(list (pair small_int int)) (fun l -> \
of_list l |> cardinal = List.length (l |> List.map fst |> CCList.sort_uniq ~cmp:CCInt.compare))
*)
(*$= & ~printer:Q.Print.int
1 (let t = of_list [(197151390, 0); (197151390, 0)] in cardinal t)
*)
let add_iter t iter =
let t = ref t in
iter (fun (k,v) -> t := add k v !t);
@ -641,16 +393,6 @@ let to_gen m =
in
next
(*$T
doubleton 1 "a" 2 "b" |> to_gen |> of_gen |> to_list \
|> List.sort Stdlib.compare = [1, "a"; 2, "b"]
*)
(*$Q
Q.(list (pair int bool)) (fun l -> \
let m = of_list l in equal ~eq:(=) m (m |> to_gen |> of_gen))
*)
(* E < L < N; arbitrary order for switches *)
let compare ~cmp a b =
let rec cmp_gen cmp a b = match a(), b() with
@ -667,31 +409,6 @@ let compare ~cmp a b =
in
cmp_gen cmp (to_gen a) (to_gen b)
(*$Q
Q.(list (pair int bool)) ( fun l -> \
let m1 = of_list l and m2 = of_list (List.rev l) in \
compare ~cmp:Stdlib.compare m1 m2 = 0)
*)
(*$QR
Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1, l2) ->
let l1 = List.map (fun (k,v) -> abs k,v) l1 in
let l2 = List.map (fun (k,v) -> abs k,v) l2 in
let m1 = of_list l1 and m2 = of_list l2 in
let c = compare ~cmp:Stdlib.compare m1 m2
and c' = compare ~cmp:Stdlib.compare m2 m1 in
(c = 0) = (c' = 0) && (c < 0) = (c' > 0) && (c > 0) = (c' < 0))
*)
(*$QR
Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1, l2) ->
let l1 = List.map (fun (k,v) -> abs k,v) l1 in
let l2 = List.map (fun (k,v) -> abs k,v) l2 in
let m1 = of_list l1 and m2 = of_list l2 in
(compare ~cmp:Stdlib.compare m1 m2 = 0) = equal ~eq:(=) m1 m2)
*)
let rec add_seq m l = match l() with
| Seq.Nil -> m
| Seq.Cons ((k,v), tl) -> add_seq (add k v m) tl
@ -710,11 +427,6 @@ let to_seq m =
in
next [m]
(*$Q
Q.(list (pair int bool)) (fun l -> \
let m = of_list l in equal ~eq:(=) m (m |> to_seq |> of_seq))
*)
type 'a tree = unit -> [`Nil | `Node of 'a * 'a tree list]
let rec as_tree t () = match t with
@ -742,166 +454,3 @@ let pp pp_x out m =
(* Some thorough tests from Jan Midtgaar
https://github.com/jmid/qc-ptrees
*)
(*$inject
let test_count = 2_500
open QCheck
type instr_tree =
| Empty
| Singleton of int * int
| Add of int * int * instr_tree
| Remove of int * instr_tree
| Union of instr_tree * instr_tree
| Inter of instr_tree * instr_tree
let rec to_string (a:instr_tree): string =
let int_to_string = string_of_int in
match a with
| Empty -> "Empty"
| Singleton (k,v) -> Printf.sprintf "Singleton(%d,%d)" k v
| Add (k,v,t) -> Printf.sprintf "Add(%d,%d," k v ^ (to_string t) ^ ")"
| Remove (n,t) -> "Remove (" ^ (int_to_string n) ^ ", " ^ (to_string t) ^ ")"
| Union (t,t') -> "Union (" ^ (to_string t) ^ ", " ^ (to_string t') ^ ")"
| Inter (t,t') -> "Inter (" ^ (to_string t) ^ ", " ^ (to_string t') ^ ")"
let merge_f _ x y = min x y
let rec interpret t : _ t = match t with
| Empty -> empty
| Singleton (k,v) -> singleton k v
| Add (k,v,t) -> add k v (interpret t)
| Remove (n,t) -> remove n (interpret t)
| Union (t,t') ->
let s = interpret t in
let s' = interpret t' in
union merge_f s s'
| Inter (t,t') ->
let s = interpret t in
let s' = interpret t' in
inter merge_f s s'
let tree_gen int_gen : instr_tree Q.Gen.t =
let open Gen in
sized
(fix (fun recgen n -> match n with
| 0 -> oneof [return Empty;
Gen.map2 (fun i j -> Singleton (i,j)) int_gen int_gen]
| _ ->
frequency
[ (1, return Empty);
(1, map2 (fun k v -> Singleton (k,v)) int_gen int_gen);
(2, map3 (fun i j t -> Add (i,j,t)) int_gen int_gen (recgen (n-1)));
(2, map2 (fun i t -> Remove (i,t)) int_gen (recgen (n-1)));
(2, map2 (fun l r -> Union (l,r)) (recgen (n/2)) (recgen (n/2)));
(2, map2 (fun l r -> Inter (l,r)) (recgen (n/2)) (recgen (n/2)));
]))
let (<+>) = Q.Iter.(<+>)
let rec tshrink t : instr_tree Q.Iter.t = match t with
| Empty -> Iter.empty
| Singleton (k,v) ->
(Iter.return Empty)
<+> (Iter.map (fun k' -> Singleton (k',v)) (Shrink.int k))
<+> (Iter.map (fun v' -> Singleton (k,v')) (Shrink.int v))
| Add (k,v,t) ->
(Iter.of_list [Empty; t; Singleton (k,v)])
<+> (Iter.map (fun t' -> Add (k,v,t')) (tshrink t))
<+> (Iter.map (fun k' -> Add (k',v,t)) (Shrink.int k))
<+> (Iter.map (fun v' -> Add (k,v',t)) (Shrink.int v))
| Remove (i,t) ->
(Iter.of_list [Empty; t])
<+> (Iter.map (fun t' -> Remove (i,t')) (tshrink t))
<+> (Iter.map (fun i' -> Remove (i',t)) (Shrink.int i))
| Union (t0,t1) ->
(Iter.of_list [Empty;t0;t1])
<+> (Iter.map (fun t0' -> Union (t0',t1)) (tshrink t0))
<+> (Iter.map (fun t1' -> Union (t0,t1')) (tshrink t1))
| Inter (t0,t1) ->
(Iter.of_list [Empty;t0;t1])
<+> (Iter.map (fun t0' -> Inter (t0',t1)) (tshrink t0))
<+> (Iter.map (fun t1' -> Inter (t0,t1')) (tshrink t1))
let arb_int =
frequency
[(5,small_signed_int);
(3,int);
(1, oneofl [min_int;max_int])]
let arb_tree =
make ~print:to_string ~shrink:tshrink
(tree_gen arb_int.gen)
let empty_m = []
let singleton_m k v = [k,v]
let mem_m i s = List.mem_assoc i s
let rec remove_m i s = match s with
| [] -> []
| (j,v)::s' -> if i=j then s' else (j,v)::(remove_m i s')
let add_m k v s = List.sort Stdlib.compare ((k,v)::remove_m k s)
let rec union_m s s' = match s,s' with
| [], _ -> s'
| _, [] -> s
| (k1,v1)::is,(k2,v2)::js ->
if k1<k2 then (k1,v1)::(union_m is s') else
if k1>k2 then (k2,v2)::(union_m s js) else
(k1,min v1 v2)::(union_m is js)
let rec inter_m s s' = match s with
| [] -> []
| (k,v)::s ->
if List.mem_assoc k s'
then (k,min v (List.assoc k s'))::(inter_m s s')
else inter_m s s'
let abstract s = List.sort Stdlib.compare (fold (fun k v acc -> (k,v)::acc) s [])
*)
(* A bunch of agreement properties *)
(*$=
empty_m (let s = empty in abstract s)
*)
(*$QR & ~count:test_count
(Q.pair arb_int arb_int) (fun (k,v) ->
abstract (singleton k v) = singleton_m k v)
*)
(*$QR & ~count:test_count
Q.(pair arb_tree arb_int)
(fun (t,n) ->
let s = interpret t in
mem n s = mem_m n (abstract s))
*)
(*$QR & ~count:test_count
(triple arb_tree arb_int arb_int)
(fun (t,k,v) ->
let s = interpret t in
abstract (add k v s) = add_m k v (abstract s))
*)
(*$QR & ~count:test_count
(pair arb_tree arb_int)
(fun (t,n) ->
let s = interpret t in
abstract (remove n s) = remove_m n (abstract s))
*)
(*$QR & ~count:test_count
(pair arb_tree arb_tree)
(fun (t,t') ->
let s = interpret t in
let s' = interpret t' in
abstract (union merge_f s s') = union_m (abstract s) (abstract s'))
*)
(*$QR & ~count:test_count
Q.(pair arb_tree arb_tree)
(fun (t,t') ->
let s = interpret t in
let s' = interpret t' in
abstract (inter merge_f s s') = inter_m (abstract s) (abstract s'))
*)

2
src/data/CCIntMap.mli
View file

@ -1,6 +1,4 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** Map specialized for Int keys
{b status: stable}

30
src/data/CCLazy_list.ml
View file

@ -29,10 +29,6 @@ let length l =
in
aux 0 l
(*$Q
Q.(list int) (fun l -> length (of_list l) = List.length l)
*)
let rec map ~f l =
lazy (
match l with
@ -48,11 +44,6 @@ let filter ~f l =
in
lazy (aux f l)
(*$=
[2;4;6] (of_list [1;2;3;4;5;6;7] |> filter ~f:(fun x -> x mod 2=0) |> to_list)
[2;4;6] (of_gen Gen.(1 -- max_int) |> filter ~f:(fun x -> x mod 2=0) |> take 3 |> to_list)
*)
let rec take n l =
lazy (
match l with
@ -68,11 +59,6 @@ let rec append a b =
| lazy (Cons (x,tl)) -> Cons (x, append tl b)
)
(*$Q
Q.(pair (list int) (list int)) (fun (l1,l2) ->\
length (append (of_list l1) (of_list l2)) = List.length l1 + List.length l2)
*)
let rec flat_map ~f l =
lazy (
match l with
@ -89,10 +75,6 @@ let default ~default l =
| lazy l -> l
)
(*$=
[1] (default ~default:(return 1) empty |> to_list)
*)
module Infix = struct
let (>|=) x f = map ~f x
let (>>=) x f = flat_map ~f x
@ -110,10 +92,6 @@ let rec of_gen g =
| Some x -> Cons (x, of_gen g)
)
(*$Q
Q.(list int) (fun l -> l = (Gen.of_list l |> of_gen |> to_list))
*)
let rec of_list = function
| [] -> empty
| x :: tl -> cons x (of_list tl)
@ -127,16 +105,8 @@ let to_list_rev l =
let to_list l = List.rev (to_list_rev l)
(*$Q
Q.(list int) (fun l -> l = to_list (of_list l))
*)
let to_gen l =
let l = ref l in
fun () -> match !l with
| lazy Nil -> None
| lazy (Cons (x,tl)) -> l := tl; Some x
(*$Q
Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list))
*)

22
src/data/CCMixmap.ml
View file

@ -3,28 +3,6 @@
(** {1 Maps with Heterogeneous Values} *)
(*$R
let module M = CCMixmap.Make(CCInt) in
let inj_int = CCMixmap.create_inj() in
let inj_str = CCMixmap.create_inj() in
let inj_list_int = CCMixmap.create_inj() in
let m =
M.empty
|> M.add ~inj:inj_int 1 1
|> M.add ~inj:inj_str 2 "2"
|> M.add ~inj:inj_list_int 3 [3;3;3]
in
assert_equal (M.get ~inj:inj_int 1 m) (Some 1) ;
assert_equal (M.get ~inj:inj_str 1 m) None ;
assert_equal (M.get ~inj:inj_str 2 m) (Some "2") ;
assert_equal (M.get ~inj:inj_int 2 m) None ;
assert_equal (M.get ~inj:inj_list_int 3 m) (Some [3;3;3]) ;
assert_equal (M.get ~inj:inj_str 3 m) None ;
*)
type 'b injection = {
get : (unit -> unit) -> 'b option;
set : 'b -> (unit -> unit);

16
src/data/CCMixset.ml
View file

@ -8,22 +8,6 @@ module IMap = Map.Make(struct
let compare : int -> int -> int = compare
end)
(*$R
let k1 : int key = newkey () in
let k2 : int key = newkey () in
let k3 : string key = newkey () in
let set =
empty
|> set ~key:k1 1
|> set ~key:k2 2
|> set ~key:k3 "3"
in
assert (get ~key:k1 set = Some 1);
assert (get ~key:k2 set = Some 2);
assert (get ~key:k3 set = Some "3");
()
*)
type t = (unit -> unit) IMap.t
and 'a key = {
id: int;

86
src/data/CCMixtbl.ml
View file

@ -3,32 +3,11 @@
(** {1 Hash Table with Heterogeneous Keys} *)
(*$inject
open CCFun
*)
type 'b injection = {
get : (unit -> unit) -> 'b option;
set : 'b -> (unit -> unit);
}
(*$R
let inj_int = create_inj () in
let tbl = create 10 in
OUnit2.assert_equal None (get ~inj:inj_int tbl "a");
set ~inj:inj_int tbl "a" 1;
OUnit2.assert_equal (Some 1) (get ~inj:inj_int tbl "a");
let inj_string = create_inj () in
set ~inj:inj_string tbl "b" "Hello";
OUnit2.assert_equal (Some "Hello") (get ~inj:inj_string tbl "b");
OUnit2.assert_equal None (get ~inj:inj_string tbl "a");
OUnit2.assert_equal (Some 1) (get ~inj:inj_int tbl "a");
set ~inj:inj_string tbl "a" "Bye";
OUnit2.assert_equal None (get ~inj:inj_int tbl "a");
OUnit2.assert_equal (Some "Bye") (get ~inj:inj_string tbl "a");
*)
type 'a t = ('a, unit -> unit) Hashtbl.t
let create n = Hashtbl.create n
@ -53,33 +32,8 @@ let set ~inj tbl x y =
let length tbl = Hashtbl.length tbl
(*$R
let inj_int = create_inj () in
let tbl = create 5 in
set ~inj:inj_int tbl "foo" 1;
set ~inj:inj_int tbl "bar" 2;
OUnit2.assert_equal 2 (length tbl);
OUnit2.assert_equal 2 (find ~inj:inj_int tbl "bar");
set ~inj:inj_int tbl "foo" 42;
OUnit2.assert_equal 2 (length tbl);
remove tbl "bar";
OUnit2.assert_equal 1 (length tbl);
*)
let clear tbl = Hashtbl.clear tbl
(*$R
let inj_int = create_inj () in
let inj_str = create_inj () in
let tbl = create 5 in
set ~inj:inj_int tbl "foo" 1;
set ~inj:inj_int tbl "bar" 2;
set ~inj:inj_str tbl "baaz" "hello";
OUnit2.assert_equal 3 (length tbl);
clear tbl;
OUnit2.assert_equal 0 (length tbl);
*)
let remove tbl x = Hashtbl.remove tbl x
let copy tbl = Hashtbl.copy tbl
@ -93,21 +47,6 @@ let mem ~inj tbl x =
is_some (inj.get (Hashtbl.find tbl x))
with Not_found -> false
(*$R
let inj_int = create_inj () in
let inj_str = create_inj () in
let tbl = create 5 in
set ~inj:inj_int tbl "foo" 1;
set ~inj:inj_int tbl "bar" 2;
set ~inj:inj_str tbl "baaz" "hello";
OUnit2.assert_bool "mem foo int" (mem ~inj:inj_int tbl "foo");
OUnit2.assert_bool "mem bar int" (mem ~inj:inj_int tbl "bar");
OUnit2.assert_bool "not mem baaz int" (not (mem ~inj:inj_int tbl "baaz"));
OUnit2.assert_bool "not mem foo str" (not (mem ~inj:inj_str tbl "foo"));
OUnit2.assert_bool "not mem bar str" (not (mem ~inj:inj_str tbl "bar"));
OUnit2.assert_bool "mem baaz str" (mem ~inj:inj_str tbl "baaz");
*)
let find ~inj tbl x =
match inj.get (Hashtbl.find tbl x) with
| None -> raise Not_found
@ -128,17 +67,6 @@ let keys_iter tbl yield =
(fun x _ -> yield x)
tbl
(*$R
let inj_int = create_inj () in
let inj_str = create_inj () in
let tbl = create 5 in
set ~inj:inj_int tbl "foo" 1;
set ~inj:inj_int tbl "bar" 2;
set ~inj:inj_str tbl "baaz" "hello";
let l = keys_iter tbl |> Iter.to_list in
OUnit2.assert_equal ["baaz"; "bar"; "foo"] (List.sort compare l);
*)
let bindings_of ~inj tbl yield =
Hashtbl.iter
(fun k value ->
@ -154,17 +82,3 @@ let bindings tbl yield =
Hashtbl.iter
(fun x y -> yield (x, Value (fun inj -> inj.get y)))
tbl
(*$R
let inj_int = create_inj () in
let inj_str = create_inj () in
let tbl = create 5 in
set ~inj:inj_int tbl "foo" 1;
set ~inj:inj_int tbl "bar" 2;
set ~inj:inj_str tbl "baaz" "hello";
set ~inj:inj_str tbl "str" "rts";
let l_int = bindings_of ~inj:inj_int tbl |> Iter.to_list in
OUnit2.assert_equal ["bar", 2; "foo", 1] (List.sort compare l_int);
let l_str = bindings_of ~inj:inj_str tbl |> Iter.to_list in
OUnit2.assert_equal ["baaz", "hello"; "str", "rts"] (List.sort compare l_str);
*)

9
src/data/CCMultiSet.ml
View file

@ -258,12 +258,3 @@ module Make(O : Set.OrderedType) = struct
seq (fun (x,n) -> m := add_mult !m x n);
!m
end
(*$T
let module S = CCMultiSet.Make(String) in \
S.count (S.add_mult S.empty "a" 5) "a" = 5
let module S = CCMultiSet.Make(String) in \
S.count (S.remove_mult (S.add_mult S.empty "a" 5) "a" 3) "a" = 2
let module S = CCMultiSet.Make(String) in \
S.count (S.remove_mult (S.add_mult S.empty "a" 4) "a" 6) "a" = 0
*)

75
src/data/CCMutHeap.ml
View file

@ -144,78 +144,3 @@ module Make(Elt : RANKED) = struct
x
end [@@inline]
(*$inject
type elt = {
x: string;
mutable rank: int;
mutable idx: int;
}
module Elt = struct
type t = elt
let idx x = x.idx
let set_idx x i = x.idx <- i
let lt a b =
if a.rank = b.rank then a.x < b.x else a.rank < b.rank
end
module H = CCMutHeap.Make(Elt)
*)
(*$R
let h = H.create() in
let x1 = {x="a"; rank=10; idx= -1} in
let x2 = {x="b"; rank=10; idx= -1} in
let x3 = {x="c"; rank=10; idx= -1} in
H.insert h x1;
assert (H.in_heap x1);
assert (not (H.in_heap x2));
assert (not (H.in_heap x3));
H.insert h x2;
H.insert h x3;
assert (Elt.lt x1 x2);
assert (Elt.lt x2 x3);
let x = H.remove_min h in
assert (x == x1);
let x = H.remove_min h in
assert (x == x2);
let x = H.remove_min h in
assert (x == x3);
assert (try ignore (H.remove_min h); false with Not_found -> true);
*)
(*$R
let h = H.create() in
let x1 = {x="a"; rank=10; idx= -1} in
let x2 = {x="b"; rank=10; idx= -1} in
let x3 = {x="c"; rank=10; idx= -1} in
H.insert h x1;
H.insert h x2;
H.insert h x3;
x3.rank <- 2;
H.decrease h x3;
assert (Elt.lt x3 x1);
assert (Elt.lt x3 x2);
let x = H.remove_min h in
assert (x == x3);
x1.rank <- 20;
H.increase h x1;
let x = H.remove_min h in
assert (x == x2);
let x = H.remove_min h in
assert (x == x1);
assert (try ignore (H.remove_min h); false with Not_found -> true);
*)

12
src/data/CCPersistentArray.ml
View file

@ -99,13 +99,6 @@ let flat_map f a =
let a' = map f a in
flatten a'
(*$T
of_list [ of_list [1]; of_list []; of_list [2;3;4]; of_list [5]; of_list [6;7]] \
|> flatten |> to_list = [1;2;3;4;5;6;7]
of_list [ of_list []; of_list []; of_list []] |> flatten |> length = 0
of_list [] |> flatten |> length = 0
*)
let to_array t = Array.copy (reroot t)
let of_array a = init (Array.length a) (fun i -> a.(i))
@ -156,11 +149,6 @@ let to_gen a =
Some x
)
(*$Q
Q.(list int) (fun l -> \
of_list l |> to_gen |> of_gen |> to_list = l)
*)
type 'a printer = Format.formatter -> 'a -> unit
let pp pp_item out v =

168
src/data/CCPersistentHashtbl.ml
View file

@ -118,27 +118,6 @@ module type S = sig
@since 0.14 *)
end
(*$inject
module H = Make(CCInt)
let my_list =
[ 1, "a";
2, "b";
3, "c";
4, "d";
]
let my_iter = Iter.of_list my_list
let _list_uniq = CCList.sort_uniq
~cmp:(fun a b -> Stdlib.compare (fst a) (fst b))
let _list_int_int = Q.(
map_same_type _list_uniq
(list_of_size Gen.(0 -- 40) (pair small_int small_int))
)
*)
(** {2 Implementation} *)
module Make(H : HashedType) : S with type key = H.t = struct
@ -222,41 +201,6 @@ module Make(H : HashedType) : S with type key = H.t = struct
| Cons (k4,v4,l4) ->
if H.equal k k4 then v4 else find_rec_ k l4
(*$R
let h = H.of_iter my_iter in
OUnit2.assert_equal "a" (H.find h 1);
OUnit2.assert_raises Not_found (fun () -> H.find h 5);
let h' = H.replace h 5 "e" in
OUnit2.assert_equal "a" (H.find h' 1);
OUnit2.assert_equal "e" (H.find h' 5);
OUnit2.assert_equal "a" (H.find h 1);
OUnit2.assert_raises Not_found (fun () -> H.find h 5);
*)
(*$R
let n = 10000 in
let seq = Iter.map (fun i -> i, string_of_int i) Iter.(0--n) in
let h = H.of_iter seq in
Iter.iter
(fun (k,v) ->
OUnit2.assert_equal ~printer:(fun x -> x) v (H.find h k))
seq;
OUnit2.assert_raises Not_found (fun () -> H.find h (n+1));
*)
(*$QR
_list_int_int
(fun l ->
let h = H.of_list l in
List.for_all
(fun (k,v) ->
try
H.find h k = v
with Not_found -> false)
l
)
*)
let get_exn k t = find t k
let get k t =
@ -267,20 +211,6 @@ module Make(H : HashedType) : S with type key = H.t = struct
try ignore (find t k); true
with Not_found -> false
(*$R
let h = H.of_iter
Iter.(map (fun i -> i, string_of_int i)
(0 -- 200)) in
OUnit2.assert_equal 201 (H.length h);
*)
(*$QR
_list_int_int (fun l ->
let h = H.of_list l in
H.length h = List.length l
)
*)
let rec buck_rev_iter_ ~f l = match l with
| Nil -> ()
| Cons (k,v,l') -> buck_rev_iter_ ~f l'; f k v
@ -369,26 +299,6 @@ module Make(H : HashedType) : S with type key = H.t = struct
t'
)
(*$R
let h = H.of_iter my_iter in
OUnit2.assert_equal "a" (H.find h 1);
OUnit2.assert_raises Not_found (fun () -> H.find h 5);
let h1 = H.add h 5 "e" in
OUnit2.assert_equal "a" (H.find h1 1);
OUnit2.assert_equal "e" (H.find h1 5);
OUnit2.assert_equal "a" (H.find h 1);
let h2 = H.add h1 5 "ee" in
OUnit2.assert_equal "ee" (H.find h2 5);
OUnit2.assert_raises Not_found (fun () -> H.find h 5);
let h3 = H.remove h2 1 in
OUnit2.assert_equal "ee" (H.find h3 5);
OUnit2.assert_raises Not_found (fun () -> H.find h3 1);
let h4 = H.remove h3 5 in
OUnit2.assert_equal "e" (H.find h4 5);
OUnit2.assert_equal "ee" (H.find h3 5);
*)
(* return [Some l'] if [l] changed into [l'] by removing [k] *)
let rec remove_rec_ k l = match l with
| Nil -> None
@ -413,36 +323,6 @@ module Make(H : HashedType) : S with type key = H.t = struct
t.arr <- Set (i,l,t');
t'
(*$R
let h = H.of_iter my_iter in
OUnit2.assert_equal (H.find h 2) "b";
OUnit2.assert_equal (H.find h 3) "c";
OUnit2.assert_equal (H.find h 4) "d";
OUnit2.assert_equal (H.length h) 4;
let h = H.remove h 2 in
OUnit2.assert_equal (H.find h 3) "c";
OUnit2.assert_equal (H.length h) 3;
OUnit2.assert_raises Not_found (fun () -> H.find h 2)
*)
(*$R
let open Iter.Infix in
let n = 10000 in
let seq = Iter.map (fun i -> i, string_of_int i) (0 -- n) in
let h = H.of_iter seq in
OUnit2.assert_equal (n+1) (H.length h);
let h = Iter.fold (fun h i -> H.remove h i) h (0 -- 500) in
OUnit2.assert_equal (n-500) (H.length h);
OUnit2.assert_bool "is_empty" (H.is_empty (H.create 16));
*)
(*$QR
_list_int_int (fun l ->
let h = H.of_list l in
let h = List.fold_left (fun h (k,_) -> H.remove h k) h l in
H.is_empty h)
*)
let update t k f =
let v = get k t in
match v, f v with
@ -559,22 +439,6 @@ module Make(H : HashedType) : S with type key = H.t = struct
| Some v' -> replace tbl k v'
) tbl t2
(*$R
let t1 = H.of_list [1, "a"; 2, "b1"] in
let t2 = H.of_list [2, "b2"; 3, "c"] in
let t = H.merge
~f:(fun _ -> function
| `Right v2 -> Some v2
| `Left v1 -> Some v1
| `Both (s1,s2) -> if s1 < s2 then Some s1 else Some s2)
t1 t2
in
OUnit2.assert_equal ~printer:string_of_int 3 (H.length t);
OUnit2.assert_equal "a" (H.find t 1);
OUnit2.assert_equal "b1" (H.find t 2);
OUnit2.assert_equal "c" (H.find t 3);
*)
let add_iter init seq =
let tbl = ref init in
seq (fun (k,v) -> tbl := replace !tbl k v);
@ -585,46 +449,14 @@ module Make(H : HashedType) : S with type key = H.t = struct
let add_list init l =
add_iter init (fun k -> List.iter k l)
(*$QR
_list_int_int (fun l ->
let l1, l2 = List.partition (fun (x,_) -> x mod 2 = 0) l in
let h1 = H.of_list l1 in
let h2 = H.add_list h1 l2 in
List.for_all
(fun (k,v) -> H.find h2 k = v)
l
&&
List.for_all
(fun (k,v) -> H.find h1 k = v)
l1
&&
List.length l1 = H.length h1
&&
List.length l = H.length h2
)
*)
let of_list l = add_list (empty ()) l
let to_list t = fold (fun acc k v -> (k,v)::acc) [] t
(*$R
let h = H.of_iter my_iter in
let l = Iter.to_list (H.to_iter h) in
OUnit2.assert_equal my_list (List.sort compare l)
*)
let to_iter t =
fun k ->
iter t (fun x y -> k (x,y))
(*$R
let h = H.of_iter my_iter in
OUnit2.assert_equal "b" (H.find h 2);
OUnit2.assert_equal "a" (H.find h 1);
OUnit2.assert_raises Not_found (fun () -> H.find h 42);
*)
let equal eq t1 t2 =
length t1 = length t2
&&

199
src/data/CCRAL.ml
View file

@ -54,21 +54,6 @@ and tree_update_ size t i v =match t, i with
then Node (x, tree_update_ size' t1 (i-1) v, t2)
else Node (x, t1, tree_update_ size' t2 (i-1-size') v)
(*$Q & ~small:(CCFun.compose snd List.length)
Q.(pair (pair small_int int) (list int)) (fun ((i,v),l) -> \
l=[] || \
(let i = (abs i) mod (List.length l) in \
let ral = of_list l in let ral = set ral i v in \
get_exn ral i = v))
*)
(*$Q & ~small:List.length
Q.(list small_int) (fun l -> \
let l1 = of_list l in \
CCList.mapi (fun i x -> i,x) l \
|> List.for_all (fun (i,x) -> get_exn l1 i = x))
*)
let cons x l = match l with
| Cons (size1, t1, Cons (size2, t2, l')) when size1=size2 ->
Cons (1 + size1 + size2, Node (x, t1, t2), l')
@ -88,17 +73,6 @@ let tl l = match l with
let size' = size / 2 in
Cons (size', t1, Cons (size', t2, l'))
(*$T
let l = of_list[1;2;3] in hd l = 1
let l = of_list[1;2;3] in tl l |> to_list = [2;3]
*)
(*$Q
Q.(list_of_size Gen.(1--100) int) (fun l -> \
let l' = of_list l in \
(not (is_empty l')) ==> (equal ~eq:CCInt.equal l' (cons (hd l') (tl l'))) )
*)
let front l = match l with
| Nil -> None
| Cons (_, Leaf x, tl) -> Some (x, tl)
@ -121,10 +95,6 @@ let rec _remove prefix l i =
let remove l i = _remove [] l i
(*$= & ~printer:Q.Print.(list int)
[1;2;4] (to_list @@ remove (of_list [1;2;3;4]) 2)
*)
let rec _get_and_remove_exn prefix l i =
let x, l' = front_exn l in
if i=0
@ -134,10 +104,6 @@ let rec _get_and_remove_exn prefix l i =
let get_and_remove_exn l i =
_get_and_remove_exn [] l i
(*$= & ~printer:Q.Print.(pair int (list int))
(3,[1;2;4]) (CCPair.map_snd to_list @@ get_and_remove_exn (of_list [1;2;3;4]) 2)
*)
let rec _map_tree f t = match t with
| Leaf x -> Leaf (f x)
| Node (x, l, r) -> Node (f x, _map_tree f l, _map_tree f r)
@ -159,20 +125,6 @@ let mapi ~f l =
in
aux f 0 l
(*$QR
Q.small_int (fun n ->
let l = CCList.(0 -- n) in
let l' = of_list l |> mapi ~f:(fun i x ->i,x) in
List.mapi (fun i x->i,x) l = to_list l'
)
*)
(*$Q
Q.(pair (list small_int)(fun2 Observable.int Observable.int bool)) (fun (l,f) -> \
let f = Q.Fn.apply f in \
mapi ~f (of_list l) |> to_list = List.mapi f l )
*)
let rec length l = match l with
| Nil -> 0
| Cons (size,_, l') -> size + length l'
@ -229,28 +181,10 @@ and fold_tree_rev t acc f = match t with
let rev_map ~f l = fold ~f:(fun acc x -> cons (f x) acc) ~x:empty l
(*$Q
Q.(list int) (fun l -> \
let f x = x+1 in \
of_list l |> rev_map ~f |> to_list = List.rev_map f l)
*)
let rev l = fold ~f:cons' ~x:empty l
(*$Q
Q.(list small_int) (fun l -> \
let l = of_list l in rev (rev l) = l)
Q.(list small_int) (fun l -> \
let l1 = of_list l in length l1 = List.length l)
*)
let append l1 l2 = fold_rev ~f:(fun l2 x -> cons x l2) ~x:l2 l1
(*$Q & ~small:(CCPair.merge (CCFun.compose_binop List.length (+)))
Q.(pair (list int) (list int)) (fun (l1,l2) -> \
append (of_list l1) (of_list l2) = of_list (l1 @ l2))
*)
let append_tree_ t l = fold_tree_rev t l cons'
let filter ~f l =
@ -263,10 +197,6 @@ let filter_map ~f l =
| Some y -> cons y acc
)
(*$T
of_list [1;2;3;4;5;6] |> filter ~f:(fun x -> x mod 2=0) |> to_list = [2;4;6]
*)
let flat_map f l =
fold_rev ~x:empty l
~f:(fun acc x ->
@ -274,25 +204,8 @@ let flat_map f l =
append l acc
)
(*$Q
Q.(pair (fun1 Observable.int (small_list int)) (small_list int)) (fun (f,l) -> \
let f x = Q.Fn.apply f x in \
let f' x = f x |> of_list in \
of_list l |> flat_map f' |> to_list = CCList.(flat_map f l))
*)
let flatten l = fold_rev ~f:(fun acc l -> append l acc) ~x:empty l
(*$T
flatten (of_list [of_list [1]; of_list []; of_list [2;3]]) = \
of_list [1;2;3;]
*)
(*$Q
Q.(small_list (small_list int)) (fun l -> \
of_list l |> map ~f:of_list |> flatten |> to_list = CCList.flatten l)
*)
let app funs l =
fold_rev ~x:empty funs
~f:(fun acc f ->
@ -300,11 +213,6 @@ let app funs l =
~f:(fun acc x -> cons (f x) acc)
)
(*$T
app (of_list [(+) 2; ( * ) 10]) (of_list [1;10]) |> to_list = \
[3; 12; 10; 100]
*)
type 'a stack =
| St_nil
| St_list of 'a t * 'a stack
@ -330,17 +238,6 @@ and take_tree_ ~size n t = match t with
then cons x (append_tree_ l (take_tree_ ~size:size' (n-size'-1) r))
else cons x (take_tree_ ~size:size' (n-1) l)
(*$T
take 3 (of_list CCList.(1--10)) |> to_list = [1;2;3]
take 5 (of_list CCList.(1--10)) |> to_list = [1;2;3;4;5]
take 0 (of_list CCList.(1--10)) |> to_list = []
*)
(*$Q
Q.(pair small_int (list int)) (fun (n,l) -> \
of_list l |> take n |> to_list = CCList.take n l)
*)
let take_while ~f l =
(* st: stack of subtrees *)
let rec aux p st = match st with
@ -353,15 +250,6 @@ let take_while ~f l =
if p x then cons x (aux p (St_tree (l, St_tree (r, st')))) else Nil
in aux f (St_list (l, St_nil))
(*$Q
Q.(list int) (fun l -> \
let f x = x mod 7 <> 0 in \
of_list l |> take_while ~f |> to_list = CCList.take_while f l)
Q.(pair (fun1 Observable.int bool) (list int)) (fun (f,l) -> \
let f x = Q.Fn.apply f x in \
of_list l |> take_while ~f |> to_list = CCList.take_while f l)
*)
(* drop [n < size] elements from [t] *)
let rec drop_tree_ ~size n t tail = match t with
| _ when n=0 -> tail
@ -392,15 +280,6 @@ let rec drop n l = match l with
if n >= size then drop (n-size) tl
else drop_tree_ ~size n t tl
(*$T
of_list [1;2;3] |> drop 2 |> length = 1
*)
(*$Q
Q.(pair small_int (list int)) (fun (n,l) -> \
of_list l |> drop n |> to_list = CCList.drop n l)
*)
let drop_while ~f l =
let rec aux p st = match st with
| St_nil -> Nil
@ -415,19 +294,6 @@ let drop_while ~f l =
else append_tree_ tree (stack_to_list st')
in aux f (St_list (l, St_nil))
(*$T
drop 3 (of_list CCList.(1--10)) |> to_list = CCList.(4--10)
drop 5 (of_list CCList.(1--10)) |> to_list = [6;7;8;9;10]
drop 0 (of_list CCList.(1--10)) |> to_list = CCList.(1--10)
drop 15 (of_list CCList.(1--10)) |> to_list = []
*)
(*$Q
Q.(list_of_size Gen.(0 -- 200) int) (fun l -> \
let f x = x mod 10 <> 0 in \
of_list l |> drop_while ~f |> to_list = CCList.drop_while f l)
*)
let take_drop n l = take n l, drop n l
let equal ~eq l1 l2 =
@ -446,11 +312,6 @@ let equal ~eq l1 l2 =
in
aux ~eq l1 l2
(*$Q
Q.(pair (list int)(list int)) (fun (l1,l2) -> \
equal ~eq:CCInt.equal (of_list l1) (of_list l2) = (l1=l2))
*)
(** {2 Utils} *)
let make n x =
@ -465,12 +326,6 @@ let repeat n l =
in
aux n l empty
(*$Q
Q.(pair small_int (small_list int)) (fun (n,l) -> \
of_list l |> repeat n |> to_list = CCList.(repeat n l))
*)
let range i j =
let rec aux i j acc =
if i=j then cons i acc
@ -481,29 +336,11 @@ let range i j =
in
aux i j empty
(*$T
range 0 3 |> to_list = [0;1;2;3]
range 3 0 |> to_list = [3;2;1;0]
range 17 17 |> to_list = [17]
*)
(*$Q
Q.(pair small_int small_int) (fun (i,j) -> \
range i j |> to_list = CCList.(i -- j) )
*)
let range_r_open_ i j =
if i=j then empty
else if i<j then range i (j-1)
else range i (j+1)
(*$= & ~printer:CCFormat.(to_string (hbox (list int)))
[1;2;3;4] (1 --^ 5 |> to_list)
[5;4;3;2] (5 --^ 1 |> to_list)
[1] (1 --^ 2 |> to_list)
[] (0 --^ 0 |> to_list)
*)
(** {2 Conversions} *)
type 'a iter = ('a -> unit) -> unit
@ -511,19 +348,10 @@ type 'a gen = unit -> 'a option
let add_list l l2 = List.fold_left (fun acc x -> cons x acc) l (List.rev l2)
(*$Q & ~small:(CCPair.merge (CCFun.compose_binop List.length (+)))
Q.(pair (list small_int) (list small_int)) (fun (l1,l2) -> \
add_list (of_list l2) l1 |> to_list = l1 @ l2)
*)
let of_list l = add_list empty l
let to_list l = fold_rev ~f:(fun acc x -> x :: acc) ~x:[] l
(*$Q
Q.(list int) (fun l -> to_list (of_list l) = l)
*)
let add_array l a = Array.fold_right cons a l
let of_array a = add_array empty a
@ -537,11 +365,6 @@ let to_array l = match l with
iteri ~f:(fun i x -> Array.set arr i x) l;
arr
(*$Q
Q.(array int) (fun a -> \
of_array a |> to_array = a)
*)
let of_iter s =
let l = ref empty in
s (fun x -> l := cons x !l);
@ -554,17 +377,6 @@ let add_iter l s =
let to_iter l yield = iter ~f:yield l
(*$Q & ~small:List.length
Q.(list small_int) (fun l -> \
of_list l |> to_iter |> Iter.to_list = l)
Q.(list small_int) (fun l -> \
Iter.of_list l |> of_iter |> to_list = l)
*)
(*$T
add_iter (of_list [3;4]) (Iter.of_list [1;2]) |> to_list = [1;2;3;4]
*)
let rec gen_iter_ f g = match g() with
| None -> ()
| Some x -> f x; gen_iter_ f g
@ -596,12 +408,6 @@ let to_gen l =
in
next
(*$Q & ~small:List.length
Q.(list small_int) (fun l -> of_list l |> to_gen |> Gen.to_list = l)
Q.(list small_int) (fun l -> \
Gen.of_list l |> of_gen |> to_list = l)
*)
let rec of_list_map ~f l = match l with
| [] -> empty
| x::l' ->
@ -619,11 +425,6 @@ let compare ~cmp l1 l2 =
in
cmp_gen ~cmp (to_gen l1)(to_gen l2)
(*$Q
Q.(pair (list int)(list int)) (fun (l1,l2) -> \
compare ~cmp:CCInt.compare (of_list l1) (of_list l2) = (Stdlib.compare l1 l2))
*)
(** {2 Infix} *)
module Infix = struct

446
src/data/CCRingBuffer.ml
View file

@ -202,13 +202,6 @@ module type S = sig
@since 0.11 *)
end
(*$inject
open Q.Gen
let g_char = map Char.chr (Char.code 'A' -- Char.code 'z')
let g_str = string_size ~gen:g_char (0--10)
let a_str = Q.set_gen g_str Q.string
*)
module MakeFromArray(A:Array.S) : S with module Array = A = struct
module Array = A
@ -230,25 +223,10 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
let copy b =
{ b with buf=A.copy b.buf; }
(*$T
let b = Byte.of_array (Bytes.of_string "abc") in \
let b' = Byte.copy b in \
Byte.clear b; \
Byte.to_array b' = (Bytes.of_string "abc") && Byte.to_array b = Bytes.empty
*)
let capacity b =
let len = A.length b.buf in
match len with 0 -> 0 | l -> l - 1
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
Byte.capacity b >= s_len)
*)
let length b =
if b.stop >= b.start
then b.stop - b.start
@ -278,44 +256,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
done
)
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
let b' = Byte.copy b in \
try Byte.iteri b ~f:(fun i c -> if Byte.get_front b' i <> c then raise Exit); true with Exit -> false)
*)
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
Byte.push_back b 'X'; \
Byte.peek_back_exn b = 'X')
*)
(*$Q
(Q.pair a_str a_str) (fun (s,s') -> \
let b = Byte.create (max (String.length s+String.length s') 64) in \
let s = Bytes.of_string s in let s' = Bytes.of_string s' in \
Byte.blit_from b s 0 (Bytes.length s); \
Byte.blit_from b s' 0 (Bytes.length s'); \
Byte.length b = Bytes.length s + Bytes.length s')
*)
(*$Q
(Q.pair a_str a_str) (fun (s,s') -> \
let s = Bytes.of_string s in let s' = Bytes.of_string s' in \
let b = Byte.create (max (Bytes.length s + Bytes.length s') 64) in \
Byte.blit_from b s 0 (Bytes.length s); \
Byte.blit_from b s' 0 (Bytes.length s'); \
Byte.length b = Bytes.length s + Bytes.length s')
*)
let blit_into b to_buf o len =
if o+len > A.length to_buf then (
invalid_arg "CCRingBuffer.blit_into";
@ -336,26 +276,8 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
)
)
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let b = Byte.create (max 64 (Bytes.length s)) in \
Byte.blit_from b s 0 (Bytes.length s); \
let to_buf = Bytes.create (Bytes.length s) in \
let len = Byte.blit_into b to_buf 0 (Bytes.length s) in \
to_buf = s && len = Bytes.length s)
*)
let is_empty b = b.start = b.stop
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
Byte.skip b s_len; \
Byte.is_empty b)
*)
let take_front_exn b =
if b.start = b.stop then raise Empty;
let c = A.get b.buf b.start in
@ -365,15 +287,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
let take_front b = try Some (take_front_exn b) with Empty -> None
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
try let front = Byte.take_front_exn b in \
front = Bytes.get s 0 with Byte.Empty -> s_len = 0)
*)
let take_back_exn b =
if b.start = b.stop then raise Empty;
if b.stop = 0
@ -385,16 +298,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
let take_back b = try Some (take_back_exn b) with Empty -> None
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
try let back = Byte.take_back_exn b in \
back = Bytes.get s (Bytes.length s - 1) \
with Byte.Empty -> s_len = 0)
*)
let junk_front b =
if b.start = b.stop then raise Empty;
A.set b.buf b.start A.dummy;
@ -402,15 +305,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
then b.start <- 0
else b.start <- b.start + 1
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
try let () = Byte.junk_front b in \
s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0)
*)
let junk_back b =
if b.start = b.stop then raise Empty;
if b.stop = 0
@ -418,15 +312,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
else b.stop <- b.stop - 1;
A.set b.buf b.stop A.dummy
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
try let () = Byte.junk_back b in \
s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0)
*)
let skip b len =
if len > length b then (
invalid_arg "CCRingBuffer.skip";
@ -435,31 +320,9 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
junk_front b
done
(*$Q
(Q.pair a_str a_str) (fun (s,s') -> \
let s = Bytes.of_string s in let s' = Bytes.of_string s' in \
let b = Byte.create (max (Bytes.length s+Bytes.length s') 64) in \
Byte.blit_from b s 0 (Bytes.length s); \
Byte.blit_from b s' 0 (Bytes.length s'); \
let h = Bytes.of_string "hello world" in \
Byte.blit_from b h 0 (Bytes.length h); (* big enough *) \
let l = Byte.length b in let l' = l/2 in Byte.skip b l'; \
Byte.length b + l' = l)
*)
let clear b =
skip b (length b)
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
Byte.clear b; \
Byte.length b = 0)
*)
let iter b ~f =
if b.stop >= b.start
then for i = b.start to b.stop - 1 do f (A.get b.buf i) done
@ -476,15 +339,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
for i = 0 to b.stop - 1 do f i (A.get b.buf i) done;
)
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
try Byte.iteri b ~f:(fun i c -> if Byte.get_front b i <> c then raise Exit); \
true with Exit -> false)
*)
let get b i =
if b.stop >= b.start
then (
@ -504,35 +358,12 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
invalid_arg "CCRingBuffer.get_front"
) else get b i
(*$Q
(Q.pair Q.small_int a_str) (fun (i, s) -> \
let s = Bytes.of_string (s ^ " ") in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
let index = abs (i mod Byte.length b) in \
let front = Byte.get_front b index in \
front = Bytes.get s index)
*)
let get_back b i =
let offset = ((length b) - i - 1) in
if offset < 0 then (
invalid_arg "CCRingBuffer.get_back"
) else get b offset
(*$Q
(Q.pair Q.small_int a_str) (fun (i, s) -> \
let s = Bytes.of_string (s ^ " ") in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
let index = abs (i mod Byte.length b) in \
let back = Byte.get_back b index in \
back = Bytes.get s (s_len - index - 1))
*)
let to_list b =
let len = length b in
let rec build l i =
@ -540,18 +371,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
in
build [] (len-1)
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
let l = Byte.to_list b in \
let explode s = let rec exp i l = \
if i < 0 then l else exp (i - 1) (Bytes.get s i :: l) in \
exp (Bytes.length s - 1) [] in \
explode s = l)
*)
(* TODO: more efficient version, with one or two blit *)
let append b ~into =
iter b ~f:(push_back into)
@ -562,15 +381,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
let peek_front b = try Some (peek_front_exn b) with Empty -> None
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
try let back = Byte.peek_front_exn b in \
back = Bytes.get s 0 with Byte.Empty -> s_len = 0)
*)
let peek_back_exn b = if is_empty b
then raise Empty
else (
@ -580,15 +390,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
let peek_back b = try Some (peek_back_exn b) with Empty -> None
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create (max s_len 64) in \
Byte.blit_from b s 0 s_len; \
try let back = Byte.peek_back_exn b in \
back = Bytes.get s (s_len - 1) with Byte.Empty -> s_len = 0)
*)
let of_array a =
let b = create (max (A.length a) 16) in
blit_from b a 0 (A.length a);
@ -599,12 +400,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
let n = blit_into b a 0 (length b) in
assert (n = length b);
a
(*$Q
a_str (fun s -> let s = Bytes.of_string s in \
let b = Byte.of_array s in let s' = Byte.to_array b in \
s = s')
*)
end
module Byte = MakeFromArray(Array.Byte)
@ -613,244 +408,3 @@ module Make(Elt:sig
type t
val dummy : t
end) = MakeFromArray(Array.Make(Elt))
(*$inject
module BI = CCRingBuffer.Make(struct type t = int let dummy=0 end)
*)
(* try to trigger an error on resize
see issue #126 *)
(*$R
let b = BI.create 50 in
let st = Random.State.make [| 0 |] in
for _i = 1 to 100_000 do
if Random.State.float st 1.0 < 0.5 then
BI.push_back b 0
else
let _ = BI.take_front b in ()
done
*)
(* Test against reference implementation (lists) on a succession of
operations.
Remarks on semantics:
JUNK_FRONT/JUNK_BACK: try to remove if not empty
SKIP: if at least n elements, skip; else nop
*)
(*$inject
module BS = CCRingBuffer.Byte
type op =
| Push_back of char
| Take_front
| Take_back
| Peek_front
| Peek_back
| Junk_front
| Junk_back
| Skip of int
| Blit of string * int * int
| Z_if_full
let str_of_op = function
| Push_back c -> Printf.sprintf "push_back(%C)" c
| Take_front -> Printf.sprintf "take_front"
| Take_back -> Printf.sprintf "take_back"
| Peek_front -> Printf.sprintf "peek_front"
| Peek_back -> Printf.sprintf "peek_back"
| Junk_front -> Printf.sprintf "junk_front"
| Junk_back -> Printf.sprintf "junk_back"
| Skip n -> Printf.sprintf "skip(%d)" n
| Blit (s,i,len) -> Printf.sprintf "blit(%S,%d,%d)" s i len
| Z_if_full -> "zero_if_full"
let push_back c = Push_back c
let skip n = assert (n>=0); Skip n
let blit s i len =
if i<0 || len<0 || i+len > String.length s then (
failwith ("wrong blit: " ^ str_of_op (Blit (s,i,len)));
);
Blit (s,i,len)
let shrink_op =
let open Q.Iter in
function
| Push_back c -> Q.Shrink.char c >|= push_back
| Take_front | Take_back | Junk_back | Junk_front
| Z_if_full | Peek_front | Peek_back
-> empty
| Skip n -> Q.Shrink.int n >|= skip
| Blit (s,i,len) ->
let s_i =
Q.Shrink.int i >>= fun i' ->
assert (i' <= i && i' + len <= String.length s);
if i' <= 0 then empty else return (blit s i' len)
and s_len =
Q.Shrink.int len >>= fun len'->
assert (len' <= len && i + len' <= String.length s);
if len' <= 0 then empty else return (blit s i len')
and s_s =
Q.Shrink.string s >>= fun s' ->
if i+len > String.length s' then empty else return (blit s' i len)
in
append s_i (append s_len s_s)
let rec len_op size acc = function
| Push_back _ -> min size (acc + 1)
| Take_front | Take_back | Junk_front | Junk_back -> max (acc-1) 0
| Skip n -> if acc >= n then acc-n else acc
| Z_if_full | Peek_front | Peek_back -> acc
| Blit (_,_,len) -> min size (acc + len)
let apply_op b = function
| Push_back c -> BS.push_back b c; None
| Take_front -> BS.take_front b
| Take_back -> BS.take_back b
| Junk_front -> (try BS.junk_front b with BS.Empty -> ()); None
| Junk_back -> (try BS.junk_back b with BS.Empty -> ()); None
| Peek_front -> BS.peek_front b
| Peek_back -> BS.peek_back b
| Skip n -> if n <= BS.length b then BS.skip b n; None
| Blit (s,i,len) ->
assert(i+len <= String.length s);
BS.blit_from b (Bytes.unsafe_of_string s) i len; None
| Z_if_full -> if BS.is_full b then Some '0' else None
let gen_op =
let open Q.Gen in
let g_blit =
string_size ~gen:g_char (5--20) >>= fun s ->
(0 -- String.length s) >>= fun len ->
assert (len >= 0 && len <= String.length s);
(0--(String.length s-len)) >|= fun i ->
blit s i len
in
frequency
[ 3, return Take_back;
3, return Take_front;
1, return Junk_back;
1, return Junk_front;
1, return Peek_front;
1, return Peek_back;
2, g_blit;
1, (0--5 >|= skip);
2, map push_back g_char;
1, return Z_if_full;
]
let arb_op =
Q.make
~shrink:shrink_op
~print:str_of_op
gen_op
let arb_ops = Q.list_of_size Q.Gen.(0 -- 20) arb_op
module L_impl = struct
type t = {
size: int;
mutable l: char list;
}
let create size = {size; l=[]}
let normalize_ b =
let n = List.length b.l in
if n>b.size then b.l <- CCList.drop (n-b.size) b.l
let push_back b c = b.l <- b.l @ [c]; normalize_ b
let take_front b = match b.l with
| [] -> None
| c :: l -> b.l <- l; Some c
let peek_front b = match b.l with [] -> None | x::_ -> Some x
let take_back b =
let n = List.length b.l in
if n=0 then None
else (
let init, last = CCList.take_drop (n-1) b.l in
let x = List.hd last in
b.l <- init;
Some x
)
let peek_back b = match b.l with [] -> None | l -> Some (List.hd (List.rev l))
let junk_front b = ignore (take_front b)
let junk_back b = ignore (take_back b)
let skip b n =
if n <= List.length b.l then (
CCInt.range' 0 n (fun _ -> junk_front b)
)
let blit b s i len =
for j=i to i+len-1 do push_back b (String.get s j) done
let apply_op b = function
| Push_back c -> push_back b c; None
| Take_front -> take_front b
| Take_back -> take_back b
| Peek_front -> peek_front b
| Peek_back -> peek_back b
| Junk_back -> junk_back b; None
| Junk_front -> junk_front b; None
| Skip n -> skip b n; None
| Blit (s,i,len) -> blit b s i len; None
| Z_if_full -> if b.size = List.length b.l then Some '0' else None
let to_list b = b.l
end
*)
(* check that a lot of operations can be applied without failure,
and that the result has correct length *)
(*$QR & ~count:3_000
arb_ops (fun ops ->
let size = 64 in
let b = BS.create size in
List.iter (fun o-> ignore (apply_op b o)) ops;
BS.length b = List.fold_left (len_op size) 0 ops)
*)
(* check identical behavior with list implem *)
(*$QR & ~count:3_000
arb_ops (fun ops ->
let size = 64 in
let b = BS.create size in
let l = L_impl.create size in
let l1 = CCList.filter_map (apply_op b) ops in
let l2 = CCList.filter_map (L_impl.apply_op l) ops in
l1=l2 && BS.to_list b = L_impl.to_list l)
*)
(* check that deleted elements can be GCed *)
(*$inject
module BO = CCRingBuffer.Make(struct type t = int option let dummy=None end)
let make_bo () =
let b = BO.create 1000 in
for i = 1 to BO.capacity b do
BO.push_back b (Some i)
done;
b
let test_no_major_blocks clear =
Gc.full_major ();
let live_blocks_before = (Gc.stat ()).live_blocks in
let b = make_bo () in
clear b;
Gc.full_major ();
let live_blocks_after = (Gc.stat ()).live_blocks in
assert (BO.length b = 0);
let diff = live_blocks_after - live_blocks_before in
diff < BO.capacity b / 2
*)
(*$T
test_no_major_blocks (fun b -> for _ = 1 to BO.length b do BO.junk_front b; done)
test_no_major_blocks (fun b -> for _ = 1 to BO.length b do BO.junk_back b; done)
test_no_major_blocks (fun b -> for _ = 1 to BO.length b do ignore (BO.take_front b); done)
test_no_major_blocks (fun b -> for _ = 1 to BO.length b do ignore (BO.take_back b); done)
test_no_major_blocks (fun b -> BO.skip b (BO.length b))
test_no_major_blocks (fun b -> BO.clear b)
*)

47
src/data/CCSimple_queue.ml
View file

@ -52,12 +52,6 @@ let pop q =
try Some (pop_exn q)
with Invalid_argument _ -> None
(*$Q
Q.(list small_int) (fun l -> \
let q = of_list l in \
equal CCInt.equal (Gen.unfold pop q |> of_gen) q)
*)
let junk q =
try
let _, q' = pop_exn q in
@ -68,26 +62,8 @@ let map f q = { hd=List.map f q.hd; tl=List.map f q.tl; }
let rev q = make_ q.tl q.hd
(*$Q
Q.(list small_int) (fun l -> \
equal CCInt.equal (of_list l |> rev) (of_list (List.rev l)))
Q.(list small_int) (fun l -> \
let q = of_list l in \
equal CCInt.equal q (q |> rev |> rev))
*)
let length q = List.length q.hd + List.length q.tl
(*$Q
Q.(list small_int)(fun l -> \
length (of_list l) = List.length l)
*)
(*$Q
Q.(list small_int)(fun l -> \
equal CCInt.equal (of_list l) (List.fold_left snoc empty l))
*)
let fold f acc q =
let acc' = List.fold_left f acc q.hd in
List.fold_right (fun x acc -> f acc x) q.tl acc'
@ -115,15 +91,6 @@ let add_iter q seq =
let of_iter s = add_iter empty s
(*$Q
Q.(list small_int) (fun l -> \
equal CCInt.equal \
(of_iter (Iter.of_list l)) \
(of_list l))
Q.(list small_int) (fun l -> \
l = (of_list l |> to_iter |> Iter.to_list))
*)
let add_seq q l = add_iter q (fun k -> Seq.iter k l)
let of_seq l = add_seq empty l
@ -164,23 +131,11 @@ let rec seq_equal eq l1 l2 = match l1(), l2() with
let equal eq q1 q2 = seq_equal eq (to_seq q1) (to_seq q2)
(*$Q
Q.(pair (list small_int)(list small_int)) (fun (l1,l2) -> \
equal CCInt.equal (of_list l1)(of_list l2) = (l1=l2))
*)
let append q1 q2 =
add_seq q1
(fun yield ->
to_seq q2 yield)
(*$Q
Q.(pair (list small_int)(list small_int)) (fun (l1,l2) -> \
equal CCInt.equal \
(append (of_list l1)(of_list l2)) \
(of_list (List.append l1 l2)))
*)
module Infix = struct
let (>|=) q f = map f q
let (<::) = snoc
@ -189,8 +144,6 @@ end
include Infix
(** {2 IO} *)
let pp ?(sep=fun out () -> Format.fprintf out ",@ ") pp_item out l =
let first = ref true in
iter

146
src/data/CCTrie.ml
View file

@ -115,32 +115,6 @@ module type S = sig
(**/**)
end
(*$inject
module T = MakeList(CCInt)
module S = String
let l1 = [ [1;2], "12"; [1], "1"; [2;1], "21"; [1;2;3], "123"; [], "[]" ]
let t1 = T.of_list l1
let small_l l = List.fold_left (fun acc (k,v) -> List.length k+acc) 0 l
let s1 = String.of_list ["cat", 1; "catogan", 2; "foo", 3]
*)
(*$T
String.of_list ["a", 1; "b", 2] |> String.size = 2
String.of_list ["a", 1; "b", 2; "a", 3] |> String.size = 2
String.of_list ["a", 1; "b", 2] |> String.find_exn "a" = 1
String.of_list ["a", 1; "b", 2] |> String.find_exn "b" = 2
String.of_list ["a", 1; "b", 2] |> String.find "c" = None
s1 |> String.find_exn "cat" = 1
s1 |> String.find_exn "catogan" = 2
s1 |> String.find_exn "foo" = 3
s1 |> String.find "cato" = None
*)
module Make(W : WORD)
: S with type char_ = W.char_ and type key = W.t
= struct
@ -307,14 +281,6 @@ module Make(W : WORD)
let remove k t = update k (fun _ -> None) t
(*$T
T.add [3] "3" t1 |> T.find_exn [3] = "3"
T.add [3] "3" t1 |> T.find_exn [1;2] = "12"
T.remove [1;2] t1 |> T.find [1;2] = None
T.remove [1;2] t1 |> T.find [1] = Some "1"
T.remove [1;2] t1 |> T.find [] = Some "[]"
*)
let find_exn k t =
(* at subtree [t], and character [c] *)
let goto t c = match t with
@ -360,20 +326,6 @@ module Make(W : WORD)
let word = W.to_iter k in
_fold_iter_and_then goto ~finish (t,_id) word
(*$= & ~printer:CCFun.id
"ca" (String.longest_prefix "carte" s1)
"" (String.longest_prefix "yolo" s1)
"cat" (String.longest_prefix "cat" s1)
"catogan" (String.longest_prefix "catogan" s1)
*)
(*$Q
Q.(pair (list (pair (printable_string_of_size Gen.(0 -- 30)) int)) printable_string) (fun (l,s) -> \
let m = String.of_list l in \
let s' = String.longest_prefix s m in \
CCString.prefix ~pre:s' s)
*)
(* fold that also keeps the path from the root, so as to provide the list
of chars that lead to a value. The path is a difference list, ie
a function that prepends a list to some suffix *)
@ -396,11 +348,6 @@ module Make(W : WORD)
f acc key v)
_id t acc
(*$T
T.fold (fun acc k v -> (k,v) :: acc) [] t1 \
|> List.sort Stdlib.compare = List.sort Stdlib.compare l1
*)
let mapi f t =
let rec map_ prefix t = match t with
| Empty -> Empty
@ -417,12 +364,6 @@ module Make(W : WORD)
in Node (v', map')
in map_ _id t
(*$= & ~printer:Q.Print.(list (pair (list int) string))
(List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Stdlib.compare) \
(T.mapi (fun k v -> v ^ "!") t1 \
|> T.to_list |> List.sort Stdlib.compare)
*)
let map f t =
let rec map_ = function
| Empty -> Empty
@ -434,12 +375,6 @@ module Make(W : WORD)
in let map' = M.map map_ map
in Node (v', map')
in map_ t
(*$= & ~printer:Q.Print.(list (pair (list int) string))
(List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Stdlib.compare) \
(T.map (fun v -> v ^ "!") t1 \
|> T.to_list |> List.sort Stdlib.compare)
*)
let iter f t =
_fold
@ -512,17 +447,6 @@ module Make(W : WORD)
in
_mk_node v map'
(*$QR & ~count:30
Q.(let p = list_of_size Gen.(0--100) (pair printable_string small_int) in pair p p)
(fun (l1,l2) ->
let t1 = S.of_list l1 and t2 = S.of_list l2 in
let t = S.merge (fun a _ -> Some a) t1 t2 in
S.to_iter t |> Iter.for_all
(fun (k,v) -> S.find k t1 = Some v || S.find k t2 = Some v) &&
S.to_iter t1 |> Iter.for_all (fun (k,v) -> S.find k t <> None) &&
S.to_iter t2 |> Iter.for_all (fun (k,v) -> S.find k t <> None))
*)
let rec size t = match t with
| Empty -> 0
| Cons (_, t') -> size t'
@ -532,10 +456,6 @@ module Make(W : WORD)
(fun _ t' acc -> size t' + acc)
map s
(*$T
T.size t1 = List.length l1
*)
let to_list t = fold (fun acc k v -> (k,v)::acc) [] t
let of_list l =
@ -561,8 +481,6 @@ module Make(W : WORD)
let l = M.bindings map in
`Node(x, List.map (fun (c,t') -> _tree_node (`Char c) [to_tree t']) l)
(** {6 Ranges} *)
(* stack of actions for [above] and [below] *)
type 'a alternative =
| Yield of 'a * char_ difflist
@ -668,70 +586,6 @@ module Make(W : WORD)
let below key t =
_half_range ~dir:Below ~p:(fun ~cur ~other -> W.compare cur other > 0) key t
(*$= & ~printer:CCFormat.(to_string (list (pair (list int) string)))
[ [1], "1"; [1;2], "12"; [1;2;3], "123"; [2;1], "21" ] \
(T.above [1] t1 |> Iter.to_list)
[ [1;2], "12"; [1;2;3], "123"; [2;1], "21" ] \
(T.above [1;1] t1 |> Iter.to_list)
[ [1;2], "12"; [1], "1"; [], "[]" ] \
(T.below [1;2] t1 |> Iter.to_list)
[ [1], "1"; [], "[]" ] \
(T.below [1;1] t1 |> Iter.to_list)
*)
(* NOTE: Regression test. See #158 *)
(*$T
let module TPoly = Make (struct \
type t = (unit -> char) list \
type char_ = char \
let compare = compare \
let to_iter a k = List.iter (fun c -> k (c ())) a \
let of_list l = List.map (fun c -> (fun () -> c)) l \
end) \
in \
let trie = TPoly.of_list [[fun () -> 'a'], 1; [fun () -> 'b'], 2] in \
ignore (TPoly.below [fun () -> 'a'] trie |> Iter.to_list); \
true
*)
(*$Q & ~count:30
Q.(list_of_size Gen.(0--100) (pair printable_string small_int)) (fun l -> \
let t = S.of_list l in \
S.check_invariants t)
*)
(*$inject
let rec sorted ~rev = function
| [] | [_] -> true
| x :: ((y ::_) as tl) ->
(if rev then x >= y else x <= y) && sorted ~rev tl
let gen_str = Q.small_printable_string
*)
(*$Q & ~count:200
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \
(fun l -> let t = String.of_list l in \
List.for_all (fun (k,_) -> \
String.above k t |> Iter.for_all (fun (k',v) -> k' >= k)) \
l)
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \
(fun l -> let t = String.of_list l in \
List.for_all (fun (k,_) -> \
String.below k t |> Iter.for_all (fun (k',v) -> k' <= k)) \
l)
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \
(fun l -> let t = String.of_list l in \
List.for_all (fun (k,_) -> \
String.above k t |> Iter.to_list |> sorted ~rev:false) \
l)
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \
(fun l -> let t = String.of_list l in \
List.for_all (fun (k,_) -> \
String.below k t |> Iter.to_list |> sorted ~rev:true) \
l)
*)
end
module type ORDERED = sig

107
src/data/CCWBTree.ml
View file

@ -8,39 +8,6 @@
The coefficients 5/2, 3/2 for balancing come from "balancing weight-balanced trees"
*)
(*$inject
module M = Make(CCInt)
type op =
| Add of int * int
| Remove of int
| Remove_min
let gen_op = CCRandom.(choose_exn
[ return Remove_min
; map (fun x->Remove x) small_int
; pure (fun x y->Add (x,y)) <*> small_int <*> small_int])
and pp_op =let open Printf in
function Add (x,y) -> sprintf "Add %d %d" x y
| Remove x -> sprintf "Remove %d" x | Remove_min -> "Remove_min"
let apply_ops l m = List.fold_left
(fun m -> function
| Add (i,b) -> M.add i b m
| Remove i -> M.remove i m
| Remove_min ->
try let _, _, m' = M.extract_min m in m' with Not_found -> m
) m l
let op = Q.make ~print:pp_op gen_op
let _list_uniq = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst Stdlib.compare)
*)
(*$Q & ~count:200
Q.(list op) (fun l -> let m = apply_ops l M.empty in M.balanced m)
*)
type 'a iter = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
type 'a printer = Format.formatter -> 'a -> unit
@ -289,18 +256,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct
| n when n<0 -> balance_r k' v' (add k v l) r
| _ -> balance_l k' v' l (add k v r)
(*$Q
Q.(list (pair small_int bool)) (fun l -> \
let m = M.of_list l in \
M.balanced m)
Q.(list (pair small_int small_int)) (fun l -> \
let l = _list_uniq l in let m = M.of_list l in \
List.for_all (fun (k,v) -> M.get_exn k m = v) l)
Q.(list (pair small_int small_int)) (fun l -> \
let l = _list_uniq l in let m = M.of_list l in \
M.cardinal m = List.length l)
*)
(* extract min binding of the tree *)
let rec extract_min m = match m with
| E -> raise Not_found
@ -341,16 +296,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct
| n when n<0 -> balance_l k' v' (remove k l) r
| _ -> balance_r k' v' l (remove k r)
(*$Q
Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l -> \
let m = M.of_list l in \
List.for_all (fun (k,_) -> \
M.mem k m && (let m' = M.remove k m in not (M.mem k m'))) l)
Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l -> \
let m = M.of_list l in \
List.for_all (fun (k,_) -> let m' = M.remove k m in M.balanced m') l)
*)
let update k f m =
let maybe_v = get k m in
match maybe_v, f maybe_v with
@ -373,11 +318,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct
try Some (nth_exn i m)
with Not_found -> None
(*$T
let m = CCList.(0 -- 1000 |> map (fun i->i,i) |> M.of_list) in \
List.for_all (fun i -> M.nth_exn i m = (i,i)) CCList.(0--1000)
*)
let get_rank k m =
let rec aux i k m = match m with
| E -> if i=0 then `First else `After i
@ -389,17 +329,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct
in
aux 0 k m
(*$QR & ~count:1_000
Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l ->
let l = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst compare) l in
let m = M.of_list l in
List.for_all
(fun (k,v) -> match M.get_rank k m with
| `First | `After _ -> true
| `At n -> (k,v) = M.nth_exn n m)
l)
*)
let rec fold ~f ~x:acc m = match m with
| E -> acc
| N (k, v, l, r, _) ->
@ -494,20 +423,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct
let rl, o, rr = split k r in
node_ k' v' l rl, o, rr
(*$QR & ~count:20
Q.(list_of_size Gen.(1 -- 100) (pair small_int small_int)) ( fun lst ->
let lst = _list_uniq lst in
let m = M.of_list lst in
List.for_all (fun (k,v) ->
let l, v', r = M.split k m in
v' = Some v
&& (M.to_iter l |> Iter.for_all (fun (k',_) -> k' < k))
&& (M.to_iter r |> Iter.for_all (fun (k',_) -> k' > k))
&& M.balanced m
&& M.cardinal l + M.cardinal r + 1 = List.length lst
) lst)
*)
let rec merge ~f a b = match a, b with
| E, E -> E
| E, N (k, v, l, r, _) ->
@ -531,28 +446,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct
mk_node_or_join_ k1 (f k1 (Some v1) v2')
(merge ~f l1 l2') (merge ~f r1 r2')
(*$R
let m1 = M.of_list [1, 1; 2, 2; 4, 4] in
let m2 = M.of_list [1, 1; 3, 3; 4, 4; 7, 7] in
let m = M.merge ~f:(fun k -> CCOption.map2 (+)) m1 m2 in
assert_bool "balanced" (M.balanced m);
assert_equal
~cmp:(CCList.equal (CCPair.equal CCInt.equal CCInt.equal))
~printer:CCFormat.(to_string (list (pair int int)))
[1, 2; 4, 8]
(M.to_list m |> List.sort Stdlib.compare)
*)
(*$QR
Q.(let p = list (pair small_int small_int) in pair p p) (fun (l1, l2) ->
let l1 = _list_uniq l1 and l2 = _list_uniq l2 in
let m1 = M.of_list l1 and m2 = M.of_list l2 in
let m = M.merge ~f:(fun _ v1 v2 -> match v1 with
| None -> v2 | Some _ as r -> r) m1 m2 in
List.for_all (fun (k,v) -> M.get_exn k m = v) l1 &&
List.for_all (fun (k,v) -> M.mem k m1 || M.get_exn k m = v) l2)
*)
let cardinal m = fold ~f:(fun acc _ _ -> acc+1) ~x:0 m
let add_list m l = List.fold_left (fun acc (k,v) -> add k v acc) m l

30
src/data/CCZipper.ml
View file

@ -11,24 +11,10 @@ let is_empty = function
| [], [] -> true
| _ -> false
(*$T
(is_empty empty)
not ([42] |> make |> right |> is_empty)
*)
let to_list (l,r) = List.rev_append l r
let to_rev_list (l,r) = List.rev_append r l
(*$inject
let zip_gen = Q.(pair (small_list int)(small_list int))
*)
(*$Q
zip_gen (fun z -> \
to_list z = List.rev (to_rev_list z))
*)
let make l = [], l
let left = function
@ -67,11 +53,6 @@ let focused = function
| _, x::_ -> Some x
| _, [] -> None
(*$Q
zip_gen (fun g -> \
is_focused g = (focused g |> CCOption.is_some))
*)
let focused_exn = function
| _, x::_ -> x
| _, [] -> raise Not_found
@ -82,11 +63,6 @@ let remove (l,r) = match r with
| [] -> l, []
| _ :: r' -> l, r'
(*$Q
Q.(triple int (list small_int)(list small_int)) (fun (x,l,r) -> \
insert x (l,r) |> remove = (l,r))
*)
let drop_before (_, r) = [], r
let drop_after (l, r) = match r with
@ -94,9 +70,3 @@ let drop_after (l, r) = match r with
| x :: _ -> l, [x]
let drop_after_and_focused (l, _) = l, []
(*$=
([1], [2]) (drop_after ([1], [2;3]))
([1], []) (drop_after ([1], []))
([1], []) (drop_after_and_focused ([1], [2;3]))
*)

2
tests/data/dune
View file

@ -2,4 +2,4 @@
(name t)
(flags :standard -strict-sequence -warn-error -a+8 -open CCShims_)
(modes native)
(libraries containers containers-data containers_testlib iter))
(libraries containers containers-data containers_testlib iter gen))

18
tests/data/t.ml
View file

@ -5,4 +5,22 @@ Containers_testlib.run_all ~descr:"containers-data" [
T_bitfield.Test.get();
T_cache.Test.get();
T_deque.Test.get();
T_fqueue.Test.get();
T_fun_vec.Test.get();
T_graph.Test.get();
T_hashset.Test.get();
T_hashtrie.Test.get();
T_het.Test.get();
T_immutarray.Test.get();
T_intmap.Test.get();
T_lazylist.Test.get();
T_misc.Test.get();
T_mutheap.Test.get();
T_persistenthashtbl.Test.get();
T_ral.Test.get();
T_ringbuffer.Test.get();
T_simplequeue.Test.get();
T_trie.Test.get();
T_wbt.Test.get();
T_zipper.Test.get();
];;

126
tests/data/t_fqueue.ml Normal file
View file

@ -0,0 +1,126 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCFQueue;;
let pp_ilist = CCFormat.(to_string (list int));;
t @@ fun () ->
let q = empty in
assert_bool "is_empty" (is_empty q);
true;;
q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) ->
cons x (of_list l) |> to_list = x::l);;
q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) ->
snoc (of_list l) x |> to_list = l @ [x]);;
t @@ fun () ->
let q = List.fold_left snoc empty [1;2;3;4;5] in
let q = tail q in
let q = List.fold_left snoc q [6;7;8] in
let l = Iter.to_list (to_iter q) in
assert_equal ~printer:pp_ilist [2;3;4;5;6;7;8] l;
true ;;
q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) ->
let x', q = cons x (of_list l) |> take_front_exn in
x'=x && to_list q = l);;
t @@ fun () ->
let q = of_list [1;2;3;4] in
let x, q = take_front_exn q in
assert_equal 1 x;
let q = List.fold_left snoc q [5;6;7] in
assert_equal 2 (first_exn q);
let x, _q = take_front_exn q in
assert_equal 2 x;
true;;
t @@ fun () -> take_front empty = None;;
t @@ fun () ->
let l, q = take_front_l 5 (1 -- 10) in
l = [1;2;3;4;5] && to_list q = [6;7;8;9;10];;
t @@ fun () -> take_front_while (fun x-> x<5) (1 -- 10) |> fst = [1;2;3;4];;
q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) ->
let q,x' = snoc (of_list l) x |> take_back_exn in
x'=x && to_list q = l);;
t @@ fun () -> take_back empty = None;;
q (Q.list Q.int) (fun l ->
size (of_list l) = List.length l);;
t @@ fun () ->
let l = CCList.(0--100) in let q = of_list l in
List.map (fun i->nth_exn i q) l = l;;
q ~count:30
(Q.list Q.int) (fun l ->
let len = List.length l in let idx = CCList.(0 -- (len - 1)) in
let q = of_list l in
l = [] || List.for_all (fun i -> nth i q = Some (List.nth l i)) idx);;
q (Q.list Q.int) (fun l ->
l = [] || (of_list l |> init |> to_list = List.rev (List.tl (List.rev l))));;
q (Q.list Q.int) (fun l ->
l = [] || (of_list l |> tail |> to_list = List.tl l));;
q Q.(pair (list int) (list int)) (fun (l1, l2) ->
add_iter_front (Iter.of_list l1) (of_list l2) |> to_list = l1 @ l2);;
q (Q.list Q.int) (fun l ->
of_list l |> to_iter |> Iter.to_list = l);;
q (Q.pair (Q.list Q.int)(Q.list Q.int)) (fun (l1,l2) ->
append (of_list l1) (of_list l2) |> to_list = l1 @ l2) ;;
t @@ fun () ->
let q1 = of_iter (Iter.of_list [1;2;3;4]) in
let q2 = of_iter (Iter.of_list [5;6;7;8]) in
let q = append q1 q2 in
let l = Iter.to_list (to_iter q) in
assert_equal ~printer:pp_ilist [1;2;3;4;5;6;7;8] l;
true;;
q Q.(pair (list int) (list int)) (fun (l1, l2) ->
add_seq_front (CCList.to_seq l1) (of_list l2) |> to_list = l1 @ l2);;
q (Q.list Q.int) (fun l ->
of_list l |> to_seq |> CCList.of_seq = l);;
q (Q.list Q.int) (fun l ->
of_list l |> map string_of_int |> to_list = List.map string_of_int l);;
q (Q.list Q.int) (fun l ->
of_list l |> fold (fun acc x->x::acc) [] = List.rev l);;
t @@ fun () ->
let q = of_iter (Iter.of_list [1;2;3;4]) in
let n = fold (+) 0 q in
assert_equal 10 n;
true;;
q (Q.list Q.int) (fun l ->
Iter.of_list l |> of_iter |> to_list = l);;
q (Q.list Q.int) (fun l ->
of_list l |> rev |> to_list = List.rev l);;
t @@ fun () ->
let q1 = 1 -- 10 and q2 = append (1 -- 5) (6 -- 10) in
equal (=) q1 q2;;
t @@ fun () -> 1 -- 5 |> to_list = [1;2;3;4;5];;
t @@ fun () -> 5 -- 1 |> to_list = [5;4;3;2;1];;
t @@ fun () -> 0 -- 0 |> to_list = [0];;
t @@ fun () -> 1 --^ 5 |> to_list = [1;2;3;4];;
t @@ fun () -> 5 --^ 1 |> to_list = [5;4;3;2];;
t @@ fun () -> 1 --^ 2 |> to_list = [1];;
t @@ fun () -> 0 --^ 0 |> to_list = [];;

65
tests/data/t_fun_vec.ml Normal file
View file

@ -0,0 +1,65 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCFun_vec;;
let _listuniq =
let g = Q.(small_list (pair small_int small_int)) in
Q.map_same_type
(fun l ->
CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a)(fst b)) l
) g
;;
t @@ fun () -> is_empty empty;;
t @@ fun () -> not (is_empty (return 2));;
t @@ fun () -> length (return 2) = 1;;
q _listuniq (fun l ->
let m = of_list l in
List.for_all (fun (i,y) -> get_exn i m = y) @@ List.mapi CCPair.make l);;
(* regression test for #298 *)
t @@ fun () ->
let rec consume x = match CCFun_vec.pop x with
| None -> () | Some (_, x) -> consume x
in
consume (of_list (CCList.(1 -- 100)));
true;;
q Q.(pair int (small_list int)) (fun (x,l) ->
let q0 = of_list l in
let q = push x q0 in
assert_equal (length q) (length q0+1);
let y, q = pop_exn q in
assert_equal x y;
assert_equal (to_list q) (to_list q0);
true
);;
q Q.(pair (fun1 Observable.int bool)(small_list int)) (fun (f,l) ->
let f = Q.Fn.apply f in
(List.map f l) = (of_list l |> map f |> to_list)
);;
q Q.(pair (small_list int)(small_list int)) (fun (l1,l2) ->
(l1 @ l2) = (append (of_list l1)(of_list l2) |> to_list)
);;
q Q.(small_list int) (fun l ->
l = to_list (of_list l));;
q _listuniq (fun l ->
(List.sort Stdlib.compare l) =
(l |> Iter.of_list |> of_iter |> to_iter |> Iter.to_list
|> List.sort Stdlib.compare) );;
q _listuniq (fun l ->
(List.sort Stdlib.compare l) =
(l |> Gen.of_list |> of_gen |> to_gen |> Gen.to_list
|> List.sort Stdlib.compare) );;
t @@ fun () -> choose empty = None;;
t @@ fun () -> choose (of_list [1,1; 2,2]) <> None;;

68
tests/data/t_graph.ml Normal file
View file

@ -0,0 +1,68 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCGraph;;
t @@ fun () ->
let l =
let tbl = mk_table ~eq:CCInt.equal 128 in
Traverse.Event.dfs ~tbl ~eq:CCInt.equal ~graph:divisors_graph (Iter.return 345614)
|> Iter.to_list in
let expected =
[`Enter (345614, 0, []); `Edge (345614, (), 172807, `Forward);
`Enter (172807, 1, [(345614, (), 172807)]); `Edge (172807, (), 1, `Forward);
`Enter (1, 2, [(172807, (), 1); (345614, (), 172807)]); `Exit 1; `Exit 172807;
`Edge (345614, (), 2, `Forward); `Enter (2, 3, [(345614, (), 2)]);
`Edge (2, (), 1, `Cross); `Exit 2; `Edge (345614, (), 1, `Cross);
`Exit 345614]
in
assert_equal expected l;
true;;
t @@ fun () ->
let tbl = mk_table ~eq:CCInt.equal 128 in
let l = topo_sort ~eq:CCInt.equal ~tbl ~graph:divisors_graph (Iter.return 42) in
List.for_all (fun (i,j) ->
let idx_i = CCList.find_idx ((=)i) l |> CCOption.get_exn_or "" |> fst in
let idx_j = CCList.find_idx ((=)j) l |> CCOption.get_exn_or "" |> fst in
idx_i < idx_j)
[ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3];;
t @@ fun () ->
let tbl = mk_table ~eq:CCInt.equal 128 in
let l = topo_sort ~eq:CCInt.equal ~rev:true ~tbl ~graph:divisors_graph (Iter.return 42) in
List.for_all (fun (i,j) ->
let idx_i = CCList.find_idx ((=)i) l |> CCOption.get_exn_or "" |> fst in
let idx_j = CCList.find_idx ((=)j) l |> CCOption.get_exn_or "" |> fst in
idx_i > idx_j)
[ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3];;
(* example from https://en.wikipedia.org/wiki/Strongly_connected_component *)
t @@ fun () ->
let set_eq ?(eq=(=)) l1 l2 = CCList.subset ~eq l1 l2 && CCList.subset ~eq l2 l1 in
let graph = of_list ~eq:CCString.equal
[ "a", "b"
; "b", "e"
; "e", "a"
; "b", "f"
; "e", "f"
; "f", "g"
; "g", "f"
; "b", "c"
; "c", "g"
; "c", "d"
; "d", "c"
; "d", "h"
; "h", "d"
; "h", "g"
] in
let tbl = mk_table ~eq:CCString.equal 128 in
let res = scc ~tbl ~graph (Iter.return "a") |> Iter.to_list in
assert_bool "scc"
(set_eq ~eq:(set_eq ?eq:None) res
[ [ "a"; "b"; "e" ]
; [ "f"; "g" ]
; [ "c"; "d"; "h" ]
]
);
true;;

22
tests/data/t_hashset.ml Normal file
View file

@ -0,0 +1,22 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCHashSet;;
t @@ fun () -> let module IS = Make(CCInt) in IS.cardinal (IS.create 10) = 0;;
t @@ fun () -> let module IS = Make(CCInt) in IS.find (IS.of_list [1;2;3]) 3 = Some 3;;
t @@ fun () -> let module IS = Make(CCInt) in IS.find (IS.of_list [1;2;3]) 5 = None;;
t @@ fun () ->
let module IS = Make(CCInt) in
IS.(equal (inter (of_list [1;2;3]) (of_list [2;5;4])) (of_list [2]));;
t @@ fun () ->
let module IS = Make(CCInt) in
IS.(equal (union (of_list [1;2;3]) (of_list [2;5;4])) (of_list [1;2;3;4;5]));;
t @@ fun () ->
let module IS = Make(CCInt) in
IS.(equal (diff (of_list [1;2;3]) (of_list [2;4;5])) (of_list [1;3]));;

108
tests/data/t_hashtrie.ml Normal file
View file

@ -0,0 +1,108 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCHashTrie;;
module M = Make(CCInt) ;;
let _listuniq =
let g = Q.(list (pair small_int small_int)) in
Q.map_same_type
(fun l ->
CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a)(fst b)) l
) g
;;
t @@ fun () -> M.is_empty M.empty;;
t @@ fun () -> not (M.is_empty (M.singleton 1 2));;
t @@ fun () -> M.cardinal (M.singleton 1 2) = 1;;
t @@ fun () -> popcount 5L = 2;;
t @@ fun () -> popcount 256L = 1;;
t @@ fun () -> popcount 255L = 8;;
t @@ fun () -> popcount 0xFFFFL = 16;;
t @@ fun () -> popcount 0xFF1FL = 13;;
t @@ fun () -> popcount 0xFFFFFFFFL = 32;;
t @@ fun () -> popcount 0xFFFFFFFFFFFFFFFFL = 64;;
q Q.int (fun i -> let i = Int64.of_int i in popcount i <= 64);;
q _listuniq (fun l ->
let m = M.of_list l in
List.for_all (fun (x,y) -> M.get_exn x m = y) l);;
q _listuniq (fun l ->
let m = List.fold_left (fun m (x,y) -> M.add x y m) M.empty l in
List.for_all (fun (x,y) -> M.get_exn x m = y) l);;
t @@ fun () ->
let lsort = List.sort Stdlib.compare in
let m = M.of_list [1, 1; 2, 2] in
let id = Transient.create() in
let m' = M.add_mut ~id 3 3 m in
let m' = M.add_mut ~id 4 4 m' in
assert_equal [1, 1; 2, 2] (M.to_list m |> lsort);
assert_equal [1, 1; 2, 2; 3,3; 4,4] (M.to_list m' |> lsort);
Transient.freeze id;
assert_bool "must raise"
(try ignore(M.add_mut ~id 5 5 m'); false with Transient.Frozen -> true);
true;;
q _listuniq (fun l ->
let m = M.of_list l in
List.for_all
(fun (x,_) ->
let m' = M.remove x m in
not (M.mem x m') &&
M.cardinal m' = M.cardinal m - 1 &&
List.for_all
(fun (y,v) -> y = x || M.get_exn y m' = v)
l
) l
);;
t @@ fun () ->
let m = M.of_list [1, 1; 2, 2; 5, 5] in
let m' = M.update 4
~f:(function
| None -> Some 4
| Some _ -> Some 0
) m
in
assert_equal [1,1; 2,2; 4,4; 5,5] (M.to_list m' |> List.sort Stdlib.compare);
true;;
t @@ fun () ->
let l = CCList.(1 -- 10 |> map (fun x->x,x)) in
M.of_list l
|> M.fold ~f:(fun acc x y -> (x,y)::acc) ~x:[]
|> List.sort Stdlib.compare = l ;;
q _listuniq (fun l ->
(List.sort Stdlib.compare l) =
(l |> Iter.of_list |> M.of_iter |> M.to_iter |> Iter.to_list
|> List.sort Stdlib.compare) );;
q _listuniq (fun l ->
(List.sort Stdlib.compare l) =
(l |> Gen.of_list |> M.of_gen |> M.to_gen |> Gen.to_list
|> List.sort Stdlib.compare) );;
t @@ fun () -> M.choose M.empty = None;;
t @@ fun () -> M.choose M.(of_list [1,1; 2,2]) <> None;;
t @@ fun () ->
let m = M.of_list CCList.( (501 -- 1000) @ (500 -- 1) |> map (fun i->i,i)) in
assert_equal ~printer:CCInt.to_string 1000 (M.cardinal m);
assert_bool "check all get"
(Iter.for_all (fun i -> i = M.get_exn i m) Iter.(1 -- 1000));
let m = Iter.(501 -- 1000 |> fold (fun m i -> M.remove i m) m) in
assert_equal ~printer:CCInt.to_string 500 (M.cardinal m);
assert_bool "check all get after remove"
(Iter.for_all (fun i -> i = M.get_exn i m) Iter.(1 -- 500));
assert_bool "check all get after remove"
(Iter.for_all (fun i -> None = M.get i m) Iter.(501 -- 1000));
true;;

32
tests/data/t_het.ml Normal file
View file

@ -0,0 +1,32 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCHet;;
t @@ fun () ->
let k1 : int Key.t = Key.create() in
let k2 : int Key.t = Key.create() in
let k3 : string Key.t = Key.create() in
let k4 : float Key.t = Key.create() in
let tbl = Tbl.create () in
Tbl.add tbl k1 1;
Tbl.add tbl k2 2;
Tbl.add tbl k3 "k3";
assert_equal (Some 1) (Tbl.find tbl k1);
assert_equal (Some 2) (Tbl.find tbl k2);
assert_equal (Some "k3") (Tbl.find tbl k3);
assert_equal None (Tbl.find tbl k4);
assert_equal 3 (Tbl.length tbl);
Tbl.add tbl k1 10;
assert_equal (Some 10) (Tbl.find tbl k1);
assert_equal 3 (Tbl.length tbl);
assert_equal None (Tbl.find tbl k4);
Tbl.add tbl k4 0.0;
assert_equal (Some 0.0) (Tbl.find tbl k4);
true

48
tests/data/t_immutarray.ml Normal file
View file

@ -0,0 +1,48 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCImmutArray;;
let print_array f a = to_list a |> Array.of_list |> Q.Print.(array f);;
eq ~printer:(print_array Q.Print.int)
(of_list [0]) (set (of_list [5]) 0 0);;
eq ~printer:(print_array Q.Print.int)
(of_list [1; 3; 4; 5]) (set (of_list [1; 2; 4; 5]) 1 3);;
let eq' = eq ~printer:(print_array Q.Print.int) ;;
eq' empty (append empty empty);;
eq' (of_list [1; 2; 3]) (append empty (of_list [1; 2; 3]));;
eq' (of_list [1; 2; 3]) (append (of_list [1; 2; 3]) empty);;
eq' (of_list [3; 1; 4; 1; 5]) (append (of_list [3; 1]) (of_list [4; 1; 5]));;
eq ~printer:Q.Print.(list (pair int string))
([2, "baz"; 1, "bar"; 0, "foo"])
(foldi (fun l i a -> (i, a) :: l) [] (of_list ["foo"; "bar"; "baz"]));;
let eq' = eq ~printer:Q.Print.bool;;
eq' true (for_all (fun _ -> false) empty);;
eq' false (for_all (fun _ -> false) (singleton 3));;
eq' true (for_all (fun n -> n mod 2 = 0) (of_list [2; 4; 8]));;
eq' false (for_all (fun n -> n mod 2 = 0) (of_list [2; 4; 5; 8]));;
eq' false (exists (fun _ -> true) empty);;
eq' true (exists (fun _ -> true) (singleton 3));;
eq' false (exists (fun _ -> false) (singleton 3));;
eq' false (exists (fun n -> n mod 2 = 1) (of_list [2; 4; 8]));;
eq' true (exists (fun n -> n mod 2 = 1) (of_list [2; 4; 5; 8]));;
q Q.(list bool) (fun l -> let a = of_list l in not @@ exists (fun b -> b) a = for_all not a);;
q Q.(list bool) (fun l -> let a = of_list l in not @@ for_all (fun b -> b) a = exists not a);;
q Q.(list bool) (fun l -> exists (fun b -> b) (of_list l) = List.fold_left (||) false l);;
q Q.(list bool) (fun l -> for_all (fun b -> b) (of_list l) = List.fold_left (&&) true l);;
q Q.(list int) (fun l ->
let g = Iter.of_list l in
of_iter g |> to_iter |> Iter.to_list = l);;
q Q.(list int) (fun l ->
let g = Gen.of_list l in
of_gen g |> to_gen |> Gen.to_list = l);;

377
tests/data/t_intmap.ml Normal file
View file

@ -0,0 +1,377 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCIntMap;;
let highest2 x : int =
let rec aux i =
if i=0 then i
else if 1 = (x lsr i) then 1 lsl i else aux (i-1)
in
if x<0 then min_int else aux (Sys.word_size-2);;
q ~count:1_000
Q.int (fun x ->
if Bit.equal_int (highest2 x) (Bit.highest x) then true
else QCheck.Test.fail_reportf "x=%d, highest=%d, highest2=%d@." x
(Bit.highest x :> int) (highest2 x));;
let _list_uniq l = CCList.sort_uniq ~cmp:(fun a b-> Stdlib.compare (fst a)(fst b)) l;;
q Q.(small_list (pair int int)) (fun l ->
let m = of_list l in
is_empty m = (cardinal m = 0)) ;;
q Q.int (fun i ->
let b = Bit.highest i in
((b:>int) land i = (b:>int)) && (i < 0 || ((b:>int) <= i && (i-(b:>int)) < (b:>int))));;
q Q.int (fun i -> (Bit.highest i = Bit.min_int) = (i < 0));;
q Q.int (fun i -> ((Bit.highest i:>int) < 0) = (Bit.highest i = Bit.min_int));;
q Q.int (fun i -> let j = (Bit.highest i :> int) in j land (j-1) = 0);;
t @@ fun () -> (Bit.highest min_int :> int) = min_int;;
t @@ fun () -> (Bit.highest 2 :> int) = 2;;
t @@ fun () -> (Bit.highest 17 :> int) = 16;;
t @@ fun () -> (Bit.highest 300 :> int) = 256;;
q Q.(list (pair int bool)) (fun l ->
check_invariants (of_list l));;
q Q.(list (pair int int)) (fun l ->
let l = _list_uniq l in
let m = of_list l in
List.for_all (fun (k,v) -> find k m = Some v) l);;
q Q.(list (pair int int)) (fun l ->
let m = of_list l in
List.for_all (fun (k,_) -> mem k m) l);;
q ~count:20
Q.(list (pair int int)) (fun l ->
let l = _list_uniq l in let m = of_list l in
List.for_all (fun (k,v) -> find_exn k m = v) l);;
q ~count:20
Q.(list (pair int int)) (fun l ->
let l = _list_uniq l in let m = of_list l in
List.for_all (fun (k,_) -> mem k m && not (mem k (remove k m))) l);;
eq ~printer:Q.Print.(list (pair int int))
[1,1; 2, 22; 3, 3]
(of_list [1,1;2,2;3,3]
|> update 2 (function None -> assert false | Some _ -> Some 22)
|> to_list |> List.sort Stdlib.compare);;
q Q.(list (pair int bool)) ( fun l ->
let open Q in
CCList.sort_uniq ~cmp:CCOrd.poly l = CCList.sort CCOrd.poly l ==>
equal ~eq:(=) (of_list l) (of_list (List.rev l)));;
(* regression for #329 *)
t @@ fun () ->
let minus m1 m2 =
union (fun _key v1 v2 -> v1 - v2) m1 m2 in
let key = 0 in
let m0 = singleton key 1 in (* a map of [key] to the value 1 *)
let m1 = minus m0 m0 in (* a map of [key] to the value 0 *)
let m2 = minus m0 m1 in (* a map of [key] to the value 1 *)
let observed = equal ~eq:(=) m2 m0 in (* [m0] and [m2] should be equal *)
assert_equal true observed;
true;;
q
Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1,l2) ->
check_invariants (union (fun _ _ x -> x) (of_list l1) (of_list l2)));;
q
Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1,l2) ->
check_invariants (inter (fun _ _ x -> x) (of_list l1) (of_list l2)));;
(* associativity of union *)
q Q.(let p = list (pair int int) in triple p p p) (fun (l1,l2,l3) ->
let m1 = of_list l1 and m2 = of_list l2 and m3 = of_list l3 in
let f _ x y = max x y in
equal ~eq:(=) (union f (union f m1 m2) m3) (union f m1 (union f m2 m3)));;
t @@ fun () ->
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp))
(of_list [1, "1"; 2, "2"; 3, "3"; 4, "4"])
(union (fun _ a _ -> a)
(of_list [1, "1"; 3, "3"]) (of_list [2, "2"; 4, "4"]));
true;;
t @@ fun () ->
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp))
(of_list [1, "1"; 2, "2"; 3, "3"; 4, "4"])
(union (fun _ a _ -> a)
(of_list [1, "1"; 2, "2"; 3, "3"]) (of_list [2, "2"; 4, "4"]));
true;;
q Q.(list (pair int bool)) (fun l ->
equal ~eq:(=) (of_list l) (union (fun _ a _ -> a) (of_list l)(of_list l)));;
let union_l l1 l2 =
let l2' = List.filter (fun (x,_) -> not @@ List.mem_assoc x l1) l2 in
_list_uniq (l1 @ l2')
let inter_l l1 l2 =
let l2' = List.filter (fun (x,_) -> List.mem_assoc x l1) l2 in
_list_uniq l2';;
q Q.(pair (small_list (pair small_int unit)) (small_list (pair small_int unit)))
(fun (l1,l2) ->
union_l l1 l2 = _list_uniq @@ to_list (union (fun _ _ _ ->())(of_list l1) (of_list l2)));;
q Q.(pair (small_list (pair small_int unit)) (small_list (pair small_int unit)))
(fun (l1,l2) ->
inter_l l1 l2 = _list_uniq @@ to_list (inter (fun _ _ _ ->()) (of_list l1) (of_list l2)));;
t @@ fun () ->
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp))
(singleton 2 "2")
(inter (fun _ a _ -> a)
(of_list [1, "1"; 2, "2"; 3, "3"]) (of_list [2, "2"; 4, "4"]));
true;;
q Q.(list (pair int bool)) (fun l ->
equal ~eq:(=) (of_list l) (inter (fun _ a _ -> a) (of_list l)(of_list l)));;
(* associativity of inter *)
q Q.(let p = list (pair int int) in triple p p p) (fun (l1,l2,l3) ->
let m1 = of_list l1 and m2 = of_list l2 and m3 = of_list l3 in
let f _ x y = max x y in
equal ~eq:(=) (inter f (inter f m1 m2) m3) (inter f m1 (inter f m2 m3)));;
q Q.(pair (fun2 Observable.int Observable.int bool) (small_list (pair int int))) (fun (f,l) ->
let QCheck.Fun(_,f) = f in
_list_uniq (List.filter (fun (x,y) -> f x y) l) =
(_list_uniq @@ to_list @@ filter f @@ of_list l)
);;
q Q.(pair (fun2 Observable.int Observable.int @@ option bool) (small_list (pair int int))) (fun (f,l) ->
let QCheck.Fun(_,f) = f in
_list_uniq (CCList.filter_map (fun (x,y) -> CCOption.map (CCPair.make x) @@ f x y) l) =
(_list_uniq @@ to_list @@ filter_map f @@ of_list l)
);;
let merge_union _x o = match o with
| `Left v | `Right v | `Both (v,_) -> Some v
let merge_inter _x o = match o with
| `Left _ | `Right _ -> None
| `Both (v,_) -> Some v;;
q Q.(let p = small_list (pair small_int small_int) in pair p p) (fun (l1,l2) ->
check_invariants
(merge ~f:merge_union (of_list l1) (of_list l2)));;
q Q.(let p = small_list (pair small_int small_int) in pair p p) (fun (l1,l2) ->
check_invariants
(merge ~f:merge_inter (of_list l1) (of_list l2)));;
q Q.(let p = small_list (pair small_int unit) in pair p p) (fun (l1,l2) ->
let l1 = _list_uniq l1 and l2 = _list_uniq l2 in
equal ~eq:Stdlib.(=)
(union (fun _ v1 _ -> v1) (of_list l1) (of_list l2))
(merge ~f:merge_union (of_list l1) (of_list l2)));;
q Q.(let p = small_list (pair small_int unit) in pair p p) (fun (l1,l2) ->
let l1 = _list_uniq l1 and l2 = _list_uniq l2 in
equal ~eq:Stdlib.(=)
(inter (fun _ v1 _ -> v1) (of_list l1) (of_list l2))
(merge ~f:merge_inter (of_list l1) (of_list l2)));;
q Q.(list (pair int int)) (fun l ->
let l = List.map (fun (k,v) -> abs k,v) l in
let rec is_sorted = function [] | [_] -> true
| x::y::tail -> x <= y && is_sorted (y::tail) in
of_list l |> to_list |> List.rev_map fst |> is_sorted);;
q Q.(list (pair int int)) (fun l ->
of_list l |> cardinal = List.length (l |> List.map fst |> CCList.sort_uniq ~cmp:CCInt.compare));;
q Q.(list (pair small_int int)) (fun l ->
of_list l |> cardinal = List.length (l |> List.map fst |> CCList.sort_uniq ~cmp:CCInt.compare));;
eq ~printer:Q.Print.int
1 (let t = of_list [(197151390, 0); (197151390, 0)] in cardinal t);;
t @@ fun () ->
doubleton 1 "a" 2 "b" |> to_gen |> of_gen |> to_list
|> List.sort Stdlib.compare = [1, "a"; 2, "b"];;
q Q.(list (pair int bool)) (fun l ->
let m = of_list l in equal ~eq:(=) m (m |> to_gen |> of_gen));;
q Q.(list (pair int bool)) ( fun l ->
let m1 = of_list l and m2 = of_list (List.rev l) in
compare ~cmp:Stdlib.compare m1 m2 = 0);;
q Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1, l2) ->
let l1 = List.map (fun (k,v) -> abs k,v) l1 in
let l2 = List.map (fun (k,v) -> abs k,v) l2 in
let m1 = of_list l1 and m2 = of_list l2 in
let c = compare ~cmp:Stdlib.compare m1 m2
and c' = compare ~cmp:Stdlib.compare m2 m1 in
(c = 0) = (c' = 0) && (c < 0) = (c' > 0) && (c > 0) = (c' < 0));;
q Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1, l2) ->
let l1 = List.map (fun (k,v) -> abs k,v) l1 in
let l2 = List.map (fun (k,v) -> abs k,v) l2 in
let m1 = of_list l1 and m2 = of_list l2 in
(compare ~cmp:Stdlib.compare m1 m2 = 0) = equal ~eq:(=) m1 m2);;
q Q.(list (pair int bool)) (fun l ->
let m = of_list l in equal ~eq:(=) m (m |> to_seq |> of_seq));;
let test_count = 2_500
open QCheck
type instr_tree =
| Empty
| Singleton of int * int
| Add of int * int * instr_tree
| Remove of int * instr_tree
| Union of instr_tree * instr_tree
| Inter of instr_tree * instr_tree
let rec to_string (a:instr_tree): string =
let int_to_string = string_of_int in
match a with
| Empty -> "Empty"
| Singleton (k,v) -> Printf.sprintf "Singleton(%d,%d)" k v
| Add (k,v,t) -> Printf.sprintf "Add(%d,%d," k v ^ (to_string t) ^ ")"
| Remove (n,t) -> "Remove (" ^ (int_to_string n) ^ ", " ^ (to_string t) ^ ")"
| Union (t,t') -> "Union (" ^ (to_string t) ^ ", " ^ (to_string t') ^ ")"
| Inter (t,t') -> "Inter (" ^ (to_string t) ^ ", " ^ (to_string t') ^ ")"
let merge_f _ x y = min x y
let rec interpret t : _ t = match t with
| Empty -> empty
| Singleton (k,v) -> singleton k v
| Add (k,v,t) -> add k v (interpret t)
| Remove (n,t) -> remove n (interpret t)
| Union (t,t') ->
let s = interpret t in
let s' = interpret t' in
union merge_f s s'
| Inter (t,t') ->
let s = interpret t in
let s' = interpret t' in
inter merge_f s s'
let tree_gen int_gen : instr_tree Q.Gen.t =
let open Gen in
sized
(fix (fun recgen n -> match n with
| 0 -> oneof [return Empty;
Gen.map2 (fun i j -> Singleton (i,j)) int_gen int_gen]
| _ ->
frequency
[ (1, return Empty);
(1, map2 (fun k v -> Singleton (k,v)) int_gen int_gen);
(2, map3 (fun i j t -> Add (i,j,t)) int_gen int_gen (recgen (n-1)));
(2, map2 (fun i t -> Remove (i,t)) int_gen (recgen (n-1)));
(2, map2 (fun l r -> Union (l,r)) (recgen (n/2)) (recgen (n/2)));
(2, map2 (fun l r -> Inter (l,r)) (recgen (n/2)) (recgen (n/2)));
]))
let (<+>) = Q.Iter.(<+>)
let rec tshrink t : instr_tree Q.Iter.t = match t with
| Empty -> Iter.empty
| Singleton (k,v) ->
(Iter.return Empty)
<+> (Iter.map (fun k' -> Singleton (k',v)) (Shrink.int k))
<+> (Iter.map (fun v' -> Singleton (k,v')) (Shrink.int v))
| Add (k,v,t) ->
(Iter.of_list [Empty; t; Singleton (k,v)])
<+> (Iter.map (fun t' -> Add (k,v,t')) (tshrink t))
<+> (Iter.map (fun k' -> Add (k',v,t)) (Shrink.int k))
<+> (Iter.map (fun v' -> Add (k,v',t)) (Shrink.int v))
| Remove (i,t) ->
(Iter.of_list [Empty; t])
<+> (Iter.map (fun t' -> Remove (i,t')) (tshrink t))
<+> (Iter.map (fun i' -> Remove (i',t)) (Shrink.int i))
| Union (t0,t1) ->
(Iter.of_list [Empty;t0;t1])
<+> (Iter.map (fun t0' -> Union (t0',t1)) (tshrink t0))
<+> (Iter.map (fun t1' -> Union (t0,t1')) (tshrink t1))
| Inter (t0,t1) ->
(Iter.of_list [Empty;t0;t1])
<+> (Iter.map (fun t0' -> Inter (t0',t1)) (tshrink t0))
<+> (Iter.map (fun t1' -> Inter (t0,t1')) (tshrink t1))
let arb_int =
frequency
[(5,small_signed_int);
(3,int);
(1, oneofl [min_int;max_int])]
let arb_tree =
make ~print:to_string ~shrink:tshrink
(tree_gen arb_int.gen)
let empty_m = []
let singleton_m k v = [k,v]
let mem_m i s = List.mem_assoc i s
let rec remove_m i s = match s with
| [] -> []
| (j,v)::s' -> if i=j then s' else (j,v)::(remove_m i s')
let add_m k v s = List.sort Stdlib.compare ((k,v)::remove_m k s)
let rec union_m s s' = match s,s' with
| [], _ -> s'
| _, [] -> s
| (k1,v1)::is,(k2,v2)::js ->
if k1<k2 then (k1,v1)::(union_m is s') else
if k1>k2 then (k2,v2)::(union_m s js) else
(k1,min v1 v2)::(union_m is js)
let rec inter_m s s' = match s with
| [] -> []
| (k,v)::s ->
if List.mem_assoc k s'
then (k,min v (List.assoc k s'))::(inter_m s s')
else inter_m s s';;
let abstract s = List.sort Stdlib.compare (fold (fun k v acc -> (k,v)::acc) s []);;
(* A bunch of agreement properties *)
eq empty_m (let s = empty in abstract s);;
q ~count:test_count
(Q.pair arb_int arb_int) (fun (k,v) ->
abstract (singleton k v) = singleton_m k v);;
q ~count:test_count
Q.(pair arb_tree arb_int)
(fun (t,n) ->
let s = interpret t in
mem n s = mem_m n (abstract s));;
q ~count:test_count
(triple arb_tree arb_int arb_int)
(fun (t,k,v) ->
let s = interpret t in
abstract (add k v s) = add_m k v (abstract s));;
q ~count:test_count
(pair arb_tree arb_int)
(fun (t,n) ->
let s = interpret t in
abstract (remove n s) = remove_m n (abstract s));;
q ~count:test_count
(pair arb_tree arb_tree)
(fun (t,t') ->
let s = interpret t in
let s' = interpret t' in
abstract (union merge_f s s') = union_m (abstract s) (abstract s'));;
q ~count:test_count
Q.(pair arb_tree arb_tree)
(fun (t,t') ->
let s = interpret t in
let s' = interpret t' in
abstract (inter merge_f s s') = inter_m (abstract s) (abstract s'));;

21
tests/data/t_lazylist.ml Normal file
View file

@ -0,0 +1,21 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCLazy_list;;
q Q.(list int) (fun l -> length (of_list l) = List.length l);;
eq [2;4;6] (of_list [1;2;3;4;5;6;7] |> filter ~f:(fun x -> x mod 2=0) |> to_list);;
eq [2;4;6] (of_gen Gen.(1 -- max_int) |> filter ~f:(fun x -> x mod 2=0) |> take 3 |> to_list);;
q Q.(pair (list int) (list int)) (fun (l1,l2) ->
length (append (of_list l1) (of_list l2)) = List.length l1 + List.length l2);;
eq [1] (default ~default:(return 1) empty |> to_list);;
q Q.(list int) (fun l -> l = (Gen.of_list l |> of_gen |> to_list));;
q Q.(list int) (fun l -> l = to_list (of_list l));;
q Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list));;

166
tests/data/t_misc.ml Normal file
View file

@ -0,0 +1,166 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
module Mixmap = struct
open CCMixmap;;
t @@ fun () ->
let module M = CCMixmap.Make(CCInt) in
let inj_int = CCMixmap.create_inj() in
let inj_str = CCMixmap.create_inj() in
let inj_list_int = CCMixmap.create_inj() in
let m =
M.empty
|> M.add ~inj:inj_int 1 1
|> M.add ~inj:inj_str 2 "2"
|> M.add ~inj:inj_list_int 3 [3;3;3]
in
assert_equal (M.get ~inj:inj_int 1 m) (Some 1) ;
assert_equal (M.get ~inj:inj_str 1 m) None ;
assert_equal (M.get ~inj:inj_str 2 m) (Some "2") ;
assert_equal (M.get ~inj:inj_int 2 m) None ;
assert_equal (M.get ~inj:inj_list_int 3 m) (Some [3;3;3]) ;
assert_equal (M.get ~inj:inj_str 3 m) None ;
true
end
module Mixset = struct
open CCMixset ;;
t @@ fun () ->
let k1 : int key = newkey () in
let k2 : int key = newkey () in
let k3 : string key = newkey () in
let set =
empty
|> set ~key:k1 1
|> set ~key:k2 2
|> set ~key:k3 "3"
in
assert (get ~key:k1 set = Some 1);
assert (get ~key:k2 set = Some 2);
assert (get ~key:k3 set = Some "3");
true
end
module Mixtbl = struct
open CCFun
open CCMixtbl;;
t @@ fun () ->
let inj_int = create_inj () in
let tbl = create 10 in
assert_equal None (get ~inj:inj_int tbl "a");
set ~inj:inj_int tbl "a" 1;
assert_equal (Some 1) (get ~inj:inj_int tbl "a");
let inj_string = create_inj () in
set ~inj:inj_string tbl "b" "Hello";
assert_equal (Some "Hello") (get ~inj:inj_string tbl "b");
assert_equal None (get ~inj:inj_string tbl "a");
assert_equal (Some 1) (get ~inj:inj_int tbl "a");
set ~inj:inj_string tbl "a" "Bye";
assert_equal None (get ~inj:inj_int tbl "a");
assert_equal (Some "Bye") (get ~inj:inj_string tbl "a");
true;;
t @@ fun () ->
let inj_int = create_inj () in
let tbl = create 5 in
set ~inj:inj_int tbl "foo" 1;
set ~inj:inj_int tbl "bar" 2;
assert_equal 2 (length tbl);
assert_equal 2 (find ~inj:inj_int tbl "bar");
set ~inj:inj_int tbl "foo" 42;
assert_equal 2 (length tbl);
remove tbl "bar";
assert_equal 1 (length tbl);
true;;
t @@ fun () ->
let inj_int = create_inj () in
let inj_str = create_inj () in
let tbl = create 5 in
set ~inj:inj_int tbl "foo" 1;
set ~inj:inj_int tbl "bar" 2;
set ~inj:inj_str tbl "baaz" "hello";
assert_equal 3 (length tbl);
clear tbl;
assert_equal 0 (length tbl);
true;;
t @@ fun () ->
let inj_int = create_inj () in
let inj_str = create_inj () in
let tbl = create 5 in
set ~inj:inj_int tbl "foo" 1;
set ~inj:inj_int tbl "bar" 2;
set ~inj:inj_str tbl "baaz" "hello";
assert_bool "mem foo int" (mem ~inj:inj_int tbl "foo");
assert_bool "mem bar int" (mem ~inj:inj_int tbl "bar");
assert_bool "not mem baaz int" (not (mem ~inj:inj_int tbl "baaz"));
assert_bool "not mem foo str" (not (mem ~inj:inj_str tbl "foo"));
assert_bool "not mem bar str" (not (mem ~inj:inj_str tbl "bar"));
assert_bool "mem baaz str" (mem ~inj:inj_str tbl "baaz");
true;;
t @@ fun () ->
let inj_int = create_inj () in
let inj_str = create_inj () in
let tbl = create 5 in
set ~inj:inj_int tbl "foo" 1;
set ~inj:inj_int tbl "bar" 2;
set ~inj:inj_str tbl "baaz" "hello";
let l = keys_iter tbl |> Iter.to_list in
assert_equal ["baaz"; "bar"; "foo"] (List.sort compare l);
true;;
t @@ fun () ->
let inj_int = create_inj () in
let inj_str = create_inj () in
let tbl = create 5 in
set ~inj:inj_int tbl "foo" 1;
set ~inj:inj_int tbl "bar" 2;
set ~inj:inj_str tbl "baaz" "hello";
set ~inj:inj_str tbl "str" "rts";
let l_int = bindings_of ~inj:inj_int tbl |> Iter.to_list in
assert_equal ["bar", 2; "foo", 1] (List.sort compare l_int);
let l_str = bindings_of ~inj:inj_str tbl |> Iter.to_list in
assert_equal ["baaz", "hello"; "str", "rts"] (List.sort compare l_str);
true;;
end
module Multiset = struct
open CCMultiSet;;
t @@ fun () -> let module S = CCMultiSet.Make(String) in
S.count (S.add_mult S.empty "a" 5) "a" = 5;;
t @@ fun () -> let module S = CCMultiSet.Make(String) in
S.count (S.remove_mult (S.add_mult S.empty "a" 5) "a" 3) "a" = 2;;
t @@ fun () -> let module S = CCMultiSet.Make(String) in
S.count (S.remove_mult (S.add_mult S.empty "a" 4) "a" 6) "a" = 0;;
end
module PersistentArray = struct
open CCPersistentArray;;
t @@ fun () ->
of_list [ of_list [1]; of_list []; of_list [2;3;4]; of_list [5]; of_list [6;7]]
|> flatten |> to_list = [1;2;3;4;5;6;7];;
t @@ fun () ->
of_list [ of_list []; of_list []; of_list []] |> flatten |> length = 0;;
t @@ fun () -> of_list [] |> flatten |> length = 0;;
q Q.(list int) (fun l ->
of_list l |> to_gen |> of_gen |> to_list = l);;
end

76
tests/data/t_mutheap.ml Normal file
View file

@ -0,0 +1,76 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCMutHeap;;
type elt = {
x: string;
mutable rank: int;
mutable idx: int;
}
module Elt = struct
type t = elt
let idx x = x.idx
let set_idx x i = x.idx <- i
let lt a b =
if a.rank = b.rank then a.x < b.x else a.rank < b.rank
end
module H = CCMutHeap.Make(Elt);;
t @@ fun () ->
let h = H.create() in
let x1 = {x="a"; rank=10; idx= -1} in
let x2 = {x="b"; rank=10; idx= -1} in
let x3 = {x="c"; rank=10; idx= -1} in
H.insert h x1;
assert (H.in_heap x1);
assert (not (H.in_heap x2));
assert (not (H.in_heap x3));
H.insert h x2;
H.insert h x3;
assert (Elt.lt x1 x2);
assert (Elt.lt x2 x3);
let x = H.remove_min h in
assert (x == x1);
let x = H.remove_min h in
assert (x == x2);
let x = H.remove_min h in
assert (x == x3);
assert (try ignore (H.remove_min h); false with Not_found -> true);
true;;
t @@ fun () ->
let h = H.create() in
let x1 = {x="a"; rank=10; idx= -1} in
let x2 = {x="b"; rank=10; idx= -1} in
let x3 = {x="c"; rank=10; idx= -1} in
H.insert h x1;
H.insert h x2;
H.insert h x3;
x3.rank <- 2;
H.decrease h x3;
assert (Elt.lt x3 x1);
assert (Elt.lt x3 x2);
let x = H.remove_min h in
assert (x == x3);
x1.rank <- 20;
H.increase h x1;
let x = H.remove_min h in
assert (x == x2);
let x = H.remove_min h in
assert (x == x1);
assert (try ignore (H.remove_min h); false with Not_found -> true);
true;;

162
tests/data/t_persistenthashtbl.ml Normal file
View file

@ -0,0 +1,162 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCPersistentHashtbl;;
module H = Make(CCInt)
let my_list =
[ 1, "a";
2, "b";
3, "c";
4, "d";
]
let my_iter = Iter.of_list my_list
let _list_uniq = CCList.sort_uniq
~cmp:(fun a b -> Stdlib.compare (fst a) (fst b))
let _list_int_int = Q.(
map_same_type _list_uniq
(list_of_size Gen.(0 -- 40) (pair small_int small_int))
);;
t @@ fun () ->
let h = H.of_iter my_iter in
assert_equal "a" (H.find h 1);
assert_raises ((=)Not_found) (fun () -> H.find h 5);
let h' = H.replace h 5 "e" in
assert_equal "a" (H.find h' 1);
assert_equal "e" (H.find h' 5);
assert_equal "a" (H.find h 1);
assert_raises ((=)Not_found) (fun () -> H.find h 5);
true;;
t @@ fun () ->
let n = 10000 in
let seq = Iter.map (fun i -> i, string_of_int i) Iter.(0--n) in
let h = H.of_iter seq in
Iter.iter
(fun (k,v) ->
assert_equal ~printer:(fun x -> x) v (H.find h k))
seq;
assert_raises ((=)Not_found) (fun () -> H.find h (n+1));
true;;
q _list_int_int
(fun l ->
let h = H.of_list l in
List.for_all
(fun (k,v) ->
try
H.find h k = v
with Not_found -> false)
l
);;
t @@ fun () ->
let h = H.of_iter
Iter.(map (fun i -> i, string_of_int i)
(0 -- 200)) in
assert_equal 201 (H.length h);
true;;
q _list_int_int (fun l ->
let h = H.of_list l in
H.length h = List.length l
);;
t @@ fun () ->
let h = H.of_iter my_iter in
assert_equal "a" (H.find h 1);
assert_raises ((=)Not_found) (fun () -> H.find h 5);
let h1 = H.add h 5 "e" in
assert_equal "a" (H.find h1 1);
assert_equal "e" (H.find h1 5);
assert_equal "a" (H.find h 1);
let h2 = H.add h1 5 "ee" in
assert_equal "ee" (H.find h2 5);
assert_raises ((=)Not_found) (fun () -> H.find h 5);
let h3 = H.remove h2 1 in
assert_equal "ee" (H.find h3 5);
assert_raises ((=)Not_found) (fun () -> H.find h3 1);
let h4 = H.remove h3 5 in
assert_equal "e" (H.find h4 5);
assert_equal "ee" (H.find h3 5);
true;;
t @@ fun () ->
let h = H.of_iter my_iter in
assert_equal (H.find h 2) "b";
assert_equal (H.find h 3) "c";
assert_equal (H.find h 4) "d";
assert_equal (H.length h) 4;
let h = H.remove h 2 in
assert_equal (H.find h 3) "c";
assert_equal (H.length h) 3;
assert_raises ((=)Not_found) (fun () -> H.find h 2);
true;;
t @@ fun () ->
let open Iter.Infix in
let n = 10000 in
let seq = Iter.map (fun i -> i, string_of_int i) (0 -- n) in
let h = H.of_iter seq in
assert_equal (n+1) (H.length h);
let h = Iter.fold (fun h i -> H.remove h i) h (0 -- 500) in
assert_equal (n-500) (H.length h);
assert_bool "is_empty" (H.is_empty (H.create 16));
true;;
q _list_int_int (fun l ->
let h = H.of_list l in
let h = List.fold_left (fun h (k,_) -> H.remove h k) h l in
H.is_empty h);;
t @@ fun () ->
let t1 = H.of_list [1, "a"; 2, "b1"] in
let t2 = H.of_list [2, "b2"; 3, "c"] in
let t = H.merge
~f:(fun _ -> function
| `Right v2 -> Some v2
| `Left v1 -> Some v1
| `Both (s1,s2) -> if s1 < s2 then Some s1 else Some s2)
t1 t2
in
assert_equal ~printer:string_of_int 3 (H.length t);
assert_equal "a" (H.find t 1);
assert_equal "b1" (H.find t 2);
assert_equal "c" (H.find t 3);
true;;
q _list_int_int (fun l ->
let l1, l2 = List.partition (fun (x,_) -> x mod 2 = 0) l in
let h1 = H.of_list l1 in
let h2 = H.add_list h1 l2 in
List.for_all
(fun (k,v) -> H.find h2 k = v)
l
&&
List.for_all
(fun (k,v) -> H.find h1 k = v)
l1
&&
List.length l1 = H.length h1
&&
List.length l = H.length h2
);;
t @@ fun () ->
let h = H.of_iter my_iter in
let l = Iter.to_list (H.to_iter h) in
assert_equal my_list (List.sort compare l);
true;;
t @@ fun () ->
let h = H.of_iter my_iter in
assert_equal "b" (H.find h 2);
assert_equal "a" (H.find h 1);
assert_raises ((=)Not_found) (fun () -> H.find h 42);
true;;

139
tests/data/t_ral.ml Normal file
View file

@ -0,0 +1,139 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCRAL;;
q Q.(pair (pair small_int int) (list int)) (fun ((i,v),l) ->
l=[] ||
(let i = (abs i) mod (List.length l) in
let ral = of_list l in let ral = set ral i v in
get_exn ral i = v));;
q Q.(list small_int) (fun l ->
let l1 = of_list l in
CCList.mapi (fun i x -> i,x) l
|> List.for_all (fun (i,x) -> get_exn l1 i = x));;
t @@ fun () -> let l = of_list[1;2;3] in hd l = 1;;
t @@ fun () -> let l = of_list[1;2;3] in tl l |> to_list = [2;3];;
q Q.(list_of_size Gen.(1--100) int) (fun l ->
let open Q in
let l' = of_list l in
(not (is_empty l')) ==> (equal ~eq:CCInt.equal l' (cons (hd l') (tl l'))) );;
eq ~printer:Q.Print.(list int)
[1;2;4] (to_list @@ remove (of_list [1;2;3;4]) 2);;
eq ~printer:Q.Print.(pair int (list int))
(3,[1;2;4]) (CCPair.map_snd to_list @@ get_and_remove_exn (of_list [1;2;3;4]) 2);;
q Q.small_int (fun n ->
let l = CCList.(0 -- n) in
let l' = of_list l |> mapi ~f:(fun i x ->i,x) in
List.mapi (fun i x->i,x) l = to_list l'
);;
q Q.(pair (list small_int)(fun2 Observable.int Observable.int bool)) (fun (l,f) ->
let f = Q.Fn.apply f in
mapi ~f (of_list l) |> to_list = List.mapi f l );;
q Q.(list int) (fun l ->
let f x = x+1 in
of_list l |> rev_map ~f |> to_list = List.rev_map f l);;
q Q.(list small_int) (fun l ->
let l = of_list l in rev (rev l) = l);;
q Q.(list small_int) (fun l ->
let l1 = of_list l in length l1 = List.length l);;
q Q.(pair (list int) (list int)) (fun (l1,l2) ->
append (of_list l1) (of_list l2) = of_list (l1 @ l2));;
t @@ fun () -> of_list [1;2;3;4;5;6] |> filter ~f:(fun x -> x mod 2=0) |> to_list = [2;4;6];;
q Q.(pair (fun1 Observable.int (small_list int)) (small_list int)) (fun (f,l) ->
let f x = Q.Fn.apply f x in
let f' x = f x |> of_list in
of_list l |> flat_map f' |> to_list = CCList.(flat_map f l));;
t @@ fun () ->
flatten (of_list [of_list [1]; of_list []; of_list [2;3]]) =
of_list [1;2;3;];;
q Q.(small_list (small_list int)) (fun l ->
of_list l |> map ~f:of_list |> flatten |> to_list = CCList.flatten l);;
t @@ fun () ->
app (of_list [(+) 2; ( * ) 10]) (of_list [1;10]) |> to_list =
[3; 12; 10; 100];;
t @@ fun () -> take 3 (of_list CCList.(1--10)) |> to_list = [1;2;3];;
t @@ fun () -> take 5 (of_list CCList.(1--10)) |> to_list = [1;2;3;4;5];;
t @@ fun () -> take 0 (of_list CCList.(1--10)) |> to_list = [];;
q Q.(pair small_int (list int)) (fun (n,l) ->
of_list l |> take n |> to_list = CCList.take n l);;
q Q.(list int) (fun l ->
let f x = x mod 7 <> 0 in
of_list l |> take_while ~f |> to_list = CCList.take_while f l);;
q Q.(pair (fun1 Observable.int bool) (list int)) (fun (f,l) ->
let f x = Q.Fn.apply f x in
of_list l |> take_while ~f |> to_list = CCList.take_while f l);;
t @@ fun () -> of_list [1;2;3] |> drop 2 |> length = 1;;
q Q.(pair small_int (list int)) (fun (n,l) ->
of_list l |> drop n |> to_list = CCList.drop n l);;
t @@ fun () -> drop 3 (of_list CCList.(1--10)) |> to_list = CCList.(4--10);;
t @@ fun () -> drop 5 (of_list CCList.(1--10)) |> to_list = [6;7;8;9;10];;
t @@ fun () -> drop 0 (of_list CCList.(1--10)) |> to_list = CCList.(1--10);;
t @@ fun () -> drop 15 (of_list CCList.(1--10)) |> to_list = [];;
q Q.(list_of_size Gen.(0 -- 200) int) (fun l ->
let f x = x mod 10 <> 0 in
of_list l |> drop_while ~f |> to_list = CCList.drop_while f l);;
q Q.(pair (list int)(list int)) (fun (l1,l2) ->
equal ~eq:CCInt.equal (of_list l1) (of_list l2) = (l1=l2));;
q Q.(pair small_int (small_list int)) (fun (n,l) ->
of_list l |> repeat n |> to_list = CCList.(repeat n l));;
t @@ fun () -> range 0 3 |> to_list = [0;1;2;3];;
t @@ fun () -> range 3 0 |> to_list = [3;2;1;0];;
t @@ fun () -> range 17 17 |> to_list = [17];;
q Q.(pair small_int small_int) (fun (i,j) ->
range i j |> to_list = CCList.(i -- j) );;
let eq' = eq ~printer:CCFormat.(to_string (hbox (list int)));;
eq' [1;2;3;4] (1 --^ 5 |> to_list);;
eq' [5;4;3;2] (5 --^ 1 |> to_list);;
eq' [1] (1 --^ 2 |> to_list);;
eq' [] (0 --^ 0 |> to_list);;
q Q.(pair (list small_int) (list small_int)) (fun (l1,l2) ->
add_list (of_list l2) l1 |> to_list = l1 @ l2);;
q Q.(list int) (fun l -> to_list (of_list l) = l);;
q Q.(array int) (fun a ->
of_array a |> to_array = a);;
q Q.(list small_int) (fun l ->
of_list l |> to_iter |> Iter.to_list = l);;
q Q.(list small_int) (fun l ->
Iter.of_list l |> of_iter |> to_list = l);;
t @@ fun () -> add_iter (of_list [3;4]) (Iter.of_list [1;2]) |> to_list = [1;2;3;4];;
q Q.(list small_int) (fun l -> of_list l |> to_gen |> Gen.to_list = l);;
q Q.(list small_int) (fun l ->
Gen.of_list l |> of_gen |> to_list = l);;
q Q.(pair (list int)(list int)) (fun (l1,l2) ->
compare ~cmp:CCInt.compare (of_list l1) (of_list l2) = (Stdlib.compare l1 l2));;

394
tests/data/t_ringbuffer.ml Normal file
View file

@ -0,0 +1,394 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCRingBuffer;;
open Q.Gen
let g_char = map Char.chr (Char.code 'A' -- Char.code 'z')
let g_str = string_size ~gen:g_char (0--10)
let a_str = Q.set_gen g_str Q.string;;
t @@ fun () ->
let b = Byte.of_array (Bytes.of_string "abc") in
let b' = Byte.copy b in
Byte.clear b;
Byte.to_array b' = (Bytes.of_string "abc") && Byte.to_array b = Bytes.empty ;;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
Byte.capacity b >= s_len);;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
let b' = Byte.copy b in
try Byte.iteri b
~f:(fun i c -> if Byte.get_front b' i <> c then raise Exit); true
with Exit -> false);;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
Byte.push_back b 'X';
Byte.peek_back_exn b = 'X');;
q (Q.pair a_str a_str) (fun (s,s') ->
let b = Byte.create (max (String.length s+String.length s') 64) in
let s = Bytes.of_string s in let s' = Bytes.of_string s' in
Byte.blit_from b s 0 (Bytes.length s);
Byte.blit_from b s' 0 (Bytes.length s');
Byte.length b = Bytes.length s + Bytes.length s');;
q (Q.pair a_str a_str) (fun (s,s') ->
let s = Bytes.of_string s in let s' = Bytes.of_string s' in
let b = Byte.create (max (Bytes.length s + Bytes.length s') 64) in
Byte.blit_from b s 0 (Bytes.length s);
Byte.blit_from b s' 0 (Bytes.length s');
Byte.length b = Bytes.length s + Bytes.length s');;
q a_str (fun s -> let s = Bytes.of_string s in
let b = Byte.create (max 64 (Bytes.length s)) in
Byte.blit_from b s 0 (Bytes.length s);
let to_buf = Bytes.create (Bytes.length s) in
let len = Byte.blit_into b to_buf 0 (Bytes.length s) in
to_buf = s && len = Bytes.length s);;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
Byte.skip b s_len;
Byte.is_empty b);;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
try let front = Byte.take_front_exn b in
front = Bytes.get s 0 with Byte.Empty -> s_len = 0);;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
try let back = Byte.take_back_exn b in
back = Bytes.get s (Bytes.length s - 1)
with Byte.Empty -> s_len = 0);;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
try let () = Byte.junk_front b in
s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0);;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
try let () = Byte.junk_back b in
s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0);;
q (Q.pair a_str a_str) (fun (s,s') ->
let s = Bytes.of_string s in let s' = Bytes.of_string s' in
let b = Byte.create (max (Bytes.length s+Bytes.length s') 64) in
Byte.blit_from b s 0 (Bytes.length s);
Byte.blit_from b s' 0 (Bytes.length s');
let h = Bytes.of_string "hello world" in
Byte.blit_from b h 0 (Bytes.length h); (* big enough *)
let l = Byte.length b in let l' = l/2 in Byte.skip b l';
Byte.length b + l' = l);;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
Byte.clear b;
Byte.length b = 0);;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
try Byte.iteri b ~f:(fun i c -> if Byte.get_front b i <> c then raise Exit);
true with Exit -> false);;
q (Q.pair Q.small_int a_str) (fun (i, s) ->
let s = Bytes.of_string (s ^ " ") in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
let index = abs (i mod Byte.length b) in
let front = Byte.get_front b index in
front = Bytes.get s index);;
q (Q.pair Q.small_int a_str) (fun (i, s) ->
let s = Bytes.of_string (s ^ " ") in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
let index = abs (i mod Byte.length b) in
let back = Byte.get_back b index in
back = Bytes.get s (s_len - index - 1));;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
let l = Byte.to_list b in
let explode s = let rec exp i l =
if i < 0 then l else exp (i - 1) (Bytes.get s i :: l) in
exp (Bytes.length s - 1) [] in
explode s = l);;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
try let back = Byte.peek_front_exn b in
back = Bytes.get s 0 with Byte.Empty -> s_len = 0);;
q a_str (fun s -> let s = Bytes.of_string s in
let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in
Byte.blit_from b s 0 s_len;
try let back = Byte.peek_back_exn b in
back = Bytes.get s (s_len - 1) with Byte.Empty -> s_len = 0);;
q a_str (fun s -> let s = Bytes.of_string s in
let b = Byte.of_array s in let s' = Byte.to_array b in
s = s');;
module BI = CCRingBuffer.Make(struct type t = int let dummy=0 end);;
(* try to trigger an error on resize
see issue #126 *)
t @@ fun () ->
let b = BI.create 50 in
let st = Random.State.make [| 0 |] in
for _i = 1 to 100_000 do
if Random.State.float st 1.0 < 0.5 then
BI.push_back b 0
else
let _ = BI.take_front b in ()
done;
true;;
(* Test against reference implementation (lists) on a succession of
operations.
Remarks on semantics:
JUNK_FRONT/JUNK_BACK: try to remove if not empty
SKIP: if at least n elements, skip; else nop
*)
module BS = CCRingBuffer.Byte
type op =
| Push_back of char
| Take_front
| Take_back
| Peek_front
| Peek_back
| Junk_front
| Junk_back
| Skip of int
| Blit of string * int * int
| Z_if_full
let str_of_op = function
| Push_back c -> Printf.sprintf "push_back(%C)" c
| Take_front -> Printf.sprintf "take_front"
| Take_back -> Printf.sprintf "take_back"
| Peek_front -> Printf.sprintf "peek_front"
| Peek_back -> Printf.sprintf "peek_back"
| Junk_front -> Printf.sprintf "junk_front"
| Junk_back -> Printf.sprintf "junk_back"
| Skip n -> Printf.sprintf "skip(%d)" n
| Blit (s,i,len) -> Printf.sprintf "blit(%S,%d,%d)" s i len
| Z_if_full -> "zero_if_full"
let push_back c = Push_back c
let skip n = assert (n>=0); Skip n
let blit s i len =
if i<0 || len<0 || i+len > String.length s then (
failwith ("wrong blit: " ^ str_of_op (Blit (s,i,len)));
);
Blit (s,i,len)
let shrink_op =
let open Q.Iter in
function
| Push_back c -> Q.Shrink.char c >|= push_back
| Take_front | Take_back | Junk_back | Junk_front
| Z_if_full | Peek_front | Peek_back
-> empty
| Skip n -> Q.Shrink.int n >|= skip
| Blit (s,i,len) ->
let s_i =
Q.Shrink.int i >>= fun i' ->
assert (i' <= i && i' + len <= String.length s);
if i' <= 0 then empty else return (blit s i' len)
and s_len =
Q.Shrink.int len >>= fun len'->
assert (len' <= len && i + len' <= String.length s);
if len' <= 0 then empty else return (blit s i len')
and s_s =
Q.Shrink.string s >>= fun s' ->
if i+len > String.length s' then empty else return (blit s' i len)
in
append s_i (append s_len s_s)
let len_op size acc = function
| Push_back _ -> min size (acc + 1)
| Take_front | Take_back | Junk_front | Junk_back -> max (acc-1) 0
| Skip n -> if acc >= n then acc-n else acc
| Z_if_full | Peek_front | Peek_back -> acc
| Blit (_,_,len) -> min size (acc + len)
let apply_op b = function
| Push_back c -> BS.push_back b c; None
| Take_front -> BS.take_front b
| Take_back -> BS.take_back b
| Junk_front -> (try BS.junk_front b with BS.Empty -> ()); None
| Junk_back -> (try BS.junk_back b with BS.Empty -> ()); None
| Peek_front -> BS.peek_front b
| Peek_back -> BS.peek_back b
| Skip n -> if n <= BS.length b then BS.skip b n; None
| Blit (s,i,len) ->
assert(i+len <= String.length s);
BS.blit_from b (Bytes.unsafe_of_string s) i len; None
| Z_if_full -> if BS.is_full b then Some '0' else None
let gen_op =
let open Q.Gen in
let g_blit =
string_size ~gen:g_char (5--20) >>= fun s ->
(0 -- String.length s) >>= fun len ->
assert (len >= 0 && len <= String.length s);
(0--(String.length s-len)) >|= fun i ->
blit s i len
in
frequency
[ 3, return Take_back;
3, return Take_front;
1, return Junk_back;
1, return Junk_front;
1, return Peek_front;
1, return Peek_back;
2, g_blit;
1, (0--5 >|= skip);
2, map push_back g_char;
1, return Z_if_full;
]
let arb_op =
Q.make
~shrink:shrink_op
~print:str_of_op
gen_op
let arb_ops = Q.list_of_size Q.Gen.(0 -- 20) arb_op
module L_impl = struct
type t = {
size: int;
mutable l: char list;
}
let create size = {size; l=[]}
let normalize_ b =
let n = List.length b.l in
if n>b.size then b.l <- CCList.drop (n-b.size) b.l
let push_back b c = b.l <- b.l @ [c]; normalize_ b
let take_front b = match b.l with
| [] -> None
| c :: l -> b.l <- l; Some c
let peek_front b = match b.l with [] -> None | x::_ -> Some x
let take_back b =
let n = List.length b.l in
if n=0 then None
else (
let init, last = CCList.take_drop (n-1) b.l in
let x = List.hd last in
b.l <- init;
Some x
)
let peek_back b = match b.l with [] -> None | l -> Some (List.hd (List.rev l))
let junk_front b = ignore (take_front b)
let junk_back b = ignore (take_back b)
let skip b n =
if n <= List.length b.l then (
CCInt.range' 0 n (fun _ -> junk_front b)
)
let blit b s i len =
for j=i to i+len-1 do push_back b (String.get s j) done
let apply_op b = function
| Push_back c -> push_back b c; None
| Take_front -> take_front b
| Take_back -> take_back b
| Peek_front -> peek_front b
| Peek_back -> peek_back b
| Junk_back -> junk_back b; None
| Junk_front -> junk_front b; None
| Skip n -> skip b n; None
| Blit (s,i,len) -> blit b s i len; None
| Z_if_full -> if b.size = List.length b.l then Some '0' else None
let to_list b = b.l
end;;
(* check that a lot of operations can be applied without failure,
and that the result has correct length *)
q ~count:3_000
arb_ops (fun ops ->
let size = 64 in
let b = BS.create size in
List.iter (fun o-> ignore (apply_op b o)) ops;
BS.length b = List.fold_left (len_op size) 0 ops);;
(* check identical behavior with list implem *)
q ~count:3_000
arb_ops (fun ops ->
let size = 64 in
let b = BS.create size in
let l = L_impl.create size in
let l1 = CCList.filter_map (apply_op b) ops in
let l2 = CCList.filter_map (L_impl.apply_op l) ops in
l1=l2 && BS.to_list b = L_impl.to_list l);;
(* check that deleted elements can be GCed *)
module BO = CCRingBuffer.Make(struct type t = int option let dummy=None end)
let make_bo () =
let b = BO.create 1000 in
for i = 1 to BO.capacity b do
BO.push_back b (Some i)
done;
b
let test_no_major_blocks clear =
Gc.full_major ();
let live_blocks_before = (Gc.stat ()).live_blocks in
let b = make_bo () in
clear b;
Gc.full_major ();
let live_blocks_after = (Gc.stat ()).live_blocks in
assert (BO.length b = 0);
let diff = live_blocks_after - live_blocks_before in
diff < BO.capacity b / 2;;
t @@ fun () -> test_no_major_blocks (fun b -> for _ = 1 to BO.length b do BO.junk_front b; done);;
t @@ fun () -> test_no_major_blocks (fun b -> for _ = 1 to BO.length b do BO.junk_back b; done);;
t @@ fun () -> test_no_major_blocks (fun b -> for _ = 1 to BO.length b do ignore (BO.take_front b); done);;
t @@ fun () -> test_no_major_blocks (fun b -> for _ = 1 to BO.length b do ignore (BO.take_back b); done);;
t @@ fun () -> test_no_major_blocks (fun b -> BO.skip b (BO.length b));;
t @@ fun () -> test_no_major_blocks (fun b -> BO.clear b);;

36
tests/data/t_simplequeue.ml Normal file
View file

@ -0,0 +1,36 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCSimple_queue;;
q Q.(list small_int) (fun l ->
let q = of_list l in
equal CCInt.equal (Gen.unfold pop q |> of_gen) q);;
q Q.(list small_int) (fun l ->
equal CCInt.equal (of_list l |> rev) (of_list (List.rev l)));;
q Q.(list small_int) (fun l ->
let q = of_list l in
equal CCInt.equal q (q |> rev |> rev));;
q Q.(list small_int)(fun l ->
length (of_list l) = List.length l);;
q Q.(list small_int)(fun l ->
equal CCInt.equal (of_list l) (List.fold_left snoc empty l));;
q Q.(list small_int) (fun l ->
equal CCInt.equal
(of_iter (Iter.of_list l))
(of_list l));;
q Q.(list small_int) (fun l ->
l = (of_list l |> to_iter |> Iter.to_list));;
q Q.(pair (list small_int)(list small_int)) (fun (l1,l2) ->
equal CCInt.equal (of_list l1)(of_list l2) = (l1=l2));;
q Q.(pair (list small_int)(list small_int)) (fun (l1,l2) ->
equal CCInt.equal
(append (of_list l1)(of_list l2))
(of_list (List.append l1 l2)));;

134
tests/data/t_trie.ml Normal file
View file

@ -0,0 +1,134 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCTrie;;
module T = MakeList(CCInt)
module S = String
let l1 = [ [1;2], "12"; [1], "1"; [2;1], "21"; [1;2;3], "123"; [], "[]" ]
let t1 = T.of_list l1
let small_l l = List.fold_left (fun acc (k,_) -> List.length k+acc) 0 l
let s1 = String.of_list ["cat", 1; "catogan", 2; "foo", 3];;
t @@ fun () -> String.of_list ["a", 1; "b", 2] |> String.size = 2;;
t @@ fun () -> String.of_list ["a", 1; "b", 2; "a", 3] |> String.size = 2;;
t @@ fun () -> String.of_list ["a", 1; "b", 2] |> String.find_exn "a" = 1;;
t @@ fun () -> String.of_list ["a", 1; "b", 2] |> String.find_exn "b" = 2;;
t @@ fun () -> String.of_list ["a", 1; "b", 2] |> String.find "c" = None;;
t @@ fun () -> s1 |> String.find_exn "cat" = 1;;
t @@ fun () -> s1 |> String.find_exn "catogan" = 2;;
t @@ fun () -> s1 |> String.find_exn "foo" = 3;;
t @@ fun () -> s1 |> String.find "cato" = None;;
t @@ fun () -> T.add [3] "3" t1 |> T.find_exn [3] = "3";;
t @@ fun () -> T.add [3] "3" t1 |> T.find_exn [1;2] = "12";;
t @@ fun () -> T.remove [1;2] t1 |> T.find [1;2] = None;;
t @@ fun () -> T.remove [1;2] t1 |> T.find [1] = Some "1";;
t @@ fun () -> T.remove [1;2] t1 |> T.find [] = Some "[]";;
eq ~printer:CCFun.id
"ca" (String.longest_prefix "carte" s1);;
eq ~printer:CCFun.id
"" (String.longest_prefix "yolo" s1);;
eq ~printer:CCFun.id
"cat" (String.longest_prefix "cat" s1);;
eq ~printer:CCFun.id
"catogan" (String.longest_prefix "catogan" s1);;
q Q.(pair (list (pair (printable_string_of_size Gen.(0 -- 30)) int)) printable_string) (fun (l,s) ->
let m = String.of_list l in
let s' = String.longest_prefix s m in
CCString.prefix ~pre:s' s);;
t @@ fun () ->
T.fold (fun acc k v -> (k,v) :: acc) [] t1
|> List.sort Stdlib.compare = List.sort Stdlib.compare l1;;
eq ~printer:Q.Print.(list (pair (list int) string))
(List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Stdlib.compare)
(T.mapi (fun _ v -> v ^ "!") t1
|> T.to_list |> List.sort Stdlib.compare);;
eq ~printer:Q.Print.(list (pair (list int) string))
(List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Stdlib.compare)
(T.map (fun v -> v ^ "!") t1
|> T.to_list |> List.sort Stdlib.compare);;
q ~count:30
Q.(let p = list_of_size Gen.(0--100) (pair printable_string small_int) in pair p p)
(fun (l1,l2) ->
let t1 = S.of_list l1 and t2 = S.of_list l2 in
let t = S.merge (fun a _ -> Some a) t1 t2 in
S.to_iter t |> Iter.for_all
(fun (k,v) -> S.find k t1 = Some v || S.find k t2 = Some v) &&
S.to_iter t1 |> Iter.for_all (fun (k,_) -> S.find k t <> None) &&
S.to_iter t2 |> Iter.for_all (fun (k,_) -> S.find k t <> None));;
t @@ fun () -> T.size t1 = List.length l1
let eq' = eq ~printer:CCFormat.(to_string (list (pair (list int) string)));;
eq' [ [1], "1"; [1;2], "12"; [1;2;3], "123"; [2;1], "21" ]
(T.above [1] t1 |> Iter.to_list);;
eq' [ [1;2], "12"; [1;2;3], "123"; [2;1], "21" ]
(T.above [1;1] t1 |> Iter.to_list);;
eq' [ [1;2], "12"; [1], "1"; [], "[]" ]
(T.below [1;2] t1 |> Iter.to_list);;
eq' [ [1], "1"; [], "[]" ]
(T.below [1;1] t1 |> Iter.to_list);;
(* NOTE: Regression test. See #158 *)
t @@ fun () ->
let module TPoly = Make (struct
type t = (unit -> char) list
type char_ = char
let compare = compare
let to_iter a k = List.iter (fun c -> k (c ())) a
let of_list l = List.map (fun c -> (fun () -> c)) l
end)
in
let trie = TPoly.of_list [[fun () -> 'a'], 1; [fun () -> 'b'], 2] in
ignore (TPoly.below [fun () -> 'a'] trie |> Iter.to_list);
true;;
q ~count:30
Q.(list_of_size Gen.(0--100) (pair printable_string small_int)) (fun l ->
let t = S.of_list l in
S.check_invariants t);;
let rec sorted ~rev = function
| [] | [_] -> true
| x :: ((y ::_) as tl) ->
(if rev then x >= y else x <= y) && sorted ~rev tl
let gen_str = Q.small_printable_string;;
q ~count:200
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int))
(fun l -> let t = String.of_list l in
List.for_all (fun (k,_) ->
String.above k t |> Iter.for_all (fun (k',_) -> k' >= k))
l);;
q ~count:200
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int))
(fun l -> let t = String.of_list l in
List.for_all (fun (k,_) ->
String.below k t |> Iter.for_all (fun (k',_) -> k' <= k))
l);;
q ~count:200
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int))
(fun l -> let t = String.of_list l in
List.for_all (fun (k,_) ->
String.above k t |> Iter.to_list |> sorted ~rev:false)
l);;
q ~count:200
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int))
(fun l -> let t = String.of_list l in
List.for_all (fun (k,_) ->
String.below k t |> Iter.to_list |> sorted ~rev:true)
l);;

100
tests/data/t_wbt.ml Normal file
View file

@ -0,0 +1,100 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCWBTree;;
module M = Make(CCInt)
type op =
| Add of int * int
| Remove of int
| Remove_min
let gen_op = CCRandom.(choose_exn
[ return Remove_min
; map (fun x->Remove x) small_int
; pure (fun x y->Add (x,y)) <*> small_int <*> small_int])
and pp_op =let open Printf in
function Add (x,y) -> sprintf "Add %d %d" x y
| Remove x -> sprintf "Remove %d" x | Remove_min -> "Remove_min"
let apply_ops l m = List.fold_left
(fun m -> function
| Add (i,b) -> M.add i b m
| Remove i -> M.remove i m
| Remove_min ->
try let _, _, m' = M.extract_min m in m' with Not_found -> m
) m l
let op = Q.make ~print:pp_op gen_op
let _list_uniq = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst Stdlib.compare);;
q ~count:200
Q.(list op) (fun l -> let m = apply_ops l M.empty in M.balanced m);;
q Q.(list (pair small_int bool)) (fun l ->
let m = M.of_list l in
M.balanced m);;
q Q.(list (pair small_int small_int)) (fun l ->
let l = _list_uniq l in let m = M.of_list l in
List.for_all (fun (k,v) -> M.get_exn k m = v) l);;
q Q.(list (pair small_int small_int)) (fun l ->
let l = _list_uniq l in let m = M.of_list l in
M.cardinal m = List.length l);;
q Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l ->
let m = M.of_list l in
List.for_all (fun (k,_) ->
M.mem k m && (let m' = M.remove k m in not (M.mem k m'))) l);;
q Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l ->
let m = M.of_list l in
List.for_all (fun (k,_) -> let m' = M.remove k m in M.balanced m') l);;
t @@ fun () ->
let m = CCList.(0 -- 1000 |> map (fun i->i,i) |> M.of_list) in
List.for_all (fun i -> M.nth_exn i m = (i,i)) CCList.(0--1000);;
q ~count:1_000
Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l ->
let l = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst compare) l in
let m = M.of_list l in
List.for_all
(fun (k,v) -> match M.get_rank k m with
| `First | `After _ -> true
| `At n -> (k,v) = M.nth_exn n m)
l);;
q ~count:20
Q.(list_of_size Gen.(1 -- 100) (pair small_int small_int)) ( fun lst ->
let lst = _list_uniq lst in
let m = M.of_list lst in
List.for_all (fun (k,v) ->
let l, v', r = M.split k m in
v' = Some v
&& (M.to_iter l |> Iter.for_all (fun (k',_) -> k' < k))
&& (M.to_iter r |> Iter.for_all (fun (k',_) -> k' > k))
&& M.balanced m
&& M.cardinal l + M.cardinal r + 1 = List.length lst
) lst);;
t @@ fun () ->
let m1 = M.of_list [1, 1; 2, 2; 4, 4] in
let m2 = M.of_list [1, 1; 3, 3; 4, 4; 7, 7] in
let m = M.merge ~f:(fun _ -> CCOption.map2 (+)) m1 m2 in
assert_bool "balanced" (M.balanced m);
assert_equal
~cmp:(CCList.equal (CCPair.equal CCInt.equal CCInt.equal))
~printer:CCFormat.(to_string (list (pair int int)))
[1, 2; 4, 8]
(M.to_list m |> List.sort Stdlib.compare);
true;;
q Q.(let p = list (pair small_int small_int) in pair p p) (fun (l1, l2) ->
let l1 = _list_uniq l1 and l2 = _list_uniq l2 in
let m1 = M.of_list l1 and m2 = M.of_list l2 in
let m = M.merge ~f:(fun _ v1 v2 -> match v1 with
| None -> v2 | Some _ as r -> r) m1 m2 in
List.for_all (fun (k,v) -> M.get_exn k m = v) l1 &&
List.for_all (fun (k,v) -> M.mem k m1 || M.get_exn k m = v) l2);;

23
tests/data/t_zipper.ml Normal file
View file

@ -0,0 +1,23 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCZipper;;
t @@ fun () -> (is_empty empty);;
t @@ fun () -> not ([42] |> make |> right |> is_empty);;
let zip_gen = Q.(pair (small_list int)(small_list int));;
q zip_gen (fun z ->
to_list z = List.rev (to_rev_list z));;
q zip_gen (fun g ->
is_focused g = (focused g |> CCOption.is_some));;
q Q.(triple int (list small_int)(list small_int)) (fun (x,l,r) ->
insert x (l,r) |> remove = (l,r));;
eq ([1], [2]) (drop_after ([1], [2;3]));;
eq ([1], []) (drop_after ([1], []));;
eq ([1], []) (drop_after_and_focused ([1], [2;3]));;