diff --git a/.merlin b/.merlin index 09ba253e..0110f580 100644 --- a/.merlin +++ b/.merlin @@ -18,4 +18,4 @@ PKG threads PKG threads.posix PKG lwt PKG qcheck -FLG -w +a -w -4 -w -44 +FLG -w +a-4-44-48-60 diff --git a/.ocp-indent b/.ocp-indent new file mode 100644 index 00000000..98dcc784 --- /dev/null +++ b/.ocp-indent @@ -0,0 +1,2 @@ +match_clause=2 +with=2 diff --git a/AUTHORS.adoc b/AUTHORS.adoc index 561fa633..b31a8f64 100644 --- a/AUTHORS.adoc +++ b/AUTHORS.adoc @@ -21,4 +21,5 @@ - Glenn Slotte (glennsl) - @LemonBoy - Leonid Rozenberg (@rleonid) -- Bikal Gurung (@bikalgurung) \ No newline at end of file +- Bikal Gurung (@bikalgurung) +- Fabian Hemmer (copy) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index 92ce2c9d..badb978e 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -1,5 +1,25 @@ = Changelog +== 1.4 + +- add `CCMap.union` +- add `CCRef.swap` +- add `CCArray.swap` +- change signature of `CCWBTree.get_rank` +- add `CCWBTree.get_rank{,_exn}` + +- more efficient `List.map` Using efficient chunking algorithm +- Fix `CCVector.append_array` (empty vector case) +- `CCFQueue.take_back_exn` raised InvalidArg instead of Empty on an empty queue +- faster `CCString.{prefix,suffix}` +- speed improvements and benchmarks for `CCString.{prefix,suffix}` + +- add ocp-indent file +- fix `CCFun.tap` example in doc +- specify behavior of `CCFQueue.take_{front,back}_l` in some corner cases +- More tests for CCVector.append and CCVector.append_array +- assertions and cleanup in `CCPool` + == 1.3 - deprecate `CCBool.negate` diff --git a/HOWTO.adoc b/HOWTO.adoc index 599a3e7c..ea0f84d9 100644 --- a/HOWTO.adoc +++ b/HOWTO.adoc @@ -10,7 +10,7 @@ can be removed. . `make update_next_tag` (to update `@since` comments; be careful not to change symlinks) . check status of modules (`{b status: foo}`) and update if required; removed deprecated functions, etc. -. update `CHANGELOG.md` (see its end to find the right git command) +. update `CHANGELOG.adoc` (see its end to find the right git command) . commit the changes . `git checkout stable` . `git merge master` diff --git a/README.adoc b/README.adoc index c8442367..35751dd0 100644 --- a/README.adoc +++ b/README.adoc @@ -96,14 +96,8 @@ and <> for a gentle introduction. In general, see http://c-cube.github.io/ocaml-containers/last/ or http://cedeela.fr/~simon/software/containers for the **API documentation**. -Some examples can be found link:doc/containers.adoc[there]. - -API documentation by version: - -- http://c-cube.github.io/ocaml-containers/dev/[dev branch] -- http://c-cube.github.io/ocaml-containers/1.0/[1.0] -- http://c-cube.github.io/ocaml-containers/0.19/[0.19] -- http://c-cube.github.io/ocaml-containers/0.17/[0.17] +Some examples can be found link:doc/containers.adoc[there], +per-version doc http://c-cube.github.io/ocaml-containers/[there]. [[build]] == Build diff --git a/_oasis b/_oasis index 01373e42..2871eb57 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: containers -Version: 1.3 +Version: 1.4 Homepage: https://github.com/c-cube/ocaml-containers Authors: Simon Cruanes License: BSD-2-clause diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index 1b56a613..8e10fc0d 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -1177,6 +1177,99 @@ module Str = struct let bench_find = bench_find_ ~dir:`Direct let bench_rfind = bench_find_ ~dir:`Reverse + module Pre = struct + let prefix_rec ~pre s = + let rec same s1 s2 i = + if i = String.length s1 then true + else ( + String.unsafe_get s1 i = String.unsafe_get s2 i && same s1 s2 (i+1) + ) + in + String.length pre <= String.length s && + same pre s 0 + + let prefix_while ~pre s = + String.length pre <= String.length s && + begin + let i = ref 0 in + while !i < String.length pre && + String.unsafe_get s !i = String.unsafe_get pre !i + do incr i done; + !i = String.length pre + end + + exception Exit_false + + let prefix_for_exn ~pre s = + String.length pre <= String.length s && + try + for i=0 to String.length pre-1 do + if String.unsafe_get s i != String.unsafe_get pre i + then raise Exit_false + done; + true + with Exit_false -> false + + let prefix_sub ~pre:prfx s = + let len_s = String.length s in + let len_p = String.length prfx in + if len_s < len_p then + false + else + let sub = String.sub s 0 len_p in + CCString.equal prfx sub + + let bat_prefix ~pre:p str = + let len = String.length p in + if String.length str < len then false + else + let rec loop str p i = + if i = len then true + else if String.unsafe_get str i <> String.unsafe_get p i then false + else loop str p (i + 1) + in loop str p 0 + + let make ~max_len ~max_len_prefix n = + let rand = Random.State.make_self_init () in + let input = + Array.init n + (fun _ -> + let str = + QCheck.Gen.(string_size ~gen:printable (10 -- max_len)) + |> QCheck.Gen.generate1 ~rand + in + let prfx_len = Random.State.int rand (min max_len_prefix (String.length str + 1)) in + let prfx = + if Random.State.bool rand then + String.sub str 0 prfx_len + else + String.sub str (String.length str - prfx_len) prfx_len + in + (prfx, str)) + in + let output = + Array.map + (fun (pre, str) -> prefix_rec ~pre str) + input + in + let test f () = + Array.iteri + (fun i (pre, y) -> + let res = f ~pre y in + assert (res = output.(i))) + input + in + Benchmark.throughputN 3 + [ + "containers", test CCString.prefix, (); + "while_unsafe", test prefix_while, (); + "rec_unsafe", test prefix_rec, (); + "for_exn_unsafe", test prefix_for_exn, (); + "sub_eq", test prefix_sub, (); + "bat_prefix", test bat_prefix, (); + ] + end + let () = B.Tree.register ( "string" @>>> [ "find" @>>> @@ -1205,6 +1298,11 @@ module Str = struct ; "50" @>> app_ints (bench_rfind ~size:50) [100; 100_000; 500_000] ; "500" @>> app_ints (bench_rfind ~size:500) [100_000; 500_000] ]; + "prefix" @>>> + [ "max_len:1000,max_pre_len:15" @>> app_ints (Pre.make ~max_len:1000 ~max_len_prefix:15) [100; 1_000]; + "max_len:1000,max_pre_len:100" @>> app_ints (Pre.make ~max_len:1000 ~max_len_prefix:100) [100; 1_000]; + "max_len:1000,max_pre_len:300" @>> app_ints (Pre.make ~max_len:1000 ~max_len_prefix:300) [100; 1_000]; + ] ]) end diff --git a/doc/intro.txt b/doc/intro.txt index 01244284..43c894e2 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -82,6 +82,7 @@ CCFlatHashtbl CCGraph CCHashSet CCHashTrie +CCHet CCImmutArray CCIntMap CCMixmap diff --git a/opam b/opam index 9cb7ff76..a6c1b05c 100644 --- a/opam +++ b/opam @@ -1,6 +1,6 @@ opam-version: "1.2" name: "containers" -version: "1.2" +version: "1.4" author: "Simon Cruanes" maintainer: "simon.cruanes@inria.fr" build: [ diff --git a/setup.ml b/setup.ml index 7ccc5b43..863a29c9 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: a62cfaee59320a25dee6d9bbad9cd339) *) +(* DO NOT EDIT (digest: b1097bcfb2d6eab143d1ac25252d8b14) *) (* Regenerated by OASIS v0.4.10 Visit http://oasis.forge.ocamlcore.org for more information and @@ -7041,7 +7041,7 @@ let setup_t = { oasis_version = "0.4"; ocaml_version = Some (OASISVersion.VGreaterEqual "4.00.1"); - version = "1.3"; + version = "1.4"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -8900,8 +8900,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.10"; - oasis_digest = - Some "\164\233\1428\169\160\007\155\182\180\021s\193\n\134-"; + oasis_digest = Some "\213\002\219\227i{sJJ\160\246\216o\167\\^"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -8909,7 +8908,7 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 8913 "setup.ml" +# 8912 "setup.ml" let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t open BaseCompat.Compat_0_4 (* OASIS_STOP *) diff --git a/src/core/CCArray.ml b/src/core/CCArray.ml index 76ed250a..3daf1e7e 100644 --- a/src/core/CCArray.ml +++ b/src/core/CCArray.ml @@ -468,6 +468,35 @@ let compare cmp a b = compare CCOrd.compare [| 1; 2; 3 |] [| 1; 2; |] > 0 *) +(* swap elements of array *) +let swap a i j = + if i<>j then ( + let tmp = a.(i) in + a.(i) <- a.(j); + a.(j) <- tmp; + ) + +(*$T + let a = [| 1;2;3 |] in \ + swap a 0 1; \ + a = [| 2;1;3 |] + let a = [| 1;2;3 |] in \ + swap a 0 2; \ + a = [| 3;2;1 |] +*) + +(*$QR + Q.(array small_int) (fun a -> + let b = Array.copy a in + for i = 0 to Array.length a-1 do + for j = i+1 to Array.length a-1 do + swap a i j; done; done; + for i = 0 to Array.length a-1 do + for j = i+1 to Array.length a-1 do + swap a i j; done; done; + a=b) +*) + (* shuffle a[i...j[ using the given int random generator See http://en.wikipedia.org/wiki/Fisher-Yates_shuffle *) let _shuffle _rand_int a i j = diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index 4511a56b..d0b5e4f9 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -23,6 +23,10 @@ val equal : 'a equal -> 'a t equal val compare : 'a ord -> 'a t ord +val swap : 'a t -> int -> int -> unit +(** [swap arr i j] swaps elements at indices [i] and [j]. + @since 1.4 *) + val get : 'a t -> int -> 'a val get_safe : 'a t -> int -> 'a option @@ -71,10 +75,10 @@ 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 at which the [i]-th element of [sorted cmp a] + such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a] appears in [a]. [a] is not modified. - In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a]. + 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 *) @@ -84,7 +88,7 @@ val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array such that [b.(i)] is the index at which the [i]-the element of [a] appears in [sorted cmp a]. [a] is not modified. - In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a]. + In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a]. [sort_ranking] yields the inverse permutation of {!sort_indices}. In the absence of duplicate elements in [a], we also have diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 29360823..65830791 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -162,7 +162,7 @@ val some : 'a printer -> 'a option printer "what is your @{favorite color@}? @{blue@}! No, @{red@}! Ahhhhhhh@.";; ]} - {b status: experimental} + {b status: unstable} @since 0.15 *) val set_color_tag_handling : t -> unit @@ -177,13 +177,13 @@ val set_color_default : bool -> unit val with_color : string -> 'a printer -> 'a printer (** [with_color "Blue" pp] behaves like the printer [pp], but with the given style. - {b status: experimental} + {b status: unstable} @since 0.16 *) val with_colorf : string -> t -> ('a, t, unit, unit) format4 -> 'a (** [with_colorf "Blue" out "%s %d" "yolo" 42] will behave like {!Format.fprintf}, but wrapping the content with the given style - {b status: experimental} + {b status: unstable} @since 0.16 *) val with_color_sf : string -> ('a, t, unit, string) format4 -> 'a @@ -193,7 +193,7 @@ val with_color_sf : string -> ('a, t, unit, string) format4 -> 'a {[ CCFormat.with_color_sf "red" "%a" CCFormat.Dump.(list int) [1;2;3] |> print_endline;; ]} - {b status: experimental} + {b status: unstable} @since 0.21 *) val with_color_ksf : f:(string -> 'b) -> string -> ('a, t, unit, 'b) format4 -> 'a diff --git a/src/core/CCFun.mli b/src/core/CCFun.mli index 496aa1b4..94618a5b 100644 --- a/src/core/CCFun.mli +++ b/src/core/CCFun.mli @@ -40,7 +40,7 @@ val tap : ('a -> _) -> 'a -> 'a in a pipeline, for instance: {[CCArray.(1 -- 10) |> tap CCArray.shuffle - |> tap CCArray.sort Pervasives.compare + |> tap @@ CCArray.sort Pervasives.compare ]} *) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index f044884c..89dd6a80 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -20,13 +20,37 @@ let is_empty = function (* max depth for direct recursion *) let direct_depth_default_ = 1000 +let tail_map f l = + (* Unwind the list of tuples, reconstructing the full list front-to-back. + @param tail_acc a suffix of the final list; we append tuples' content + at the front of it *) + let rec rebuild tail_acc = function + | [] -> tail_acc + | (y0, y1, y2, y3, y4, y5, y6, y7, y8) :: bs -> + rebuild (y0 :: y1 :: y2 :: y3 :: y4 :: y5 :: y6 :: y7 :: y8 :: tail_acc) bs + in + (* Create a compressed reverse-list representation using tuples + @param tuple_acc a reverse list of chunks mapped with [f] *) + let rec dive tuple_acc = function + | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: xs -> + let y0 = f x0 in let y1 = f x1 in let y2 = f x2 in + let y3 = f x3 in let y4 = f x4 in let y5 = f x5 in + let y6 = f x6 in let y7 = f x7 in let y8 = f x8 in + dive ((y0, y1, y2, y3, y4, y5, y6, y7, y8) :: tuple_acc) xs + | xs -> + (* Reverse direction, finishing off with a direct map *) + let tail = List.map f xs in + rebuild tail tuple_acc + in + dive [] l + let map f l = let rec direct f i l = match l with | [] -> [] | [x] -> [f x] | [x1;x2] -> let y1 = f x1 in [y1; f x2] | [x1;x2;x3] -> let y1 = f x1 in let y2 = f x2 in [y1; y2; f x3] - | _ when i=0 -> List.rev (List.rev_map f l) + | _ when i=0 -> tail_map f l | x1::x2::x3::x4::l' -> let y1 = f x1 in let y2 = f x2 in @@ -387,8 +411,8 @@ let combine_gen l1 l2 = res1 = res2) *) -let split l = - let rec direct i l = match l with +let split l = + let rec direct i l = match l with | [] -> [], [] | [x1, y1] -> [x1], [y1] | [x1, y1; x2, y2] -> [x1;x2], [y1;y2] @@ -396,19 +420,19 @@ let split l = | [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 + 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 + and acc2 = x2 :: acc2 in split_slow acc1 acc2 tail - in + in direct direct_depth_default_ l -(*$Q +(*$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 \ @@ -926,6 +950,11 @@ let uniq ?(eq=(=)) l = uniq [1;1;2;2;3;4;4;2;4;1;5] |> List.sort Pervasives.compare = [1;2;3;4;5] *) +(*$Q + Q.(small_list small_int) (fun l -> \ + sort_uniq l = (uniq l |> sort Pervasives.compare)) + *) + let union ?(eq=(=)) l1 l2 = let rec union eq acc l1 l2 = match l1 with | [] -> List.rev_append acc l2 diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 710dadc8..f143de16 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -92,7 +92,7 @@ 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 +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 diff --git a/src/core/CCMap.ml b/src/core/CCMap.ml index 056c01d2..8caa6a11 100644 --- a/src/core/CCMap.ml +++ b/src/core/CCMap.ml @@ -29,6 +29,11 @@ module type S = sig (** [merge_safe ~f a b] merges the maps [a] and [b] together. @since 0.17 *) + val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t + (** Union of both maps, using the function to combine bindings + that belong to both inputs + @since 1.4 *) + val of_seq : (key * 'a) sequence -> 'a t val add_seq : 'a t -> (key * 'a) sequence -> 'a t @@ -85,6 +90,15 @@ module Make(O : Map.OrderedType) = struct | Some v1, Some v2 -> f k (`Both (v1,v2))) a b + let union f a b = + merge + (fun k v1 v2 -> match v1, v2 with + | None, None -> assert false + | None, (Some _ as r) -> r + | Some _ as r, None -> r + | Some v1, Some v2 -> f k v1 v2) + a b + let add_seq m s = let m = ref m in s (fun (k,v) -> m := add k v !m); diff --git a/src/core/CCMap.mli b/src/core/CCMap.mli index 8ba47dd7..5804b5a6 100644 --- a/src/core/CCMap.mli +++ b/src/core/CCMap.mli @@ -32,6 +32,11 @@ module type S = sig (** [merge_safe ~f a b] merges the maps [a] and [b] together. @since 0.17 *) + val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t + (** Union of both maps, using the function to combine bindings + that belong to both inputs + @since 1.4 *) + val of_seq : (key * 'a) sequence -> 'a t (** Same as {!of_list} *) diff --git a/src/core/CCRef.ml b/src/core/CCRef.ml index 5fb260b0..44eab344 100644 --- a/src/core/CCRef.ml +++ b/src/core/CCRef.ml @@ -32,6 +32,11 @@ let compare f r1 r2 = f !r1 !r2 let equal f r1 r2 = f !r1 !r2 +let swap a b = + let x = !a in + a := !b; + b := x + let to_list r = [!r] let to_seq r yield = yield !r diff --git a/src/core/CCRef.mli b/src/core/CCRef.mli index 4a488600..c5d4750c 100644 --- a/src/core/CCRef.mli +++ b/src/core/CCRef.mli @@ -31,6 +31,10 @@ val get_then_incr : int t -> int (** [get_then_incr r] increments [r] and returns its old value, think [r++] @since 0.17 *) +val swap : 'a t -> 'a t -> unit +(** Swap values. + @since 1.4 *) + val compare : 'a ord -> 'a t ord val equal : 'a eq -> 'a t eq diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 14498171..9e588999 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -491,18 +491,28 @@ let repeat s n = init (len * n) (fun i -> s.[i mod len]) let prefix ~pre s = - String.length pre <= String.length s && - (let i = ref 0 in - while !i < String.length pre && s.[!i] = pre.[!i] do incr i done; - !i = String.length pre + let len = String.length pre in + if len > String.length s then false + else ( + let rec check i = + if i=len then true + else if String.unsafe_get s i != String.unsafe_get pre i then false + else check (i+1) + in + check 0 ) let suffix ~suf s = - String.length suf <= String.length s && - let off = String.length s - String.length suf in - (let i = ref 0 in - while !i < String.length suf && s.[off + !i] = suf.[!i] do incr i done; - !i = String.length suf + let len = String.length suf in + if len > String.length s then false + else ( + let off = String.length s - len in + let rec check i = + if i=len then true + else if String.unsafe_get s (off+i) != String.unsafe_get suf i then false + else check (i+1) + in + check 0 ) let take n s = diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 3d61b5b1..cb9bbb4f 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -212,6 +212,10 @@ val prefix : pre:string -> string -> bool prefix ~pre:"aab" "aabcd" not (prefix ~pre:"ab" "aabcd") not (prefix ~pre:"abcd" "abc") + prefix ~pre:"abc" "abcde" + prefix ~pre:"" "" + prefix ~pre:"" "abc" + prefix ~pre:"abc" "abc" *) val suffix : suf:string -> string -> bool @@ -220,6 +224,8 @@ val suffix : suf:string -> string -> bool (*$T suffix ~suf:"cd" "abcd" + suffix ~suf:"" "" + suffix ~suf:"" "abc" not (suffix ~suf:"cd" "abcde") not (suffix ~suf:"abcd" "cd") *) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index fcfd4c87..13586ae7 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -67,14 +67,14 @@ let init n f = { vec=Array.init n f; } -(* is the underlying empty? *) -let _empty_array v = +(* is the underlying array empty? *) +let array_is_empty_ v = Array.length v.vec = 0 (* assuming the underlying array isn't empty, resize it *) -let _resize v newcapacity = +let resize_ v newcapacity = assert (newcapacity >= v.size); - assert (not (_empty_array v)); + assert (not (array_is_empty_ v)); let new_vec = Array.make newcapacity v.vec.(0) in Array.blit v.vec 0 new_vec 0 v.size; v.vec <- new_vec; @@ -86,38 +86,38 @@ let _resize v newcapacity = *) (* grow the array, using [x] as a filler if required *) -let _grow v x = - if _empty_array v +let grow_with_ v ~filler:x = + if array_is_empty_ v then v.vec <- Array.make 32 x else ( let n = Array.length v.vec in let size = min (2 * n + 10) Sys.max_array_length in if size = n then failwith "vec: can't grow any further"; - _resize v size + resize_ v size ) (* v is not empty; ensure it has at least [size] slots. Use a doubling-size strategy so that calling many times [ensure] will behave well *) -let ensure_not_empty_ v size = +let ensure_assuming_not_empty_ v ~size = if size > Sys.max_array_length then failwith "vec.ensure: size too big" else ( let n = ref (max 16 (Array.length v.vec)) in while !n < size do n := min Sys.max_array_length (2* !n) done; - _resize v !n + resize_ v !n ) let ensure_with ~init v size = if Array.length v.vec = 0 then v.vec <- Array.make size init - else ensure_not_empty_ v size + else ensure_assuming_not_empty_ v ~size let ensure v size = if Array.length v.vec = 0 then () - else ensure_not_empty_ v size + else ensure_assuming_not_empty_ v ~size let clear v = v.size <- 0 @@ -137,8 +137,7 @@ let push_unsafe_ v x = v.size <- v.size + 1 let push v x = - if v.size = Array.length v.vec - then _grow v x; + if v.size = Array.length v.vec then grow_with_ v ~filler:x; push_unsafe_ v x (*$T @@ -148,15 +147,14 @@ let push v x = (** Add all elements of b to a *) let append a b = - if _empty_array a - then if _empty_array b - then () + if array_is_empty_ a then ( + if array_is_empty_ b then () else ( a.vec <- Array.copy b.vec; a.size <- b.size ) - else ( - ensure a (a.size + b.size); + ) else ( + ensure_assuming_not_empty_ a ~size:(a.size + b.size); assert (Array.length a.vec >= a.size + b.size); Array.blit b.vec 0 a.vec a.size b.size; a.size <- a.size + b.size @@ -165,6 +163,14 @@ let append a b = (*$T let v1 = init 5 (fun i->i) and v2 = init 5 (fun i->i+5) in \ append v1 v2; to_list v1 = CCList.(0--9) + let empty = create () and v2 = init 5 (fun i->i) in \ + append empty v2; to_list empty = CCList.(0--4) + let v1 = init 5 (fun i->i) and empty = create () in \ + append v1 empty; to_list v1 = CCList.(0--4) + let v = init 3 (fun i->i) in \ + append v v; to_list v = [0; 1; 2; 0; 1; 2] + let empty = create () in \ + append empty empty; to_list empty = [] *) (*$R @@ -197,13 +203,24 @@ let append_seq a seq = let append_array a b = let len_b = Array.length b in - ensure a (a.size + len_b); - Array.blit b 0 a.vec a.size len_b; - a.size <- a.size + len_b + if array_is_empty_ a then ( + a.vec <- Array.copy b; + a.size <- len_b; + ) else ( + ensure_assuming_not_empty_ a ~size:(a.size + len_b); + Array.blit b 0 a.vec a.size len_b; + a.size <- a.size + len_b + ) (*$T let v1 = init 5 (fun i->i) and v2 = Array.init 5 (fun i->i+5) in \ append_array v1 v2; to_list v1 = CCList.(0--9) + let empty = create () in \ + append_array empty CCArray.(0--5); to_list empty = CCList.(0--5) + let v1 = init 5 (fun i->i) in \ + append_array v1 [| |]; to_list v1 = CCList.(0--4) + let empty = create () in \ + append_array empty [| |]; to_list empty = [] *) let append_list a b = match b with @@ -421,7 +438,7 @@ let iteri k v = *) let map f v = - if _empty_array v + if array_is_empty_ v then create () else ( let vec = Array.init v.size (fun i -> f (Array.unsafe_get v.vec i)) in @@ -454,7 +471,7 @@ let filter' p v = *) let filter p v = - if _empty_array v + if array_is_empty_ v then create () else ( let v' = create_with ~capacity:v.size v.vec.(0) in diff --git a/src/core/META b/src/core/META index 5d3124ea..e8662f18 100644 --- a/src/core/META +++ b/src/core/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: 2c23f3e7c83e14a0b87e7d6bb7df91bd) -version = "1.3" +# DO NOT EDIT (digest: 3a776cf70f415cc6c1505c02b13044b5) +version = "1.4" description = "A modular standard library focused on data structures." requires = "bytes result" archive(byte) = "containers.cma" @@ -9,7 +9,7 @@ archive(native) = "containers.cmxa" archive(native, plugin) = "containers.cmxs" exists_if = "containers.cma" package "unix" ( - version = "1.3" + version = "1.4" description = "A modular standard library focused on data structures." requires = "bytes result unix" archive(byte) = "containers_unix.cma" @@ -20,7 +20,7 @@ package "unix" ( ) package "top" ( - version = "1.3" + version = "1.4" description = "A modular standard library focused on data structures." requires = "compiler-libs.common containers containers.data containers.unix containers.sexp containers.iter" @@ -32,7 +32,7 @@ package "top" ( ) package "thread" ( - version = "1.3" + version = "1.4" description = "A modular standard library focused on data structures." requires = "containers threads" archive(byte) = "containers_thread.cma" @@ -43,7 +43,7 @@ package "thread" ( ) package "sexp" ( - version = "1.3" + version = "1.4" description = "A modular standard library focused on data structures." requires = "bytes result" archive(byte) = "containers_sexp.cma" @@ -54,7 +54,7 @@ package "sexp" ( ) package "iter" ( - version = "1.3" + version = "1.4" description = "A modular standard library focused on data structures." archive(byte) = "containers_iter.cma" archive(byte, plugin) = "containers_iter.cma" @@ -64,7 +64,7 @@ package "iter" ( ) package "data" ( - version = "1.3" + version = "1.4" description = "A modular standard library focused on data structures." requires = "bytes" archive(byte) = "containers_data.cma" diff --git a/src/data/CCFQueue.ml b/src/data/CCFQueue.ml index e1cb7736..de6848f1 100644 --- a/src/data/CCFQueue.ml +++ b/src/data/CCFQueue.ml @@ -131,7 +131,14 @@ let take_front q = try Some (take_front_exn q) with Empty -> None +(*$T + take_front empty = None +*) + let take_front_l n q = + if n<0 then ( + invalid_arg "take_back_l: cannot take negative number of arguments" + ); let rec aux acc q n = if n=0 || is_empty q then List.rev acc, q else @@ -158,7 +165,7 @@ let take_front_while p q = let rec take_back_exn : 'a. 'a t -> 'a t * 'a = fun q -> match q with - | Shallow Zero -> invalid_arg "FQueue.take_back_exn" + | Shallow Zero -> raise Empty | Shallow (One x) -> empty, x | Shallow (Two (x,y)) -> _single x, y | Shallow (Three (x,y,z)) -> Shallow (Two(x,y)), z @@ -182,7 +189,14 @@ let take_back q = try Some (take_back_exn q) with Empty -> None +(*$T + take_back empty = None +*) + let take_back_l n q = + if n<0 then ( + invalid_arg "take_back_l: cannot take negative number of arguments" + ); let rec aux acc q n = if n=0 || is_empty q then q, acc else diff --git a/src/data/CCFQueue.mli b/src/data/CCFQueue.mli index fe159c4e..fddb78ac 100644 --- a/src/data/CCFQueue.mli +++ b/src/data/CCFQueue.mli @@ -38,7 +38,8 @@ val take_front_exn : 'a t -> ('a * 'a t) val take_front_l : int -> 'a t -> 'a list * 'a t (** [take_front_l n q] takes at most [n] elements from the front - of [q], and returns them wrapped in a list *) + of [q], and returns them wrapped in a list + @raise Invalid_argument if n<0 *) val take_front_while : ('a -> bool) -> 'a t -> 'a list * 'a t @@ -46,12 +47,15 @@ val take_back : 'a t -> ('a t * 'a) option (** Take last element *) val take_back_exn : 'a t -> ('a t * 'a) +(** Same as {!take_back}, but fails on empty queues. + @raise Empty if the queue is empty *) val take_back_l : int -> 'a t -> 'a t * 'a list (** [take_back_l n q] removes and returns the last [n] elements of [q]. The elements are in the order of the queue, that is, the head of the returned list is the first element to appear via {!take_front}. - [take_back_l 2 (of_list [1;2;3;4]) = of_list [1;2], [3;4]] *) + [take_back_l 2 (of_list [1;2;3;4]) = of_list [1;2], [3;4]] + @raise Invalid_argument if n<0 *) val take_back_while : ('a -> bool) -> 'a t -> 'a t * 'a list diff --git a/src/data/CCWBTree.ml b/src/data/CCWBTree.ml index 27d47a4e..f3ac3336 100644 --- a/src/data/CCWBTree.ml +++ b/src/data/CCWBTree.ml @@ -82,6 +82,12 @@ module type S = sig val nth_exn : int -> 'a t -> key * 'a (** @raise Not_found if the index is invalid *) + val get_rank : key -> 'a t -> [`At of int | `After of int | `First] + (** [get_rank k m] looks for the rank of [k] in [m], i.e. the index + of [k] in the sorted list of bindings of [m]. + [let (`At n) = get_rank k m in nth_exn n m = get m k] should hold. + @since 1.4 *) + val add : key -> 'a -> 'a t -> 'a t val remove : key -> 'a t -> 'a t @@ -98,8 +104,14 @@ module type S = sig val fold : f:('b -> key -> 'a -> 'b) -> x:'b -> 'a t -> 'b val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t + (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. + @since 0.17 + *) val map : f:('a -> 'b) -> 'a t -> 'b t + (** Map values, giving only the value. + @since 0.17 + *) val iter : f:(key -> 'a -> unit) -> 'a t -> unit @@ -365,6 +377,28 @@ module MakeFull(K : KEY) : S with type key = K.t = struct List.for_all (fun i -> M.nth_exn i m = (i,i)) CCList.(0--1000) *) + let get_rank k m = + let rec aux i k m = match m with + | E -> if i=0 then `First else `After i + | N (k', _, l, r, _) -> + match K.compare k k' with + | 0 -> `At (i + weight l) + | n when n<0 -> aux i k l + | _ -> aux (1 + weight l + i) k r + in + aux 0 k m + + (*$QR & ~count:1_000 + Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l -> + let l = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst compare) l in + let m = M.of_list l in + List.for_all + (fun (k,v) -> match M.get_rank k m with + | `First | `After _ -> true + | `At n -> (k,v) = M.nth_exn n m) + l) + *) + let rec fold ~f ~x:acc m = match m with | E -> acc | N (k, v, l, r, _) -> diff --git a/src/data/CCWBTree.mli b/src/data/CCWBTree.mli index c3c85ef8..767735db 100644 --- a/src/data/CCWBTree.mli +++ b/src/data/CCWBTree.mli @@ -47,6 +47,12 @@ module type S = sig val nth_exn : int -> 'a t -> key * 'a (** @raise Not_found if the index is invalid *) + val get_rank : key -> 'a t -> [`At of int | `After of int | `First] + (** [get_rank k m] looks for the rank of [k] in [m], i.e. the index + of [k] in the sorted list of bindings of [m]. + [let (`At n) = get_rank k m in nth_exn n m = get m k] should hold. + @since 1.4 *) + val add : key -> 'a -> 'a t -> 'a t val remove : key -> 'a t -> 'a t diff --git a/src/threads/CCPool.ml b/src/threads/CCPool.ml index 1863e2a8..914461cc 100644 --- a/src/threads/CCPool.ml +++ b/src/threads/CCPool.ml @@ -69,6 +69,8 @@ module Make(P : PARAM) = struct let incr_size_ p = p.cur_size <- p.cur_size + 1 let decr_size_ p = p.cur_size <- p.cur_size - 1 + let incr_idle_ p = p.cur_idle <- p.cur_idle + 1 + let decr_idle_ p = p.cur_idle <- p.cur_idle - 1 (* next thing a thread should do *) type command = @@ -85,8 +87,7 @@ module Make(P : PARAM) = struct assert (pool.cur_size > 0); decr_size_ pool; Die - ) - else if Queue.is_empty pool.jobs then Wait + ) else if Queue.is_empty pool.jobs then Wait else ( let job = Queue.pop pool.jobs in Process job @@ -94,6 +95,8 @@ module Make(P : PARAM) = struct (* Thread: entry point. They seek jobs in the queue *) let rec serve pool = + assert (pool.cur_size <= P.max_size); + assert (pool.cur_size > 0); let cmd = with_lock_ pool get_next_ in run_cmd cmd @@ -101,7 +104,12 @@ module Make(P : PARAM) = struct and run_cmd = function | Die -> () | Wait -> - with_lock_ pool (fun p -> Condition.wait p.cond p.mutex) + with_lock_ pool + (fun p -> + incr_idle_ pool; + Condition.wait p.cond p.mutex; + decr_idle_ pool); + serve pool | Process (Job1 (f, x)) -> begin try ignore (f x) with e -> pool.exn_handler e end; serve pool | Process (Job2 (f, x, y)) -> @@ -116,6 +124,8 @@ module Make(P : PARAM) = struct (* launch the minimum required number of threads *) let () = + if P.min_size < 0 then invalid_arg "CCPool: min_size must be >= 0"; + if P.min_size > P.max_size then invalid_arg "CCPool: min_size must be <= max_size"; for _i = 1 to P.min_size do launch_worker_ pool done (* heuristic criterion for starting a new thread. *) @@ -137,7 +147,7 @@ module Make(P : PARAM) = struct ) else ( (* cannot start thread, push and wait for some worker to pick it up *) Queue.push job pool.jobs; - Condition.signal pool.cond; (* wake up *) + Condition.signal pool.cond; (* wake up some worker, if any *) (* might want to process in the background, if all threads are busy *) if pool.cur_idle = 0 && can_start_thread_ pool then ( incr_size_ pool; @@ -264,7 +274,7 @@ module Make(P : PARAM) = struct let l = List.rev_map (fun i -> Fut.make (fun () -> - Thread.delay 0.05; + Thread.delay 0.01; 1 )) l in let l' = List.map Fut.get l in