mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-07 11:45:31 -05:00
Merge branch 'master' into stable
This commit is contained in:
Simon Cruanes
commit
ad8a61a795
30 changed files with 388 additions and 82 deletions
2
.merlin
2
.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
|
||||
|
|
|
|||
2
.ocp-indent
Normal file
2
.ocp-indent
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
match_clause=2
|
||||
with=2
|
||||
|
|
@ -21,4 +21,5 @@
|
|||
- Glenn Slotte (glennsl)
|
||||
- @LemonBoy
|
||||
- Leonid Rozenberg (@rleonid)
|
||||
- Bikal Gurung (@bikalgurung)
|
||||
- Bikal Gurung (@bikalgurung)
|
||||
- Fabian Hemmer (copy)
|
||||
|
|
|
|||
|
|
@ -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`
|
||||
|
|
|
|||
|
|
@ -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`
|
||||
|
|
|
|||
10
README.adoc
10
README.adoc
|
|
@ -96,14 +96,8 @@ and <<tutorial,the tutorial below>> 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
|
||||
|
|
|
|||
2
_oasis
2
_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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -82,6 +82,7 @@ CCFlatHashtbl
|
|||
CCGraph
|
||||
CCHashSet
|
||||
CCHashTrie
|
||||
CCHet
|
||||
CCImmutArray
|
||||
CCIntMap
|
||||
CCMixmap
|
||||
|
|
|
|||
2
opam
2
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: [
|
||||
|
|
|
|||
9
setup.ml
9
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 *)
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -162,7 +162,7 @@ val some : 'a printer -> 'a option printer
|
|||
"what is your @{<White>favorite color@}? @{<blue>blue@}! No, @{<red>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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
]}
|
||||
*)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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} *)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
*)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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, _) ->
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue