Merge branch 'master' into stable for 0.19

.ocamlinit

@@ -30,6 +30,5 @@
 #load "containers_top.cma";;
 #thread;;
 #load "containers_thread.cma";;
-#install_printer CCSexp.print;;
 (* vim:syntax=ocaml:
 *)

CHANGELOG.adoc

@@ -1,5 +1,17 @@
 = Changelog
 
+== 0.19
+
+- add regression test for #75
+- Fix `CCString.Split.{left,right}` (#75)
+- additional functions in `CCMultiSet`
+- show ocaml array type concretely in `CCRingBuffer.Make` sig
+- cleanup and more tests in `CCHeap`
+- fix bugs in `CCFlatHashtbl`, add some tests
+- add more generic printers for `CCError` and `CCResult` (close #73)
+- add `CCstring.of_char`
+- update headers
+
 == 0.18
 
 - update implem of `CCVector.equal`
@@ -9,7 +21,7 @@
 - add aliases to deprecated  functions from `String`, add `Fun.opaque_identity`
 - add `CCLazy_list.take`
 - add `Lazy_list.filter`
-- add CCList.range_by
+- add `CCList.range_by`
 
 == 0.17
 

HOWTO.adoc

@@ -5,19 +5,21 @@
 Beforehand, check `grep deprecated -r src` to see whether some functions
 can be removed.
 
-1. `make test`
+. `make test`
-2. update version in `_oasis`
+. update version in `_oasis`
-3. `make update_next_tag` (to update `@since` comments; be careful not to change symlinks)
+. `make update_next_tag` (to update `@since` comments; be careful not to change symlinks)
-4. check status of modules (`{b status: foo}`) and update if required;
+. check status of modules (`{b status: foo}`) and update if required;
    removed deprecated functions, etc.
-5. update `CHANGELOG.md` (see its end to find the right git command)
+. update `CHANGELOG.md` (see its end to find the right git command)
-6. commit the changes
+. commit the changes
-7. `git checkout stable`
+. `git checkout stable`
-8. `git merge master`
+. `git merge master`
-9. `oasis setup; make test doc`
+. `oasis setup; make test doc`
-10. tag, and push both to github
+. update `opam` (the version field; remove `oasis` in deps)
-11. `opam pin https://github.com/c-cube/ocaml-containers#<release>`
+. tag, and push both to github
-12. new opam package: `opam publish prepare; opam publish submit`
+. `opam pin add containers https://github.com/c-cube/ocaml-containers.git#<release>`
+. new opam package: `opam publish prepare; opam publish submit`
+. re-generate doc: `make doc push_doc`
 
 == List Authors
 

_oasis

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

opam

@@ -1,6 +1,6 @@
 opam-version: "1.2"
 name: "containers"
-version: "0.17"
+version: "0.19"
 author: "Simon Cruanes"
 maintainer: "simon.cruanes@inria.fr"
 build: [
@@ -26,13 +26,18 @@ remove: [
 ]
 depends: [
     "ocamlfind" {build}
-    "oasis" {build}
     "base-bytes"
     "result"
     "cppo" {build}
     "ocamlbuild" {build}
 ]
-depopts: [ "sequence" "base-bigarray" "base-unix" "base-threads" "qtest" { test } ]
+depopts: [
+  "sequence"
+  "base-bigarray"
+  "base-unix"
+  "base-threads"
+  "qtest" { test }
+]
 conflicts: [
   "sequence" { < "0.5" }
   "qtest" { < "2.2" }
@@ -45,12 +50,8 @@ available: [ocaml-version >= "4.00.0"]
 dev-repo: "https://github.com/c-cube/ocaml-containers.git"
 bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"
 post-messages: [
-"Another large release, with many new features:
+"Small release with mostly bugfixes, and a few improvements of some
+already existing modules.
 
-- performance improvements, in particular for string search (using KMP)
+changelog: https://github.com/c-cube/ocaml-containers/blob/0.19/CHANGELOG.adoc"
-- `CCHet`, a heterogeneous map with unique keys
-- `CCImmutArray`, immutable arrays
-- `CCString.pad`, for webscale string padding!
-
-as usual, see https://github.com/c-cube/ocaml-containers/blob/0.17/CHANGELOG.adoc"
 ]

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.4 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 935c9eb827a9a1a9b4de988f1afb58dd) *)
+(* DO NOT EDIT (digest: cbbbbd12ca7bf75f770eaacaf3a54236) *)
 (*
    Regenerated by OASIS v0.4.6
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6898,7 +6898,7 @@ let setup_t =
           alpha_features = ["ocamlbuild_more_args"];
           beta_features = [];
           name = "containers";
-          version = "0.18";
+          version = "0.19";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -7745,8 +7745,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.6";
-     oasis_digest =
+     oasis_digest = Some ",\224J\206\221\238\129V\182\136\172 \240v\168\211";
-       Some "\006\139\194\135\189\021\197\018\208\031.\187\212'\016\192";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -7754,6 +7753,6 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 7758 "setup.ml"
+# 7757 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

src/core/CCError.ml

@@ -260,6 +260,14 @@ let pp pp_x buf e = match e with
   | `Ok x -> Printf.bprintf buf "ok(%a)" pp_x x
   | `Error s -> Printf.bprintf buf "error(%s)" s
 
+let pp' pp_x pp_e buf e = match e with
+  | `Ok x -> Printf.bprintf buf "ok(%a)" pp_x x
+  | `Error s -> Printf.bprintf buf "error(%a)" pp_e s
+
 let print pp_x fmt e = match e with
   | `Ok x -> Format.fprintf fmt "@[ok(@,%a)@]" pp_x x
   | `Error s -> Format.fprintf fmt "@[error(@,%s)@]" s
+
+let print' pp_x pp_e fmt e = match e with
+  | `Ok x -> Format.fprintf fmt "@[ok(@,%a)@]" pp_x x
+  | `Error s -> Format.fprintf fmt "@[error(@,%a)@]" pp_e s

src/core/CCError.mli

@@ -190,8 +190,16 @@ val to_seq : ('a, _) t -> 'a sequence
 
 val pp : 'a printer -> ('a, string) t printer
 
+val pp': 'a printer -> 'e printer -> ('a, 'e) t printer
+(** Printer that is generic on the error type
+    @since 0.19 *)
+
 val print : 'a formatter -> ('a, string) t formatter
 
+val print' : 'a formatter -> 'e formatter -> ('a, 'e) t formatter
+(** Printer that is generic on the error type
+    @since 0.19 *)
+
 (** {2 Global Exception Printers}
 
 One can register exception printers here, so they will be used by {!guard},

src/core/CCHeap.ml

@@ -64,6 +64,19 @@ end
   )
 *)
 
+(* test filter *)
+(*$QR & ~count:30
+  Q.(list_of_size Gen.(return 1_000) int) (fun l ->
+    (* put elements into a heap *)
+    let h = H.of_seq (Sequence.of_list l) in
+    let h = H.filter (fun x->x mod 2=0) h in
+    OUnit.assert_bool "all odd"
+      (H.to_seq h |> Sequence.for_all (fun x -> x mod 2 = 0));
+    let l' = extract_list h in
+    is_sorted l'
+  )
+*)
+
 module type S = sig
   type elt
   type t
@@ -114,7 +127,7 @@ module type S = sig
   (** Number of elements (linear complexity) *)
 
   (** {2 Conversions}
-      
+
       The interface of [of_gen], [of_seq], [of_klist]
       has changed @since 0.16 (the old signatures
       are now [add_seq], [add_gen], [add_klist]) *)

src/core/CCHeap.mli

@@ -65,7 +65,7 @@ module type S = sig
   (** Number of elements (linear complexity) *)
 
   (** {2 Conversions}
-      
+
       The interface of [of_gen], [of_seq], [of_klist]
       has changed @since 0.16 (the old signatures
       are now [add_seq], [add_gen], [add_klist]) *)

src/core/CCResult.ml

@@ -261,6 +261,14 @@ let pp pp_x buf e = match e with
   | Ok x -> Printf.bprintf buf "ok(%a)" pp_x x
   | Error s -> Printf.bprintf buf "error(%s)" s
 
+let pp' pp_x pp_e buf e = match e with
+  | Ok x -> Printf.bprintf buf "ok(%a)" pp_x x
+  | Error s -> Printf.bprintf buf "error(%a)" pp_e s
+
 let print pp_x fmt e = match e with
   | Ok x -> Format.fprintf fmt "@[ok(@,%a)@]" pp_x x
   | Error s -> Format.fprintf fmt "@[error(@,%s)@]" s
+
+let print' pp_x pp_e fmt e = match e with
+  | Ok x -> Format.fprintf fmt "@[ok(@,%a)@]" pp_x x
+  | Error s -> Format.fprintf fmt "@[error(@,%a)@]" pp_e s

src/core/CCResult.mli

@@ -193,4 +193,13 @@ val to_err : ('a, 'b) t -> ('a, 'b) error
 
 val pp : 'a printer -> ('a, string) t printer
 
+val pp': 'a printer -> 'e printer -> ('a, 'e) t printer
+(** Printer that is generic on the error type
+    @since 0.19 *)
+
 val print : 'a formatter -> ('a, string) t formatter
+
+val print' : 'a formatter -> 'e formatter -> ('a, 'e) t formatter
+(** Printer that is generic on the error type
+    @since 0.19 *)
+

src/core/CCString.cppo.ml

@@ -367,14 +367,18 @@ module Split = struct
   let left_exn ~by s =
     let i = find ~sub:by s in
     if i = ~-1 then raise Not_found
-    else String.sub s 0 i, String.sub s (i+1) (String.length s - i - 1)
+    else
+      let right = i + String.length by in
+      String.sub s 0 i, String.sub s right (String.length s - right)
 
   let left ~by s = try Some (left_exn ~by s) with Not_found -> None
 
   let right_exn ~by s =
     let i = rfind ~sub:by s in
     if i = ~-1 then raise Not_found
-    else String.sub s 0 i, String.sub s (i+1) (String.length s - i - 1)
+    else
+      let right = i + String.length by in
+      String.sub s 0 i, String.sub s right (String.length s - right)
 
   let right ~by s = try Some (right_exn ~by s) with Not_found -> None
 end
@@ -398,11 +402,6 @@ let compare_versions a b =
   in
   cmp_rec (Split.gen_cpy ~by:"." a) (Split.gen_cpy ~by:"." b)
 
-(*$Q
-  Q.(pair printable_string printable_string) (fun (a,b) -> \
-    CCOrd.equiv (compare_versions a b) (CCOrd.opp (compare_versions b a)))
-*)
-
 let repeat s n =
   assert (n>=0);
   let len = String.length s in
@@ -475,6 +474,8 @@ let _to_gen s i0 len =
 
 let to_gen s = _to_gen s 0 (String.length s)
 
+let of_char c = String.make 1 c
+
 let of_gen g =
   let b = Buffer.create 32 in
   let rec aux () = match g () with

src/core/CCString.mli

@@ -94,6 +94,10 @@ val pad : ?side:[`Left|`Right] -> ?c:char -> int -> string -> string
   "aaa" (pad ~side:`Right ~c:'a' 3 "")
 *)
 
+val of_char : char -> string
+(** [of_char 'a' = "a"]
+    @since 0.19 *)
+
 val of_gen : char gen -> string
 val of_seq : char sequence -> string
 val of_klist : char klist -> string
@@ -445,7 +449,10 @@ module Split : sig
 
   (*$T
     Split.left ~by:" " "ab cde f g " = Some ("ab", "cde f g ")
+    Split.left ~by:"__" "a__c__e_f" = Some ("a", "c__e_f")
     Split.left ~by:"_" "abcde" = None
+    Split.left ~by:"bb" "abbc" = Some ("a", "c")
+    Split.left ~by:"a_" "abcde" = None
   *)
 
   val right : by:string -> string -> (string * string) option
@@ -460,7 +467,9 @@ module Split : sig
 
   (*$T
     Split.right ~by:" " "ab cde f g" = Some ("ab cde f", "g")
+    Split.right ~by:"__" "a__c__e_f" = Some ("a__c", "e_f")
     Split.right ~by:"_" "abcde" = None
+    Split.right ~by:"a_" "abcde" = None
   *)
 end
 
@@ -480,6 +489,12 @@ val compare_versions : string -> string -> int
   compare_versions "1.2.3.4" "01.2.4.3" < 0
 *)
 
+(*$Q
+  Q.(pair printable_string printable_string) (fun (a,b) -> \
+    CCOrd.equiv (compare_versions a b) (CCOrd.opp compare_versions b a))
+*)
+
+
 (** {2 Slices} A contiguous part of a string *)
 
 module Sub : sig

src/core/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: 048ee564ec86589b85b55f903119ad20)
+# DO NOT EDIT (digest: 56ec39bd73892c447789e2116b0f000e)
-version = "0.18"
+version = "0.19"
 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 = "0.18"
+ version = "0.19"
  description = "A modular standard library focused on data structures."
  requires = "bytes unix"
  archive(byte) = "containers_unix.cma"
@@ -20,7 +20,7 @@ package "unix" (
 )
 
 package "top" (
- version = "0.18"
+ version = "0.19"
  description = "A modular standard library focused on data structures."
  requires =
  "compiler-libs.common containers containers.data containers.bigarray containers.string containers.unix containers.sexp containers.iter"
@@ -32,7 +32,7 @@ package "top" (
 )
 
 package "thread" (
- version = "0.18"
+ version = "0.19"
  description = "A modular standard library focused on data structures."
  requires = "containers threads"
  archive(byte) = "containers_thread.cma"
@@ -43,7 +43,7 @@ package "thread" (
 )
 
 package "string" (
- version = "0.18"
+ version = "0.19"
  description = "A modular standard library focused on data structures."
  requires = "bytes"
  archive(byte) = "containers_string.cma"
@@ -54,7 +54,7 @@ package "string" (
 )
 
 package "sexp" (
- version = "0.18"
+ version = "0.19"
  description = "A modular standard library focused on data structures."
  requires = "bytes"
  archive(byte) = "containers_sexp.cma"
@@ -65,7 +65,7 @@ package "sexp" (
 )
 
 package "iter" (
- version = "0.18"
+ version = "0.19"
  description = "A modular standard library focused on data structures."
  archive(byte) = "containers_iter.cma"
  archive(byte, plugin) = "containers_iter.cma"
@@ -75,7 +75,7 @@ package "iter" (
 )
 
 package "io" (
- version = "0.18"
+ version = "0.19"
  description = "A modular standard library focused on data structures."
  requires = "bytes"
  archive(byte) = "containers_io.cma"
@@ -86,7 +86,7 @@ package "io" (
 )
 
 package "data" (
- version = "0.18"
+ version = "0.19"
  description = "A modular standard library focused on data structures."
  requires = "bytes"
  archive(byte) = "containers_data.cma"
@@ -97,7 +97,7 @@ package "data" (
 )
 
 package "bigarray" (
- version = "0.18"
+ version = "0.19"
  description = "A modular standard library focused on data structures."
  requires = "containers bigarray bytes"
  archive(byte) = "containers_bigarray.cma"
@@ -108,7 +108,7 @@ package "bigarray" (
 )
 
 package "advanced" (
- version = "0.18"
+ version = "0.19"
  description = "A modular standard library focused on data structures."
  requires = "containers sequence"
  archive(byte) = "containers_advanced.cma"

src/data/CCFlatHashtbl.ml

@@ -101,6 +101,9 @@ module Make(X : HASHABLE) = struct
     let i = min Sys.max_array_length (max i 8) in
     { arr=Array.make i Empty; size=0; }
 
+  (* TODO: enforce that [tbl.arr] has a power of 2 as length, then
+     initial_index is just a mask with (length-1)? *)
+
   (* initial index for a value with hash [h] *)
   let _initial_idx tbl h =
     h mod Array.length tbl.arr
@@ -109,18 +112,15 @@ module Make(X : HASHABLE) = struct
     let i' = i+1 in
     if i' = Array.length tbl.arr then 0 else i'
 
-  let _pred tbl i =
-    if i = 0 then Array.length tbl.arr - 1 else i-1
-
   (* distance to initial bucket, at index [i] with hash [h] *)
-  let _dib tbl h i =
+  let _dib tbl h ~i =
     let i0 = _initial_idx tbl h in
     if i>=i0
-      then i-i0
+    then i - i0
-      else i+ (Array.length tbl.arr - i0 - 1)
+    else i + (Array.length tbl.arr - i0)
 
-  (* insert k->v in [tbl], currently at index [i] *)
+  (* insert k->v in [tbl], currently at index [i] and distance [dib] *)
-  let rec _linear_probe tbl k v h_k i =
+  let rec _linear_probe tbl k v h_k i dib =
     match tbl.arr.(i) with
     | Empty ->
         (* add binding *)
@@ -131,14 +131,16 @@ module Make(X : HASHABLE) = struct
         assert (h_k = h_k');
         tbl.arr.(i) <- Key (k, v, h_k)
     | Key (k', v', h_k') ->
-        if _dib tbl h_k i < _dib tbl h_k' i
+        let dib' = _dib tbl h_k' ~i in
+        if dib > dib'
         then (
           (* replace *)
           tbl.arr.(i) <- Key (k, v, h_k);
-          _linear_probe tbl k' v' h_k' (_succ tbl i)
+          _linear_probe tbl k' v' h_k' (_succ tbl i) (dib'+1)
-        ) else
+        ) else (
           (* go further *)
-          _linear_probe tbl k v h_k (_succ tbl i)
+          _linear_probe tbl k v h_k (_succ tbl i) (dib+1)
+        )
 
   (* resize table: put a bigger array in it, then insert values
     from the old array *)
@@ -152,65 +154,73 @@ module Make(X : HASHABLE) = struct
     Array.iter
       (function
         | Empty -> ()
-        | Key (k, v, h_k) -> _linear_probe tbl k v h_k (_initial_idx tbl h_k)
+        | Key (k, v, h_k) ->
-      ) old_arr
+          _linear_probe tbl k v h_k (_initial_idx tbl h_k) 0)
+      old_arr
 
   let add tbl k v =
-    if _reached_max_load tbl
+    if _reached_max_load tbl then _resize tbl;
-      then _resize tbl;
     (* insert value *)
     let h_k = X.hash k in
-    _linear_probe tbl k v h_k (_initial_idx tbl h_k)
+    _linear_probe tbl k v h_k (_initial_idx tbl h_k) 0
 
-  (* shift back elements that have a DIB > 0 until an empty bucket is
+  (* shift back elements that have a DIB > 0 until an empty bucket
-   met, or some element doesn't need shifting *)
+     or a bucket that doesn't need shifting is met *)
-  let rec _backward_shift tbl i =
+  let rec _backward_shift tbl ~prev:prev_i i =
     match tbl.arr.(i) with
-    | Empty -> ()
+    | Empty ->
-    | Key (_, _, h_k) when _dib tbl h_k i = 0 ->
+        tbl.arr.(prev_i) <- Empty;
-        ()  (* stop *)
+    | Key (_, _, h_k) as bucket ->
-    | Key (_k, _v, h_k) as bucket ->
+        let d = _dib tbl h_k ~i in
-        assert (_dib tbl h_k i > 0);
+        assert (d >= 0);
-        (* shift backward *)
+        if d > 0 then (
-        tbl.arr.(_pred tbl i) <- bucket;
+          (* shift backward *)
-        tbl.arr.(i) <- Empty;
+          tbl.arr.(prev_i) <- bucket;
-        _backward_shift tbl (_succ tbl i)
+          _backward_shift tbl ~prev:i (_succ tbl i)
+        ) else (
+          tbl.arr.(prev_i) <- Empty;
+        )
 
-  (* linear probing for removal of [k] *)
+  (* linear probing for removal of [k]: find the bucket containing [k],
-  let rec _linear_probe_remove tbl k h_k i =
+     if any, and perform backward shift from there *)
+  let rec _linear_probe_remove tbl k h_k i dib =
     match tbl.arr.(i) with
     | Empty -> ()
     | Key (k', _, _) when X.equal k k' ->
-        tbl.arr.(i) <- Empty;
         tbl.size <- tbl.size - 1;
-        _backward_shift tbl (_succ tbl i)
+        (* shift all elements that follow and have a DIB > 0;
+           it will also erase the last shifted bucket, and erase [i] in
+           any case *)
+        _backward_shift tbl ~prev:i (_succ tbl i)
     | Key (_, _, h_k') ->
-        if _dib tbl h_k' i < _dib tbl h_k i
+      if dib > _dib tbl h_k' ~i
-          then ()  (* [k] not present, would be here otherwise *)
+      then ()  (* [k] not present, would be here otherwise *)
-          else _linear_probe_remove tbl k h_k (_succ tbl i)
+      else _linear_probe_remove tbl k h_k (_succ tbl i) (dib+1)
 
   let remove tbl k =
     let h_k = X.hash k in
-    _linear_probe_remove tbl k h_k (_initial_idx tbl h_k)
+    _linear_probe_remove tbl k h_k (_initial_idx tbl h_k) 0
 
-  let rec _get_exn tbl k h_k i dib =
+  let rec get_exn_rec tbl k h_k i dib =
     match tbl.arr.(i) with
     | Empty -> raise Not_found
     | Key (k', v', _) when X.equal k k' -> v'
     | Key (_, _, h_k') ->
-        if _dib tbl h_k' i < dib
+        if dib > _dib tbl h_k' ~i
-          then raise Not_found  (* [k] would be here otherwise *)
+        then raise Not_found  (* [k] would be here otherwise *)
-          else _get_exn tbl k h_k (_succ tbl i) (dib+1)
+        else get_exn_rec tbl k h_k (_succ tbl i) (dib+1)
 
   let get_exn k tbl =
     let h_k = X.hash k in
     let i0 = _initial_idx tbl h_k in
+    (* unroll a few steps *)
     match tbl.arr.(i0) with
     | Empty -> raise Not_found
     | Key (k', v, _) ->
       if X.equal k k' then v
-      else let i1 = _succ tbl i0 in
+      else
-        match  tbl.arr.(i1) with
+        let i1 = _succ tbl i0 in
+        match tbl.arr.(i1) with
         | Empty -> raise Not_found
         | Key (k', v, _) ->
           if X.equal k k' then v
@@ -220,7 +230,7 @@ module Make(X : HASHABLE) = struct
             | Empty -> raise Not_found
             | Key (k', v, _) ->
               if X.equal k k' then v
-              else _get_exn tbl k h_k (_succ tbl i2) 3
+              else get_exn_rec tbl k h_k (_succ tbl i2) 3
 
   let get k tbl =
     try Some (get_exn k tbl)
@@ -245,8 +255,8 @@ module Make(X : HASHABLE) = struct
     Array.fold_left
       (fun acc bucket -> match bucket with
         | Empty -> acc
-        | Key (k,v,_) -> (k,v)::acc
+        | Key (k,v,_) -> (k,v)::acc)
-      ) [] tbl.arr
+      [] tbl.arr
 
   let of_seq seq =
     let tbl = create 16 in
@@ -267,4 +277,112 @@ module Make(X : HASHABLE) = struct
     Array.iter
       (function Empty -> () | Key (_, v, _) -> yield v)
       tbl.arr
+
+  (*
+  let pp_debug_ out t =
+    let open T in
+    let pp_buck out (i,b) = match b with
+      | Empty -> Format.fprintf out "_"
+      | Key (k,v,h_k) ->
+        let dib = _dib t h_k ~i in
+        Format.fprintf out "[%d]{%d -> %d (dib=%d)}@," i (Obj.magic k) (Obj.magic v) dib
+    in
+    Format.fprintf out "@[";
+    Array.iteri
+      (fun i b -> pp_buck out (i,b))
+      t.arr;
+    Format.fprintf out "@]";
+    ()
+   *)
 end
+
+(*$inject
+  module T = Make(CCInt)
+
+  let gen_l =
+   let g = Q.(list (pair small_int small_int)) in
+   Q.map_same_type
+    (CCList.sort_uniq ~cmp:(fun x y -> compare (fst x) (fst y)))
+    g
+
+
+  type op =
+    | Add of int*int
+    | Remove of int
+
+  let op_add x y = Add (x,y)
+  let op_remove x = Remove x
+
+  let op_exec t = function
+    | Add (x,y) -> T.add t x y
+    | Remove x -> T.remove t x
+
+  let op_pp = function
+    | Add (x,y) -> Printf.sprintf "add(%d,%d)" x y
+    | Remove x -> Printf.sprintf "remove(%d)" x
+
+  let gen_ops n =
+    let open Q.Gen in
+    let gen_op =
+      frequency
+        [ 2, return op_add <*> small_int <*> small_int
+        ; 1, return op_remove <*> small_int
+        ]
+    in
+    list_size (0--n) gen_op
+
+  let arb_ops n : op list Q.arbitrary =
+    let shrink_op o =
+      let open Q.Iter in
+      match o with
+      | Add (x,y) ->
+        (return op_add <*> Q.Shrink.int x <*> return y)
+        <+>
+        (return op_add <*> return x <*> Q.Shrink.int y)
+      | Remove x -> map op_remove (Q.Shrink.int x)
+    in
+    let shrink =
+      Q.Shrink.list ~shrink:shrink_op in
+    let print = Q.Print.list op_pp in
+    Q.make ~shrink ~print (gen_ops n)
+
+  module TRef = CCHashtbl.Make(CCInt)
+
+  let op_exec_ref t = function
+    | Add (x,y) -> TRef.replace t x y
+    | Remove x -> TRef.remove t x
+*)
+
+(*$T
+  let t = T.create 32 in \
+    T.add t 0 "0"; T.find t 0 = Some "0"
+*)
+
+(*$Q
+  gen_l (fun l -> \
+  (T.of_list l |> T.to_list |> List.sort CCOrd.compare) = l)
+*)
+
+(* test that the table behaves the same as a normal hashtable *)
+
+(*$inject
+  let test_ops l =
+    let t = T.create 16 in
+    let t' = TRef.create 16 in
+    List.iter (op_exec t) l;
+    List.iter (op_exec_ref t') l;
+    (T.to_list t |> List.sort CCOrd.compare) =
+    (TRef.to_list t' |> List.sort CCOrd.compare)
+*)
+
+(*$Q & ~count:500
+  (arb_ops 300) test_ops
+*)
+
+(*$Q & ~count:10
+  (arb_ops 3000) test_ops
+*)
+
+(*$Q & ~count:5
+  (arb_ops 30000) test_ops
+*)

src/data/CCMultiSet.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 Multiset} *)
 
@@ -46,31 +24,53 @@ module type S = sig
   val remove : t -> elt -> t
 
   val add_mult : t -> elt -> int -> t
+  (** [add_mult set x n] adds [n] occurrences of [x] to [set]
+      @raise Invalid_argument if [n < 0]
+      @since 0.6 *)
 
   val remove_mult : t -> elt -> int -> t
+  (** [remove_mult set x n] removes at most [n] occurrences of [x] from [set]
+      @raise Invalid_argument if [n < 0]
+      @since 0.6 *)
 
   val update : t -> elt -> (int -> int) -> t
+  (** [update set x f] calls [f n] where [n] is the current multiplicity
+      of [x] in [set] ([0] to indicate its absence); the result of [f n]
+      is the new multiplicity of [x].
+      @raise Invalid_argument if [f n < 0]
+      @since 0.6 *)
 
   val min : t -> elt
+  (** Minimal element w.r.t the total ordering on elements *)
 
   val max : t -> elt
+  (** Maximal element w.r.t the total ordering on elements *)
 
   val union : t -> t -> t
+  (** [union a b] contains as many occurrences of an element [x]
+      as [count a x + count b x]. *)
 
   val meet : t -> t -> t
+  (** [meet a b] is a multiset such that
+      [count (meet a b) x = max (count a x) (count b x)] *)
 
   val intersection : t -> t -> t
+  (** [intersection a b] is a multiset such that
+      [count (intersection a b) x = min (count a x) (count b x)] *)
 
   val diff : t -> t -> t
+  (** MultiSet difference.
+      [count (diff a b) x = max (count a x - count b x) 0] *)
 
   val contains : t -> t -> bool
+  (** [contains a x = (count m x > 0)] *)
 
   val compare : t -> t -> int
 
   val equal : t -> t -> bool
 
   val cardinal : t -> int
-    (** Number of distinct elements *)
+  (** Number of distinct elements *)
 
   val iter : t -> (int -> elt -> unit) -> unit
 
@@ -83,6 +83,18 @@ module type S = sig
   val to_seq : t -> elt sequence
 
   val of_seq : elt sequence -> t
+
+  val of_list_mult : (elt * int) list -> t
+  (** @since 0.19 *)
+
+  val to_list_mult : t -> (elt * int) list
+  (** @since 0.19 *)
+
+  val to_seq_mult : t -> (elt * int) sequence
+  (** @since 0.19 *)
+
+  val of_seq_mult : (elt * int) sequence -> t
+  (** @since 0.19 *)
 end
 
 module Make(O : Set.OrderedType) = struct
@@ -221,6 +233,21 @@ module Make(O : Set.OrderedType) = struct
     let m = ref empty in
     seq (fun x -> m := add !m x);
     !m
+
+  let of_list_mult l =
+    List.fold_left
+      (fun s (x,i) -> add_mult s x i)
+      empty l
+
+  let to_list_mult m =
+    fold m [] (fun acc n x -> (x,n) :: acc)
+
+  let to_seq_mult m k = M.iter (fun x n -> k (x,n)) m
+
+  let of_seq_mult seq =
+    let m = ref empty in
+    seq (fun (x,n) -> m := add_mult !m x n);
+    !m
 end
 
 (*$T

src/data/CCMultiSet.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 Multiset} *)
 
@@ -105,6 +83,18 @@ module type S = sig
   val to_seq : t -> elt sequence
 
   val of_seq : elt sequence -> t
+
+  val of_list_mult : (elt * int) list -> t
+  (** @since 0.19 *)
+
+  val to_list_mult : t -> (elt * int) list
+  (** @since 0.19 *)
+
+  val to_seq_mult : t -> (elt * int) sequence
+  (** @since 0.19 *)
+
+  val of_seq_mult : (elt * int) sequence -> t
+  (** @since 0.19 *)
 end
 
 module Make(O : Set.OrderedType) : S with type elt = O.t

src/data/CCRingBuffer.mli

@@ -210,4 +210,4 @@ 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
+module Make(X : sig type t end) : S with type Array.elt = X.t and type Array.t = X.t array

src/sexp/CCSexpM.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 Simple S-expression parsing/printing} *)
 

src/sexp/CCSexpM.mli

@@ -1,31 +1,9 @@
-(*
-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 Simple and efficient S-expression parsing/printing}
 
-@since 0.7 *)
+    @since 0.7 *)
 
 type 'a or_error = [ `Ok of 'a | `Error of string ]
 type 'a sequence = ('a -> unit) -> unit

src/top/containers_top.ml

@@ -15,13 +15,15 @@ let install_printer s =
     ()
 let install_printers = List.iter install_printer
 
-let pp_vector pp_x out (v: _ CCVector.vector) = CCVector.print pp_x out v
+let pp_rw_vector pp_x out (v: _ CCVector.vector) = CCVector.print pp_x out v
+let pp_ro_vector pp_x out (v: _ CCVector.ro_vector) = CCVector.print pp_x out v
 let pp_klist (ppx:Format.formatter -> 'a -> unit) out l = CCKList.print ppx out l
 
 let () =
   install_printers
     [ "CCHashtbl.print"
-    ; "Containers_top.pp_vector"
+    ; "Containers_top.pp_rw_vector"
+    ; "Containers_top.pp_ro_vector"
     ; "CCBV.print"
     ; "CCDeque.print"
     ; "CCFQueue.print"