Merge https://github.com/c-cube/ocaml-containers

.merlin

@@ -26,4 +26,5 @@ PKG bigarray
 PKG sequence
 PKG hamt
 PKG gen
+PKG qcheck
 FLG -w +a -w -4 -w -44

_oasis

@@ -80,7 +80,7 @@ Library "containers_data"
                     CCMixmap, CCRingBuffer, CCIntMap, CCPersistentArray,
                     CCMixset, CCHashconsedSet, CCGraph, CCHashSet, CCBitField,
                     CCHashTrie, CCBloom, CCWBTree, CCRAL, CCAllocCache,
-                    CCImmutArray
+                    CCImmutArray, CCHet
   BuildDepends:     bytes
   # BuildDepends:     bytes, bisect_ppx
   FindlibParent:    containers
@@ -155,7 +155,7 @@ Executable run_benchs
   CompiledObject:   best
   Build$:           flag(bench)
   MainIs:           run_benchs.ml
-  BuildDepends:     containers, containers.advanced,
+  BuildDepends:     containers, containers.advanced, qcheck,
                     containers.data, containers.string, containers.iter,
                     containers.thread, sequence, gen, benchmark, hamt
 
@@ -179,7 +179,7 @@ Executable run_qtest
                     containers.io, containers.advanced, containers.sexp,
                     containers.bigarray, containers.unix, containers.thread,
                     containers.data,
-                    sequence, gen, unix, oUnit, QTest2Lib
+                    sequence, gen, unix, oUnit, qcheck 
 
 Test all
   Command:      ./run_qtest.native

_tags

@@ -155,7 +155,7 @@ true: annot, bin_annot
 # OASIS_STOP
 <tests/*.ml{,i}>: thread
 <src/threads/*.ml{,i}>: thread
-<src/core/CCVector.cmx>: inline(25)
+<src/core/CCVector.cmx> or <src/core/CCString.cmx>: inline(25)
 <src/data/CCFlatHashtbl.cm*> or <src/data/CCHashTrie.cm*> or <src/data/CCPersistent*>: inline(15)
 <src/**/*.ml> and not <src/misc/*.ml>: warn_A, warn(-4), warn(-44)
 true: no_alias_deps, safe_string, short_paths

benchs/run_benchs.ml

@@ -42,14 +42,24 @@ module L = struct
     else if x mod 5 = 1 then [x;x+1]
     else [x;x+1;x+2;x+3]
 
+  let f_ral_ x =
+    if x mod 10 = 0 then CCRAL.empty
+    else if x mod 5 = 1 then CCRAL.of_list [x;x+1]
+    else CCRAL.of_list [x;x+1;x+2;x+3]
+
   let bench_flat_map ?(time=2) n =
     let l = CCList.(1 -- n) in
-    let flatten_map_ l = List.flatten (CCList.map f_ l)
+    let ral = CCRAL.of_list l in
-    and flatten_ccmap_ l = List.flatten (List.map f_ l) in
+    let flatten_map_ l () = ignore @@ List.flatten (CCList.map f_ l)
+    and flatmap l () = ignore @@ CCList.flat_map f_ l
+    and flatten_ccmap_ l () = ignore @@ List.flatten (List.map f_ l)
+    and flatmap_ral_ l () = ignore @@ CCRAL.flat_map f_ral_ l
+    in
     B.throughputN time ~repeat
-      [ "flat_map", CCList.flat_map f_, l
+      [ "flat_map", flatmap l, ()
-      ; "flatten o CCList.map", flatten_ccmap_, l
+      ; "flatten o CCList.map", flatten_ccmap_ l, ()
-      ; "flatten o map", flatten_map_, l
+      ; "flatten o map", flatten_map_ l, ()
+      ; "ral_flatmap", flatmap_ral_ ral, ()
       ]
 
   (* APPEND *)
@@ -87,6 +97,21 @@ module L = struct
       ; "CCList.(fold_right append)", cc_fold_right_append_, l
       ]
 
+  (* RANDOM ACCESS *)
+
+  let bench_nth ?(time=2) n =
+    let l = CCList.(1 -- n) in
+    let ral = CCRAL.of_list l in
+    let bench_list l () =
+      for i = 0 to n-1 do ignore (List.nth l i) done
+    and bench_ral l () =
+      for i = 0 to n-1 do ignore (CCRAL.get_exn l i) done
+    in
+    B.throughputN time ~repeat
+      [ "List.nth", bench_list l, ()
+      ; "RAL.get", bench_ral ral, ()
+      ]
+
   (* MAIN *)
 
   let () = B.Tree.register (
@@ -112,6 +137,11 @@ module L = struct
           [ app_int (bench_append ~time:2) 100
           ; app_int (bench_append ~time:2) 10_000
           ; app_int (bench_append ~time:4) 100_000]
+      ; "nth" @>>
+        B.Tree.concat
+          [ app_int (bench_nth ~time:2) 100
+          ; app_int (bench_nth ~time:2) 10_000
+          ; app_int (bench_nth ~time:4) 100_000]
       ]
     )
 end
@@ -1081,7 +1111,6 @@ module Thread = struct
 end
 
 module Graph = struct
-
   (* divisors graph *)
   let div_children_ i =
     (* divisors of [i] that are [>= j] *)
@@ -1155,6 +1184,140 @@ module Graph = struct
     )
 end
 
+module Str = struct
+  (* random string, but always returns the same for a given size *)
+  let rand_str_ ?(among="abcdefgh") n =
+    let module Q = QCheck in
+    let st = Random.State.make [| n + 17 |] in
+    let gen_c = QCheck.Gen.oneofl (CCString.to_list among) in
+    QCheck.Gen.string_size ~gen:gen_c (QCheck.Gen.return n) st
+
+  let find ?(start=0) ~sub s =
+    let n = String.length sub in
+    let i = ref start in
+    try
+      while !i + n <= String.length s do
+        if CCString.is_sub ~sub 0 s !i ~len:n then raise Exit;
+        incr i
+      done;
+      -1
+    with Exit ->
+      !i
+
+  let rfind ~sub s =
+    let n = String.length sub in
+    let i = ref (String.length s - n) in
+    try
+      while !i >= 0 do
+        if CCString.is_sub ~sub 0 s !i ~len:n then raise Exit;
+        decr i
+      done;
+      ~-1
+    with Exit ->
+      !i
+
+  let find_all ?(start=0) ~sub s =
+    let i = ref start in
+    fun () ->
+      let res = find ~sub s ~start:!i in
+      if res = ~-1 then None
+      else (
+        i := res + 1;
+        Some res
+      )
+
+  let find_all_l ?start ~sub s = find_all ?start ~sub s |> Gen.to_list
+
+  let pp_pb needle haystack =
+    Format.printf "search needle `%s` in `%s`...@."
+      needle (String.sub haystack 0 (min 300 (String.length haystack)))
+
+  (* benchmark String.{,r}find *)
+  let bench_find_ ~dir ~size n =
+    let needle = rand_str_ size in
+    let haystack = rand_str_ n in
+    pp_pb needle haystack;
+    let mk_naive = match dir with
+      | `Direct -> fun () -> find ~sub:needle haystack
+      | `Reverse -> fun () -> rfind ~sub:needle haystack
+    and mk_current = match dir with
+      | `Direct -> fun () -> CCString.find ~sub:needle haystack
+      | `Reverse -> fun () -> CCString.rfind ~sub:needle haystack
+    and mk_current_compiled = match dir with
+      | `Direct -> let f = CCString.find ~start:0 ~sub:needle in fun () -> f haystack
+      | `Reverse -> let f = CCString.rfind ~sub:needle in fun () -> f haystack
+    in
+    assert (mk_naive () = mk_current ());
+    B.throughputN 3 ~repeat
+      [ "naive", mk_naive, ()
+      ; "current", mk_current, ()
+      ; "current_compiled", mk_current_compiled, ()
+      ]
+
+  (* benchmark String.find_all *)
+  let bench_find_all ~size n =
+    let needle = rand_str_ size in
+    let haystack = rand_str_ n in
+    pp_pb needle haystack;
+    let mk_naive () = find_all_l ~sub:needle haystack
+    and mk_current () = CCString.find_all_l ~sub:needle haystack
+    and mk_current_compiled =
+      let f = CCString.find_all_l ~start:0 ~sub:needle in fun () -> f haystack in
+    assert (mk_naive () = mk_current ());
+    B.throughputN 3 ~repeat
+      [ "naive", mk_naive, ()
+      ; "current", mk_current, ()
+      ; "current_compiled", mk_current_compiled, ()
+      ]
+
+  (* benchmark String.find_all on constant strings *)
+  let bench_find_all_special ~size n =
+    let needle = CCString.repeat "a" (size-1) ^ "b" in
+    let haystack = CCString.repeat "a" n in
+    pp_pb needle haystack;
+    let mk_naive () = find_all_l ~sub:needle haystack
+    and mk_current () = CCString.find_all_l ~sub:needle haystack in
+    assert (mk_naive () = mk_current ());
+    B.throughputN 3 ~repeat
+      [ "naive", mk_naive, ()
+      ; "current", mk_current, ()
+      ]
+
+  let bench_find  = bench_find_ ~dir:`Direct
+  let bench_rfind  = bench_find_ ~dir:`Reverse
+
+  let () = B.Tree.register (
+    "string" @>>>
+      [ "find" @>>>
+          [ "3" @>> app_ints (bench_find ~size:3) [100; 100_000; 500_000]
+          ; "5" @>> app_ints (bench_find ~size:5) [100; 100_000; 500_000]
+          ; "15" @>> app_ints (bench_find ~size:15) [100; 100_000; 500_000]
+          ; "50" @>> app_ints (bench_find ~size:50) [100; 100_000; 500_000]
+          ; "500" @>> app_ints (bench_find ~size:500) [100_000; 500_000]
+          ];
+        "find_all" @>>>
+          [ "1" @>> app_ints (bench_find_all ~size:1) [100; 100_000; 500_000]
+          ; "3" @>> app_ints (bench_find_all ~size:3) [100; 100_000; 500_000]
+          ; "5" @>> app_ints (bench_find_all ~size:5) [100; 100_000; 500_000]
+          ; "15" @>> app_ints (bench_find_all ~size:15) [100; 100_000; 500_000]
+          ; "50" @>> app_ints (bench_find_all ~size:50) [100; 100_000; 500_000]
+          ; "500" @>> app_ints (bench_find_all ~size:500) [100_000; 500_000]
+          ; "special" @>>>
+            [ "6" @>> app_ints (bench_find_all_special ~size:6) [100_000; 500_000]
+            ; "30" @>> app_ints (bench_find_all_special ~size:30) [100_000; 500_000]
+            ; "100" @>> app_ints (bench_find_all_special ~size:100) [100_000; 500_000]
+            ]
+          ];
+        "rfind" @>>>
+          [ "3" @>> app_ints (bench_rfind ~size:3) [100; 100_000; 500_000]
+          ; "15" @>> app_ints (bench_rfind ~size:15) [100; 100_000; 500_000]
+          ; "50" @>> app_ints (bench_rfind ~size:50) [100; 100_000; 500_000]
+          ; "500" @>> app_ints (bench_rfind ~size:500) [100_000; 500_000]
+          ];
+      ])
+
+end
+
 module Alloc = struct
   module type ALLOC_ARR = sig
     type 'a t

doc/build_deps.ml

@@ -1,5 +1,8 @@
 #!/usr/bin/env ocaml
 
+(* note: this requires to generate documentation first, so that
+   .odoc files are generated *)
+
 #use "topfind";;
 #require "containers";;
 #require "containers.io";;

src/core/CCArray.ml

@@ -443,6 +443,28 @@ let (--) i j =
   else
     Array.init (i-j+1) (fun k -> i-k)
 
+(*$T
+  (1 -- 4) |> Array.to_list = [1;2;3;4]
+  (4 -- 1) |> Array.to_list = [4;3;2;1]
+  (0 -- 0) |> Array.to_list = [0]
+*)
+
+(*$Q
+  Q.(pair small_int small_int) (fun (a,b) -> \
+    (a -- b) |> Array.to_list = CCList.(a -- b))
+*)
+
+let (--^) i j =
+  if i=j then [| |]
+  else if i>j
+    then Array.init (i-j) (fun k -> i-k)
+    else Array.init (j-i) (fun k -> i+k)
+
+(*$Q
+  Q.(pair small_int small_int) (fun (a,b) -> \
+    (a --^ b) |> Array.to_list = CCList.(a --^ b))
+*)
+
 (** all the elements of a, but the i-th, into a list *)
 let except_idx a i =
   foldi

src/core/CCArray.mli

@@ -166,6 +166,10 @@ val except_idx : 'a t -> int -> 'a list
 val (--) : int -> int -> int t
 (** Range array *)
 
+val (--^) : int -> int -> int t
+(** Range array, excluding right bound
+    @since NEXT_RELEASE *)
+
 val random : 'a random_gen -> 'a t random_gen
 val random_non_empty : 'a random_gen -> 'a t random_gen
 val random_len : int -> 'a random_gen -> 'a t random_gen

src/core/CCIO.ml

@@ -49,15 +49,18 @@ let gen_flat_map f next_elem =
   in
   next
 
+let finally_ f x ~h =
+  try
+    let res = f x in
+    h x;
+    res
+  with e ->
+    h x;
+    raise e
+
 let with_in ?(mode=0o644) ?(flags=[Open_text]) filename f =
   let ic = open_in_gen (Open_rdonly::flags) mode filename in
-  try
+  finally_ f ic ~h:close_in
-    let x = f ic in
-    close_in ic;
-    x
-  with e ->
-    close_in ic;
-    raise e
 
 let read_chunks ?(size=1024) ic =
   let buf = Bytes.create size in
@@ -139,13 +142,7 @@ let read_all ?(size=1024) ic = read_all_ ~op:Ret_string ~size ic
 
 let with_out ?(mode=0o644) ?(flags=[Open_creat; Open_trunc; Open_text]) filename f =
   let oc = open_out_gen (Open_wronly::flags) mode filename in
-  try
+  finally_ f oc ~h:close_out
-    let x = f oc in
-    close_out oc;
-    x
-  with e ->
-    close_out oc;
-    raise e
 
 let with_out_a ?mode ?(flags=[]) filename f =
   with_out ?mode ~flags:(Open_wronly::Open_creat::Open_append::flags) filename f
@@ -323,8 +320,8 @@ module File = struct
       gen_filter_map
         (function
           | `File, f -> Some f
-          | `Dir, _ -> None
+          | `Dir, _ -> None)
-        ) (walk d)
+        (walk d)
     else read_dir_base d
 
   let show_walk_item (i,f) =
@@ -332,4 +329,8 @@ module File = struct
       | `File -> "file:"
       | `Dir -> "dir:"
     ) ^ f
+
+  let with_temp ?temp_dir ~prefix ~suffix f =
+    let name = Filename.temp_file ?temp_dir prefix suffix in
+    finally_ f name ~h:remove_noerr
 end

src/core/CCIO.mli

@@ -195,4 +195,14 @@ module File : sig
       symlinks, etc.) *)
 
   val show_walk_item : walk_item -> string
+
+  val with_temp :
+    ?temp_dir:string -> prefix:string -> suffix:string ->
+    (string -> 'a) -> 'a
+  (** [with_temp ~prefix ~suffix f] will call [f] with the name of a new
+      temporary file (located in [temp_dir]).
+      After [f] returns, the file is deleted. Best to be used in
+      combination with {!with_out}.
+      See {!Filename.temp_file}
+      @since NEXT_RELEASE *)
 end

src/core/CCList.ml

@@ -174,6 +174,21 @@ let fold_map2 f acc l1 l2 =
    with Invalid_argument _ -> true)
 *)
 
+let fold_filter_map f acc l =
+  let rec aux f acc map_acc l = match l with
+    | [] -> acc, List.rev map_acc
+    | x :: l' ->
+        let acc, y = f acc x in
+        aux f acc (cons_maybe y map_acc) l'
+  in
+  aux f acc [] l
+
+(*$= & ~printer:Q.Print.(pair int (list int))
+  (List.fold_left (+) 0 (1--10), [2;4;6;8;10]) \
+  (fold_filter_map (fun acc x -> acc+x, if x mod 2 = 0 then Some x else None) \
+    0 (1--10))
+*)
+
 let fold_flat_map f acc l =
   let rec aux f acc map_acc l = match l with
     | [] -> acc, List.rev map_acc
@@ -763,11 +778,18 @@ let range' i j =
 
 let (--) = range
 
+let (--^) = range'
+
 (*$T
   append (range 0 100) (range 101 1000) = range 0 1000
   append (range 1000 501) (range 500 0) = range 1000 0
 *)
 
+(*$Q
+  Q.(pair small_int small_int) (fun (a,b) -> \
+    let l = (a--^b) in not (List.mem b l))
+*)
+
 let replicate i x =
   let rec aux acc i =
     if i = 0 then acc
@@ -1103,6 +1125,7 @@ module Infix = struct
   let (<$>) = (<$>)
   let (>>=) = (>>=)
   let (--) = (--)
+  let (--^) = (--^)
 end
 
 (** {2 IO} *)

src/core/CCList.mli

@@ -53,6 +53,11 @@ val fold_map2 : ('acc -> 'a -> 'b -> 'acc * 'c) -> 'acc -> 'a list -> 'b list ->
     @raise Invalid_argument if the lists do not have the same length
     @since 0.16 *)
 
+val fold_filter_map : ('acc -> 'a -> 'acc * 'b option) -> 'acc -> 'a list -> 'acc * 'b list
+(** [fold_filter_map f acc l] is a [fold_left]-like function, but also
+    generates a list of output in a way similar to {!filter_map}
+    @since NEXT_RELEASE *)
+
 val fold_flat_map : ('acc -> 'a -> 'acc * 'b list) -> 'acc -> 'a list -> 'acc * 'b list
 (** [fold_flat_map f acc l] is a [fold_left]-like function, but it also maps the
     list to a list of lists that is then [flatten]'d..
@@ -263,6 +268,10 @@ val range' : int -> int -> int t
 val (--) : int -> int -> int t
 (** Infix alias for [range] *)
 
+val (--^) : int -> int -> int t
+(** Infix alias for [range']
+    @since NEXT_RELEASE *)
+
 val replicate : int -> 'a -> 'a t
 (** Replicate the given element [n] times *)
 
@@ -482,6 +491,9 @@ module Infix : sig
   val (<$>) : ('a -> 'b) -> 'a t -> 'b t
   val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
   val (--) : int -> int -> int t
+
+  val (--^) : int -> int -> int t
+  (** @since NEXT_RELEASE *)
 end
 
 (** {2 IO} *)

src/core/CCMap.ml

@@ -24,6 +24,12 @@ module type S = sig
       [k] is removed from [m], and if the result is [Some v'] then
       [add k v' m] is returned. *)
 
+  val merge_safe :
+    f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) ->
+    'a t -> 'b t -> 'c t
+  (** [merge_safe ~f a b] merges the maps [a] and [b] together.
+      @since NEXT_RELEASE *)
+
   val of_seq : (key * 'a) sequence -> 'a t
 
   val add_seq : 'a t -> (key * 'a) sequence -> 'a t
@@ -75,6 +81,15 @@ module Make(O : Map.OrderedType) = struct
     | None -> remove k m
     | Some v' -> add k v' m
 
+  let merge_safe ~f a b =
+    merge
+      (fun k v1 v2 -> match v1, v2 with
+         | None, None -> assert false
+         | Some v1, None -> f k (`Left v1)
+         | None, Some v2 -> f k (`Right v2)
+         | Some v1, Some v2 -> f k (`Both (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

@@ -27,6 +27,12 @@ module type S = sig
       [k] is removed from [m], and if the result is [Some v'] then
       [add k v' m] is returned. *)
 
+  val merge_safe :
+    f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) ->
+    'a t -> 'b t -> 'c t
+  (** [merge_safe ~f a b] merges the maps [a] and [b] together.
+      @since NEXT_RELEASE *)
+
   val of_seq : (key * 'a) sequence -> 'a t
 
   val add_seq : 'a t -> (key * 'a) sequence -> 'a t

src/core/CCRandom.ml

@@ -213,5 +213,5 @@ let uniformity_test ?(size_hint=10) k rng st =
   Hashtbl.fold predicate histogram true
 
 (*$T split_list
-  run ~st:(Runner.random_state()) ( uniformity_test 50_000 (split_list 10 ~len:3) )
+  run ~st:(QCheck_runner.random_state()) ( uniformity_test 50_000 (split_list 10 ~len:3) )
 *)

src/core/CCString.cppo.ml

@@ -50,6 +50,10 @@ let init n f =
 
 let length = String.length
 
+let rev s =
+  let n = length s in
+  init n (fun i -> s.[n-i-1])
+
 let rec _to_list s acc i len =
   if len=0 then List.rev acc
   else _to_list s (s.[i]::acc) (i+1) (len-1)
@@ -66,32 +70,197 @@ let is_sub ~sub i s j ~len =
   if i+len > String.length sub then invalid_arg "CCString.is_sub";
   _is_sub ~sub i s j ~len
 
-(* note: inefficient *)
+type _ direction =
-let find ?(start=0) ~sub s =
+  | Direct : [`Direct] direction
-  let n = String.length sub in
+  | Reverse : [`Reverse] direction
-  let i = ref start in
+
-  try
+(* we follow https://en.wikipedia.org/wiki/Knuth–Morris–Pratt_algorithm *)
-    while !i + n <= String.length s do
+module Find = struct
-      if _is_sub ~sub 0 s !i ~len:n then raise Exit;
+  type 'a kmp_pattern = {
-      incr i
+    failure : int array;
+    str : string;
+  }
+  (* invariant: [length failure = length str].
+   We use a phantom type to avoid mixing the directions. *)
+
+  let kmp_pattern_length p = String.length p.str
+
+  (* access the [i]-th element of [s] according to direction [dir] *)
+  let get_
+    : type a. dir:a direction -> string -> int -> char
+    = fun ~dir -> match dir with
+    | Direct -> String.get
+    | Reverse -> (fun s i -> s.[String.length s - i - 1])
+
+  let kmp_compile_
+  : type a. dir:a direction -> string -> a kmp_pattern
+  = fun ~dir str ->
+    let len = length str in
+    let get = get_ ~dir in (* how to read elements of the string *)
+    match len with
+    | 0 -> {failure=[| |]; str;}
+    | 1 -> {failure=[| -1 |]; str;}
+    | _ ->
+      (* at least 2 elements, the algorithm can work *)
+      let failure = Array.make len 0 in
+      failure.(0) <- -1;
+      (* i: current index in str *)
+      let i = ref 2 in
+      (* j: index of candidate substring *)
+      let j = ref 0 in
+      while !i < len do
+        match !j with
+        | _ when get str (!i-1) = get str !j ->
+          (* substring starting at !j continues matching current char *)
+          incr j;
+          failure.(!i) <- !j;
+          incr i;
+        | 0 ->
+          (* back to the beginning *)
+          failure.(!i) <- 0;
+          incr i;
+        | _ ->
+          (* fallback for the prefix string *)
+          assert (!j > 0);
+          j := failure.(!j)
       done;
-    -1
+      (* Format.printf "{@[failure:%a, str:%s@]}@." CCFormat.(array int) failure str; *)
-  with Exit ->
+      { failure; str; }
-    !i
+
+  let kmp_compile s = kmp_compile_ ~dir:Direct s
+  let kmp_rcompile s = kmp_compile_ ~dir:Reverse s
+
+  (* proper search function.
+    [i] index in [s]
+    [j] index in [pattern]
+    [len] length of [s] *)
+  let kmp_find ~pattern s idx =
+    let len = length s in
+    let i = ref idx in
+    let j = ref 0 in
+    let pat_len = kmp_pattern_length pattern in
+    while !j < pat_len && !i + !j < len do
+      let c = String.get s (!i + !j) in
+      let expected = String.get pattern.str !j in
+      if c = expected
+      then (
+        (* char matches *)
+        incr j;
+      ) else (
+        let fail_offset = pattern.failure.(!j) in
+        if fail_offset >= 0
+        then (
+          assert (fail_offset < !j);
+          (* follow the failure link *)
+          i := !i + !j - fail_offset;
+          j := fail_offset
+        ) else (
+          (* beginning of pattern *)
+          j := 0;
+          incr i
+        )
+      )
+    done;
+    if !j = pat_len
+    then !i
+    else -1
+
+  (* proper search function, from the right.
+    [i] index in [s]
+    [j] index in [pattern]
+    [len] length of [s] *)
+  let kmp_rfind ~pattern s idx =
+    let len = length s in
+    let i = ref (len - idx - 1) in
+    let j = ref 0 in
+    let pat_len = kmp_pattern_length pattern in
+    while !j < pat_len && !i + !j < len do
+      let c = String.get s (len - !i - !j - 1) in
+      let expected = String.get pattern.str (String.length pattern.str - !j - 1) in
+      if c = expected
+      then (
+        (* char matches *)
+        incr j;
+      ) else (
+        let fail_offset = pattern.failure.(!j) in
+        if fail_offset >= 0
+        then (
+          assert (fail_offset < !j);
+          (* follow the failure link *)
+          i := !i + !j - fail_offset;
+          j := fail_offset
+        ) else (
+          (* beginning of pattern *)
+          j := 0;
+          incr i
+        )
+      )
+    done;
+    (* adjust result: first, [res = string.length s - res -1] to convert
+       back to real indices; then, what we got is actually the position
+       of the end of the pattern, so we subtract the [length of the pattern -1]
+       to obtain the real result. *)
+    if !j = pat_len
+    then len - !i - kmp_pattern_length pattern
+    else -1
+
+  type 'a pattern =
+    | P_char of char
+    | P_KMP of 'a kmp_pattern
+
+  let pattern_length = function
+    | P_char _ -> 1
+    | P_KMP p -> kmp_pattern_length p
+
+  let compile ~sub : [`Direct] pattern =
+    if length sub=1
+    then P_char sub.[0]
+    else P_KMP (kmp_compile sub)
+
+  let rcompile ~sub : [`Reverse] pattern =
+    if length sub=1
+    then P_char sub.[0]
+    else P_KMP (kmp_rcompile sub)
+
+  let find ~pattern s start = match pattern with
+    | P_char c ->
+        (try String.index_from s start c with Not_found -> -1)
+    | P_KMP pattern -> kmp_find ~pattern s start
+
+  let rfind ~pattern s start = match pattern with
+    | P_char c ->
+        (try String.rindex_from s start c with Not_found -> -1)
+    | P_KMP pattern -> kmp_rfind ~pattern s start
+end
+
+let find ?(start=0) ~sub =
+  let pattern = Find.compile ~sub in
+  fun s -> Find.find ~pattern s start
+
+let find_all ?(start=0) ~sub =
+  let pattern = Find.compile ~sub in
+  fun s ->
+    let i = ref start in
+    fun () ->
+      let res = Find.find ~pattern s !i in
+      if res = ~-1 then None
+      else (
+        i := res + 1; (* possible overlap *)
+        Some res
+      )
+
+let find_all_l ?start ~sub s =
+  let rec aux acc g = match g () with
+    | None -> List.rev acc
+    | Some i -> aux (i::acc) g
+  in
+  aux [] (find_all ?start ~sub s)
 
 let mem ?start ~sub s = find ?start ~sub s >= 0
 
-let rfind ~sub s =
+let rfind ~sub =
-  let n = String.length sub in
+  let pattern = Find.rcompile ~sub in
-  let i = ref (String.length s - n) in
+  fun s -> Find.rfind ~pattern s (String.length s-1)
-  try
-    while !i >= 0 do
-      if _is_sub ~sub 0 s !i ~len:n then raise Exit;
-      decr i
-    done;
-    ~-1
-  with Exit ->
-    !i
 
 (* Replace substring [s.[pos]....s.[pos+len-1]] by [by] in [s] *)
 let replace_at_ ~pos ~len ~by s =
@@ -105,16 +274,18 @@ let replace ?(which=`All) ~sub ~by s =
   if sub="" then invalid_arg "CCString.replace";
   match which with
   | `Left ->
-      let i = find ~sub s in
+      let i = find ~sub s ~start:0 in
       if i>=0 then replace_at_ ~pos:i ~len:(String.length sub) ~by s else s
   | `Right ->
       let i = rfind ~sub s in
       if i>=0 then replace_at_ ~pos:i ~len:(String.length sub) ~by s else s
   | `All ->
+      (* compile search pattern only once *)
+      let pattern = Find.compile ~sub in
       let b = Buffer.create (String.length s) in
       let start = ref 0 in
       while !start < String.length s do
-        let i = find ~start:!start ~sub s in
+        let i = Find.find ~pattern s !start in
         if i>=0 then (
           (* between last and cur occurrences *)
           Buffer.add_substring b s !start (i- !start);
@@ -133,29 +304,20 @@ module Split = struct
     | SplitStop
     | SplitAt of int (* previous *)
 
-  (* [by_j... prefix of s_i...] ? *)
-  let rec _is_prefix ~by s i j =
-    j = String.length by
-    ||
-    ( i < String.length s &&
-      s.[i] = by.[j] &&
-      _is_prefix ~by s (i+1) (j+1)
-    )
-
   let rec _split ~by s state = match state with
     | SplitStop -> None
-    | SplitAt prev -> _split_search ~by s prev prev
+    | SplitAt prev -> _split_search ~by s prev
-  and _split_search ~by s prev i =
+  and _split_search ~by s prev =
-    if i >= String.length s
+    let j = Find.find ~pattern:by s prev in
+    if j < 0
       then Some (SplitStop, prev, String.length s - prev)
-      else if _is_prefix ~by s i 0
+      else Some (SplitAt (j+Find.pattern_length by), prev, j-prev)
-        then Some (SplitAt (i+String.length by), prev, i-prev)
-      else _split_search ~by s prev (i+1)
 
   let _tuple3 x y z = x,y,z
 
   let _mkgen ~by s k =
     let state = ref (SplitAt 0) in
+    let by = Find.compile ~sub:by in
     fun () ->
       match _split ~by s !state with
         | None -> None
@@ -168,6 +330,7 @@ module Split = struct
   let gen_cpy ~by s = _mkgen ~by s String.sub
 
   let _mklist ~by s k =
+    let by = Find.compile ~sub:by in
     let rec build acc state = match _split ~by s state with
       | None -> List.rev acc
       | Some (state', i, len) ->
@@ -180,6 +343,7 @@ module Split = struct
   let list_cpy ~by s = _mklist ~by s String.sub
 
   let _mkklist ~by s k =
+    let by = Find.compile ~sub:by in
     let rec make state () = match _split ~by s state with
       | None -> `Nil
       | Some (state', i, len) ->
@@ -191,6 +355,7 @@ module Split = struct
   let klist_cpy ~by s = _mkklist ~by s String.sub
 
   let _mkseq ~by s f k =
+    let by = Find.compile ~sub:by in
     let rec aux state = match _split ~by s state with
       | None -> ()
       | Some (state', i, len) -> k (f s i len); aux state'
@@ -259,6 +424,27 @@ let suffix ~suf s =
     !i = String.length suf
   )
 
+let take n s =
+  if n < String.length s
+  then String.sub s 0 n
+  else s
+
+let drop n s =
+  if n < String.length s
+  then String.sub s n (String.length s - n)
+  else ""
+
+let take_drop n s = take n s, drop n s
+
+let chop_suffix ~suf s =
+  if suffix ~suf s
+  then Some (String.sub s 0 (String.length s-String.length suf))
+  else None
+
+let chop_prefix ~pre s =
+  if prefix ~pre s
+  then Some (String.sub s (String.length pre) (String.length s-String.length pre))
+  else None
 
 let blit = String.blit
 
@@ -268,6 +454,15 @@ let fold f acc s =
     else fold_rec f (f acc s.[i]) s (i+1)
   in fold_rec f acc s 0
 
+let pad ?(side=`Left) ?(c=' ') n s =
+  let len_s = String.length s in
+  if len_s >= n then s
+  else
+    let pad_len = n - len_s in
+    match side with
+      | `Left -> init n (fun i -> if i < pad_len then c else s.[i-pad_len])
+      | `Right -> init n (fun i -> if i < len_s then s.[i] else c)
+
 let _to_gen s i0 len =
   let i = ref i0 in
   fun () ->
@@ -373,6 +568,22 @@ let mapi f s = init (length s) (fun i -> f i s.[i])
 
 #endif
 
+let filter_map f s =
+  let buf = Buffer.create (String.length s) in
+  iter
+    (fun c -> match f c with
+       | None -> ()
+       | Some c' -> Buffer.add_char buf c')
+    s;
+  Buffer.contents buf
+
+let filter f s =
+  let buf = Buffer.create (String.length s) in
+  iter
+    (fun c -> if f c then Buffer.add_char buf c)
+    s;
+  Buffer.contents buf
+
 let flat_map ?sep f s =
   let buf = Buffer.create (String.length s) in
   iteri

src/core/CCString.mli

@@ -63,6 +63,37 @@ val init : int -> (int -> char) -> string
   init 0 (fun _ -> assert false) = ""
 *)
 
+val rev : string -> string
+(** [rev s] returns the reverse of [s]
+    @since NEXT_RELEASE *)
+
+(*$Q
+  Q.printable_string (fun s -> s = rev (rev s))
+  Q.printable_string (fun s -> length s = length (rev s))
+*)
+
+(*$=
+  "abc" (rev "cba")
+  "" (rev "")
+  " " (rev " ")
+*)
+
+val pad : ?side:[`Left|`Right] -> ?c:char -> int -> string -> string
+(** [pad n str] ensures that [str] is at least [n] bytes long,
+    and pads it on the [side] with [c] if it's not the case.
+    @param side determines where padding occurs (default: [`Left])
+    @param c the char used to pad (default: ' ')
+    @since NEXT_RELEASE *)
+
+(*$= & ~printer:Q.Print.string
+  "  42" (pad 4 "42")
+  "0042" (pad ~c:'0' 4 "42")
+  "4200" (pad ~side:`Right ~c:'0' 4 "42")
+  "hello" (pad 4 "hello")
+  "aaa" (pad ~c:'a' 3 "")
+  "aaa" (pad ~side:`Right ~c:'a' 3 "")
+*)
+
 val of_gen : char gen -> string
 val of_seq : char sequence -> string
 val of_klist : char klist -> string
@@ -81,10 +112,35 @@ val find : ?start:int -> sub:string -> string -> int
     Should only be used with very small [sub] *)
 
 (*$= & ~printer:string_of_int
-  (find ~sub:"bc" "abcd") 1
+  1 (find ~sub:"bc" "abcd")
-  (find ~sub:"bc" "abd") ~-1
+  ~-1 (find ~sub:"bc" "abd")
-  (find ~sub:"a" "_a_a_a_") 1
+  1 (find ~sub:"a" "_a_a_a_")
-  (find ~sub:"a" ~start:5 "a1a234a") 6
+  6 (find ~sub:"a" ~start:5 "a1a234a")
+*)
+
+(*$Q & ~count:10_000
+  Q.(pair printable_string printable_string) (fun (s1,s2) -> \
+    let i = find ~sub:s2 s1 in \
+    i < 0 || String.sub s1 i (length s2) = s2)
+*)
+
+val find_all : ?start:int -> sub:string -> string -> int gen
+(** [find_all ~sub s] finds all occurrences of [sub] in [s], even overlapping
+    instances.
+    @param start starting position in [s]
+    @since NEXT_RELEASE *)
+
+val find_all_l : ?start:int -> sub:string -> string -> int list
+(** [find_all ~sub s] finds all occurrences of [sub] in [s] and returns
+    them in a list
+    @param start starting position in [s]
+    @since NEXT_RELEASE *)
+
+(*$= & ~printer:Q.Print.(list int)
+  [1; 6] (find_all_l ~sub:"bc" "abc aabc  aab")
+  [] (find_all_l ~sub:"bc" "abd")
+  [76] (find_all_l ~sub:"aaaaaa" \
+    "aabbaabbaaaaabbbbabababababbbbabbbabbaaababbbaaabaabbaabbaaaabbababaaaabbaabaaaaaabbbaaaabababaabaaabbaabaaaabbababbaabbaaabaabbabababbbaabababaaabaaababbbaaaabbbaabaaababbabaababbaabbaaaaabababbabaababbbaaabbabbabababaaaabaaababaaaaabbabbaabbabbbbbbbbbbbbbbaabbabbbbbabbaaabbabbbbabaaaaabbababbbaaaa")
 *)
 
 val mem : ?start:int -> sub:string -> string -> bool
@@ -102,11 +158,17 @@ val rfind : sub:string -> string -> int
     @since 0.12 *)
 
 (*$= & ~printer:string_of_int
-  (rfind ~sub:"bc" "abcd") 1
+  1 (rfind ~sub:"bc" "abcd")
-  (rfind ~sub:"bc" "abd") ~-1
+  ~-1 (rfind ~sub:"bc" "abd")
-  (rfind ~sub:"a" "_a_a_a_") 5
+  5 (rfind ~sub:"a" "_a_a_a_")
-  (rfind ~sub:"bc" "abcdbcd") 4
+  4 (rfind ~sub:"bc" "abcdbcd")
-  (rfind ~sub:"a" "a1a234a") 6
+  6 (rfind ~sub:"a" "a1a234a")
+*)
+
+(*$Q & ~count:10_000
+  Q.(pair printable_string printable_string) (fun (s1,s2) -> \
+    let i = rfind ~sub:s2 s1 in \
+    i < 0 || String.sub s1 i (length s2) = s2)
 *)
 
 val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> string
@@ -157,6 +219,46 @@ val suffix : suf:string -> string -> bool
   not (suffix ~suf:"abcd" "cd")
 *)
 
+val chop_prefix : pre:string -> string -> string option
+(** [chop_pref ~pre s] removes [pre] from [s] if [pre] really is a prefix
+    of [s], returns [None] otherwise
+    @since NEXT_RELEASE *)
+
+(*$= & ~printer:Q.Print.(option string)
+  (Some "cd") (chop_prefix ~pre:"aab" "aabcd")
+  None (chop_prefix ~pre:"ab" "aabcd")
+  None (chop_prefix ~pre:"abcd" "abc")
+*)
+
+val chop_suffix : suf:string -> string -> string option
+(** [chop_suffix ~suf s] removes [suf] from [s] if [suf] really is a suffix
+    of [s], returns [None] otherwise
+    @since NEXT_RELEASE *)
+
+(*$= & ~printer:Q.Print.(option string)
+  (Some "ab") (chop_suffix ~suf:"cd" "abcd")
+  None (chop_suffix ~suf:"cd" "abcde")
+  None (chop_suffix ~suf:"abcd" "cd")
+*)
+
+val take : int -> string -> string
+(** [take n s] keeps only the [n] first chars of [s]
+    @since NEXT_RELEASE *)
+
+val drop : int -> string -> string
+(** [drop n s] removes the [n] first chars of [s]
+    @since NEXT_RELEASE *)
+
+val take_drop : int -> string -> string * string
+(** [take_drop n s = take n s, drop n s]
+    @since NEXT_RELEASE *)
+
+(*$=
+  ("ab", "cd") (take_drop 2 "abcd")
+  ("abc", "") (take_drop 3 "abc")
+  ("abc", "") (take_drop 5 "abc")
+*)
+
 val lines : string -> string list
 (** [lines s] returns a list of the lines of [s] (splits along '\n')
     @since 0.10 *)
@@ -210,6 +312,25 @@ val mapi : (int -> char -> char) -> string -> string
 (** Map chars with their index
     @since 0.12 *)
 
+val filter_map : (char -> char option) -> string -> string
+(** @since NEXT_RELEASE *)
+
+(*$= & ~printer:Q.Print.string
+  "bcef" (filter_map \
+     (function 'c' -> None | c -> Some (Char.chr (Char.code c + 1))) "abcde")
+*)
+
+val filter : (char -> bool) -> string -> string
+(** @since NEXT_RELEASE *)
+
+(*$= & ~printer:Q.Print.string
+  "abde" (filter (function 'c' -> false | _ -> true) "abcdec")
+*)
+
+(*$Q
+  Q.printable_string (fun s -> filter (fun _ -> true) s = s)
+*)
+
 val flat_map : ?sep:string -> (char -> string) -> string -> string
 (** Map each chars to a string, then concatenates them all
     @param sep optional separator between each generated string

src/core/CCVector.ml

@@ -637,6 +637,22 @@ let (--) i j =
   (0 -- 0) |> to_list = [0]
 *)
 
+(*$Q
+  Q.(pair small_int small_int) (fun (a,b) -> \
+    (a -- b) |> to_list = CCList.(a -- b))
+*)
+
+let (--^) i j =
+  if i=j then create()
+  else if i>j
+    then init (i-j) (fun k -> i-k)
+    else init (j-i) (fun k -> i+k)
+
+(*$Q
+  Q.(pair small_int small_int) (fun (a,b) -> \
+    (a --^ b) |> to_list = CCList.(a --^ b))
+*)
+
 let of_array a =
   if Array.length a = 0
   then create ()

src/core/CCVector.mli

@@ -237,6 +237,11 @@ val (--) : int -> int -> (int, 'mut) t
     therefore the result is never empty).
     Example: [1 -- 10] returns the vector [[1;2;3;4;5;6;7;8;9;10]] *)
 
+val (--^) : int -> int -> (int, 'mut) t
+(** Range of integers, either ascending or descending, but excluding right.,
+    Example: [1 --^ 10] returns the vector [[1;2;3;4;5;6;7;8;9]]
+    @since NEXT_RELEASE *)
+
 val of_array : 'a array -> ('a, 'mut) t
 val of_list : 'a list -> ('a, 'mut) t
 val to_array : ('a,_) t -> 'a array

src/core/containers.ml

@@ -80,3 +80,12 @@ module Vector = CCVector
 
 module Int64 = CCInt64
 (** @since 0.13 *)
+
+module Char = struct
+  include Char
+  include (CCChar : module type of CCChar with type t := t)
+end
+(** @since NEXT_RELEASE *)
+
+module Result = CCResult
+(** @since NEXT_RELEASE *)

src/data/CCHet.ml

@@ -0,0 +1,191 @@
+
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {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 sequence = ('a -> unit) -> unit
+type 'a gen = unit -> 'a option
+
+module type KEY_IMPL = sig
+  type t
+  exception Store of t
+  val id : int
+end
+
+module Key = struct
+  type 'a t = (module KEY_IMPL with type t = 'a)
+
+  let _n = ref 0
+
+  let create (type k) () =
+    incr _n;
+    let id = !_n in
+    let module K = struct
+      type t = k
+      let id = id
+      exception Store of k
+    end in
+    (module K : KEY_IMPL with type t = k)
+
+  let id (type k) (module K : KEY_IMPL with type t = k) = K.id
+
+  let equal
+    : type a b. a t -> b t -> bool
+    = fun (module K1) (module K2) -> K1.id = K2.id
+end
+
+type pair =
+  | Pair : 'a Key.t * 'a -> pair
+
+type exn_pair =
+  | E_pair : 'a Key.t * exn -> exn_pair
+
+let pair_of_e_pair (E_pair (k,e)) =
+  let module K = (val k) in
+  match e with
+  | K.Store v -> Pair (k,v)
+  | _ -> assert false
+
+module Tbl = struct
+  module M = Hashtbl.Make(struct
+      type t = int
+      let equal (i:int) j = i=j
+      let hash (i:int) = Hashtbl.hash i
+    end)
+
+  type t = exn_pair M.t
+
+  let create ?(size=16) () = M.create size
+
+  let mem t k = M.mem t (Key.id k)
+
+  let find_exn (type a) t (k : a Key.t) : a =
+    let module K = (val k) in
+    let E_pair (_, v) = M.find t K.id in
+    match v with
+      | K.Store v -> v
+      | _ -> assert false
+
+  let find t k =
+    try Some (find_exn t k)
+    with Not_found -> None
+
+  let add_pair_ t p =
+    let Pair (k,v) = p in
+    let module K = (val k) in
+    let p = E_pair (k, K.Store v) in
+    M.replace t K.id p
+
+  let add t k v = add_pair_ t (Pair (k,v))
+
+  let length t = M.length t
+
+  let iter f t = M.iter (fun _ pair -> f (pair_of_e_pair pair)) t
+
+  let to_seq t yield = iter yield t
+
+  let to_list t = M.fold (fun _ p l -> pair_of_e_pair p::l) t []
+
+  let add_list t l = List.iter (add_pair_ t) l
+
+  let add_seq t seq = seq (add_pair_ t)
+
+  let of_list l =
+    let t = create() in
+    add_list t l;
+    t
+
+  let of_seq seq =
+    let t = create() in
+    add_seq t seq;
+    t
+end
+
+module Map = struct
+  module M = Map.Make(struct
+      type t = int
+      let compare (i:int) j = Pervasives.compare i j
+    end)
+
+  type t = exn_pair M.t
+
+  let empty = M.empty
+
+  let mem k t = M.mem (Key.id k) t
+
+  let find_exn (type a) (k : a Key.t) t : a =
+    let module K = (val k) in
+    let E_pair (_, e) = M.find K.id t in
+    match e with
+    | K.Store v -> v
+    | _ -> assert false
+
+  let find k t =
+    try Some (find_exn k t)
+    with Not_found -> None
+
+  let add_e_pair_ p t =
+    let E_pair ((module K),_) = p in
+    M.add K.id p t
+
+  let add_pair_ p t =
+    let Pair ((module K) as k,v) = p in
+    let p = E_pair (k, K.Store v) in
+    M.add K.id p t
+
+  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 cardinal t = M.cardinal t
+
+  let length = cardinal
+
+  let iter f t = M.iter (fun _ p -> f (pair_of_e_pair p)) t
+
+  let to_seq t yield = iter yield t
+
+  let to_list t = M.fold (fun _ p l -> pair_of_e_pair p::l) t []
+
+  let add_list t l = List.fold_right add_pair_ l t
+
+  let add_seq t seq =
+    let t = ref t in
+    seq (fun pair -> t := add_pair_ pair !t);
+    !t
+
+  let of_list l = add_list empty l
+
+  let of_seq seq = add_seq empty seq
+end

src/data/CCHet.mli

@@ -0,0 +1,90 @@
+
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {1 Associative containers with Heterogenerous Values}
+
+    This is similar to {!CCMixtbl}, but the injection is directly used as
+    a key.
+
+    @since NEXT_RELEASE *)
+
+type 'a sequence = ('a -> unit) -> unit
+type 'a gen = unit -> 'a option
+
+module Key : sig
+  type 'a t
+
+  val create : unit -> 'a t
+
+  val equal : 'a t -> 'a t -> bool
+  (** Compare two keys that have compatible types *)
+end
+
+type pair =
+  | Pair : 'a Key.t * 'a -> pair
+
+(** {2 Imperative table indexed by {!Key}} *)
+module Tbl : sig
+  type t
+
+  val create : ?size:int -> unit -> t
+
+  val mem : t -> _ Key.t -> bool
+
+  val add : t -> 'a Key.t -> 'a -> unit
+
+  val length : t -> int
+
+  val find : t -> 'a Key.t -> 'a option
+
+  val find_exn : t -> 'a Key.t -> 'a
+  (** @raise Not_found if the key is not in the table *)
+
+  val iter : (pair -> unit) -> t -> unit
+
+  val to_seq : t -> pair sequence
+
+  val of_seq : pair sequence -> t
+
+  val add_seq : t -> pair sequence -> unit
+
+  val add_list : t -> pair list -> unit
+
+  val of_list : pair list -> t
+
+  val to_list : t -> pair list
+end
+
+(** {2 Immutable map} *)
+module Map : sig
+  type t
+
+  val empty : t
+
+  val mem : _ Key.t -> t -> bool
+
+  val add : 'a Key.t -> 'a -> t -> t
+
+  val length : t -> int
+
+  val cardinal : t -> int
+
+  val find : 'a Key.t -> t -> 'a option
+
+  val find_exn : 'a Key.t -> t -> 'a
+  (** @raise Not_found if the key is not in the table *)
+
+  val iter : (pair -> unit) -> t -> unit
+
+  val to_seq : t -> pair sequence
+
+  val of_seq : pair sequence -> t
+
+  val add_seq : t -> pair sequence -> t
+
+  val add_list : t -> pair list -> t
+
+  val of_list : pair list -> t
+
+  val to_list : t -> pair list
+end

src/data/CCPersistentHashtbl.ml

@@ -1,27 +1,5 @@
-(*
-Copyright (c) 2013, Simon Cruanes
-All rights reserved.
 
-Redistribution and use in source and binary forms, with or without
+(* This file is free software, part of containers. See file "license" for more details. *)
-modification, are permitted provided that the following conditions are met:
-
-Redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  Redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
 
 (** {1 Persistent hash-table on top of OCaml's hashtables} *)
 
@@ -89,7 +67,8 @@ module type S = sig
   (** Fresh copy of the table; the underlying structure is not shared
       anymore, so using both tables alternatively will be efficient *)
 
-  val merge : (key -> 'a option -> 'b option -> 'c option) ->
+  val merge :
+    f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) ->
     'a t -> 'b t -> 'c t
   (** Merge two tables together into a new table. The function's argument
       correspond to values associated with the key (if present); if the
@@ -561,12 +540,15 @@ module Make(H : HashedType) : S with type key = H.t = struct
       false
     with ExitPTbl -> true
 
-  let merge f t1 t2 =
+  let merge ~f t1 t2 =
     let tbl = create (max (length t1) (length t2)) in
     let tbl = fold
       (fun tbl k v1 ->
-        let v2 = try Some (find t2 k) with Not_found -> None in
+        let comb =
-        match f k (Some v1) v2 with
+          try `Both (v1, find t2 k)
+          with Not_found -> `Left v1
+        in
+        match f k comb with
         | None -> tbl
         | Some v' -> replace tbl k v')
       tbl t1
@@ -574,7 +556,7 @@ module Make(H : HashedType) : S with type key = H.t = struct
     fold
       (fun tbl k v2 ->
         if mem t1 k then tbl
-        else match f k None (Some v2) with
+        else match f k (`Right v2) with
           | None -> tbl
           | Some v' -> replace tbl k v'
       ) tbl t2
@@ -583,10 +565,10 @@ module Make(H : HashedType) : S with type key = H.t = struct
     let t1 = H.of_list [1, "a"; 2, "b1"] in
     let t2 = H.of_list [2, "b2"; 3, "c"] in
     let t = H.merge
-      (fun _ v1 v2 -> match v1, v2 with
+      ~f:(fun _ -> function
-        | None, _ -> v2
+        | `Right v2 -> Some v2
-        | _ , None -> v1
+        | `Left v1 -> Some v1
-        | Some s1, Some s2 -> if s1 < s2 then Some s1 else Some s2)
+        | `Both (s1,s2) -> if s1 < s2 then Some s1 else Some s2)
       t1 t2
     in
     OUnit.assert_equal ~printer:string_of_int 3 (H.length t);

src/data/CCPersistentHashtbl.mli

@@ -1,27 +1,5 @@
-(*
-Copyright (c) 2013, Simon Cruanes
-All rights reserved.
 
-Redistribution and use in source and binary forms, with or without
+(* This file is free software, part of containers. See file "license" for more details. *)
-modification, are permitted provided that the following conditions are met:
-
-Redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  Redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
 
 (** {1 Persistent hash-table on top of OCaml's hashtables}
 
@@ -96,7 +74,8 @@ module type S = sig
   (** Fresh copy of the table; the underlying structure is not shared
       anymore, so using both tables alternatively will be efficient *)
 
-  val merge : (key -> 'a option -> 'b option -> 'c option) ->
+  val merge :
+    f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) ->
     'a t -> 'b t -> 'c t
   (** Merge two tables together into a new table. The function's argument
       correspond to values associated with the key (if present); if the

src/string/CCKMP.ml

@@ -1,27 +1,5 @@
-(*
-copyright (c) 2013-2014, simon cruanes
-all rights reserved.
 
-redistribution and use in source and binary forms, with or without
+(* This file is free software, part of containers. See file "license" for more details. *)
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
 
 (** {1 Knuth-Morris-Pratt} *)
 

src/string/CCKMP.mli

@@ -1,27 +1,5 @@
-(*
-copyright (c) 2013-2014, simon cruanes
-all rights reserved.
 
-redistribution and use in source and binary forms, with or without
+(* This file is free software, part of containers. See file "license" for more details. *)
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
 
 (** {1 Knuth-Morris-Pratt} *)
 

src/string/CCParse.ml

@@ -121,6 +121,31 @@ exception ParseError of line_num * col_num * (unit -> string)
 
 *)
 
+(* test with a temporary file *)
+(*$R
+  let test n =
+    let p = CCParse.(U.list ~sep:"," U.int) in
+
+    let l = CCList.(1 -- n) in
+    let l' =
+      CCIO.File.with_temp ~temp_dir:"/tmp/"
+       ~prefix:"containers_test" ~suffix:""
+       (fun name ->
+          (* write test into file *)
+         CCIO.with_out name
+          (fun oc ->
+            let fmt = Format.formatter_of_out_channel oc in
+            Format.fprintf fmt "@[%a@]@."
+              (CCList.print ~sep:"," ~start:"[" ~stop:"]" CCInt.print) l);
+         (* parse it back *)
+         CCParse.parse_file_exn ~size:1024 ~file:name ~p)
+    in
+    assert_equal ~printer:Q.Print.(list int) l l'
+  in
+  test 100_000;
+  test 400_000;
+*)
+
 let const_ x () = x
 
 let input_of_string s =

src/threads/CCPool.ml

@@ -264,7 +264,7 @@ module Make(P : PARAM) = struct
           let l = List.rev_map (fun i ->
             Fut.make
               (fun () ->
-                Thread.delay 0.1;
+                Thread.delay 0.05;
                 1
             )) l in
           let l' = List.map Fut.get l in

src/threads/CCTimer.ml

@@ -184,12 +184,12 @@ let stop timer =
   let timer = create () in
   let n = CCLock.create 1 in
   let res = CCLock.create 0 in
-  after timer 0.6
+  after timer 0.3
     ~f:(fun () -> CCLock.update n (fun x -> x+2));
   ignore (Thread.create
-    (fun _ -> Thread.delay 0.8; CCLock.set res (CCLock.get n)) ());
+    (fun _ -> Thread.delay 0.4; CCLock.set res (CCLock.get n)) ());
-  after timer 0.4
+  after timer 0.2
     ~f:(fun () -> CCLock.update n (fun x -> x * 4));
-  Thread.delay 1. ;
+  Thread.delay 0.6 ;
   OUnit.assert_equal 6 (CCLock.get res);
 *)

src/unix/CCUnix.ml

@@ -1,27 +1,5 @@
-(*
-copyright (c) 2013-2015, simon cruanes
-all rights reserved.
 
-redistribution and use in source and binary forms, with or without
+(* This file is free software, part of containers. See file "license" for more details. *)
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
 
 (** {1 High-level Functions on top of Unix} *)
 

src/unix/CCUnix.mli

@@ -1,27 +1,5 @@
-(*
-copyright (c) 2013-2015, simon cruanes
-all rights reserved.
 
-redistribution and use in source and binary forms, with or without
+(* This file is free software, part of containers. See file "license" for more details. *)
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
 
 (** {1 High-level Functions on top of Unix}