Merge branch 'master' into stable

.merlin

@@ -18,4 +18,4 @@ PKG threads
 PKG threads.posix
 PKG lwt
 PKG qcheck
-FLG -w +a -w -4 -w -44
+FLG -w +a-4-44-48-60

.ocp-indent

@@ -0,0 +1,2 @@
+match_clause=2
+with=2

AUTHORS.adoc

@@ -22,3 +22,4 @@
 - @LemonBoy
 - Leonid Rozenberg (@rleonid)
 - Bikal Gurung (@bikalgurung)
+- Fabian Hemmer (copy)

CHANGELOG.adoc

@@ -1,5 +1,25 @@
 = Changelog
 
+== 1.4
+
+- add `CCMap.union`
+- add `CCRef.swap`
+- add `CCArray.swap`
+- change signature of `CCWBTree.get_rank`
+- add `CCWBTree.get_rank{,_exn}`
+
+- more efficient `List.map` Using efficient chunking algorithm
+- Fix `CCVector.append_array` (empty vector case)
+- `CCFQueue.take_back_exn` raised InvalidArg instead of Empty on an empty queue
+- faster `CCString.{prefix,suffix}`
+- speed improvements and benchmarks for `CCString.{prefix,suffix}`
+
+- add ocp-indent file
+- fix `CCFun.tap` example in doc
+- specify behavior of `CCFQueue.take_{front,back}_l` in some corner cases
+- More tests for CCVector.append and CCVector.append_array
+- assertions and cleanup in `CCPool`
+
 == 1.3
 
 - deprecate `CCBool.negate`

HOWTO.adoc

@@ -10,7 +10,7 @@ can be removed.
 . `make update_next_tag` (to update `@since` comments; be careful not to change symlinks)
 . check status of modules (`{b status: foo}`) and update if required;
    removed deprecated functions, etc.
-. update `CHANGELOG.md` (see its end to find the right git command)
+. update `CHANGELOG.adoc` (see its end to find the right git command)
 . commit the changes
 . `git checkout stable`
 . `git merge master`

README.adoc

@@ -96,14 +96,8 @@ and <<tutorial,the tutorial below>> for a gentle introduction.
 In general, see http://c-cube.github.io/ocaml-containers/last/ or
 http://cedeela.fr/~simon/software/containers for the **API documentation**.
 
-Some examples can be found link:doc/containers.adoc[there].
+Some examples can be found link:doc/containers.adoc[there],
-
+per-version doc http://c-cube.github.io/ocaml-containers/[there].
-API documentation by version:
-
-- http://c-cube.github.io/ocaml-containers/dev/[dev branch]
-- http://c-cube.github.io/ocaml-containers/1.0/[1.0]
-- http://c-cube.github.io/ocaml-containers/0.19/[0.19]
-- http://c-cube.github.io/ocaml-containers/0.17/[0.17]
 
 [[build]]
 == Build

_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        containers
-Version:     1.3
+Version:     1.4
 Homepage:    https://github.com/c-cube/ocaml-containers
 Authors:     Simon Cruanes
 License:     BSD-2-clause

benchs/run_benchs.ml

@@ -1177,6 +1177,99 @@ module Str = struct
   let bench_find  = bench_find_ ~dir:`Direct
   let bench_rfind  = bench_find_ ~dir:`Reverse
 
+  module Pre = struct
+    let prefix_rec ~pre s =
+      let rec same s1 s2 i =
+        if i = String.length s1 then true
+        else (
+          String.unsafe_get s1 i = String.unsafe_get s2 i && same s1 s2 (i+1)
+        )
+      in
+      String.length pre <= String.length s &&
+      same pre s 0
+
+    let prefix_while ~pre s =
+      String.length pre <= String.length s &&
+      begin
+        let i = ref 0 in
+        while !i < String.length pre &&
+              String.unsafe_get s !i = String.unsafe_get pre !i
+        do incr i done;
+        !i = String.length pre
+      end
+
+    exception Exit_false
+
+    let prefix_for_exn ~pre s =
+      String.length pre <= String.length s &&
+      try
+        for i=0 to String.length pre-1 do
+          if String.unsafe_get s i != String.unsafe_get pre i
+          then raise Exit_false
+        done;
+        true
+      with Exit_false -> false
+
+    let prefix_sub ~pre:prfx s =
+      let len_s = String.length s in
+      let len_p = String.length prfx in
+      if len_s < len_p then
+        false
+      else
+        let sub = String.sub s 0 len_p in
+        CCString.equal prfx sub
+
+    let bat_prefix ~pre:p str =
+      let len = String.length p in
+      if String.length str < len then false
+      else
+        let rec loop str p i =
+          if i = len then true
+          else if String.unsafe_get str i <> String.unsafe_get p i then false
+          else loop str p (i + 1)
+        in loop str p 0
+
+    let make ~max_len ~max_len_prefix n =
+      let rand = Random.State.make_self_init () in
+      let input =
+        Array.init n
+          (fun _ ->
+             let str =
+               QCheck.Gen.(string_size ~gen:printable (10 -- max_len))
+               |> QCheck.Gen.generate1 ~rand
+             in
+             let prfx_len = Random.State.int rand (min max_len_prefix (String.length str + 1)) in
+             let prfx =
+               if Random.State.bool rand then
+                 String.sub str 0 prfx_len
+               else
+                 String.sub str (String.length str - prfx_len) prfx_len
+             in
+             (prfx, str))
+      in
+      let output =
+        Array.map
+          (fun (pre, str) -> prefix_rec ~pre str)
+          input
+      in
+      let test f () =
+        Array.iteri
+          (fun i (pre, y) ->
+             let res = f ~pre y in
+             assert (res = output.(i)))
+          input
+      in
+      Benchmark.throughputN 3
+        [
+          "containers", test CCString.prefix, ();
+          "while_unsafe", test prefix_while, ();
+          "rec_unsafe", test prefix_rec, ();
+          "for_exn_unsafe", test prefix_for_exn, ();
+          "sub_eq", test prefix_sub, ();
+          "bat_prefix", test bat_prefix, ();
+        ]
+  end
+
   let () = B.Tree.register (
     "string" @>>>
       [ "find" @>>>
@@ -1205,6 +1298,11 @@ module Str = struct
           ; "50" @>> app_ints (bench_rfind ~size:50) [100; 100_000; 500_000]
           ; "500" @>> app_ints (bench_rfind ~size:500) [100_000; 500_000]
           ];
+        "prefix" @>>>
+        [ "max_len:1000,max_pre_len:15" @>> app_ints (Pre.make ~max_len:1000 ~max_len_prefix:15) [100; 1_000];
+          "max_len:1000,max_pre_len:100" @>> app_ints (Pre.make ~max_len:1000 ~max_len_prefix:100) [100; 1_000];
+          "max_len:1000,max_pre_len:300" @>> app_ints (Pre.make ~max_len:1000 ~max_len_prefix:300) [100; 1_000];
+        ]
       ])
 
 end

doc/intro.txt

@@ -82,6 +82,7 @@ CCFlatHashtbl
 CCGraph
 CCHashSet
 CCHashTrie
+CCHet
 CCImmutArray
 CCIntMap
 CCMixmap

opam

@@ -1,6 +1,6 @@
 opam-version: "1.2"
 name: "containers"
-version: "1.2"
+version: "1.4"
 author: "Simon Cruanes"
 maintainer: "simon.cruanes@inria.fr"
 build: [

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.4 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: a62cfaee59320a25dee6d9bbad9cd339) *)
+(* DO NOT EDIT (digest: b1097bcfb2d6eab143d1ac25252d8b14) *)
 (*
    Regenerated by OASIS v0.4.10
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -7041,7 +7041,7 @@ let setup_t =
        {
           oasis_version = "0.4";
           ocaml_version = Some (OASISVersion.VGreaterEqual "4.00.1");
-          version = "1.3";
+          version = "1.4";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -8900,8 +8900,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.10";
-     oasis_digest =
+     oasis_digest = Some "\213\002\219\227i{sJJ\160\246\216o\167\\^";
-       Some "\164\233\1428\169\160\007\155\182\180\021s\193\n\134-";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -8909,7 +8908,7 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 8913 "setup.ml"
+# 8912 "setup.ml"
 let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t
 open BaseCompat.Compat_0_4
 (* OASIS_STOP *)

src/core/CCArray.ml

@@ -468,6 +468,35 @@ let compare cmp a b =
   compare CCOrd.compare [| 1; 2; 3 |] [| 1; 2; |] > 0
 *)
 
+(* swap elements of array *)
+let swap a i j =
+  if i<>j then (
+    let tmp = a.(i) in
+    a.(i) <- a.(j);
+    a.(j) <- tmp;
+  )
+
+(*$T
+  let a = [| 1;2;3 |] in \
+    swap a 0 1; \
+    a = [| 2;1;3 |]
+  let a = [| 1;2;3 |] in \
+    swap a 0 2; \
+    a = [| 3;2;1 |]
+*)
+
+(*$QR
+  Q.(array small_int) (fun a ->
+    let b = Array.copy a in
+    for i = 0 to Array.length a-1 do
+      for j = i+1 to Array.length a-1 do
+        swap a i j; done; done;
+    for i = 0 to Array.length a-1 do
+      for j = i+1 to Array.length a-1 do
+        swap a i j; done; done;
+    a=b)
+*)
+
 (* shuffle a[i...j[ using the given int random generator
    See http://en.wikipedia.org/wiki/Fisher-Yates_shuffle *)
 let _shuffle _rand_int a i j =

src/core/CCArray.mli

@@ -23,6 +23,10 @@ val equal : 'a equal -> 'a t equal
 
 val compare : 'a ord -> 'a t ord
 
+val swap : 'a t -> int -> int -> unit
+(** [swap arr i j] swaps elements at indices [i] and [j].
+    @since 1.4 *)
+
 val get : 'a t -> int -> 'a
 
 val get_safe : 'a t -> int -> 'a option

src/core/CCFormat.mli

@@ -162,7 +162,7 @@ val some : 'a printer -> 'a option printer
         "what is your @{<White>favorite color@}? @{<blue>blue@}! No, @{<red>red@}! Ahhhhhhh@.";;
     ]}
 
-    {b status: experimental}
+    {b status: unstable}
     @since 0.15 *)
 
 val set_color_tag_handling : t -> unit
@@ -177,13 +177,13 @@ val set_color_default : bool -> unit
 val with_color : string -> 'a printer -> 'a printer
 (** [with_color "Blue" pp] behaves like the printer [pp], but with the given
     style.
-    {b status: experimental}
+    {b status: unstable}
     @since 0.16 *)
 
 val with_colorf : string -> t -> ('a, t, unit, unit) format4 -> 'a
 (** [with_colorf "Blue" out "%s %d" "yolo" 42] will behave like {!Format.fprintf},
     but wrapping the content with the given style
-    {b status: experimental}
+    {b status: unstable}
     @since 0.16 *)
 
 val with_color_sf : string -> ('a, t, unit, string) format4 -> 'a
@@ -193,7 +193,7 @@ val with_color_sf : string -> ('a, t, unit, string) format4 -> 'a
     {[
       CCFormat.with_color_sf "red" "%a" CCFormat.Dump.(list int) [1;2;3] |> print_endline;;
     ]}
-    {b status: experimental}
+    {b status: unstable}
     @since 0.21 *)
 
 val with_color_ksf : f:(string -> 'b) -> string -> ('a, t, unit, 'b) format4 -> 'a

src/core/CCFun.mli

@@ -40,7 +40,7 @@ val tap : ('a -> _) -> 'a -> 'a
     in a pipeline, for instance:
     {[CCArray.(1 -- 10)
       |> tap CCArray.shuffle
-      |> tap CCArray.sort Pervasives.compare
+      |> tap @@ CCArray.sort Pervasives.compare
     ]}
 *)
 

src/core/CCList.ml

@@ -20,13 +20,37 @@ let is_empty = function
 (* max depth for direct recursion *)
 let direct_depth_default_ = 1000
 
+let tail_map f l =
+  (* Unwind the list of tuples, reconstructing the full list front-to-back.
+     @param tail_acc a suffix of the final list; we append tuples' content
+     at the front of it *)
+  let rec rebuild tail_acc = function
+    | [] -> tail_acc
+    | (y0, y1, y2, y3, y4, y5, y6, y7, y8) :: bs ->
+      rebuild (y0 :: y1 :: y2 :: y3 :: y4 :: y5 :: y6 :: y7 :: y8 :: tail_acc) bs
+  in
+  (* Create a compressed reverse-list representation using tuples
+     @param tuple_acc a reverse list of chunks mapped with [f] *)
+  let rec dive tuple_acc = function
+    | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: xs ->
+      let y0 = f x0 in let y1 = f x1 in let y2 = f x2 in
+      let y3 = f x3 in let y4 = f x4 in let y5 = f x5 in
+      let y6 = f x6 in let y7 = f x7 in let y8 = f x8 in
+      dive ((y0, y1, y2, y3, y4, y5, y6, y7, y8) :: tuple_acc) xs
+    | xs ->
+      (* Reverse direction, finishing off with a direct map *)
+      let tail = List.map f xs in
+      rebuild tail tuple_acc
+  in
+  dive [] l
+
 let map f l =
   let rec direct f i l = match l with
     | [] -> []
     | [x] -> [f x]
     | [x1;x2] -> let y1 = f x1 in [y1; f x2]
     | [x1;x2;x3] -> let y1 = f x1 in let y2 = f x2 in [y1; y2; f x3]
-    | _ when i=0 -> List.rev (List.rev_map f l)
+    | _ when i=0 -> tail_map f l
     | x1::x2::x3::x4::l' ->
       let y1 = f x1 in
       let y2 = f x2 in
@@ -926,6 +950,11 @@ let uniq ?(eq=(=)) l =
   uniq [1;1;2;2;3;4;4;2;4;1;5] |> List.sort Pervasives.compare = [1;2;3;4;5]
 *)
 
+(*$Q
+  Q.(small_list small_int) (fun l -> \
+    sort_uniq l = (uniq l |> sort Pervasives.compare))
+  *)
+
 let union ?(eq=(=)) l1 l2 =
   let rec union eq acc l1 l2 = match l1 with
     | [] -> List.rev_append acc l2

src/core/CCMap.ml

@@ -29,6 +29,11 @@ module type S = sig
   (** [merge_safe ~f a b] merges the maps [a] and [b] together.
       @since 0.17 *)
 
+  val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+  (** Union of both maps, using the function to combine bindings
+      that belong to both inputs
+      @since 1.4 *)
+
   val of_seq : (key * 'a) sequence -> 'a t
 
   val add_seq : 'a t -> (key * 'a) sequence -> 'a t
@@ -85,6 +90,15 @@ module Make(O : Map.OrderedType) = struct
          | Some v1, Some v2 -> f k (`Both (v1,v2)))
       a b
 
+  let union f a b =
+    merge
+      (fun k v1 v2 -> match v1, v2 with
+         | None, None -> assert false
+         | None, (Some _ as r) -> r
+         | Some _ as r, None -> r
+         | Some v1, Some v2 -> f k v1 v2)
+      a b
+
   let add_seq m s =
     let m = ref m in
     s (fun (k,v) -> m := add k v !m);

src/core/CCMap.mli

@@ -32,6 +32,11 @@ module type S = sig
   (** [merge_safe ~f a b] merges the maps [a] and [b] together.
       @since 0.17 *)
 
+  val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+  (** Union of both maps, using the function to combine bindings
+      that belong to both inputs
+      @since 1.4 *)
+
   val of_seq : (key * 'a) sequence -> 'a t
   (** Same as {!of_list} *)
 

src/core/CCRef.ml

@@ -32,6 +32,11 @@ let compare f r1 r2 = f !r1 !r2
 
 let equal f r1 r2 = f !r1 !r2
 
+let swap a b =
+  let x = !a in
+  a := !b;
+  b := x
+
 let to_list r = [!r]
 let to_seq r yield = yield !r
 

src/core/CCRef.mli

@@ -31,6 +31,10 @@ val get_then_incr : int t -> int
 (** [get_then_incr r] increments [r] and returns its old value, think [r++]
     @since 0.17 *)
 
+val swap : 'a t -> 'a t -> unit
+(** Swap values.
+    @since 1.4 *)
+
 val compare : 'a ord -> 'a t ord
 
 val equal : 'a eq -> 'a t eq

src/core/CCString.cppo.ml

@@ -491,18 +491,28 @@ let repeat s n =
   init (len * n) (fun i -> s.[i mod len])
 
 let prefix ~pre s =
-  String.length pre <= String.length s &&
+  let len = String.length pre in
-  (let i = ref 0 in
+  if len > String.length s then false
-   while !i < String.length pre && s.[!i] = pre.[!i] do incr i done;
+  else (
-   !i = String.length pre
+    let rec check i =
+      if i=len then true
+      else if String.unsafe_get s i != String.unsafe_get pre i then false
+      else check (i+1)
+    in
+    check 0
   )
 
 let suffix ~suf s =
-  String.length suf <= String.length s &&
+  let len = String.length suf in
-  let off = String.length s - String.length suf in
+  if len > String.length s then false
-  (let i = ref 0 in
+  else (
-   while !i < String.length suf && s.[off + !i] = suf.[!i] do incr i done;
+    let off = String.length s - len in
-   !i = String.length suf
+    let rec check i =
+      if i=len then true
+      else if String.unsafe_get s (off+i) != String.unsafe_get suf i then false
+      else check (i+1)
+    in
+    check 0
   )
 
 let take n s =

src/core/CCString.mli

@@ -212,6 +212,10 @@ val prefix : pre:string -> string -> bool
   prefix ~pre:"aab" "aabcd"
   not (prefix ~pre:"ab" "aabcd")
   not (prefix ~pre:"abcd" "abc")
+  prefix ~pre:"abc" "abcde"
+  prefix ~pre:"" ""
+  prefix ~pre:"" "abc"
+  prefix ~pre:"abc" "abc"
 *)
 
 val suffix : suf:string -> string -> bool
@@ -220,6 +224,8 @@ val suffix : suf:string -> string -> bool
 
 (*$T
   suffix ~suf:"cd" "abcd"
+  suffix ~suf:"" ""
+  suffix ~suf:"" "abc"
   not (suffix ~suf:"cd" "abcde")
   not (suffix ~suf:"abcd" "cd")
 *)

src/core/CCVector.ml

@@ -67,14 +67,14 @@ let init n f = {
   vec=Array.init n f;
 }
 
-(* is the underlying empty? *)
+(* is the underlying array empty? *)
-let _empty_array v =
+let array_is_empty_ v =
   Array.length v.vec = 0
 
 (* assuming the underlying array isn't empty, resize it *)
-let _resize v newcapacity =
+let resize_ v newcapacity =
   assert (newcapacity >= v.size);
-  assert (not (_empty_array v));
+  assert (not (array_is_empty_ v));
   let new_vec = Array.make newcapacity v.vec.(0) in
   Array.blit v.vec 0 new_vec 0 v.size;
   v.vec <- new_vec;
@@ -86,38 +86,38 @@ let _resize v newcapacity =
 *)
 
 (* grow the array, using [x] as a filler if required *)
-let _grow v x =
+let grow_with_ v ~filler:x =
-  if _empty_array v
+  if array_is_empty_ v
   then v.vec <- Array.make 32 x
   else (
     let n = Array.length v.vec in
     let size = min (2 * n + 10) Sys.max_array_length in
     if size = n then failwith "vec: can't grow any further";
-    _resize v size
+    resize_ v size
   )
 
 (* v is not empty; ensure it has at least [size] slots.
 
    Use a doubling-size strategy so that calling many times [ensure] will
    behave well *)
-let ensure_not_empty_ v size =
+let ensure_assuming_not_empty_ v ~size =
   if size > Sys.max_array_length
   then failwith "vec.ensure: size too big"
   else (
     let n = ref (max 16 (Array.length v.vec)) in
     while !n < size do n := min Sys.max_array_length (2* !n) done;
-    _resize v !n
+    resize_ v !n
   )
 
 let ensure_with ~init v size =
   if Array.length v.vec = 0
   then v.vec <- Array.make size init
-  else ensure_not_empty_ v size
+  else ensure_assuming_not_empty_ v ~size
 
 let ensure v size =
   if Array.length v.vec = 0
   then ()
-  else ensure_not_empty_  v size
+  else ensure_assuming_not_empty_  v ~size
 
 let clear v =
   v.size <- 0
@@ -137,8 +137,7 @@ let push_unsafe_ v x =
   v.size <- v.size + 1
 
 let push v x =
-  if v.size = Array.length v.vec
+  if v.size = Array.length v.vec then grow_with_ v ~filler:x;
-  then _grow v x;
   push_unsafe_ v x
 
 (*$T
@@ -148,15 +147,14 @@ let push v x =
 
 (** Add all elements of b to a *)
 let append a b =
-  if _empty_array a
+  if array_is_empty_ a then (
-  then if _empty_array b
+    if array_is_empty_ b then ()
-    then ()
     else (
       a.vec <- Array.copy b.vec;
       a.size <- b.size
     )
-  else (
+  ) else (
-    ensure a (a.size + b.size);
+    ensure_assuming_not_empty_ a ~size:(a.size + b.size);
     assert (Array.length a.vec >= a.size + b.size);
     Array.blit b.vec 0 a.vec a.size b.size;
     a.size <- a.size + b.size
@@ -165,6 +163,14 @@ let append a b =
 (*$T
   let v1 = init 5 (fun i->i) and v2 = init 5 (fun i->i+5) in \
   append v1 v2; to_list v1 = CCList.(0--9)
+  let empty = create () and v2 = init 5 (fun i->i) in \
+  append empty v2; to_list empty = CCList.(0--4)
+  let v1 = init 5 (fun i->i) and empty = create () in \
+  append v1 empty; to_list v1 = CCList.(0--4)
+  let v = init 3 (fun i->i) in \
+  append v v; to_list v = [0; 1; 2; 0; 1; 2]
+  let empty = create () in \
+  append empty empty; to_list empty = []
 *)
 
 (*$R
@@ -197,13 +203,24 @@ let append_seq a seq =
 
 let append_array a b =
   let len_b = Array.length b in
-  ensure a (a.size + len_b);
+  if array_is_empty_ a then (
-  Array.blit b 0 a.vec a.size len_b;
+    a.vec <- Array.copy b;
-  a.size <- a.size + len_b
+    a.size <- len_b;
+  ) else (
+    ensure_assuming_not_empty_ a ~size:(a.size + len_b);
+    Array.blit b 0 a.vec a.size len_b;
+    a.size <- a.size + len_b
+  )
 
 (*$T
   let v1 = init 5 (fun i->i) and v2 = Array.init 5 (fun i->i+5) in \
   append_array v1 v2; to_list v1 = CCList.(0--9)
+  let empty = create () in \
+  append_array empty CCArray.(0--5); to_list empty = CCList.(0--5)
+  let v1 = init 5 (fun i->i) in \
+  append_array v1 [| |]; to_list v1 = CCList.(0--4)
+  let empty = create () in \
+  append_array empty [| |]; to_list empty = []
 *)
 
 let append_list a b = match b with
@@ -421,7 +438,7 @@ let iteri k v =
 *)
 
 let map f v =
-  if _empty_array v
+  if array_is_empty_ v
   then create ()
   else (
     let vec = Array.init v.size (fun i -> f (Array.unsafe_get v.vec i)) in
@@ -454,7 +471,7 @@ let filter' p v =
 *)
 
 let filter p v =
-  if _empty_array v
+  if array_is_empty_ v
   then create ()
   else (
     let v' = create_with ~capacity:v.size v.vec.(0) in

src/core/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: 2c23f3e7c83e14a0b87e7d6bb7df91bd)
+# DO NOT EDIT (digest: 3a776cf70f415cc6c1505c02b13044b5)
-version = "1.3"
+version = "1.4"
 description = "A modular standard library focused on data structures."
 requires = "bytes result"
 archive(byte) = "containers.cma"
@@ -9,7 +9,7 @@ archive(native) = "containers.cmxa"
 archive(native, plugin) = "containers.cmxs"
 exists_if = "containers.cma"
 package "unix" (
- version = "1.3"
+ version = "1.4"
  description = "A modular standard library focused on data structures."
  requires = "bytes result unix"
  archive(byte) = "containers_unix.cma"
@@ -20,7 +20,7 @@ package "unix" (
 )
 
 package "top" (
- version = "1.3"
+ version = "1.4"
  description = "A modular standard library focused on data structures."
  requires =
  "compiler-libs.common containers containers.data containers.unix containers.sexp containers.iter"
@@ -32,7 +32,7 @@ package "top" (
 )
 
 package "thread" (
- version = "1.3"
+ version = "1.4"
  description = "A modular standard library focused on data structures."
  requires = "containers threads"
  archive(byte) = "containers_thread.cma"
@@ -43,7 +43,7 @@ package "thread" (
 )
 
 package "sexp" (
- version = "1.3"
+ version = "1.4"
  description = "A modular standard library focused on data structures."
  requires = "bytes result"
  archive(byte) = "containers_sexp.cma"
@@ -54,7 +54,7 @@ package "sexp" (
 )
 
 package "iter" (
- version = "1.3"
+ version = "1.4"
  description = "A modular standard library focused on data structures."
  archive(byte) = "containers_iter.cma"
  archive(byte, plugin) = "containers_iter.cma"
@@ -64,7 +64,7 @@ package "iter" (
 )
 
 package "data" (
- version = "1.3"
+ version = "1.4"
  description = "A modular standard library focused on data structures."
  requires = "bytes"
  archive(byte) = "containers_data.cma"

src/data/CCFQueue.ml

@@ -131,7 +131,14 @@ 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"
+  );
   let rec aux acc q n =
     if n=0 || is_empty q then List.rev acc, q
     else
@@ -158,7 +165,7 @@ let take_front_while p q =
 
 let rec take_back_exn : 'a. 'a t -> 'a t * 'a
   = fun q -> match q with
-    | Shallow Zero -> invalid_arg "FQueue.take_back_exn"
+    | Shallow Zero -> raise Empty
     | Shallow (One x) -> empty, x
     | Shallow (Two (x,y)) -> _single x, y
     | Shallow (Three (x,y,z)) -> Shallow (Two(x,y)), z
@@ -182,7 +189,14 @@ 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"
+  );
   let rec aux acc q n =
     if n=0 || is_empty q then q, acc
     else

src/data/CCFQueue.mli

@@ -38,7 +38,8 @@ val take_front_exn : 'a t -> ('a * 'a t)
 
 val take_front_l : int -> 'a t -> 'a list * 'a t
 (** [take_front_l n q] takes at most [n] elements from the front
-    of [q], and returns them wrapped in a list *)
+    of [q], and returns them wrapped in a list
+    @raise Invalid_argument if n<0 *)
 
 val take_front_while : ('a -> bool) -> 'a t -> 'a list * 'a t
 
@@ -46,12 +47,15 @@ val take_back : 'a t -> ('a t * 'a) option
 (** Take last element *)
 
 val take_back_exn : 'a t -> ('a t * 'a)
+(** Same as {!take_back}, but fails on empty queues.
+    @raise Empty if the queue is empty *)
 
 val take_back_l : int -> 'a t -> 'a t * 'a list
 (** [take_back_l n q] removes and returns the last [n] elements of [q]. The
     elements are in the order of the queue, that is, the head of the returned
     list is the first element to appear via {!take_front}.
-    [take_back_l 2 (of_list [1;2;3;4]) = of_list [1;2], [3;4]] *)
+    [take_back_l 2 (of_list [1;2;3;4]) = of_list [1;2], [3;4]]
+    @raise Invalid_argument if n<0 *)
 
 val take_back_while : ('a -> bool) -> 'a t -> 'a t * 'a list
 

src/data/CCWBTree.ml

@@ -82,6 +82,12 @@ module type S = sig
   val nth_exn : int -> 'a t -> key * 'a
   (** @raise Not_found if the index is invalid *)
 
+  val get_rank : key -> 'a t -> [`At of int | `After of int | `First]
+  (** [get_rank k m] looks for the rank of [k] in [m], i.e. the index
+      of [k] in the sorted list of bindings of [m].
+      [let (`At n) = get_rank k m in nth_exn n m = get m k] should hold.
+      @since 1.4 *)
+
   val add : key -> 'a -> 'a t -> 'a t
 
   val remove : key -> 'a t -> 'a t
@@ -98,8 +104,14 @@ module type S = sig
   val fold : f:('b -> key -> 'a -> 'b) -> x:'b -> 'a t -> 'b
 
   val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t
+  (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys.
+      @since 0.17
+  *)
 
   val map : f:('a -> 'b) -> 'a t -> 'b t
+  (** Map values, giving only the value.
+      @since 0.17
+  *)
 
   val iter : f:(key -> 'a -> unit) -> 'a t -> unit
 
@@ -365,6 +377,28 @@ module MakeFull(K : KEY) : S with type key = K.t = struct
     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
+      | N (k', _, l, r, _) ->
+        match K.compare k k' with
+          | 0 -> `At (i + weight l)
+          | n when n<0 -> aux i k l
+          | _ -> aux (1 + weight l + i) k r
+    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, _) ->

src/data/CCWBTree.mli

@@ -47,6 +47,12 @@ module type S = sig
   val nth_exn : int -> 'a t -> key * 'a
   (** @raise Not_found if the index is invalid *)
 
+  val get_rank : key -> 'a t -> [`At of int | `After of int | `First]
+  (** [get_rank k m] looks for the rank of [k] in [m], i.e. the index
+      of [k] in the sorted list of bindings of [m].
+      [let (`At n) = get_rank k m in nth_exn n m = get m k] should hold.
+      @since 1.4 *)
+
   val add : key -> 'a -> 'a t -> 'a t
 
   val remove : key -> 'a t -> 'a t

src/threads/CCPool.ml

@@ -69,6 +69,8 @@ module Make(P : PARAM) = struct
 
   let incr_size_ p = p.cur_size <- p.cur_size + 1
   let decr_size_ p = p.cur_size <- p.cur_size - 1
+  let incr_idle_ p = p.cur_idle <- p.cur_idle + 1
+  let decr_idle_ p = p.cur_idle <- p.cur_idle - 1
 
   (* next thing a thread should do *)
   type command =
@@ -85,8 +87,7 @@ module Make(P : PARAM) = struct
       assert (pool.cur_size > 0);
       decr_size_ pool;
       Die
-    )
+    ) else if Queue.is_empty pool.jobs then Wait
-    else if Queue.is_empty pool.jobs then Wait
     else (
       let job = Queue.pop pool.jobs in
       Process job
@@ -94,6 +95,8 @@ module Make(P : PARAM) = struct
 
   (* Thread: entry point. They seek jobs in the queue *)
   let rec serve pool =
+    assert (pool.cur_size <= P.max_size);
+    assert (pool.cur_size > 0);
     let cmd = with_lock_ pool get_next_ in
     run_cmd cmd
 
@@ -101,7 +104,12 @@ module Make(P : PARAM) = struct
   and run_cmd = function
     | Die -> ()
     | Wait ->
-      with_lock_ pool (fun p -> Condition.wait p.cond p.mutex)
+      with_lock_ pool
+        (fun p ->
+           incr_idle_ pool;
+           Condition.wait p.cond p.mutex;
+           decr_idle_ pool);
+      serve pool
     | Process (Job1 (f, x)) ->
       begin try ignore (f x) with e -> pool.exn_handler e end; serve pool
     | Process (Job2 (f, x, y)) ->
@@ -116,6 +124,8 @@ module Make(P : PARAM) = struct
 
   (* launch the minimum required number of threads *)
   let () =
+    if P.min_size < 0 then invalid_arg "CCPool: min_size must be >= 0";
+    if P.min_size > P.max_size then invalid_arg "CCPool: min_size must be <= max_size";
     for _i = 1 to P.min_size do launch_worker_ pool done
 
   (* heuristic criterion for starting a new thread. *)
@@ -137,7 +147,7 @@ module Make(P : PARAM) = struct
          ) else (
            (* cannot start thread, push and wait for some worker to pick it up *)
            Queue.push job pool.jobs;
-           Condition.signal pool.cond; (* wake up *)
+           Condition.signal pool.cond; (* wake up some worker, if any *)
            (* might want to process in the background, if all threads are busy *)
            if pool.cur_idle = 0 && can_start_thread_ pool then (
              incr_size_ pool;
@@ -264,7 +274,7 @@ module Make(P : PARAM) = struct
           let l = List.rev_map (fun i ->
             Fut.make
               (fun () ->
-                Thread.delay 0.05;
+                Thread.delay 0.01;
                 1
             )) l in
           let l' = List.map Fut.get l in