Merge branch 'master' into stable for 1.3

AUTHORS.adoc

@@ -21,3 +21,4 @@
 - Glenn Slotte (glennsl)
 - @LemonBoy
 - Leonid Rozenberg (@rleonid)
+- Bikal Gurung (@bikalgurung)

CHANGELOG.adoc

@@ -1,5 +1,23 @@
 = Changelog
 
+== 1.3
+
+- deprecate `CCBool.negate`
+- add `CCString.compare_natural` (closes #146)
+- add callbacks in `CCCache.with_cache{,_rec}` (closes #140)
+- tail-rec `CCList.split` (by @bikalgurung, see #138)
+- change `CCRingBuffer.peek_{front,back}` to return options (closes #127)
+- add `CCRingBuffer.is_full`
+- add `CCArray.find_map{,_i}`, deprecated older names (closes #129)
+- add `CCList.{keep,all}_{some,ok}` (closes #124)
+- large refactor of `CCSimple_queue` (close #125)
+- add `CCSimple_queue` to containers.data
+- small change for consistency in `CCIntMap`
+
+- bugfix in `CCRingBuffer.skip`, and corresponding tests
+- cleanup and refactor of `CCRingBuffer` (see #126). Add strong tests.
+- add rich testsuite to `CCIntMap`, based on @jmid's work
+
 == 1.2
 
 - make many modules extensions of stdlib (close #109)

README.adoc

@@ -4,6 +4,8 @@
 
 A modular, clean and powerful extension of the OCaml standard library.
 
+https://c-cube.github.io/ocaml-containers/last/[(Jump to the current API documentation)].
+
 Containers is an extension of OCaml's standard library (under BSD license)
 focused on data structures, combinators and iterators, without dependencies on
 unix, str or num. Every module is independent and is prefixed with 'CC' in the
@@ -91,7 +93,7 @@ and <<tutorial,the tutorial below>> for a gentle introduction.
 
 == Documentation
 
-In general, see http://c-cube.github.io/ocaml-containers/ or
+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].
@@ -135,18 +137,54 @@ To build the small benchmarking suite (requires https://github.com/chris00/ocaml
 
 == Contributing
 
-PRs on github are welcome (patches by email too, if you prefer so).
+PRs on github are very welcome (patches by email too, if you prefer so).
 
-A few guidelines:
+[[first-time-contribute]]
+=== First-Time Contributors
+
+Assuming your are in a clone of the repository:
+
+. Some dependencies are required, you'll need
+  `opam install benchmark qcheck qtest sequence`. 
+. run `make devel` to enable everything (including tests).
+. make your changes, commit, push, and open a PR.
+. use `make test` without moderation! It must pass before a PR
+  is merged.  There are around 900 tests right now, and new
+  features should come with their own tests.
+
+If you feel like writing new tests, that is totally worth a PR
+(and my gratefulness).
+
+=== General Guidelines
+
+A few guidelines to follow the philosophy of containers:
 
 - no dependencies between basic modules (even just for signatures);
 - add `@since` tags for new functions;
-- add tests if possible (using `qtest`).
+- add tests if possible (using https://github.com/vincent-hugot/iTeML/[qtest]). There are numerous inline tests already,
+to see what it looks like search for comments starting with `(*$`
+in source files.
 
-It is helpful to run `make devel` to enable everything. Some dependencies
+=== For Total Beginners
-are required, you'll need `opam install benchmark qcheck qtest sequence`. 
 
-Powered by image:http://oasis.forge.ocamlcore.org/oasis-badge.png[alt="OASIS", style="border: none;", link="http://oasis.forge.ocamlcore.org/"]
+Thanks for wanting to contribute!
+To contribute a change, here are the steps (roughly):
+
+. click "fork" on https://github.com/c-cube/ocaml-containers on the top right of the page. This will create a copy of the repository on your own github account.
+. click the big green "clone or download" button, with "SSH". Copy the URL (which should look like `git@github.com:<your username>/ocaml-containers.git`) into a terminal to enter the command:
++
+[source,sh]
+----
+$ git clone git@github.com:<your username>/ocaml-containers.git
+----
++
+. then, `cd` into the newly created directory.
+. make the changes you want. See <<first-time-contribute>> for
+  more details about what to do in particular.
+. use `git add` and `git commit` to commit these changes.
+. `git push origin master` to push the new change(s) onto your
+  copy of the repository
+. on github, open a "pull request" (PR). Et voilà !
 
 [[tutorial]]
 == Tutorial
@@ -441,3 +479,6 @@ printer:: `'a printer = Format.formatter -> 'a -> unit` is a pretty-printer
 === Extended Documentation
 
 See link:doc/containers.adoc[the extended documentation] for more examples.
+
+Powered by image:http://oasis.forge.ocamlcore.org/oasis-badge.png[alt="OASIS", style="border: none;", link="http://oasis.forge.ocamlcore.org/"]
+

_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        containers
-Version:     1.2
+Version:     1.3
 Homepage:    https://github.com/c-cube/ocaml-containers
 Authors:     Simon Cruanes
 License:     BSD-2-clause
@@ -67,7 +67,7 @@ Library "containers_data"
                     CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl,
                     CCMixmap, CCRingBuffer, CCIntMap, CCPersistentArray,
                     CCMixset, CCGraph, CCHashSet, CCBitField,
-                    CCHashTrie, CCWBTree, CCRAL,
+                    CCHashTrie, CCWBTree, CCRAL, CCSimple_queue,
                     CCImmutArray, CCHet, CCZipper
   BuildDepends:     bytes
   # BuildDepends:     bytes, bisect_ppx

benchs/run_benchs.ml

@@ -20,16 +20,24 @@ module L = struct
 
   let f_ x = x+1
 
+  let rec map_naive f l = match l with
+    | [] -> []
+    | x :: tail ->
+      let y = f x in
+      y :: map_naive f tail
+
   let bench_map ?(time=2) n =
     let l = CCList.(1 -- n) in
     let ral = CCRAL.of_list l in
     let map_naive () = ignore (try  List.map f_ l with Stack_overflow -> [])
+    and map_naive2 () = ignore (try  map_naive f_ l with Stack_overflow -> [])
     and map_tailrec () = ignore (List.rev (List.rev_map f_ l))
     and ccmap () = ignore (CCList.map f_ l)
     and ralmap () = ignore (CCRAL.map ~f:f_ ral)
     in
     B.throughputN time ~repeat
       [ "List.map", map_naive, ()
+      ; "List.map(inline)", map_naive2, ()
       ; "List.rev_map o rev", map_tailrec, ()
       ; "CCList.map", ccmap, ()
       ; "CCRAL.map", ralmap, ()

containers.odocl

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 97e963a89adef885748c84195b76d95c)
+# DO NOT EDIT (digest: fe2373b07664be05f7322781403afad6)
 src/core/CCVector
 src/core/CCHeap
 src/core/CCList
@@ -53,6 +53,7 @@ src/data/CCBitField
 src/data/CCHashTrie
 src/data/CCWBTree
 src/data/CCRAL
+src/data/CCSimple_queue
 src/data/CCImmutArray
 src/data/CCHet
 src/data/CCZipper

doc/intro.txt

@@ -93,6 +93,7 @@ CCPersistentArray
 CCPersistentHashtbl
 CCRAL
 CCRingBuffer
+CCSimple_queue
 CCTrie
 CCWBTree
 }

myocamlbuild.ml

@@ -1,5 +1,5 @@
 (* OASIS_START *)
-(* DO NOT EDIT (digest: d0913c9409d93aeda14a31d6f9ebb3b2) *)
+(* DO NOT EDIT (digest: 9ebeddeee0d56b1f8c98544fabcbbd9b) *)
 module OASISGettext = struct
 (* # 22 "src/oasis/OASISGettext.ml" *)
 
@@ -105,10 +105,7 @@ module OASISString = struct
         ok := false;
       incr str_idx
     done;
-    if !what_idx = String.length what then
+    !what_idx = String.length what
-      true
-    else
-      false
 
 
   let strip_starts_with ~what str =
@@ -131,10 +128,7 @@ module OASISString = struct
         ok := false;
       decr str_idx
     done;
-    if !what_idx = -1 then
+    !what_idx = -1
-      true
-    else
-      false
 
 
   let strip_ends_with ~what str =
@@ -440,7 +434,7 @@ module OASISExpr = struct
 end
 
 
-# 443 "myocamlbuild.ml"
+# 437 "myocamlbuild.ml"
 module BaseEnvLight = struct
 (* # 22 "src/base/BaseEnvLight.ml" *)
 
@@ -520,7 +514,7 @@ module BaseEnvLight = struct
 end
 
 
-# 523 "myocamlbuild.ml"
+# 517 "myocamlbuild.ml"
 module MyOCamlbuildFindlib = struct
 (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
 
@@ -881,7 +875,7 @@ module MyOCamlbuildBase = struct
 end
 
 
-# 884 "myocamlbuild.ml"
+# 878 "myocamlbuild.ml"
 open Ocamlbuild_plugin;;
 let package_default =
   {
@@ -921,7 +915,7 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
 
 let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
 
-# 925 "myocamlbuild.ml"
+# 919 "myocamlbuild.ml"
 (* OASIS_STOP *)
 let doc_intro = "doc/intro.txt" ;;
 

opam

@@ -43,12 +43,8 @@ available: [ocaml-version >= "4.01.0"]
 dev-repo: "https://github.com/c-cube/ocaml-containers.git"
 bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"
 post-messages: [
-"Major release, with breaking changes. The APIs are more focused,
+"Small release with many bugfixes and a few new functions.
-more consistent, and some sub-libraries were removed or merged into the core
-ones.
 
-A summary of the changes can be found at
+A summary hub.com/c-cube/ocaml-containers/issues/84
-https://github.com/c-cube/ocaml-containers/issues/84
+changelog: https://github.com/c-cube/ocaml-containers/blob/1.3/CHANGELOG.adoc"
-and in the changelog
-https://github.com/c-cube/ocaml-containers/blob/1.0/CHANGELOG.adoc"
 ]

setup.ml

@@ -1,9 +1,9 @@
 (* setup.ml generated for the first time by OASIS v0.4.4 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: fdb4a0fff7e0145854a42105c9c8afcf) *)
+(* DO NOT EDIT (digest: a62cfaee59320a25dee6d9bbad9cd339) *)
 (*
-   Regenerated by OASIS v0.4.8
+   Regenerated by OASIS v0.4.10
    Visit http://oasis.forge.ocamlcore.org for more information and
    documentation about functions used in this file.
 *)
@@ -112,10 +112,7 @@ module OASISString = struct
         ok := false;
       incr str_idx
     done;
-    if !what_idx = String.length what then
+    !what_idx = String.length what
-      true
-    else
-      false
 
 
   let strip_starts_with ~what str =
@@ -138,10 +135,7 @@ module OASISString = struct
         ok := false;
       decr str_idx
     done;
-    if !what_idx = -1 then
+    !what_idx = -1
-      true
-    else
-      false
 
 
   let strip_ends_with ~what str =
@@ -3162,7 +3156,7 @@ module OASISFileUtil = struct
 end
 
 
-# 3165 "setup.ml"
+# 3159 "setup.ml"
 module BaseEnvLight = struct
 (* # 22 "src/base/BaseEnvLight.ml" *)
 
@@ -3242,7 +3236,7 @@ module BaseEnvLight = struct
 end
 
 
-# 3245 "setup.ml"
+# 3239 "setup.ml"
 module BaseContext = struct
 (* # 22 "src/base/BaseContext.ml" *)
 
@@ -5665,7 +5659,7 @@ module BaseCompat = struct
 end
 
 
-# 5668 "setup.ml"
+# 5662 "setup.ml"
 module InternalConfigurePlugin = struct
 (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *)
 
@@ -6016,17 +6010,14 @@ module InternalInstallPlugin = struct
 
   let install =
 
-    let in_destdir =
+    let in_destdir fn =
       try
-        let destdir =
+        (* Practically speaking destdir is prepended at the beginning of the
-          destdir ()
+           target filename
-        in
+        *)
-          (* Practically speaking destdir is prepended
+        (destdir ())^fn
-           * at the beginning of the target filename
-           *)
-          fun fn -> destdir^fn
       with PropList.Not_set _ ->
-        fun fn -> fn
+        fn
     in
 
     let install_file ~ctxt ?(prepend_destdir=true) ?tgt_fn src_file envdir =
@@ -6471,7 +6462,7 @@ module InternalInstallPlugin = struct
 end
 
 
-# 6474 "setup.ml"
+# 6465 "setup.ml"
 module OCamlbuildCommon = struct
 (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
 
@@ -6828,11 +6819,10 @@ module OCamlbuildDocPlugin = struct
     run_ocamlbuild ~ctxt (index_html :: run.extra_args) argv;
     List.iter
       (fun glb ->
-         BaseBuilt.register
+         match OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb) with
-           ~ctxt
+         | (_ :: _) as filenames ->
-           BaseBuilt.BDoc
+             BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name [filenames]
-           cs.cs_name
+         | [] -> ())
-           [OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb)])
       ["*.html"; "*.css"]
 
 
@@ -6844,7 +6834,7 @@ module OCamlbuildDocPlugin = struct
 end
 
 
-# 6847 "setup.ml"
+# 6837 "setup.ml"
 module CustomPlugin = struct
 (* # 22 "src/plugins/custom/CustomPlugin.ml" *)
 
@@ -6976,7 +6966,7 @@ module CustomPlugin = struct
 end
 
 
-# 6979 "setup.ml"
+# 6969 "setup.ml"
 open OASISTypes;;
 
 let setup_t =
@@ -7051,7 +7041,7 @@ let setup_t =
        {
           oasis_version = "0.4";
           ocaml_version = Some (OASISVersion.VGreaterEqual "4.00.1");
-          version = "1.2";
+          version = "1.3";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -7742,6 +7732,7 @@ let setup_t =
                            "CCHashTrie";
                            "CCWBTree";
                            "CCRAL";
+                           "CCSimple_queue";
                            "CCImmutArray";
                            "CCHet";
                            "CCZipper"
@@ -8908,8 +8899,9 @@ let setup_t =
           plugin_data = []
        };
      oasis_fn = Some "_oasis";
-     oasis_version = "0.4.8";
+     oasis_version = "0.4.10";
-     oasis_digest = Some "\214\023V\1858'\142!X\\k\202\255w\167\213";
+     oasis_digest =
+       Some "\164\233\1428\169\160\007\155\182\180\021s\193\n\134-";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -8917,7 +8909,7 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 8921 "setup.ml"
+# 8913 "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

@@ -212,11 +212,13 @@ let rec find_aux f a i =
     | Some _ as res -> res
     | None -> find_aux f a (i+1)
 
-let find f a =
+let find_map f a = find_aux (fun _ -> f ) a 0
-  find_aux (fun _ -> f ) a 0
 
-let findi f a =
+let find = find_map
-  find_aux f a 0
+
+let find_map_i f a = find_aux f a 0
+
+let findi = find_map_i
 
 let find_idx p a =
   find_aux (fun i x -> if p x then Some (i,x) else None) a 0

src/core/CCArray.mli

@@ -71,30 +71,44 @@ val sorted : ('a -> 'a -> int) -> 'a t -> 'a array
 
 val sort_indices : ('a -> 'a -> int) -> 'a t -> int array
 (** [sort_indices cmp a] returns a new array [b], with the same length as [a],
-    such that [b.(i)] is the index of the [i]-th element of [a] in [sort cmp a].
+    such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a] 
-    In other words, [map (fun i -> a.(i)) (sort_indices a) = sorted cmp a].
+    appears in [a]. [a] is not modified.
-    [a] is not modified.
+
+    In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a]. 
+    [sort_indices] yields the inverse permutation of {!sort_ranking}.
+
     @since 1.0 *)
 
 val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array
 (** [sort_ranking cmp a] returns a new array [b], with the same length as [a],
-    such that [b.(i)] is the position in [sorted cmp a] of the [i]-th
+    such that [b.(i)] is the index at which the [i]-the element of [a] appears
-    element of [a].
+    in [sorted cmp a]. [a] is not modified.
-    [a] is not modified.
 
     In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a]. 
+    [sort_ranking] yields the inverse permutation of {!sort_indices}.
 
-    Without duplicates, we also have
+    In the absence of duplicate elements in [a], we also have
     [lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)]
     @since 1.0 *)
 
+val find_map : ('a -> 'b option) -> 'a t -> 'b option
+(** [find_map f a] returns [Some y] if there is an element [x] such
+    that [f x = Some y], else it returns [None]
+    @since 1.3
+*)
+
 val find : ('a -> 'b option) -> 'a t -> 'b option
-(** [find f a] returns [Some y] if there is an element [x] such
+(** Alias to {!find_map}
-    that [f x = Some y], else it returns [None] *)
+    @deprecated since 1.3 *)
+
+val find_map_i : (int -> 'a -> 'b option) -> 'a t -> 'b option
+(** Like {!find_map}, but also pass the index to the predicate function.
+    @since 1.3 *)
 
 val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option
-(** Like {!find}, but also pass the index to the predicate function.
+(** Alias to {!find_map_i}
-    @since 0.3.4 *)
+    @since 0.3.4
+    @deprecated since 1.3 *)
 
 val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
 (** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
@@ -107,7 +121,7 @@ val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option
       [Some i] ([i] the index of the key) otherwise *)
 
 val lookup_exn : ?cmp:'a ord -> 'a -> 'a t -> int
-(** Same as {!lookup_exn}, but
+(** Same as {!lookup}, but
     @raise Not_found if the key is not present *)
 
 val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t ->

src/core/CCArray_slice.mli

@@ -86,20 +86,23 @@ val sorted : ('a -> 'a -> int) -> 'a t -> 'a array
 
 val sort_indices : ('a -> 'a -> int) -> 'a t -> int array
 (** [sort_indices cmp a] returns a new array [b], with the same length as [a],
-    such that [b.(i)] is the index of the [i]-th element of [a] in [sort cmp a].
+    such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a] 
-    In other words, [map (fun i -> a.(i)) (sort_indices a) = sorted cmp a].
+    appears in [a]. [a] is not modified.
-    [a] is not modified.
+
+    In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a]. 
+    [sort_indices] yields the inverse permutation of {!sort_ranking}.
+
     @since 1.0 *)
 
 val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array
 (** [sort_ranking cmp a] returns a new array [b], with the same length as [a],
-    such that [b.(i)] is the position in [sorted cmp a] of the [i]-th
+    such that [b.(i)] is the index at which the [i]-the element of [a] appears
-    element of [a].
+    in [sorted cmp a]. [a] is not modified.
-    [a] is not modified.
 
     In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a]. 
+    [sort_ranking] yields the inverse permutation of {!sort_indices}.
 
-    Without duplicates, we also have
+    In the absence of duplicate elements in [a], we also have
     [lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)]
     @since 1.0 *)
 
@@ -122,7 +125,7 @@ val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option
       [Some i] ([i] the index of the key) otherwise *)
 
 val lookup_exn : ?cmp:'a ord -> 'a -> 'a t -> int
-(** Same as {!lookup_exn}, but
+(** Same as {!lookup}, but
     @raise Not_found if the key is not present *)
 
 val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t ->

src/core/CCBool.ml

@@ -7,7 +7,7 @@ let equal (a:bool) b = a=b
 
 let compare (a:bool) b = Pervasives.compare a b
 
-let negate x = not x
+let negate = not
 
 type 'a printer = Format.formatter -> 'a -> unit
 

src/core/CCBool.mli

@@ -11,7 +11,8 @@ val compare : t -> t -> int
 val equal : t -> t -> bool
 
 val negate : t -> t
-(** Negation on booleans (functional version of [not]) *)
+(** Negation on booleans (functional version of [not])
+    @deprecate since 1.3, simply use {!not} instead *)
 
 type 'a printer = Format.formatter -> 'a -> unit
 

src/core/CCFormat.ml

@@ -77,7 +77,7 @@ let text out (s:string): unit =
 (*$= & ~printer:(fun s->CCFormat.sprintf "%S" s)
   "a\nb\nc" (sprintf_no_color "@[<v>%a@]%!" text "a b c")
   "a b\nc" (sprintf_no_color "@[<h>%a@]%!" text "a b\nc")
-  *)
+*)
 
 let list ?(sep=return ",@ ") pp fmt l =
   let rec pp_list l = match l with

src/core/CCFormat.mli

@@ -311,5 +311,5 @@ module Dump : sig
   val result : 'a t -> ('a, string) Result.result t
   val result' : 'a t -> 'e t -> ('a, 'e) Result.result t
   val to_string : 'a t -> 'a -> string
-  (** Alias to {!to_string} *)
+  (** Alias to {!CCFormat.to_string} *)
 end

src/core/CCList.ml

@@ -366,7 +366,7 @@ let combine l1 l2 =
     if List.length l1=List.length l2 \
     then CCList.combine l1 l2 = List.combine l1 l2 \
     else Q.assume_fail() )
-  *)
+*)
 
 let combine_gen l1 l2 =
   let l1 = ref l1 in
@@ -385,7 +385,38 @@ let combine_gen l1 l2 =
     let res1 = combine (take n l1) (take n l2) in \
     let res2 = combine_gen l1 l2 |> of_gen in \
     res1 = res2)
-  *)
+*)
+
+let split l = 
+  let rec direct i l = match l with 
+    | [] -> [], []
+    | [x1, y1] -> [x1], [y1]
+    | [x1, y1; x2, y2] -> [x1;x2], [y1;y2]
+    | [x1, y1; x2, y2; x3, y3] -> [x1;x2;x3], [y1;y2;y3]
+    | [x1, y1; x2, y2; x3, y3; x4, y4] -> [x1;x2;x3;x4], [y1;y2;y3;y4]
+    | _ when i=0 -> split_slow [] [] l
+    | (x1, y1) :: (x2, y2) :: (x3, y3) :: (x4, y4) :: (x5, y5) :: l' ->
+      let rx, ry = direct (i-1) l' in 
+      x1 :: x2 :: x3 :: x4 :: x5 :: rx,
+      y1 :: y2 :: y3 :: y4 :: y5 :: ry
+  and split_slow acc1 acc2 l = match l with
+    | [] -> List.rev acc1, List.rev acc2
+    | (x1, x2) :: tail ->
+      let acc1 = x1 :: acc1
+      and acc2 = x2 :: acc2 in 
+      split_slow acc1 acc2 tail
+  in 
+  direct direct_depth_default_ l
+
+(*$Q 
+  (Q.(list_of_size Gen.(0--10_000) (pair small_int small_string))) (fun l -> \
+    let (l1, l2) = split l in \
+    List.length l1 = List.length l \
+    && List.length l2 = List.length l)
+
+  Q.(list_of_size Gen.(0--10_000) (pair small_int small_int)) (fun l -> \
+    split l = List.split l)
+*)
 
 let return x = [x]
 
@@ -688,9 +719,9 @@ let take_while p l =
 *)
 
 (*$Q
-  Q.(pair (fun1 small_int bool) (list small_int)) (fun (f,l) -> \
+  Q.(pair (fun1 Observable.int bool) (list small_int)) (fun (f,l) -> \
-    let l1 = take_while f l in \
+    let l1 = take_while (Q.Fn.apply f) l in \
-    List.for_all f l1)
+    List.for_all (Q.Fn.apply f) l1)
 *)
 
 let rec drop_while p l = match l with
@@ -698,8 +729,8 @@ let rec drop_while p l = match l with
   | x :: l' -> if p x then drop_while p l' else l
 
 (*$Q
-  Q.(pair (fun1 small_int bool) (list small_int)) (fun (f,l) -> \
+  Q.(pair (fun1 Observable.int bool) (list small_int)) (fun (f,l) -> \
-    take_while f l @ drop_while f l = l)
+    take_while (Q.Fn.apply f) l @ drop_while (Q.Fn.apply f) l = l)
 *)
 
 let take_drop_while p l =
@@ -720,9 +751,9 @@ let take_drop_while p l =
   direct direct_depth_default_ p l
 
 (*$Q
-  Q.(pair (fun1 small_int bool) (list small_int)) (fun (f,l) -> \
+  Q.(pair (fun1 Observable.int bool) (list small_int)) (fun (f,l) -> \
-    let l1,l2 = take_drop_while f l in \
+    let l1,l2 = take_drop_while (Q.Fn.apply f) l in \
-    (l1 = take_while f l) && (l2 = drop_while f l))
+    (l1 = take_while (Q.Fn.apply f) l) && (l2 = drop_while (Q.Fn.apply f) l))
 *)
 
 let last n l =
@@ -811,6 +842,48 @@ let filter_map f l =
       [ 1; 2; 3; 4; 5; 6 ])
 *)
 
+let keep_some l = filter_map (fun x->x) l
+
+let keep_ok l =
+  filter_map
+    (function
+      | Result.Ok x -> Some x
+      | Result.Error _ -> None)
+    l
+
+let all_some l =
+  try Some (map (function Some x -> x | None -> raise Exit) l)
+  with Exit -> None
+
+(*$=
+  (Some []) (all_some [])
+  (Some [1;2;3]) (all_some [Some 1; Some 2; Some 3])
+  None (all_some [Some 1; None; None; Some 4])
+*)
+
+let all_ok l =
+  let err = ref None in
+  try
+    Result.Ok
+      (map
+         (function Result.Ok x -> x | Error e -> err := Some e; raise Exit)
+         l)
+  with Exit ->
+    begin match !err with
+      | None -> assert false
+      | Some e -> Result.Error e
+    end
+
+(*$inject
+  open Result
+*)
+
+(*$=
+  (Ok []) (all_ok [])
+  (Ok [1;2;3]) (all_ok [Ok 1; Ok 2; Ok 3])
+  (Error "e2") (all_ok [Ok 1; Error "e2"; Error "e3"; Ok 4])
+*)
+
 let mem ?(eq=(=)) x l =
   let rec search eq x l = match l with
     | [] -> false

src/core/CCList.mli

@@ -92,6 +92,9 @@ val combine_gen : 'a list -> 'b list -> ('a * 'b) gen
     instead, the output has as many pairs as the smallest input list.
     @since 1.2 *)
 
+val split : ('a * 'b) t -> 'a t * 'b t 
+(** A tail-recursive version of {!List.split}. *)
+
 val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
 
 val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
@@ -111,13 +114,13 @@ val fold_product : ('c -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c
 val cartesian_product : 'a t t -> 'a t t
 (**
     For example:
-    {[
+   {[
-      # cartesian_product [[1;2];[3];[4;5;6]] =
+     # cartesian_product [[1;2];[3];[4;5;6]] =
-          [[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]];;
+     [[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]];;
-      # cartesian_product [[1;2];[];[4;5;6]] = [];;
+     # cartesian_product [[1;2];[];[4;5;6]] = [];;
-      # cartesian_product [[1;2];[3];[4];[5];[6]] =
+     # cartesian_product [[1;2];[3];[4];[5];[6]] =
-          [[1;3;4;5;6];[2;3;4;5;6]];;
+     [[1;3;4;5;6];[2;3;4;5;6]];;
-    ]}
+   ]}
     invariant: [cartesian_product l = map_product id l].
     @since 1.2 *)
 
@@ -247,6 +250,26 @@ val remove : ?eq:('a -> 'a -> bool) -> x:'a -> 'a t -> 'a t
 val filter_map : ('a -> 'b option) -> 'a t -> 'b t
 (** Map and remove elements at the same time *)
 
+val keep_some : 'a option t -> 'a t
+(** [filter_some l] retains only elements of the form [Some x].
+    Same as [filter_map CCFun.id]
+    @since 1.3 *)
+
+val keep_ok : ('a, _) Result.result t -> 'a t
+(** [filter_some l] retains only elements of the form [Some x].
+    Same as [filter_map CCFun.id]
+    @since 1.3 *)
+
+val all_some : 'a option t -> 'a t option
+(** [all_some l] returns [Some l'] if all elements of [l] are of the form [Some x],
+    or [None] otherwise.
+    @since 1.3 *)
+
+val all_ok : ('a, 'err) Result.result t -> ('a t, 'err) Result.result
+(** [all_ok l] returns [Ok l'] if all elements of [l] are of the form [Ok x],
+    or [Error e] otherwise (with the first error met).
+    @since 1.3 *)
+
 val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
 (** Merges elements from both sorted list *)
 
@@ -498,3 +521,5 @@ end
 
 val pp : ?start:string -> ?stop:string -> ?sep:string ->
   'a printer -> 'a t printer
+
+(** {2 Lists of pairs} *)

src/core/CCResult.ml

@@ -129,7 +129,7 @@ let fold_ok f acc r = match r with
 (*$=
   42 (fold_ok (+) 2 (Ok 40))
   40 (fold_ok (+) 40 (Error "foo"))
-  *)
+*)
 
 let is_ok = function
   | Ok _ -> true

src/core/CCString.cppo.ml

@@ -414,6 +414,44 @@ let compare_versions a b =
   in
   cmp_rec (Split.gen_cpy ~by:"." a) (Split.gen_cpy ~by:"." b)
 
+type nat_chunk =
+  | NC_char of char
+  | NC_int of int
+
+let compare_natural a b =
+  (* stream of chunks *)
+  let chunks s : unit -> nat_chunk option =
+    let i = ref 0 in
+    let rec next () =
+      if !i = length s then None
+      else match String.get s !i with
+        | '0'..'9' as c -> incr i; read_int (Char.code c - Char.code '0')
+        | c -> incr i; Some (NC_char c)
+    and read_int n =
+      if !i = length s then Some (NC_int n)
+      else match String.get s !i with
+        | '0'..'9' as c -> incr i; read_int (10 * n + Char.code c - Char.code '0')
+        | _ -> Some (NC_int n)
+    in
+    next
+  in
+  let rec cmp_rec a b = match a(), b() with
+    | None, None -> 0
+    | Some _, None -> 1
+    | None, Some _ -> -1
+    | Some x, Some y ->
+      match x, y with
+        | NC_char x, NC_char y ->
+          let c = Char.compare x y in
+          if c<>0 then c else cmp_rec a b
+        | NC_int _, NC_char _ -> 1
+        | NC_char _, NC_int _ -> -1
+        | NC_int x, NC_int y ->
+          let c = Pervasives.compare x y in
+          if c<>0 then c else cmp_rec a b
+  in
+  cmp_rec (chunks a) (chunks b)
+
 let edit_distance s1 s2 =
   if length s1 = 0
   then length s2

src/core/CCString.mli

@@ -375,7 +375,7 @@ val rtrim : t -> t
   Q.(printable_string) (fun s -> \
     let s' = rtrim s in \
     if s'="" then Q.assume_fail() else s'.[String.length s'-1] <> ' ')
-  *)
+*)
 
 (** {2 Operations on 2 strings} *)
 
@@ -578,6 +578,29 @@ val compare_versions : string -> string -> int
     CCOrd.equiv (compare_versions a b) (CCOrd.opp compare_versions b a))
 *)
 
+val compare_natural : string -> string -> int
+(** Natural Sort Order, comparing chunks of digits as natural numbers.
+    https://en.wikipedia.org/wiki/Natural_sort_order
+    @since 1.3 *)
+
+(*$T
+  compare_natural "foo1" "foo2" < 0
+  compare_natural "foo11" "foo2" > 0
+  compare_natural "foo11" "foo11" = 0
+  compare_natural "foo011" "foo11" = 0
+  compare_natural "foo1a" "foo1b" < 0
+  compare_natural "foo1a1" "foo1a2" < 0
+  compare_natural "foo1a17" "foo1a2" > 0
+*)
+
+(*Q
+  (Q.pair printable_string printable_string) (fun (a,b) -> \
+    CCOrd.opp (compare_natural a b) = compare_natural b a)
+  (Q.printable_string) (fun a -> compare_natural a a = 0)
+  (Q.triple printable_string printable_string printable_string) (fun (a,b,c) -> \
+    if compare_natural a b < 0 && compare_natural b c < 0 \
+    then compare_natural a c < 0 else Q.assume_fail())
+*)
 
 val edit_distance : string -> string -> int
 (** Edition distance between two strings. This satisfies the classical
@@ -654,7 +677,7 @@ module Sub : sig
   (*$= & ~printer:(String.make 1)
     'b' Sub.(get (make "abc" 1 ~len:2) 0)
     'c' Sub.(get (make "abc" 1 ~len:2) 1)
-    *)
+  *)
 
   (*$QR
     Q.(printable_string_of_size Gen.(3--10)) (fun s ->

src/core/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: 1e93f21c6208d4f0718882bfffe34612)
+# DO NOT EDIT (digest: 2c23f3e7c83e14a0b87e7d6bb7df91bd)
-version = "1.2"
+version = "1.3"
 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.2"
+ version = "1.3"
  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.2"
+ version = "1.3"
  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.2"
+ version = "1.3"
  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.2"
+ version = "1.3"
  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.2"
+ version = "1.3"
  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.2"
+ version = "1.3"
  description = "A modular standard library focused on data structures."
  requires = "bytes"
  archive(byte) = "containers_data.cma"

src/data/CCBV.ml

@@ -269,7 +269,7 @@ let iter bv f =
     let bv = create ~size:n true in \
     let l = iter bv |> Sequence.zip |> Sequence.to_list in \
     List.length l = n && List.for_all (fun (_,b) -> b) l)
-  *)
+*)
 
 let iter_true bv f =
   iter bv (fun i b -> if b then f i else ())

src/data/CCBV.mli

@@ -86,9 +86,9 @@ val first : t -> int option
     changed type at 1.2 *)
 
 val first_exn : t -> int
- (** First set bit, or
+(** First set bit, or
-     @raise Not_found if all bits are 0
+    @raise Not_found if all bits are 0
-     @since 1.2 *)
+    @since 1.2 *)
 
 val filter : t -> (int -> bool) -> unit
 (** [filter bv p] only keeps the true bits of [bv] whose [index]

src/data/CCCache.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 Caches} *)
 
@@ -48,18 +26,25 @@ type ('a,'b) t = {
   clear : unit -> unit;
 }
 
+type ('a, 'b) callback = in_cache:bool -> 'a -> 'b -> unit
+
 let clear c = c.clear ()
 
-let with_cache c f x =
+let default_callback_ ~in_cache:_ _ _ = ()
+
+let with_cache ?(cb=default_callback_) c f x =
   try
-    c.get x
+    let y = c.get x in
+    cb ~in_cache:true x y;
+    y
   with Not_found ->
     let y = f x in
     c.set x y;
+    cb ~in_cache:false x y;
     y
 
-let with_cache_rec c f =
+let with_cache_rec ?(cb=default_callback_) c f =
-  let rec f' x = with_cache c (f f') x in
+  let rec f' x = with_cache ~cb c (f f') x in
   f'
 
 (*$R

src/data/CCCache.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 Caches}
 
@@ -53,13 +31,22 @@ type ('a, 'b) t
 val clear : (_,_) t -> unit
 (** Clear the content of the cache *)
 
-val with_cache : ('a, 'b) t -> ('a -> 'b) -> 'a -> 'b
+type ('a, 'b) callback = in_cache:bool -> 'a -> 'b -> unit
+(** Type of the callback that is called once a cached value is found
+    or not.
+    Should never raise.
+    @param in_cache is [true] if the value was in cache, [false]
+      if the value was just produced.
+    @since 1.3 *)
+
+val with_cache : ?cb:('a, 'b) callback -> ('a, 'b) t -> ('a -> 'b) -> 'a -> 'b
 (** [with_cache c f] behaves like [f], but caches calls to [f] in the
     cache [c]. It always returns the same value as
     [f x], if [f x] returns, or raise the same exception.
-    However, [f] may not be called if [x] is in the cache. *)
+    However, [f] may not be called if [x] is in the cache.
+    @param cb called after the value is generated or retrieved *)
 
-val with_cache_rec : ('a,'b) t -> (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
+val with_cache_rec : ?cb:('a, 'b) callback -> ('a,'b) t -> (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
 (** [with_cache_rec c f] is a function that first, applies [f] to
     some [f' = fix f], such that recursive calls to [f'] are cached in [c].
     It is similar to {!with_cache} but with a function that takes as
@@ -74,6 +61,7 @@ val with_cache_rec : ('a,'b) t -> (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
 
       fib 70;;
     ]}
+    @param cb called after the value is generated or retrieved
 *)
 
 val size : (_,_) t -> int

src/data/CCGraph.ml

@@ -300,7 +300,7 @@ module Traverse = struct
      `Exit 345614]
     in
     assert_equal expected l
-    *)
+  *)
 end
 
 (** {2 Cycles} *)

src/data/CCIntMap.ml

@@ -238,13 +238,13 @@ let update k f t =
 let doubleton k1 v1 k2 v2 = add k1 v1 (singleton k2 v2)
 
 let rec equal ~eq a b = a==b || match a, b with
-  | E, E -> true
+    | E, E -> true
-  | L (ka, va), L (kb, vb) -> ka = kb && eq va vb
+    | L (ka, va), L (kb, vb) -> ka = kb && eq va vb
-  | N (pa, sa, la, ra), N (pb, sb, lb, rb) ->
+    | N (pa, sa, la, ra), N (pb, sb, lb, rb) ->
-    pa=pb && sa=sb && equal ~eq la lb && equal ~eq ra rb
+      pa=pb && sa=sb && equal ~eq la lb && equal ~eq ra rb
-  | E, _
+    | E, _
-  | N _, _
+    | N _, _
-  | L _, _ -> false
+    | L _, _ -> false
 
 (*$Q
   Q.(list (pair int bool)) ( fun l -> \
@@ -289,23 +289,23 @@ let choose t =
 let rec union f t1 t2 =
   if t1==t2 then t1
   else match t1, t2 with
-  | E, o | o, E -> o
+    | E, o | o, E -> o
-  | L (k, v), o
+    | L (k, v), o
-  | o, L (k, v) ->
+    | o, L (k, v) ->
-    (* insert k, v into o *)
+      (* insert k, v into o *)
-    insert_ (fun ~old v -> f k old v) k v o
+      insert_ (fun ~old v -> f k old v) k v o
-  | N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
+    | N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
-    if p1 = p2 && m1 = m2
+      if p1 = p2 && m1 = m2
-    then mk_node_ p1 m1 (union f l1 l2) (union f r1 r2)
+      then mk_node_ p1 m1 (union f l1 l2) (union f r1 r2)
-    else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
+      else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
-    then if Bit.is_0 p2 ~bit:m1
+      then if Bit.is_0 p2 ~bit:m1
-      then N (p1, m1, union f l1 t2, r1)
+        then N (p1, m1, union f l1 t2, r1)
-      else N (p1, m1, l1, union f r1 t2)
+        else N (p1, m1, l1, union f r1 t2)
-    else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2
+      else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2
-    then if Bit.is_0 p1 ~bit:m2
+      then if Bit.is_0 p1 ~bit:m2
-      then N (p2, m2, union f t1 l2, r2)
+        then N (p2, m2, union f t1 l2, r2)
-      else N (p2, m2, l2, union f t1 r2)
+        else N (p2, m2, l2, union f t1 r2)
-    else join_ t1 p1 t2 p2
+      else join_ t1 p1 t2 p2
 
 (*$Q & ~small:(fun (a,b) -> List.length a + List.length b)
   Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1,l2) -> \
@@ -344,26 +344,26 @@ let rec union f t1 t2 =
 let rec inter f a b =
   if a==b then a
   else match a, b with
-  | E, _ | _, E -> E
+    | E, _ | _, E -> E
-  | L (k, v), o
+    | L (k, v), o
-  | o, L (k, v) ->
+    | o, L (k, v) ->
-    begin try
+      begin try
-        let v' = find_exn k o in
+          let v' = find_exn k o in
-        L (k, f k v v')
+          L (k, f k v v')
-      with Not_found -> E
+        with Not_found -> E
-    end
+      end
-  | N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
+    | N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
-    if p1 = p2 && m1 = m2
+      if p1 = p2 && m1 = m2
-    then mk_node_ p1 m1 (inter f l1 l2) (inter f r1 r2)
+      then mk_node_ p1 m1 (inter f l1 l2) (inter f r1 r2)
-    else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
+      else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
-    then if Bit.is_0 p2 ~bit:m1
+      then if Bit.is_0 p2 ~bit:m1
-      then inter f l1 b
+        then inter f l1 b
-      else inter f r1 b
+        else inter f r1 b
-    else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2
+      else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2
-    then if Bit.is_0 p1 ~bit:m2
+      then if Bit.is_0 p1 ~bit:m2
-      then inter f l2 a
+        then inter f a l2
-      else inter f r2 a
+        else inter f a r2
-    else E
+      else E
 
 (*$R
   assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (print CCString.print))
@@ -541,3 +541,170 @@ let print pp_x out m =
        Format.pp_print_cut out ()
     ) m;
   Format.fprintf out "}@]"
+
+(* 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 Pervasives.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 Pervasives.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'))
+*)

src/data/CCRAL.ml

@@ -151,7 +151,8 @@ let mapi ~f l =
 *)
 
 (*$Q
-  Q.(pair (list small_int)(fun2 int int bool)) (fun (l,f) -> \
+  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 )
 *)
 

src/data/CCRingBuffer.mli

@@ -1,31 +1,19 @@
-(*
+
- * CCRingBuffer - Polymorphic Circular Buffer
+(* This file is free software, part of containers. See file "license" for more details. *)
- * Copyright (C) 2015 Simon Cruanes, Carmelo Piccione
+
- *
+(* Copyright (C) 2015 Simon Cruanes, Carmelo Piccione *)
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version,
- * with the special exception on linking described in file LICENSE.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- *)
 
 (** {1 Circular Buffer (Deque)}
 
-    Useful for IO, or as a general-purpose alternative to {!Queue} when
+    Useful for IO, or as a bounded-size alternative to {!Queue} when
     batch operations are needed.
 
     {b status: experimental}
 
     @since 0.9
+
+    Change in the API to provide only a bounded buffer
+    @since 1.3
 *)
 
 (** {2 Underlying Array} *)
@@ -39,11 +27,8 @@ module Array : sig
     (** The type of an array instance *)
     type t
 
-    val empty : t
+    val create : int -> t
-    (** The empty array *)
+    (** Make an array of the given size, filled with dummy elements *)
-
-    val make: int -> elt -> t
-    (** [make s e] makes an array of size [s] with [e] elements *)
 
     val length: t -> int
     (** [length t] gets the total number of elements currently in [t] *)
@@ -75,7 +60,7 @@ module Array : sig
     S with type elt = char and type t = Bytes.t
 
   (** Makes an array given an arbitrary element type *)
-  module Make(Elt:sig type t end) :
+  module Make(Elt:sig type t val dummy : t end) :
     S with type elt = Elt.t and type t = Elt.t array
 end
 
@@ -87,16 +72,17 @@ module type S = sig
   (** The module type of Array for this ring buffer *)
   module Array : Array.S
 
-  (** Defines the ring buffer type, with both bounded and
+  (** Defines the bounded ring buffer type *)
-      unbounded flavors *)
   type t
 
   (** Raised in querying functions when the buffer is empty *)
   exception Empty
 
-  val create : ?bounded:bool -> int -> t
+  val create : int -> t
-  (** [create ?bounded size] creates a new buffer with given size.
+  (** [create size] creates a new bounded buffer with given size.
-      Defaults to [bounded=false]. *)
+      The underlying array is allocated immediately and no further (large)
+      allocation will happen from now on.
+      @raise Invalid_argument if the arguments is [< 1] *)
 
   val copy : t -> t
   (** Make a fresh copy of the buffer. *)
@@ -104,26 +90,29 @@ module type S = sig
   val capacity : t -> int
   (** Length of the inner buffer. *)
 
-  val max_capacity : t -> int option
-  (** Maximum length of the inner buffer, or [None] if unbounded. *)
-
   val length : t -> int
   (** Number of elements currently stored in the buffer. *)
 
+  val is_full : t -> bool
+  (** true if pushing an element would erase another element.
+      @since 1.3 *)
+
   val blit_from : t -> Array.t -> int -> int -> unit
   (** [blit_from buf from_buf o len] copies the slice [o, ... o + len - 1] from
       a input buffer [from_buf] to the end of the buffer.
+      If the slice is too large for the buffer, only the last part of the array
+      will be copied.
       @raise Invalid_argument if [o,len] is not a valid slice of [s] *)
 
-  val blit_into : t ->  Array.t -> int -> int -> int
+  val blit_into : t -> Array.t -> int -> int -> int
   (** [blit_into buf to_buf o len] copies at most [len] elements from [buf]
       into [to_buf] starting at offset [o] in [s].
       @return the number of elements actually copied ([min len (length buf)]).
-      @raise Invalid_argument if [o,len] is not a valid slice of [s] *)
+      @raise Invalid_argument if [o,len] is not a valid slice of [s]. *)
 
   val append : t -> into:t -> unit
   (** [append b ~into] copies all data from [b] and adds it at the
-      end of [into] *)
+      end of [into]. Erases data of [into] if there is not enough room. *)
 
   val to_list : t -> Array.elt list
   (** Extract the current content into a list *)
@@ -131,9 +120,6 @@ module type S = sig
   val clear : t -> unit
   (** Clear the content of the buffer. Doesn't actually destroy the content. *)
 
-  val reset : t -> unit
-  (** Clear the content of the buffer, and also resize it to a default size *)
-
   val is_empty :t -> bool
   (** Is the buffer empty (i.e. contains no elements)? *)
 
@@ -171,26 +157,34 @@ module type S = sig
       If [t.bounded=false], the buffer will grow as needed,
       otherwise the oldest elements are replaced first. *)
 
-  val peek_front : t -> Array.elt
+  val peek_front : t -> Array.elt option
-  (** First value from front of [t].
+  (** First value from front of [t], without modification. *)
-      @raise Empty if buffer is empty. *)
 
-  val peek_back : t -> Array.elt
+  val peek_front_exn : t -> Array.elt
-  (** Get the last value from back of [t].
+  (** First value from front of [t], without modification.
-      @raise Empty if buffer is empty. *)
+      @raise Empty if buffer is empty.
+      @since 1.3 *)
+
+  val peek_back : t -> Array.elt option
+  (** Get the last value from back of [t], without modification. *)
+
+  val peek_back_exn : t -> Array.elt
+  (** Get the last value from back of [t], without modification.
+      @raise Empty if buffer is empty.
+      @since 1.3 *)
 
   val take_back : t -> Array.elt option
-  (** Take the last value from back of [t], if any *)
+  (** Take and remove the last value from back of [t], if any *)
 
   val take_back_exn : t -> Array.elt
-  (** Take the last value from back of [t].
+  (** Take and remove the last value from back of [t].
       @raise Empty if buffer is already empty. *)
 
   val take_front : t -> Array.elt option
-  (** Take the first value from front of [t], if any *)
+  (** Take and remove the first value from front of [t], if any *)
 
   val take_front_exn : t -> Array.elt
-  (** Take the first value from front of [t].
+  (** Take and remove the first value from front of [t].
       @raise Empty if buffer is already empty. *)
 
   val of_array : Array.t -> t
@@ -210,4 +204,7 @@ module Byte : S with module Array = Array.Byte
 module MakeFromArray(A : Array.S) : S with module Array = A
 
 (** Buffer using regular arrays *)
-module Make(X : sig type t end) : S with type Array.elt = X.t and type Array.t = X.t array
+module Make(X : sig
+    type t
+    val dummy : t
+  end) : S with type Array.elt = X.t and type Array.t = X.t array

src/data/CCSimple_queue.ml

@@ -0,0 +1,201 @@
+
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {1 Functional queues (fifo)} *)
+
+type 'a sequence = ('a -> unit) -> unit
+type 'a printer = Format.formatter -> 'a -> unit
+type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
+type 'a gen = unit -> 'a option
+
+type 'a t = {
+  hd : 'a list;
+  tl : 'a list;
+} (** Queue containing elements of type 'a *)
+
+let empty = {
+  hd = [];
+  tl = [];
+}
+
+(* invariant: if hd=[], then tl=[] *)
+let make_ hd tl = match hd with
+  | [] -> {hd=List.rev tl; tl=[] }
+  | _::_ -> {hd; tl; }
+
+let is_empty q = q.hd = []
+
+let push x q = make_ q.hd (x :: q.tl)
+
+let snoc q x = push x q
+
+let peek_exn q =
+  match q.hd with
+    | [] -> assert (q.tl = []); invalid_arg "Queue.peek"
+    | x::_ -> x
+
+let peek q = match q.hd with
+  | [] -> None
+  | x::_ -> Some x
+
+let pop_exn q =
+  match q.hd with
+    | [] -> assert (q.tl = []); invalid_arg "Queue.peek"
+    | x::hd' ->
+      let q' = make_ hd' q.tl in
+      x, q'
+
+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
+    q'
+  with Invalid_argument _ -> q
+
+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'
+
+(* iterate on a list in reverse order *)
+let rec rev_iter_ f l = match l with
+  | [] -> ()
+  | x :: tl -> rev_iter_ f tl; f x
+
+let iter f q =
+  List.iter f q.hd;
+  rev_iter_ f q.tl
+
+let to_list q = fold (fun acc x->x::acc) [] q |> List.rev
+
+let add_list q l = List.fold_left snoc q l
+let of_list l = add_list empty l
+
+let to_seq q = fun k -> iter k q
+
+let add_seq q seq =
+  let q = ref q in
+  seq (fun x -> q := push x !q);
+  !q
+
+let of_seq s = add_seq empty s
+
+(*$Q
+  Q.(list small_int) (fun l -> \
+    equal CCInt.equal \
+      (of_seq (Sequence.of_list l)) \
+      (of_list l))
+  Q.(list small_int) (fun l -> \
+    l = (of_list l |> to_seq |> Sequence.to_list))
+*)
+
+let rec klist_iter_ k f = match k() with
+  | `Nil -> ()
+  | `Cons (x,tl) -> f x; klist_iter_ tl f
+
+let add_klist q l = add_seq q (klist_iter_ l)
+let of_klist l = add_klist empty l
+
+let to_klist q =
+  let rec aux1 l () = match l with
+    | [] -> aux2 (List.rev q.tl) ()
+    | x :: tl -> `Cons (x, aux1 tl)
+  and aux2 l () = match l with
+    | [] -> `Nil
+    | x :: tl -> `Cons (x, aux2 tl)
+  in
+  aux1 q.hd
+
+let rec gen_iter g f = match g() with
+  | None -> ()
+  | Some x -> f x; gen_iter g f
+
+let add_gen q g = add_seq q (gen_iter g)
+let of_gen g = add_gen empty g
+
+let to_gen q =
+  let st = ref (`Left q.hd) in
+  let rec aux () = match !st with
+    | `Stop -> None
+    | `Left [] -> st := `Right q.tl; aux()
+    | `Left (x::tl) -> st := `Left tl; Some x
+    | `Right [] -> st := `Stop; None
+    | `Right (x::tl) -> st := `Right tl; Some x
+  in
+  aux
+
+let rec klist_equal eq l1 l2 = match l1(), l2() with
+  | `Nil, `Nil -> true
+  | `Nil, _
+  | _, `Nil -> false
+  | `Cons (x1,l1'), `Cons (x2,l2') ->
+    eq x1 x2 && klist_equal eq l1' l2'
+
+let equal eq q1 q2 = klist_equal eq (to_klist q1) (to_klist 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
+  let (@) = append
+end
+
+include Infix
+
+(** {2 IO} *)
+
+let pp ?(sep=fun out () -> Format.fprintf out ",@ ") pp_item out l =
+  let first = ref true in
+  iter
+    (fun x ->
+       if !first then first := false else sep out ();
+       pp_item out x)
+    l

src/data/CCSimple_queue.mli

@@ -0,0 +1,90 @@
+
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {1 Functional queues (fifo)} *)
+
+(** Simple implementation of functional queues
+    @since 1.3 *)
+
+type 'a sequence = ('a -> unit) -> unit
+type 'a printer = Format.formatter -> 'a -> unit
+type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
+type 'a gen = unit -> 'a option
+
+type +'a t
+(** Queue containing elements of type 'a *)
+
+val empty : 'a t
+
+val is_empty : 'a t -> bool
+
+val push : 'a -> 'a t -> 'a t
+(** Push element at the end of the queue *)
+
+val snoc : 'a t -> 'a -> 'a t
+(** Flip version of {!push} *)
+
+val peek : 'a t -> 'a option
+(** First element of the queue *)
+
+val peek_exn : 'a t -> 'a
+(** Same as {!peek} but
+    @raise Invalid_argument if the queue is empty *)
+
+val pop : 'a t -> ('a * 'a t) option
+(** Get and remove the first element *)
+
+val pop_exn : 'a t -> ('a * 'a t)
+(** Same as {!pop}, but fails on empty queues.
+    @raise Invalid_argument if the queue is empty *)
+
+val junk : 'a t -> 'a t
+(** Remove first element. If the queue is empty, do nothing. *)
+
+val append : 'a t -> 'a t -> 'a t
+(** Append two queues. Elements from the second one come
+    after elements of the first one.
+    Linear in the size of the second queue. *)
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+(** Map values *)
+
+val rev : 'a t -> 'a t
+(** Reverse the queue. Constant time. *)
+
+val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+
+module Infix : sig
+  val (>|=) : 'a t -> ('a -> 'b) -> 'b t (** Alias to {!map} *)
+  val (@) : 'a t -> 'a t -> 'a t (** Alias to {!append} *)
+  val (<::) : 'a t -> 'a -> 'a t (** Alias to {!snoc} *)
+end
+
+include module type of Infix
+
+val length : 'a t -> int
+(** Number of elements in the queue (linear in time) *)
+
+val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
+
+val iter : ('a -> unit) -> 'a t -> unit
+
+val to_list : 'a t -> 'a list
+val add_list : 'a t -> 'a list -> 'a t
+val of_list : 'a list -> 'a t
+
+val to_seq : 'a t -> 'a sequence
+val add_seq : 'a t -> 'a sequence -> 'a t
+val of_seq : 'a sequence -> 'a t
+
+val to_klist : 'a t -> 'a klist
+val add_klist : 'a t -> 'a klist -> 'a t
+val of_klist : 'a klist -> 'a t
+
+val of_gen : 'a gen -> 'a t
+val add_gen : 'a t -> 'a gen -> 'a t
+val to_gen : 'a t -> 'a gen
+
+(** {2 IO} *)
+
+val pp : ?sep:unit printer -> 'a printer -> 'a t printer

src/data/CCTrie.ml

@@ -684,25 +684,27 @@ module Make(W : WORD)
       | [] | [_] -> 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 printable_string small_int)) \
+    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 |> Sequence.for_all (fun (k',v) -> k' >= k)) \
           l)
-    Q.(list_of_size Gen.(1 -- 20) (pair printable_string small_int)) \
+    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 |> Sequence.for_all (fun (k',v) -> k' <= k)) \
           l)
-    Q.(list_of_size Gen.(1 -- 20) (pair printable_string small_int)) \
+    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 |> Sequence.to_list |> sorted ~rev:false) \
           l)
-    Q.(list_of_size Gen.(1 -- 20) (pair printable_string small_int)) \
+    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 |> Sequence.to_list |> sorted ~rev:true) \

src/data/CCZipper.ml

@@ -17,7 +17,7 @@ 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 -> \

src/data/containers_data.mldylib

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: faa1bae1054c39ac202fac31d38a084e)
+# DO NOT EDIT (digest: d1bab4c4f6793f682baaf28f0865fa42)
 CCMultiMap
 CCMultiSet
 CCTrie
@@ -21,6 +21,7 @@ CCBitField
 CCHashTrie
 CCWBTree
 CCRAL
+CCSimple_queue
 CCImmutArray
 CCHet
 CCZipper

src/data/containers_data.mllib

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: faa1bae1054c39ac202fac31d38a084e)
+# DO NOT EDIT (digest: d1bab4c4f6793f682baaf28f0865fa42)
 CCMultiMap
 CCMultiSet
 CCTrie
@@ -21,6 +21,7 @@ CCBitField
 CCHashTrie
 CCWBTree
 CCRAL
+CCSimple_queue
 CCImmutArray
 CCHet
 CCZipper