diff --git a/.ocamlinit b/.ocamlinit index e97f1fcf..b5f96117 100644 --- a/.ocamlinit +++ b/.ocamlinit @@ -30,6 +30,5 @@ #load "containers_top.cma";; #thread;; #load "containers_thread.cma";; -#install_printer CCSexp.print;; (* vim:syntax=ocaml: *) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index 677e85ba..2f2ab89f 100644 --- a/CHANGELOG.adoc +++ b/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 diff --git a/HOWTO.adoc b/HOWTO.adoc index de85e04c..599a3e7c 100644 --- a/HOWTO.adoc +++ b/HOWTO.adoc @@ -5,19 +5,21 @@ Beforehand, check `grep deprecated -r src` to see whether some functions can be removed. -1. `make test` -2. update version in `_oasis` -3. `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; +. `make test` +. update version in `_oasis` +. `make update_next_tag` (to update `@since` comments; be careful not to change symlinks) +. check status of modules (`{b status: foo}`) and update if required; removed deprecated functions, etc. -5. update `CHANGELOG.md` (see its end to find the right git command) -6. commit the changes -7. `git checkout stable` -8. `git merge master` -9. `oasis setup; make test doc` -10. tag, and push both to github -11. `opam pin https://github.com/c-cube/ocaml-containers#` -12. new opam package: `opam publish prepare; opam publish submit` +. update `CHANGELOG.md` (see its end to find the right git command) +. commit the changes +. `git checkout stable` +. `git merge master` +. `oasis setup; make test doc` +. update `opam` (the version field; remove `oasis` in deps) +. tag, and push both to github +. `opam pin add containers https://github.com/c-cube/ocaml-containers.git#` +. new opam package: `opam publish prepare; opam publish submit` +. re-generate doc: `make doc push_doc` == List Authors diff --git a/_oasis b/_oasis index b8d14103..5c1d47ee 100644 --- a/_oasis +++ b/_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 diff --git a/opam b/opam index 1185f504..d77d1344 100644 --- a/opam +++ b/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) -- `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" +changelog: https://github.com/c-cube/ocaml-containers/blob/0.19/CHANGELOG.adoc" ] diff --git a/setup.ml b/setup.ml index f9920ad2..7bc25707 100644 --- a/setup.ml +++ b/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 = - Some "\006\139\194\135\189\021\197\018\208\031.\187\212'\016\192"; + oasis_digest = Some ",\224J\206\221\238\129V\182\136\172 \240v\168\211"; 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 ();; diff --git a/src/core/CCError.ml b/src/core/CCError.ml index ab9af226..3b6486c8 100644 --- a/src/core/CCError.ml +++ b/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 diff --git a/src/core/CCError.mli b/src/core/CCError.mli index 64bbf525..fef90137 100644 --- a/src/core/CCError.mli +++ b/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}, diff --git a/src/core/CCHeap.ml b/src/core/CCHeap.ml index 3e66c36a..6aeb19a7 100644 --- a/src/core/CCHeap.ml +++ b/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]) *) diff --git a/src/core/CCHeap.mli b/src/core/CCHeap.mli index 551f99b5..1713e3ce 100644 --- a/src/core/CCHeap.mli +++ b/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]) *) diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index da374da6..0da2eb95 100644 --- a/src/core/CCResult.ml +++ b/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 diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index 78f15010..9a1dedc2 100644 --- a/src/core/CCResult.mli +++ b/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 *) + diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 8a510d4e..d29da1e6 100644 --- a/src/core/CCString.cppo.ml +++ b/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 diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 4d292fd1..45de6bd2 100644 --- a/src/core/CCString.mli +++ b/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 diff --git a/src/core/META b/src/core/META index c5b3582c..ffbcc747 100644 --- a/src/core/META +++ b/src/core/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: 048ee564ec86589b85b55f903119ad20) -version = "0.18" +# DO NOT EDIT (digest: 56ec39bd73892c447789e2116b0f000e) +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" diff --git a/src/data/CCFlatHashtbl.ml b/src/data/CCFlatHashtbl.ml index 3393899b..5779c267 100644 --- a/src/data/CCFlatHashtbl.ml +++ b/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 - else i+ (Array.length tbl.arr - i0 - 1) + then i - i0 + else i + (Array.length tbl.arr - i0) - (* insert k->v in [tbl], currently at index [i] *) - let rec _linear_probe tbl k v h_k i = + (* insert k->v in [tbl], currently at index [i] and distance [dib] *) + 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) - ) else + _linear_probe tbl k' v' h_k' (_succ tbl i) (dib'+1) + ) 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) - ) old_arr + | Key (k, v, h_k) -> + _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 - then _resize tbl; + if _reached_max_load 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 - met, or some element doesn't need shifting *) - let rec _backward_shift tbl i = + (* shift back elements that have a DIB > 0 until an empty bucket + or a bucket that doesn't need shifting is met *) + let rec _backward_shift tbl ~prev:prev_i i = match tbl.arr.(i) with - | Empty -> () - | Key (_, _, h_k) when _dib tbl h_k i = 0 -> - () (* stop *) - | Key (_k, _v, h_k) as bucket -> - assert (_dib tbl h_k i > 0); - (* shift backward *) - tbl.arr.(_pred tbl i) <- bucket; - tbl.arr.(i) <- Empty; - _backward_shift tbl (_succ tbl i) + | Empty -> + tbl.arr.(prev_i) <- Empty; + | Key (_, _, h_k) as bucket -> + let d = _dib tbl h_k ~i in + assert (d >= 0); + if d > 0 then ( + (* shift backward *) + tbl.arr.(prev_i) <- bucket; + _backward_shift tbl ~prev:i (_succ tbl i) + ) else ( + tbl.arr.(prev_i) <- Empty; + ) - (* linear probing for removal of [k] *) - let rec _linear_probe_remove tbl k h_k i = + (* linear probing for removal of [k]: find the bucket containing [k], + 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 - then () (* [k] not present, would be here otherwise *) - else _linear_probe_remove tbl k h_k (_succ tbl i) + if dib > _dib tbl h_k' ~i + then () (* [k] not present, would be here otherwise *) + 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 - then raise Not_found (* [k] would be here otherwise *) - else _get_exn tbl k h_k (_succ tbl i) (dib+1) + if dib > _dib tbl h_k' ~i + then raise Not_found (* [k] would be here otherwise *) + 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 - match tbl.arr.(i1) with + else + 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 - ) [] tbl.arr + | Key (k,v,_) -> (k,v)::acc) + [] 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 +*) diff --git a/src/data/CCMultiSet.ml b/src/data/CCMultiSet.ml index f5c0389b..3b0bf680 100644 --- a/src/data/CCMultiSet.ml +++ b/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 -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. -*) +(* This file is free software, part of containers. See file "license" for more details. *) (** {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 diff --git a/src/data/CCMultiSet.mli b/src/data/CCMultiSet.mli index dff270fb..8dcb6b9a 100644 --- a/src/data/CCMultiSet.mli +++ b/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 -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. -*) +(* This file is free software, part of containers. See file "license" for more details. *) (** {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 diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli index b657f47a..04f7156a 100644 --- a/src/data/CCRingBuffer.mli +++ b/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 diff --git a/src/sexp/CCSexpM.ml b/src/sexp/CCSexpM.ml index 167db917..d714924f 100644 --- a/src/sexp/CCSexpM.ml +++ b/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 -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. -*) +(* This file is free software, part of containers. See file "license" for more details. *) (** {1 Simple S-expression parsing/printing} *) diff --git a/src/sexp/CCSexpM.mli b/src/sexp/CCSexpM.mli index b16fe259..74f723c7 100644 --- a/src/sexp/CCSexpM.mli +++ b/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 -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. -*) +(* This file is free software, part of containers. See file "license" for more details. *) (** {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 diff --git a/src/top/containers_top.ml b/src/top/containers_top.ml index 0e4bafb6..4d9a3869 100644 --- a/src/top/containers_top.ml +++ b/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"