From 0ce50f9c73ed3210d9f473100e2c1334ebf3b9f1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 22 Dec 2015 16:09:32 +0100 Subject: [PATCH 01/63] fix typo in howto --- HOWTO.adoc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/HOWTO.adoc b/HOWTO.adoc index 533a0d91..528d72e8 100644 --- a/HOWTO.adoc +++ b/HOWTO.adoc @@ -14,7 +14,7 @@ can be removed. 6. commit the changes 7. `git checkout stable` 8. `git merge master` -9. `oasis setup; make tests doc` +9. `oasis setup; make test doc` 10. tag, and push both to github 11. new opam package From 5d6098b80d65e321773e5e809c10b0c14250a709 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 22 Dec 2015 16:09:40 +0100 Subject: [PATCH 02/63] make `CCFormat` color handling support nested tags properly --- src/core/CCFormat.ml | 19 ++++++++++++++----- src/core/CCFormat.mli | 2 +- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 51ec4613..aefd40c3 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -210,25 +210,34 @@ let style_of_tag_ s = match String.trim s with let color_enabled = ref false (* either prints the tag of [s] or delegate to [or_else] *) -let mark_open_tag ~or_else s = +let mark_open_tag st ~or_else s = try let style = style_of_tag_ s in + Stack.push style st; if !color_enabled then ansi_l_to_str_ style else "" with Not_found -> or_else s -let mark_close_tag ~or_else s = +let mark_close_tag st ~or_else s = try let _ = style_of_tag_ s in (* check if it's indeed about color *) - if !color_enabled then ansi_l_to_str_ [`Reset] else "" + let style = + try + ignore (Stack.pop st); (* pop current style (if well-scoped...) *) + Stack.top st (* look at previous style *) + with Stack.Empty -> + [`Reset] + in + if !color_enabled then ansi_l_to_str_ style else "" with Not_found -> or_else s (* add color handling to formatter [ppf] *) let set_color_tag_handling ppf = let open Format in let functions = pp_get_formatter_tag_functions ppf () in + let st = Stack.create () in (* stack of styles *) let functions' = {functions with - mark_open_tag=(mark_open_tag ~or_else:functions.mark_open_tag); - mark_close_tag=(mark_close_tag ~or_else:functions.mark_close_tag); + mark_open_tag=(mark_open_tag st ~or_else:functions.mark_open_tag); + mark_close_tag=(mark_close_tag st ~or_else:functions.mark_close_tag); } in pp_set_mark_tags ppf true; (* enable tags *) pp_set_formatter_tag_functions ppf functions' diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 8ab2e98f..dbc7ec2e 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -71,7 +71,7 @@ val map : ('a -> 'b) -> 'b printer -> 'a printer Use ANSI escape codes https://en.wikipedia.org/wiki/ANSI_escape_code to put some colors on the terminal. - This uses {b tags} in format strings to specify the style. Current styles + This uses {b tags} in format strings to specify the style. Current styles are the following: {ul From 03604cb8366b2702ab90be03458d73860e833e2a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 29 Dec 2015 17:19:43 +0100 Subject: [PATCH 03/63] add tests; change header --- src/core/CCOrd.ml | 31 ++++++++----------------------- src/core/CCOrd.mli | 24 +----------------------- 2 files changed, 9 insertions(+), 46 deletions(-) diff --git a/src/core/CCOrd.ml b/src/core/CCOrd.ml index f1c974b3..c8bf3f28 100644 --- a/src/core/CCOrd.ml +++ b/src/core/CCOrd.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Comparisons} *) @@ -52,6 +30,13 @@ let string_ (x:string) y = Pervasives.compare x y let bool_ (x:bool) y = Pervasives.compare x y let float_ (x:float) y = Pervasives.compare x y +(*$T + bool_ true false > 0 + bool_ false true < 0 + bool_ true true = 0 + bool_ false false = 0 +*) + (** {2 Lexicographic Combination} *) let () c (ord,x,y) = diff --git a/src/core/CCOrd.mli b/src/core/CCOrd.mli index 9c9ed76a..9311e87f 100644 --- a/src/core/CCOrd.mli +++ b/src/core/CCOrd.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Comparisons} *) From 4409f79ed4d3ca8197161771cbb0020cd11d1bcb Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 31 Dec 2015 16:18:30 +0100 Subject: [PATCH 04/63] gitignore --- .gitignore | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.gitignore b/.gitignore index d44b4ce6..8f50b9ea 100644 --- a/.gitignore +++ b/.gitignore @@ -6,6 +6,5 @@ _build .session TAGS *.docdir -setup.log -setup.data +setup.* qtest* From 03a29d72cb70278e4e81bc6871719fde5a2c2dba Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 31 Dec 2015 16:18:33 +0100 Subject: [PATCH 05/63] optional argument `~eq` to `CCGraph.Dot.pp` --- src/data/CCGraph.ml | 18 ++++++++++-------- src/data/CCGraph.mli | 2 ++ 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/src/data/CCGraph.ml b/src/data/CCGraph.ml index 9db9a9ec..f5a12a86 100644 --- a/src/data/CCGraph.ml +++ b/src/data/CCGraph.ml @@ -519,10 +519,11 @@ module Dot = struct let pp_list pp_x out l = Format.pp_print_string out "["; - List.iteri (fun i x -> + List.iteri + (fun i x -> if i > 0 then Format.fprintf out ",@;"; - pp_x out x - ) l; + pp_x out x) + l; Format.pp_print_string out "]" type vertex_state = { @@ -533,6 +534,7 @@ module Dot = struct (** Print an enum of Full.traverse_event *) let pp_seq ?(tbl=mk_table 128) + ?(eq=(=)) ?(attrs_v=fun _ -> []) ?(attrs_e=fun _ -> []) ?(name="graph") @@ -570,18 +572,18 @@ module Dot = struct get_tag=vertex_explored; set_tag=set_explored; (* allocate new ID *) } in - let events = Traverse.Event.dfs_tag ~tags ~graph seq in + let events = Traverse.Event.dfs_tag ~eq ~tags ~graph seq in Seq.iter (function | `Enter (v, _n, _path) -> let attrs = attrs_v v in - Format.fprintf out " @[%a %a;@]@." pp_vertex v (pp_list pp_attr) attrs + Format.fprintf out "@[%a %a;@]@," pp_vertex v (pp_list pp_attr) attrs | `Exit _ -> () | `Edge (e, _) -> let v1 = graph.origin e in let v2 = graph.dest e in let attrs = attrs_e e in - Format.fprintf out " @[%a -> %a %a;@]@." + Format.fprintf out "@[%a -> %a %a;@]@," pp_vertex v1 pp_vertex v2 (pp_list pp_attr) attrs @@ -590,8 +592,8 @@ module Dot = struct Format.fprintf out "}@]@;@?"; () - let pp ?tbl ?attrs_v ?attrs_e ?name ~graph fmt v = - pp_seq ?tbl ?attrs_v ?attrs_e ?name ~graph fmt (Seq.return v) + let pp ?tbl ?eq ?attrs_v ?attrs_e ?name ~graph fmt v = + pp_seq ?tbl ?eq ?attrs_v ?attrs_e ?name ~graph fmt (Seq.return v) let with_out filename f = let oc = open_out filename in diff --git a/src/data/CCGraph.mli b/src/data/CCGraph.mli index f8710e82..15911375 100644 --- a/src/data/CCGraph.mli +++ b/src/data/CCGraph.mli @@ -307,6 +307,7 @@ module Dot : sig (** Hidden state associated to a vertex *) val pp : ?tbl:('v,vertex_state) table -> + ?eq:('v -> 'v -> bool) -> ?attrs_v:('v -> attribute list) -> ?attrs_e:('e -> attribute list) -> ?name:string -> @@ -320,6 +321,7 @@ module Dot : sig @param name name of the graph *) val pp_seq : ?tbl:('v,vertex_state) table -> + ?eq:('v -> 'v -> bool) -> ?attrs_v:('v -> attribute list) -> ?attrs_e:('e -> attribute list) -> ?name:string -> From cf931aabb132c8eeccd573acf1645dbf305b6ba0 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 5 Jan 2016 16:53:33 +0100 Subject: [PATCH 06/63] add `CCList.fold_map2` --- src/core/CCList.ml | 22 ++++++++++++++++++++++ src/core/CCList.mli | 5 +++++ 2 files changed, 27 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 4d697262..0d23f6b9 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -170,6 +170,28 @@ let fold_map f acc l = fold_map (fun acc x -> x::acc, x) [] l = (List.rev l, l)) *) +let fold_map2 f acc l1 l2 = + let rec aux f acc map_acc l1 l2 = match l1, l2 with + | [], [] -> acc, List.rev map_acc + | [], _ + | _, [] -> invalid_arg "fold_map2" + | x1 :: l1', x2 :: l2' -> + let acc, y = f acc x1 x2 in + aux f acc (y :: map_acc) l1' l2' + in + aux f acc [] l1 l2 + +(*$= + (310, ["1 10"; "2 0"; "3 100"]) \ + (fold_map2 (fun acc x y->acc+x*y, string_of_int x ^ " " ^ string_of_int y) \ + 0 [1;2;3] [10;0;100]) +*) + +(*$T + (try ignore (fold_map2 (fun _ _ _ -> assert false) 42 [] [1]); false \ + with Invalid_argument _ -> true) +*) + let fold_flat_map f acc l = let rec aux f acc map_acc l = match l with | [] -> acc, List.rev map_acc diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 2f49619f..bbb5ce2e 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -70,6 +70,11 @@ val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list list to another list. @since 0.14 *) +val fold_map2 : ('acc -> 'a -> 'b -> 'acc * 'c) -> 'acc -> 'a list -> 'b list -> 'acc * 'c list +(** [fold_map2] is to [fold_map] what [List.map2] is to [List.map]. + @raise Invalid_argument if the lists do not have the same length + @since NEXT_RELEASE *) + val fold_flat_map : ('acc -> 'a -> 'acc * 'b list) -> 'acc -> 'a list -> 'acc * 'b list (** [fold_flat_map f acc l] is a [fold_left]-like function, but it also maps the list to a list of lists that is then [flatten]'d.. From b000355a7457e9fb92408631af74885b41a6dc01 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 18 Jan 2016 12:07:04 +0100 Subject: [PATCH 07/63] update `examples/id_sexp` so it can read on stdin --- examples/id_sexp.ml | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/examples/id_sexp.ml b/examples/id_sexp.ml index 90e63c27..cac7b040 100644 --- a/examples/id_sexp.ml +++ b/examples/id_sexp.ml @@ -1,13 +1,18 @@ - -let () = - if Array.length Sys.argv <> 2 then failwith "usage: id_sexp file"; - let f = Sys.argv.(1) in - let s = CCSexpM.parse_file_list f in - match s with +let pp_sexp s = match s with | `Ok l -> List.iter (fun s -> Format.printf "@[%a@]@." CCSexpM.print s) l | `Error msg -> Format.printf "error: %s@." msg + +let () = + match Sys.argv with + | [| _ |] -> + let s = CCSexpM.parse_chan_list stdin in + pp_sexp s + | [| _; file |] -> + let s = CCSexpM.parse_file_list file in + pp_sexp s + | _ -> failwith "usage: id_sexp [file]" From 3cfe3767fc77209209c1c88069dd93d48798707f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 20 Jan 2016 14:19:47 +0100 Subject: [PATCH 08/63] add breaking space in `CCFormat.{pair,triple,quad}` --- src/core/CCFormat.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index aefd40c3..3eb5f5a0 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -99,13 +99,13 @@ let opt pp fmt x = match x with | Some x -> Format.fprintf fmt "some %a" pp x let pair ppa ppb fmt (a, b) = - Format.fprintf fmt "(%a, %a)" ppa a ppb b + Format.fprintf fmt "(%a,@ %a)" ppa a ppb b let triple ppa ppb ppc fmt (a, b, c) = - Format.fprintf fmt "(%a, %a, %a)" ppa a ppb b ppc c + Format.fprintf fmt "(%a,@ %a,@ %a)" ppa a ppb b ppc c let quad ppa ppb ppc ppd fmt (a, b, c, d) = - Format.fprintf fmt "(%a, %a, %a, %a)" ppa a ppb b ppc c ppd d + Format.fprintf fmt "(%a,@ %a,@ %a,@ %a)" ppa a ppb b ppc c ppd d let map f pp fmt x = pp fmt (f x); From d3464563c123919c46ab7561f92ef35d69d63552 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 14:19:54 +0100 Subject: [PATCH 09/63] add `CCLock.{incr_then_get,get_then_incr}` --- src/threads/CCLock.ml | 36 +++++++++++++++++++++++++++++------- src/threads/CCLock.mli | 9 +++++++++ 2 files changed, 38 insertions(+), 7 deletions(-) diff --git a/src/threads/CCLock.ml b/src/threads/CCLock.ml index d7aaac7b..107e7c7d 100644 --- a/src/threads/CCLock.ml +++ b/src/threads/CCLock.ml @@ -80,11 +80,14 @@ let with_lock_as_ref l ~f = let test_it l = with_lock_as_ref l ~f:(fun r -> - let x = LockRef.get r in - LockRef.set r (x+10); - Thread.yield (); - let y = LockRef.get r in - LockRef.set r (y - 10); + (* increment and decrement *) + for j = 0 to 100 do + let x = LockRef.get r in + LockRef.set r (x+10); + if j mod 5=0 then Thread.yield (); + let y = LockRef.get r in + LockRef.set r (y - 10); + done ) in for i = 1 to 100 do ignore (Thread.create test_it l) done; @@ -117,9 +120,9 @@ let set l x = let l = create 0 in set l 4; set l 5; get l = 5 *) -let incr l = update l (fun x -> x+1) +let incr l = update l Pervasives.succ -let decr l = update l (fun x -> x-1) +let decr l = update l Pervasives.pred (*$R @@ -133,3 +136,22 @@ let decr l = update l (fun x -> x-1) let l = create 0 in incr l ; get l = 1 let l = create 0 in decr l ; get l = ~-1 *) + +let incr_then_get l = + Mutex.lock l.mutex; + l.content <- l.content + 1; + let x = l.content in + Mutex.unlock l.mutex; + x + +let get_then_incr l = + Mutex.lock l.mutex; + let x = l.content in + l.content <- l.content + 1; + Mutex.unlock l.mutex; + x + +(*$T + let l = create 0 in 1 = incr_then_get l && 1 = get l + let l = create 0 in 0 = get_then_incr l && 1 = get l +*) diff --git a/src/threads/CCLock.mli b/src/threads/CCLock.mli index f1b248d4..ad46c6c2 100644 --- a/src/threads/CCLock.mli +++ b/src/threads/CCLock.mli @@ -77,3 +77,12 @@ val incr : int t -> unit val decr : int t -> unit (** Atomically decrement the value @since 0.13 *) + +val incr_then_get : int t -> int +(** [incr_then_get x] increments [x], and return its new value + @since NEXT_RELEASE *) + +val get_then_incr : int t -> int +(** [incr_then_get x] increments [x], and return its previous value + @since NEXT_RELEASE *) + From 483f90cb523e7d92f87e954d6f32f95ff1246267 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 14:26:30 +0100 Subject: [PATCH 10/63] small fixes in `CCSemaphore` --- src/threads/CCSemaphore.ml | 11 ++++++----- src/threads/CCSemaphore.mli | 4 ++-- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/threads/CCSemaphore.ml b/src/threads/CCSemaphore.ml index 22673dfd..17d0b6de 100644 --- a/src/threads/CCSemaphore.ml +++ b/src/threads/CCSemaphore.ml @@ -6,11 +6,12 @@ type t = { cond : Condition.t; } -let create n = { - n; - mutex=Mutex.create(); - cond=Condition.create(); -} +let create n = + if n <= 0 then invalid_arg "Semaphore.create"; + { n; + mutex=Mutex.create(); + cond=Condition.create(); + } let get t = t.n diff --git a/src/threads/CCSemaphore.mli b/src/threads/CCSemaphore.mli index 7f8c9ad6..5734d31c 100644 --- a/src/threads/CCSemaphore.mli +++ b/src/threads/CCSemaphore.mli @@ -9,13 +9,13 @@ type t val create : int -> t (** [create n] creates a semaphore with initial value [n] - @raise Invalid_argument if [n < 0] *) + @raise Invalid_argument if [n <= 0] *) val get : t -> int (** Current value *) val acquire : int -> t -> unit -(** [acquire n s] blocks until [get s > n], then atomically +(** [acquire n s] blocks until [get s >= n], then atomically sets [s := !s - n] *) val release : int -> t -> unit From 49991717c11e63e6e182f9935af3a5a5cf6d0a61 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 15:13:12 +0100 Subject: [PATCH 11/63] add `CCLock.update_map` --- src/threads/CCFuture.mli | 1 + src/threads/CCLock.ml | 11 +++++++++++ src/threads/CCLock.mli | 5 +++++ 3 files changed, 17 insertions(+) diff --git a/src/threads/CCFuture.mli b/src/threads/CCFuture.mli index c42a5785..0d2a1fb2 100644 --- a/src/threads/CCFuture.mli +++ b/src/threads/CCFuture.mli @@ -146,3 +146,4 @@ val (>|=) : 'a t -> ('a -> 'b) -> 'b t val stop_pool : unit -> unit (** Stop the thread pool *) + diff --git a/src/threads/CCLock.ml b/src/threads/CCLock.ml index 107e7c7d..1088c605 100644 --- a/src/threads/CCLock.ml +++ b/src/threads/CCLock.ml @@ -104,6 +104,17 @@ let update l f = let l = create 5 in update l (fun x->x+1); get l = 6 *) +let update_map l f = + with_lock l + (fun x -> + let x', y = f x in + l.content <- x'; + y) + +(*$T + let l = create 5 in update_map l (fun x->x+1, string_of_int x) = "5" && get l = 6 + *) + let get l = Mutex.lock l.mutex; let x = l.content in diff --git a/src/threads/CCLock.mli b/src/threads/CCLock.mli index ad46c6c2..e1982e8f 100644 --- a/src/threads/CCLock.mli +++ b/src/threads/CCLock.mli @@ -60,6 +60,11 @@ val with_lock_as_ref : 'a t -> f:('a LockRef.t -> 'b) -> 'b val update : 'a t -> ('a -> 'a) -> unit (** [update l f] replaces the content [x] of [l] with [f x], atomically *) +val update_map : 'a t -> ('a -> 'a * 'b) -> 'b +(** [update_map l f] computes [x', y = f (get l)], then puts [x'] in [l] + and returns [y] + @since NEXT_RELEASE *) + val mutex : _ t -> Mutex.t (** Underlying mutex *) From 7dbf3f983baad5c64fab383f6564d44904bcd092 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 16:38:36 +0100 Subject: [PATCH 12/63] add `CCFun.finally{1,2}`, convenience around `finally` --- src/core/CCFun.cppo.ml | 22 ++++++++++++++++++++-- src/core/CCFun.mli | 14 ++++++++++++-- 2 files changed, 32 insertions(+), 4 deletions(-) diff --git a/src/core/CCFun.cppo.ml b/src/core/CCFun.cppo.ml index 77f12094..a1fad6ed 100644 --- a/src/core/CCFun.cppo.ml +++ b/src/core/CCFun.cppo.ml @@ -64,10 +64,28 @@ let lexicographic f1 f2 x y = let finally ~h ~f = try let x = f () in - h (); + ignore (h ()); x with e -> - h (); + ignore (h ()); + raise e + +let finally1 ~h f x = + try + let res = f x in + ignore (h ()); + res + with e -> + ignore (h ()); + raise e + +let finally2 ~h f x y = + try + let res = f x y in + ignore (h ()); + res + with e -> + ignore (h ()); raise e module Monad(X : sig type t end) = struct diff --git a/src/core/CCFun.mli b/src/core/CCFun.mli index b6abcf08..ab609916 100644 --- a/src/core/CCFun.mli +++ b/src/core/CCFun.mli @@ -57,7 +57,7 @@ val curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c val uncurry : ('a -> 'b -> 'c) -> ('a * 'b) -> 'c -val tap : ('a -> 'b) -> 'a -> 'a +val tap : ('a -> _) -> 'a -> 'a (** [tap f x] evaluates [f x], discards it, then returns [x]. Useful in a pipeline, for instance: {[CCArray.(1 -- 10) @@ -72,11 +72,21 @@ val (%) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c val lexicographic : ('a -> 'a -> int) -> ('a -> 'a -> int) -> 'a -> 'a -> int (** Lexicographic combination of comparison functions *) -val finally : h:(unit -> unit) -> f:(unit -> 'a) -> 'a +val finally : h:(unit -> _) -> f:(unit -> 'a) -> 'a (** [finally h f] calls [f ()] and returns its result. If it raises, the same exception is raised; in {b any} case, [h ()] is called after [f ()] terminates. *) +val finally1 : h:(unit -> _) -> ('a -> 'b) -> 'a -> 'b +(** [finally1 ~h f x] is the same as [f x], but after the computation, + [h ()] is called whether [f x] rose an exception or not. + @since NEXT_RELEASE *) + +val finally2 : h:(unit -> _) -> ('a -> 'b -> 'c) -> 'a -> 'b -> 'c +(** [finally2 ~h f x y] is the same as [f x y], but after the computation, + [h ()] is called whether [f x y] rose an exception or not. + @since NEXT_RELEASE *) + (** {2 Monad} Functions with a fixed domain are monads in their codomain *) From 7f42c94df7b4ab95daf099b7d2518bcdd2185671 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 16:39:13 +0100 Subject: [PATCH 13/63] add many helpers in `CCUnix` (for sockets, files, and processes) --- src/unix/CCUnix.ml | 74 +++++++++++++++++++++++++++++++++++++++++++++ src/unix/CCUnix.mli | 54 +++++++++++++++++++++++++++++++-- 2 files changed, 126 insertions(+), 2 deletions(-) diff --git a/src/unix/CCUnix.ml b/src/unix/CCUnix.ml index 7e38efd3..2d0af1e7 100644 --- a/src/unix/CCUnix.ml +++ b/src/unix/CCUnix.ml @@ -46,6 +46,15 @@ let rec iter_gen f g = match g() with | None -> () | Some x -> f x; iter_gen f g +let finally_ f x ~h = + try + let y = f x in + ignore (h()); + y + with e -> + ignore (h ()); + raise e + (* print a string, but escaped if required *) let escape_str buf s = if str_exists s @@ -155,6 +164,71 @@ let stderr x = x#stderr let status x = x#status let errcode x = x#errcode +let with_in ?(mode=0o644) ?(flags=[]) file ~f = + let fd = Unix.openfile file (Unix.O_RDONLY::flags) mode in + let ic = Unix.in_channel_of_descr fd in + finally_ f ic + ~h:(fun () -> Unix.close fd) + +let with_out ?(mode=0o644) ?(flags=[Unix.O_CREAT; Unix.O_TRUNC]) file ~f = + let fd = Unix.openfile file (Unix.O_WRONLY::flags) mode in + let oc = Unix.out_channel_of_descr fd in + finally_ f oc + ~h:(fun () -> flush oc; Unix.close fd) + +let with_process_in cmd ~f = + let ic = Unix.open_process_in cmd in + finally_ f ic + ~h:(fun () -> ignore (Unix.close_process_in ic)) + +let with_process_out cmd ~f = + let oc = Unix.open_process_out cmd in + finally_ f oc + ~h:(fun () -> ignore (Unix.close_process_out oc)) + +type process_full = < + stdin: out_channel; + stdout: in_channel; + stderr: in_channel; + close: Unix.process_status; +> + +let with_process_full ?env cmd ~f = + let env = match env with None -> Unix.environment () | Some e -> e in + let oc, ic, err = Unix.open_process_full cmd env in + let p = object + method stdin = ic + method stdout = oc + method stderr = err + method close = Unix.close_process_full (oc,ic,err) + end in + finally_ f p ~h:(fun () -> p#close) + +let with_connection addr ~f = + let ic, oc = Unix.open_connection addr in + finally_ (fun () -> f ic oc) () + ~h:(fun () -> Unix.shutdown_connection ic) + +exception ExitServer + +(* version of {!Unix.establish_server} that doesn't fork *) +let establish_server sockaddr ~f = + let sock = + Unix.socket (Unix.domain_of_sockaddr sockaddr) Unix.SOCK_STREAM 0 in + Unix.setsockopt sock Unix.SO_REUSEADDR true; + Unix.bind sock sockaddr; + Unix.listen sock 5; + let continue = ref true in + while !continue do + try + let s, _ = Unix.accept sock in + let ic = Unix.in_channel_of_descr s in + let oc = Unix.out_channel_of_descr s in + ignore (f ic oc) + with ExitServer -> + continue := false + done + module Infix = struct let (?|) fmt = call fmt diff --git a/src/unix/CCUnix.mli b/src/unix/CCUnix.mli index 779979e7..3eb47145 100644 --- a/src/unix/CCUnix.mli +++ b/src/unix/CCUnix.mli @@ -36,8 +36,7 @@ type 'a gen = unit -> 'a option (** {2 Calling Commands} *) val escape_str : Buffer.t -> string -> unit -(** Escape a string so it can be a shell argument. -*) +(** Escape a string so it can be a shell argument. *) (*$T CCPrint.sprintf "%a" escape_str "foo" = "foo" @@ -107,6 +106,57 @@ val stderr : < stderr : 'a; .. > -> 'a val status : < status : 'a; .. > -> 'a val errcode : < errcode : 'a; .. > -> 'a +(** {2 Simple IO} *) + +val with_in : ?mode:int -> ?flags:Unix.open_flag list -> + string -> f:(in_channel -> 'a) -> 'a +(** Open an input file with the given optional flag list, calls the function + on the input channel. When the function raises or returns, the + channel is closed. + @param flags opening flags. [Unix.O_RDONLY] is used in any cases + @since NEXT_RELEASE *) + +val with_out : ?mode:int -> ?flags:Unix.open_flag list -> + string -> f:(out_channel -> 'a) -> 'a +(** Same as {!with_in} but for an output channel + @param flags opening flags (default [[Unix.O_CREAT; Unix.O_TRUNC]]) + [Unix.O_WRONLY] is used in any cases. + @since NEXT_RELEASE *) + +val with_process_in : string -> f:(in_channel -> 'a) -> 'a +(** Open a subprocess and obtain a handle to its stdout + @since NEXT_RELEASE *) + +val with_process_out : string -> f:(out_channel -> 'a) -> 'a +(** Open a subprocess and obtain a handle to its stdin + @since NEXT_RELEASE *) + +(** Handle to a subprocess. + @since NEXT_RELEASE *) +type process_full = < + stdin: out_channel; + stdout: in_channel; + stderr: in_channel; + close: Unix.process_status; +> + +val with_process_full : ?env:string array -> string -> f:(process_full -> 'a) -> 'a +(** Open a subprocess and obtain a handle to its channels. + @param env environment to pass to the subprocess. + @since NEXT_RELEASE *) + +val with_connection : Unix.sockaddr -> f:(in_channel -> out_channel -> 'a) -> 'a +(** Wrap {!Unix.open_connection} with a handler + @since NEXT_RELEASE *) + +exception ExitServer + +val establish_server : Unix.sockaddr -> f:(in_channel -> out_channel -> _) -> unit +(** Listen on the address and calls the handler in a blocking fashion. + Using {!Thread} is recommended if handlers might take time. + The callback should raise {!ExitServer} to stop the loop. + @since NEXT_RELEASE *) + (** {2 Infix Functions} *) module Infix : sig From 32fad92be8c7838e0547d165dc079dcaa8d23e57 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 16:43:45 +0100 Subject: [PATCH 14/63] small fix --- src/unix/CCUnix.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/unix/CCUnix.ml b/src/unix/CCUnix.ml index 2d0af1e7..09ee3022 100644 --- a/src/unix/CCUnix.ml +++ b/src/unix/CCUnix.ml @@ -196,11 +196,12 @@ type process_full = < let with_process_full ?env cmd ~f = let env = match env with None -> Unix.environment () | Some e -> e in let oc, ic, err = Unix.open_process_full cmd env in + let close = lazy (Unix.close_process_full (oc,ic,err)) in let p = object method stdin = ic method stdout = oc method stderr = err - method close = Unix.close_process_full (oc,ic,err) + method close = Lazy.force close end in finally_ f p ~h:(fun () -> p#close) From 40c38a5dab4f65ac78d349e4bc263680506ec375 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 17:16:58 +0100 Subject: [PATCH 15/63] add `CCThread.spawn{1,2}` --- src/threads/CCThread.ml | 4 ++++ src/threads/CCThread.mli | 10 +++++++++- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/src/threads/CCThread.ml b/src/threads/CCThread.ml index b43104cd..521ee928 100644 --- a/src/threads/CCThread.ml +++ b/src/threads/CCThread.ml @@ -6,6 +6,10 @@ type t = Thread.t let spawn f = Thread.create f () +let spawn1 f x = Thread.create f x + +let spawn2 f x y = Thread.create (fun () -> f x y) () + let detach f = ignore (Thread.create f ()) module Arr = struct diff --git a/src/threads/CCThread.mli b/src/threads/CCThread.mli index 7c38e9a7..1ea3ff8a 100644 --- a/src/threads/CCThread.mli +++ b/src/threads/CCThread.mli @@ -7,9 +7,17 @@ type t = Thread.t -val spawn : (unit -> 'a) -> t +val spawn : (unit -> _) -> t (** [spawn f] creates a new thread that runs [f ()] *) +val spawn1 : ('a -> _) -> 'a -> t +(** [spawn1 f x] is like [spawn (fun () -> f x)]. + @since NEXT_RELEASE *) + +val spawn2 : ('a -> 'b -> _) -> 'a -> 'b -> t +(** [spawn2 f x y] is like [spawn (fun () -> f x y)]. + @since NEXT_RELEASE *) + val detach : (unit -> 'a) -> unit (** [detach f] is the same as [ignore (spawn f)] *) From f53b19545c31a3056f23b7bd409ecacaa00be39c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 17:40:27 +0100 Subject: [PATCH 16/63] udpate implem of CCFuture --- src/threads/CCFuture.ml | 39 ++++++++++++++++++++++----------------- 1 file changed, 22 insertions(+), 17 deletions(-) diff --git a/src/threads/CCFuture.ml b/src/threads/CCFuture.ml index 438b46a0..9d5d0424 100644 --- a/src/threads/CCFuture.ml +++ b/src/threads/CCFuture.ml @@ -33,7 +33,10 @@ type 'a state = (** {2 Thread pool} *) module Pool = struct type job = - | Job : ('a -> unit) * 'a -> job + | Job1 : ('a -> unit) * 'a -> job + | Job2 : ('a -> 'b -> unit) * 'a * 'b -> job + | Job3 : ('a -> 'b -> 'c -> unit) * 'a * 'b * 'c -> job + | Job4 : ('a -> 'b -> 'c -> 'd -> unit) * 'a * 'b * 'c * 'd -> job type t = { mutable stop : bool; (* indicate that threads should stop *) @@ -63,12 +66,12 @@ module Pool = struct Die (** Thread: entry point. They seek jobs in the queue *) - let rec serve pool = - match with_lock_ pool get_next with + let rec serve pool = match with_lock_ pool get_next with | Die -> () - | Process (Job (f, x)) -> - f x; - serve pool + | Process (Job1 (f, x)) -> ignore (f x); serve pool + | Process (Job2 (f, x, y)) -> ignore (f x y); serve pool + | Process (Job3 (f, x, y, z)) -> ignore (f x y z); serve pool + | Process (Job4 (f, x, y, z, w)) -> ignore (f x y z w); serve pool (* thread: seek what to do next (including dying) *) and get_next pool = @@ -112,19 +115,23 @@ module Pool = struct if should_start_thread pool then ( pool.cur_size <- pool.cur_size + 1; ignore (Thread.create serve pool) - ) - ) + )) (* run the function on the argument in the given pool *) - let run pool f x = run_job pool (Job (f, x)) + let run1 pool f x = run_job pool (Job1 (f, x)) + + let run2 pool f x y = run_job pool (Job2 (f, x, y)) + + let run3 pool f x y z = run_job pool (Job3 (f, x, y, z)) + + let run4 pool f x y z w = run_job pool (Job4 (f, x, y, z, w)) (* kill threads in the pool *) let stop pool = with_lock_ pool (fun p -> p.stop <- true; - Queue.clear p.jobs - ) + Queue.clear p.jobs) end (*$inject @@ -184,8 +191,7 @@ let set_done_ cell x = cell.state <- Done x; Condition.broadcast cell.condition; List.iter (fun f -> f cell.state) cell.handlers - | _ -> assert false - ) + | _ -> assert false) let set_fail_ cell e = with_lock_ cell @@ -194,8 +200,7 @@ let set_fail_ cell e = cell.state <- Failed e; Condition.broadcast cell.condition; List.iter (fun f -> f cell.state) cell.handlers - | _ -> assert false - ) + | _ -> assert false) let run_and_set1 cell f x = try @@ -213,7 +218,7 @@ let run_and_set2 cell f x y = let make1 f x = let cell = create_cell() in - Pool.run pool (run_and_set1 cell f) x; + Pool.run3 pool run_and_set1 cell f x; Run cell let make f = make1 f () @@ -236,7 +241,7 @@ let make f = make1 f () let make2 f x y = let cell = create_cell() in - Pool.run pool (run_and_set2 cell f x) y; + Pool.run4 pool run_and_set2 cell f x y; Run cell let get = function From 7d8369ab83f9af7fbf3cd69af534160615fbb41b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 18:29:06 +0100 Subject: [PATCH 17/63] small refactor --- src/threads/CCThread.ml | 45 ++++++++++++++++------------------------- 1 file changed, 17 insertions(+), 28 deletions(-) diff --git a/src/threads/CCThread.ml b/src/threads/CCThread.ml index 521ee928..95f3ead7 100644 --- a/src/threads/CCThread.ml +++ b/src/threads/CCThread.ml @@ -12,6 +12,15 @@ let spawn2 f x y = Thread.create (fun () -> f x y) () let detach f = ignore (Thread.create f ()) +let finally_ f x ~h = + try + let res = f x in + ignore (h ()); + res + with e -> + ignore (h()); + raise e + module Arr = struct let spawn n f = Array.init n (fun i -> Thread.create f i) @@ -42,13 +51,7 @@ module Barrier = struct let with_lock_ b f = Mutex.lock b.lock; - try - let x = f () in - Mutex.unlock b.lock; - x - with e -> - Mutex.unlock b.lock; - raise e + finally_ f () ~h:(fun () -> Mutex.unlock b.lock) let reset b = with_lock_ b (fun () -> b.activated <- false) @@ -57,17 +60,14 @@ module Barrier = struct (fun () -> while not b.activated do Condition.wait b.cond b.lock - done - ) + done) let activate b = with_lock_ b (fun () -> if not b.activated then ( b.activated <- true; - Condition.broadcast b.cond - ) - ) + Condition.broadcast b.cond)) let activated b = with_lock_ b (fun () -> b.activated) end @@ -109,13 +109,7 @@ module Queue = struct let with_lock_ q f = Mutex.lock q.lock; - try - let x = f () in - Mutex.unlock q.lock; - x - with e -> - Mutex.unlock q.lock; - raise e + finally_ f () ~h:(fun () -> Mutex.unlock q.lock) let push q x = with_lock_ q @@ -127,8 +121,7 @@ module Queue = struct Queue.push x q.q; (* if there are blocked receivers, awake one of them *) incr_size_ q; - Condition.broadcast q.cond; - ) + Condition.broadcast q.cond) let take q = with_lock_ q @@ -140,8 +133,7 @@ module Queue = struct (* if there are blocked senders, awake one of them *) decr_size_ q; Condition.broadcast q.cond; - x - ) + x) (*$R let q = Queue.create 1 in @@ -179,8 +171,7 @@ module Queue = struct done; let l = push_ q l in Condition.broadcast q.cond; - l - ) + l) in aux q l in aux q l @@ -266,9 +257,7 @@ module Queue = struct let peek q = with_lock_ q - (fun () -> - try Some (Queue.peek q.q) with Queue.Empty -> None - ) + (fun () -> try Some (Queue.peek q.q) with Queue.Empty -> None) let size q = with_lock_ q (fun () -> q.size) From e2848675f74d5abb58de85f0fa573a8d5056761e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 19:37:43 +0100 Subject: [PATCH 18/63] add `CCFormat.{with_color, with_colorf}` --- src/core/CCFormat.ml | 11 +++++++++++ src/core/CCFormat.mli | 12 ++++++++++++ 2 files changed, 23 insertions(+) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 3eb5f5a0..1ed6853d 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -264,6 +264,17 @@ let set_color_default = s *) +let with_color s pp out x = + Format.pp_open_tag out s; + pp out x; + Format.pp_close_tag out () + +let with_colorf s out fmt = + Format.pp_open_tag out s; + Format.kfprintf + (fun out -> Format.pp_close_tag out ()) + out fmt + let sprintf format = let buf = Buffer.create 64 in let fmt = Format.formatter_of_buffer buf in diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index dbc7ec2e..4f7ee00f 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -115,6 +115,18 @@ val set_color_default : bool -> unit (stdout, stderr) if [b = true] as well as on {!sprintf} formatters; it disables the color handling if [b = false]. *) +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} + @since NEXT_RELEASE *) + +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} + @since NEXT_RELEASE *) + (** {2 IO} *) val output : t -> 'a printer -> 'a -> unit From 02a9639d0203dcf86c37a413ae33cce8293a3f92 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 21:18:33 +0100 Subject: [PATCH 19/63] add `CCResult`, with dependency on `result` for retrocompat --- .merlin | 1 + _oasis | 4 +- doc/intro.txt | 1 + opam | 1 + src/core/CCResult.ml | 248 ++++++++++++++++++++++++++++++++++++++++++ src/core/CCResult.mli | 182 +++++++++++++++++++++++++++++++ 6 files changed, 435 insertions(+), 2 deletions(-) create mode 100644 src/core/CCResult.ml create mode 100644 src/core/CCResult.mli diff --git a/.merlin b/.merlin index d0a5cac0..dcf99f7b 100644 --- a/.merlin +++ b/.merlin @@ -28,6 +28,7 @@ B _build/examples B _build/tests PKG oUnit PKG benchmark +PKG result PKG threads PKG threads.posix PKG lwt diff --git a/_oasis b/_oasis index f0fb6fbc..26cffeba 100644 --- a/_oasis +++ b/_oasis @@ -46,8 +46,8 @@ Library "containers" Modules: CCVector, CCPrint, CCError, CCHeap, CCList, CCOpt, CCPair, CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray, CCRef, CCSet, CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat, CCIO, - CCInt64, CCChar, Containers - BuildDepends: bytes + CCInt64, CCChar, CCResult, Containers + BuildDepends: bytes, result # BuildDepends: bytes, bisect_ppx Library "containers_io" diff --git a/doc/intro.txt b/doc/intro.txt index 338a2596..6855b114 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -44,6 +44,7 @@ CCPair CCPrint CCRandom CCRef +CCResult CCSet CCString CCVector diff --git a/opam b/opam index a3b0dfe8..51a80a86 100644 --- a/opam +++ b/opam @@ -27,6 +27,7 @@ remove: [ depends: [ "ocamlfind" {build} "base-bytes" + "result" "cppo" {build} "oasis" {build} "ocamlbuild" {build} diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml new file mode 100644 index 00000000..ed05df1d --- /dev/null +++ b/src/core/CCResult.ml @@ -0,0 +1,248 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Error Monad} *) + +type 'a sequence = ('a -> unit) -> unit +type 'a equal = 'a -> 'a -> bool +type 'a ord = 'a -> 'a -> int +type 'a printer = Buffer.t -> 'a -> unit +type 'a formatter = Format.formatter -> 'a -> unit + +(** {2 Basics} *) + +type (+'good, +'bad) t = ('good, 'bad) Result.result = + | Ok of 'good + | Error of 'bad + +let return x = Ok x + +let fail s = Error s + +let fail_printf format = + let buf = Buffer.create 64 in + Printf.kbprintf + (fun buf -> fail (Buffer.contents buf)) + buf format + +let fail_fprintf format = + let buf = Buffer.create 64 in + let out = Format.formatter_of_buffer buf in + Format.kfprintf + (fun out -> Format.pp_print_flush out (); fail (Buffer.contents buf)) + out format + +let of_exn e = + let msg = Printexc.to_string e in + Error msg + +let of_exn_trace e = + let res = Printf.sprintf "%s\n%s" + (Printexc.to_string e) (Printexc.get_backtrace ()) + in + Error res + +let map f e = match e with + | Ok x -> Ok (f x) + | Error s -> Error s + +let map_err f e = match e with + | Ok _ as res -> res + | Error y -> Error (f y) + +let map2 f g e = match e with + | Ok x -> Ok (f x) + | Error s -> Error (g s) + +let iter f e = match e with + | Ok x -> f x + | Error _ -> () + +exception GetOnError + +let get_exn = function + | Ok x -> x + | Error _ -> raise GetOnError + +let catch e ~ok ~err = match e with + | Ok x -> ok x + | Error y -> err y + +let flat_map f e = match e with + | Ok x -> f x + | Error s -> Error s + +let (>|=) e f = map f e + +let (>>=) e f = flat_map f e + +let equal ?(err=Pervasives.(=)) eq a b = match a, b with + | Ok x, Ok y -> eq x y + | Error s, Error s' -> err s s' + | _ -> false + +let compare ?(err=Pervasives.compare) cmp a b = match a, b with + | Ok x, Ok y -> cmp x y + | Ok _, _ -> 1 + | _, Ok _ -> -1 + | Error s, Error s' -> err s s' + +let fold ~ok ~error x = match x with + | Ok x -> ok x + | Error s -> error s + +(** {2 Wrappers} *) + +let guard f = + try Ok (f ()) + with e -> Error e + +let guard_str f = + try Ok (f()) + with e -> of_exn e + +let guard_str_trace f = + try Ok (f()) + with e -> of_exn_trace e + +let wrap1 f x = + try return (f x) + with e -> Error e + +let wrap2 f x y = + try return (f x y) + with e -> Error e + +let wrap3 f x y z = + try return (f x y z) + with e -> Error e + +(** {2 Applicative} *) + +let pure = return + +let (<*>) f x = match f with + | Error s -> fail s + | Ok f -> map f x + +let join t = match t with + | Ok (Ok o) -> Ok o + | Ok (Error e) -> Error e + | (Error _) as e -> e + +let both x y = match x,y with + | Ok o, Ok o' -> Ok (o, o') + | Ok _, Error e -> Error e + | Error e, _ -> Error e + +(** {2 Collections} *) + +let map_l f l = + let rec map acc l = match l with + | [] -> Ok (List.rev acc) + | x::l' -> + match f x with + | Error s -> Error s + | Ok y -> map (y::acc) l' + in map [] l + +exception LocalExit + +let fold_seq f acc seq = + let err = ref None in + try + let acc = ref acc in + seq + (fun x -> match f !acc x with + | Error s -> err := Some s; raise LocalExit + | Ok y -> acc := y); + Ok !acc + with LocalExit -> + match !err with None -> assert false | Some s -> Error s + +let fold_l f acc l = fold_seq f acc (fun k -> List.iter k l) + +(** {2 Misc} *) + +let choose l = + let rec find_ = function + | [] -> raise Not_found + | ((Ok _) as res) :: _ -> res + | (Error _) :: l' -> find_ l' + in + try find_ l + with Not_found -> + let l' = List.map (function Error s -> s | Ok _ -> assert false) l in + Error l' + +let retry n f = + let rec retry n acc = match n with + | 0 -> fail (List.rev acc) + | _ -> + match f () with + | Ok _ as res -> res + | Error e -> retry (n-1) (e::acc) + in retry n [] + +(** {2 Infix} *) + +module Infix = struct + let (>>=) = (>>=) + let (>|=) = (>|=) + let (<*>) = (<*>) +end + +(** {2 Monadic Operations} *) + +module type MONAD = sig + type 'a t + val return : 'a -> 'a t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t +end + +module Traverse(M : MONAD) = struct + let (>>=) = M.(>>=) + + let map_m f e = match e with + | Error s -> M.return (Error s) + | Ok x -> f x >>= fun y -> M.return (Ok y) + + let sequence_m m = map_m (fun x->x) m + + let fold_m f acc e = match e with + | Error _ -> M.return acc + | Ok x -> f acc x >>= fun y -> M.return y + + let retry_m n f = + let rec retry n acc = match n with + | 0 -> M.return (fail (List.rev acc)) + | _ -> + f () >>= function + | Ok x -> M.return (Ok x) + | Error e -> retry (n-1) (e::acc) + in retry n [] +end + +(** {2 Conversions} *) + +let to_opt = function + | Ok x -> Some x + | Error _ -> None + +let of_opt = function + | None -> Error "of_opt" + | Some x -> Ok x + +let to_seq e k = match e with + | Ok x -> k x + | Error _ -> () + +(** {2 IO} *) + +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 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 diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli new file mode 100644 index 00000000..565591b8 --- /dev/null +++ b/src/core/CCResult.mli @@ -0,0 +1,182 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Error Monad} + + Uses the new "result" type from OCaml 4.03. + + @since NEXT_RELEASE *) + +type 'a sequence = ('a -> unit) -> unit +type 'a equal = 'a -> 'a -> bool +type 'a ord = 'a -> 'a -> int +type 'a printer = Buffer.t -> 'a -> unit +type 'a formatter = Format.formatter -> 'a -> unit + +(** {2 Basics} *) + +type (+'good, +'bad) t = ('good, 'bad) Result.result = + | Ok of 'good + | Error of 'bad + +val return : 'a -> ('a, 'err) t +(** Successfully return a value *) + +val fail : 'err -> ('a, 'err) t +(** Fail with an error *) + +val of_exn : exn -> ('a, string) t +(** [of_exn e] uses {!Printexc} to print the exception as a string *) + +val of_exn_trace : exn -> ('a, string) t +(** [of_exn_trace e] is similar to [of_exn e], but it adds the stacktrace + to the error message. + + Remember to call [Printexc.record_backtrace true] and compile with the + debug flag for this to work. *) + +val fail_printf : ('a, Buffer.t, unit, ('a, string) t) format4 -> 'a +(** [fail_printf format] uses [format] to obtain an error message + and then returns [Error msg] *) + +val fail_fprintf : ('a, Format.formatter, unit, ('a, string) t) format4 -> 'a +(** [fail_printf format] uses [format] to obtain an error message + and then returns [Error msg] *) + +val map : ('a -> 'b) -> ('a, 'err) t -> ('b, 'err) t +(** Map on success *) + +val map_err : ('err1 -> 'err2) -> ('a, 'err1) t -> ('a, 'err2) t +(** Map on the error variant *) + +val map2 : ('a -> 'b) -> ('err1 -> 'err2) -> ('a, 'err1) t -> ('b, 'err2) t +(** Same as {!map}, but also with a function that can transform + the error message in case of failure *) + +val iter : ('a -> unit) -> ('a, _) t -> unit +(** Apply the function only in case of Ok *) + +exception GetOnError + +val get_exn : ('a, _) t -> 'a +(** Extract the value [x] from [Ok x], fails otherwise. + You should be careful with this function, and favor other combinators + whenever possible. + @raise GetOnError if the value is an error. *) + +val catch : ('a, 'err) t -> ok:('a -> 'b) -> err:('err -> 'b) -> 'b +(** [catch e ~ok ~err] calls either [ok] or [err] depending on + the value of [e]. *) + +val flat_map : ('a -> ('b, 'err) t) -> ('a, 'err) t -> ('b, 'err) t + +val (>|=) : ('a, 'err) t -> ('a -> 'b) -> ('b, 'err) t + +val (>>=) : ('a, 'err) t -> ('a -> ('b, 'err) t) -> ('b, 'err) t + +val equal : ?err:'err equal -> 'a equal -> ('a, 'err) t equal + +val compare : ?err:'err ord -> 'a ord -> ('a, 'err) t ord + +val fold : ok:('a -> 'b) -> error:('err -> 'b) -> ('a, 'err) t -> 'b +(** [fold ~ok ~error e] opens [e] and, if [e = Ok x], returns + [ok x], otherwise [e = Error s] and it returns [error s]. *) + +(** {2 Wrappers} *) + +val guard : (unit -> 'a) -> ('a, exn) t +(** [guard f] runs [f ()] and returns its result wrapped in [Ok]. If + [f ()] raises some exception [e], then it fails with [Error e] *) + +val guard_str : (unit -> 'a) -> ('a, string) t +(** Same as {!guard} but uses {!of_exn} to print the exception. *) + +val guard_str_trace : (unit -> 'a) -> ('a, string) t +(** Same as {!guard_str} but uses {!of_exn_trace} instead of {!of_exn} so + that the stack trace is printed. *) + +val wrap1 : ('a -> 'b) -> 'a -> ('b, exn) t +(** Same as {!guard} but gives the function one argument. *) + +val wrap2 : ('a -> 'b -> 'c) -> 'a -> 'b -> ('c, exn) t +(** Same as {!guard} but gives the function two arguments. *) + +val wrap3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> ('d, exn) t +(** Same as {!guard} but gives the function three arguments. *) + +(** {2 Applicative} *) + +val pure : 'a -> ('a, 'err) t +(** Synonym of {!return} *) + +val (<*>) : ('a -> 'b, 'err) t -> ('a, 'err) t -> ('b, 'err) t +(** [a <*> b] evaluates [a] and [b], and, in case of success, returns + [Ok (a b)]. Otherwise, it fails, and the error of [a] is chosen + over the error of [b] if both fail. *) + +val join : (('a, 'err) t, 'err) t -> ('a, 'err) t +(** [join t], in case of success, returns [Ok o] from [Ok (Ok o)]. Otherwise, + it fails with [Error e] where [e] is the unwrapped error of [t]. *) + +val both : ('a, 'err) t -> ('b, 'err) t -> (('a * 'b), 'err) t +(** [both a b], in case of success, returns [Ok (o, o')] with the ok values + of [a] and [b]. Otherwise, it fails, and the error of [a] is chosen over the + error of [b] if both fail. *) + +(** {2 Infix} *) + +module Infix : sig + val (>|=) : ('a, 'err) t -> ('a -> 'b) -> ('b, 'err) t + val (>>=) : ('a, 'err) t -> ('a -> ('b, 'err) t) -> ('b, 'err) t + val (<*>) : ('a -> 'b, 'err) t -> ('a, 'err) t -> ('b, 'err) t +end + +(** {2 Collections} *) + +val map_l : ('a -> ('b, 'err) t) -> 'a list -> ('b list, 'err) t + +val fold_l : ('b -> 'a -> ('b, 'err) t) -> 'b -> 'a list -> ('b, 'err) t + +val fold_seq : ('b -> 'a -> ('b, 'err) t) -> 'b -> 'a sequence -> ('b, 'err) t + +(** {2 Misc} *) + +val choose : ('a, 'err) t list -> ('a, 'err list) t +(** [choose l] selects a member of [l] that is a [Ok _] value, + or returns [Error l] otherwise, where [l] is the list of errors. *) + +val retry : int -> (unit -> ('a, 'err) t) -> ('a, 'err list) t +(** [retry n f] calls [f] at most [n] times, returning the first result + of [f ()] that doesn't fail. If [f] fails [n] times, [retry n f] fails + with the list of successive errors. *) + +(** {2 Monadic Operations} *) +module type MONAD = sig + type 'a t + val return : 'a -> 'a t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t +end + +module Traverse(M : MONAD) : sig + val sequence_m : ('a M.t, 'err) t -> ('a, 'err) t M.t + + val fold_m : ('b -> 'a -> 'b M.t) -> 'b -> ('a, 'err) t -> 'b M.t + + val map_m : ('a -> 'b M.t) -> ('a, 'err) t -> ('b, 'err) t M.t + + val retry_m : int -> (unit -> ('a, 'err) t M.t) -> ('a, 'err list) t M.t +end + +(** {2 Conversions} *) + +val to_opt : ('a, _) t -> 'a option + +val of_opt : 'a option -> ('a, string) t + +val to_seq : ('a, _) t -> 'a sequence + +(** {2 IO} *) + +val pp : 'a printer -> ('a, string) t printer + +val print : 'a formatter -> ('a, string) t formatter From 9097cb11abc91dad4eebf3e21b817655abfa3589 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 25 Jan 2016 22:03:47 +0100 Subject: [PATCH 20/63] move `CCThread.Queue` into `CCBlockingQueue` - fix the module - fix benchs --- _oasis | 2 +- benchs/run_benchs.ml | 2 +- doc/intro.txt | 1 + src/threads/CCBlockingQueue.ml | 191 ++++++++++++++++++++++++++++++++ src/threads/CCBlockingQueue.mli | 50 +++++++++ src/threads/CCThread.ml | 180 ------------------------------ src/threads/CCThread.mli | 45 -------- 7 files changed, 244 insertions(+), 227 deletions(-) create mode 100644 src/threads/CCBlockingQueue.ml create mode 100644 src/threads/CCBlockingQueue.mli diff --git a/_oasis b/_oasis index 26cffeba..29a479c7 100644 --- a/_oasis +++ b/_oasis @@ -114,7 +114,7 @@ Library "containers_bigarray" Library "containers_thread" Path: src/threads/ - Modules: CCFuture, CCLock, CCSemaphore, CCThread + Modules: CCFuture, CCLock, CCSemaphore, CCThread, CCBlockingQueue FindlibName: thread FindlibParent: containers Build$: flag(thread) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index 555ca079..dea99e05 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -954,7 +954,7 @@ module Deque = struct end module Thread = struct - module Q = CCThread.Queue + module Q = CCBlockingQueue module type TAKE_PUSH = sig val take : 'a Q.t -> 'a diff --git a/doc/intro.txt b/doc/intro.txt index 6855b114..5fbc2bf0 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -148,6 +148,7 @@ Moved to its own repository {4 Others} {!modules: +CCBlockingQueue CCFuture CCLock CCSemaphore diff --git a/src/threads/CCBlockingQueue.ml b/src/threads/CCBlockingQueue.ml new file mode 100644 index 00000000..d767b4ab --- /dev/null +++ b/src/threads/CCBlockingQueue.ml @@ -0,0 +1,191 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Blocking Queue} *) + +type 'a t = { + q : 'a Queue.t; + lock : Mutex.t; + cond : Condition.t; + capacity : int; + mutable size : int; +} + +let create n = + if n < 1 then invalid_arg "BloquingQueue.create"; + let q = { + q=Queue.create(); + lock=Mutex.create(); + cond=Condition.create(); + capacity=n; + size=0; + } in + q + +let incr_size_ q = assert(q.size < q.capacity); q.size <- q.size + 1 +let decr_size_ q = assert(q.size > 0); q.size <- q.size - 1 + +let finally_ f x ~h = + try + let res = f x in + ignore (h ()); + res + with e -> + ignore (h()); + raise e + +let with_lock_ q f = + Mutex.lock q.lock; + finally_ f () ~h:(fun () -> Mutex.unlock q.lock) + +let push q x = + with_lock_ q + (fun () -> + while q.size = q.capacity do + Condition.wait q.cond q.lock + done; + assert (q.size < q.capacity); + Queue.push x q.q; + (* if there are blocked receivers, awake one of them *) + incr_size_ q; + Condition.broadcast q.cond) + +let take q = + with_lock_ q + (fun () -> + while q.size = 0 do + Condition.wait q.cond q.lock + done; + let x = Queue.take q.q in + (* if there are blocked senders, awake one of them *) + decr_size_ q; + Condition.broadcast q.cond; + x) + +(*$R + let q = create 1 in + let t1 = CCThread.spawn (fun () -> push q 1; push q 2) in + let t2 = CCThread.spawn (fun () -> push q 3; push q 4) in + let l = CCLock.create [] in + let t3 = CCThread.spawn (fun () -> for i = 1 to 4 do + let x = take q in + CCLock.update l (fun l -> x :: l) + done) + in + Thread.join t1; Thread.join t2; Thread.join t3; + assert_equal [1;2;3;4] (List.sort Pervasives.compare (CCLock.get l)) +*) + +let push_list q l = + (* push elements until it's not possible. + Assumes the lock is acquired. *) + let rec push_ q l = match l with + | [] -> l + | _::_ when q.size = q.capacity -> l (* no room remaining *) + | x :: tl -> + Queue.push x q.q; + incr_size_ q; + push_ q tl + in + (* push chunks of [l] in [q] until [l] is empty *) + let rec aux q l = match l with + | [] -> () + | _::_ -> + let l = with_lock_ q + (fun () -> + while q.size = q.capacity do + Condition.wait q.cond q.lock + done; + let l = push_ q l in + Condition.broadcast q.cond; + l) + in + aux q l + in aux q l + +let take_list q n = + (* take at most [n] elements of [q] and prepend them to [acc] *) + let rec pop_ acc q n = + if n=0 || Queue.is_empty q.q then acc, n + else ( (* take next element *) + let x = Queue.take q.q in + decr_size_ q; + pop_ (x::acc) q (n-1) + ) + in + (* call [pop_] until [n] elements have been gathered *) + let rec aux acc q n = + if n=0 then List.rev acc + else + let acc, n = with_lock_ q + (fun () -> + while q.size = 0 do + Condition.wait q.cond q.lock + done; + let acc, n = pop_ acc q n in + Condition.broadcast q.cond; + acc, n + ) + in + aux acc q n + in + aux [] q n + +(*$R + let n = 1000 in + let lists = [| CCList.(1 -- n) ; CCList.(n+1 -- 2*n); CCList.(2*n+1 -- 3*n) |] in + let q = create 2 in + let senders = CCThread.Arr.spawn 3 + (fun i -> + if i=1 + then push_list q lists.(i) (* test push_list *) + else List.iter (push q) lists.(i) + ) + in + let res = CCLock.create [] in + let receivers = CCThread.Arr.spawn 3 + (fun i -> + if i=1 then + let l = take_list q n in + CCLock.update res (fun acc -> l @ acc) + else + for _j = 1 to n do + let x = take q in + CCLock.update res (fun acc -> x::acc) + done + ) + in + CCThread.Arr.join senders; CCThread.Arr.join receivers; + let l = CCLock.get res |> List.sort Pervasives.compare in + assert_equal CCList.(1 -- 3*n) l +*) + +let try_take q = + with_lock_ q + (fun () -> + if q.size = 0 then None + else ( + decr_size_ q; + Some (Queue.take q.q) + )) + +let try_push q x = + with_lock_ q + (fun () -> + if q.size = q.capacity then false + else ( + incr_size_ q; + Queue.push x q.q; + Condition.signal q.cond; + true + )) + +let peek q = + with_lock_ q + (fun () -> + try Some (Queue.peek q.q) + with Queue.Empty -> None) + +let size q = with_lock_ q (fun () -> q.size) + +let capacity q = q.capacity diff --git a/src/threads/CCBlockingQueue.mli b/src/threads/CCBlockingQueue.mli new file mode 100644 index 00000000..fabd441d --- /dev/null +++ b/src/threads/CCBlockingQueue.mli @@ -0,0 +1,50 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Blocking Queue} + + This queue has a limited size. Pushing a value on the queue when it + is full will block. + + @since NEXT_RELEASE *) + +type 'a t +(** Safe-thread queue for values of type ['a] *) + +val create : int -> 'a t +(** Create a new queue of size [n]. Using [n=max_int] amounts to using + an infinite queue (2^61 items is a lot to fit in memory); using [n=1] + amounts to using a box with 0 or 1 elements inside. + @raise Invalid_argument if [n < 1] *) + +val push : 'a t -> 'a -> unit +(** [push q x] pushes [x] into [q], blocking if the queue is full *) + +val take : 'a t -> 'a +(** Take the first element, blocking if needed *) + +val push_list : 'a t -> 'a list -> unit +(** Push items of the list, one by one *) + +val take_list : 'a t -> int -> 'a list +(** [take_list n q] takes [n] elements out of [q] *) + +val try_take : 'a t -> 'a option +(** Take the first element if the queue is not empty, return [None] + otherwise *) + +val try_push : 'a t -> 'a -> bool +(** [try_push q x] pushes [x] into [q] if [q] is not full, in which + case it returns [true]. + If it fails because [q] is full, it returns [false] *) + +val peek : 'a t -> 'a option +(** [peek q] returns [Some x] if [x] is the first element of [q], + otherwise it returns [None] *) + +val size : _ t -> int +(** Number of elements currently in the queue *) + +val capacity : _ t -> int +(** Number of values the queue can hold *) + diff --git a/src/threads/CCThread.ml b/src/threads/CCThread.ml index 95f3ead7..eb274097 100644 --- a/src/threads/CCThread.ml +++ b/src/threads/CCThread.ml @@ -83,183 +83,3 @@ end Thread.join t1; Thread.join t2; assert_equal 2 (CCLock.get res) *) - -module Queue = struct - type 'a t = { - q : 'a Queue.t; - lock : Mutex.t; - cond : Condition.t; - capacity : int; - mutable size : int; - } - - let create n = - if n < 1 then invalid_arg "CCThread.Queue.create"; - let q = { - q=Queue.create(); - lock=Mutex.create(); - cond=Condition.create(); - capacity=n; - size=0; - } in - q - - let incr_size_ q = assert(q.size < q.capacity); q.size <- q.size + 1 - let decr_size_ q = assert(q.size > 0); q.size <- q.size - 1 - - let with_lock_ q f = - Mutex.lock q.lock; - finally_ f () ~h:(fun () -> Mutex.unlock q.lock) - - let push q x = - with_lock_ q - (fun () -> - while q.size = q.capacity do - Condition.wait q.cond q.lock - done; - assert (q.size < q.capacity); - Queue.push x q.q; - (* if there are blocked receivers, awake one of them *) - incr_size_ q; - Condition.broadcast q.cond) - - let take q = - with_lock_ q - (fun () -> - while q.size = 0 do - Condition.wait q.cond q.lock - done; - let x = Queue.take q.q in - (* if there are blocked senders, awake one of them *) - decr_size_ q; - Condition.broadcast q.cond; - x) - - (*$R - let q = Queue.create 1 in - let t1 = spawn (fun () -> Queue.push q 1; Queue.push q 2) in - let t2 = spawn (fun () -> Queue.push q 3; Queue.push q 4) in - let l = CCLock.create [] in - let t3 = spawn (fun () -> for i = 1 to 4 do - let x = Queue.take q in - CCLock.update l (fun l -> x :: l) - done) - in - Thread.join t1; Thread.join t2; Thread.join t3; - assert_equal [1;2;3;4] (List.sort Pervasives.compare (CCLock.get l)) - *) - - let push_list q l = - let is_empty_ = function [] -> true | _::_ -> false in - (* push elements until it's not possible *) - let rec push_ q l = match l with - | [] -> l - | _::_ when q.size = q.capacity -> l (* no room remaining *) - | x :: tl -> - Queue.push x q.q; - incr_size_ q; - push_ q tl - in - (* push chunks of [l] in [q] until [l] is empty *) - let rec aux q l = - if not (is_empty_ l) - then - let l = with_lock_ q - (fun () -> - while q.size = q.capacity do - Condition.wait q.cond q.lock - done; - let l = push_ q l in - Condition.broadcast q.cond; - l) - in - aux q l - in aux q l - - let take_list q n = - (* take at most [n] elements of [q] and prepend them to [acc] *) - let rec pop_ acc q n = - if n=0 || Queue.is_empty q.q then acc, n - else ( (* take next element *) - let x = Queue.take q.q in - decr_size_ q; - pop_ (x::acc) q (n-1) - ) - in - (* call [pop_] until [n] elements have been gathered *) - let rec aux acc q n = - if n=0 then List.rev acc - else - let acc, n = with_lock_ q - (fun () -> - while q.size = 0 do - Condition.wait q.cond q.lock - done; - let acc, n = pop_ acc q n in - Condition.broadcast q.cond; - acc, n - ) - in - aux acc q n - in - aux [] q n - - (*$R - let n = 1000 in - let lists = [| CCList.(1 -- n) ; CCList.(n+1 -- 2*n); CCList.(2*n+1 -- 3*n) |] in - let q = Queue.create 2 in - let senders = Arr.spawn 3 - (fun i -> - if i=1 - then Queue.push_list q lists.(i) (* test push_list *) - else List.iter (Queue.push q) lists.(i) - ) - in - let res = CCLock.create [] in - let receivers = Arr.spawn 3 - (fun i -> - if i=1 then - let l = Queue.take_list q n in - CCLock.update res (fun acc -> l @ acc) - else - for _j = 1 to n do - let x = Queue.take q in - CCLock.update res (fun acc -> x::acc) - done - ) - in - Arr.join senders; Arr.join receivers; - let l = CCLock.get res |> List.sort Pervasives.compare in - assert_equal CCList.(1 -- 3*n) l - *) - - let try_take q = - with_lock_ q - (fun () -> - if q.size > 0 - then ( - decr_size_ q; - Some (Queue.take q.q) - ) else None - ) - - let try_push q x = - with_lock_ q - (fun () -> - if q.size < q.capacity - then ( - incr_size_ q; - Queue.push x q.q; - Condition.signal q.cond; - true - ) else false - ) - - let peek q = - with_lock_ q - (fun () -> try Some (Queue.peek q.q) with Queue.Empty -> None) - - let size q = with_lock_ q (fun () -> q.size) - - let capacity q = q.capacity -end diff --git a/src/threads/CCThread.mli b/src/threads/CCThread.mli index 1ea3ff8a..d33f8fd4 100644 --- a/src/threads/CCThread.mli +++ b/src/threads/CCThread.mli @@ -56,48 +56,3 @@ module Barrier : sig was not called since. In other words, [activated b = true] means [wait b] will not block. *) end - -(** {2 Blocking Queue} - - This queue has a limited size. Pushing a value on the queue when it - is full will block *) -module Queue : sig - type 'a t - (** Safe-thread queue for values of type ['a] *) - - val create : int -> 'a t - (** Create a new queue of size [n]. Using [n=max_int] amounts to using - an infinite queue (2^61 items is a lot to fit in memory). - @raise Invalid_argument if [n < 1] *) - - val push : 'a t -> 'a -> unit - (** [push q x] pushes [x] into [q], blocking if the queue is full *) - - val take : 'a t -> 'a - (** Take the first element, blocking if needed *) - - val push_list : 'a t -> 'a list -> unit - (** Push items of the list, one by one *) - - val take_list : 'a t -> int -> 'a list - (** [take_list n q] takes [n] elements out of [q] *) - - val try_take : 'a t -> 'a option - (** Take the first element if the queue is not empty, return [None] - otherwise *) - - val try_push : 'a t -> 'a -> bool - (** [try_push q x] pushes [x] into [q] if [q] is not full, in which - case it returns [true]. - If it fails because [q] is full, it returns [false] *) - - val peek : 'a t -> 'a option - (** [peek q] returns [Some x] if [x] is the first element of [q], - otherwise it returns [None] *) - - val size : _ t -> int - (** Number of elements currently in the queue *) - - val capacity : _ t -> int - (** Number of values the queue can hold *) -end From 6b03a28cbae9047b8ab5923ef95952505e28a54e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 26 Jan 2016 01:01:04 +0100 Subject: [PATCH 21/63] split `CCTimer` out of `CCFuture`, a standalone 1-thread timer --- src/threads/CCTimer.ml | 195 ++++++++++++++++++++++++++++++++++++++++ src/threads/CCTimer.mli | 43 +++++++++ 2 files changed, 238 insertions(+) create mode 100644 src/threads/CCTimer.ml create mode 100644 src/threads/CCTimer.mli diff --git a/src/threads/CCTimer.ml b/src/threads/CCTimer.ml new file mode 100644 index 00000000..cb4739dd --- /dev/null +++ b/src/threads/CCTimer.ml @@ -0,0 +1,195 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Event timer} *) + +type job = + | Job : float * (unit -> 'a) -> job + +module TaskHeap = CCHeap.Make(struct + type t = job + let leq (Job(f1,_)) (Job (f2,_)) = f1 <= f2 +end) + +exception Stopped + +type t = { + mutable stop : bool; + mutable tasks : TaskHeap.t; + mutable exn_handler : (exn -> unit); + t_mutex : Mutex.t; + fifo_in : Unix.file_descr; + fifo_out : Unix.file_descr; +} + +let set_exn_handler timer f = timer.exn_handler <- f + +let standby_wait = 10. +(* when no task is scheduled, this is the amount of time that is waited + in a row for something to happen. This is also the maximal delay + between the call to {!stop} and the actual termination of the + thread. *) + +let epsilon = 0.0001 +(* accepted time diff for actions. *) + +let with_lock_ t f = + Mutex.lock t.t_mutex; + try + let x = f t in + Mutex.unlock t.t_mutex; + x + with e -> + Mutex.unlock t.t_mutex; + raise e + +type command = + | Quit + | Run : (unit -> _) -> command + | Wait of float + +let pop_task_ t = + let tasks, _ = TaskHeap.take_exn t.tasks in + t.tasks <- tasks + +let call_ timer f = + try ignore (f ()) + with e -> timer.exn_handler e + +(* check next task *) +let next_task_ timer = match TaskHeap.find_min timer.tasks with + | _ when timer.stop -> Quit + | None -> Wait standby_wait + | Some Job (time, f) -> + let now = Unix.gettimeofday () in + if now +. epsilon > time then ( + (* now! *) + pop_task_ timer; + Run f + ) else Wait (time -. now) + +(* The main thread function: wait for next event, run it, and loop *) +let serve timer = + let buf = Bytes.make 1 '_' in + (* acquire lock, call [process_task] and do as it commands *) + let rec next () = match with_lock_ timer next_task_ with + | Quit -> () + | Run f -> + call_ timer f; (* call outside of any lock *) + next () + | Wait delay -> wait delay + (* wait for [delay] seconds, or until something happens on [fifo_in] *) + and wait delay = + let read = Thread.wait_timed_read timer.fifo_in delay in + (* remove char from fifo, so that next write can happen *) + if read then ignore (Unix.read timer.fifo_in buf 0 1); + next () + in + next () + +let nop_handler_ _ = () + +let create () = + let fifo_in, fifo_out = Unix.pipe () in + let timer = { + stop = false; + tasks = TaskHeap.empty; + exn_handler = nop_handler_; + t_mutex = Mutex.create (); + fifo_in; + fifo_out; + } in + (* start a thread to process tasks *) + let _t = Thread.create serve timer in + timer + +let underscore_ = Bytes.make 1 '_' + +(* awake the thread *) +let awaken_ timer = + ignore (Unix.single_write timer.fifo_out underscore_ 0 1) + +(** [at s t ~f] will run [f ()] at the Unix echo [t] *) +let at timer time ~f = + if timer.stop then raise Stopped; + let now = Unix.gettimeofday () in + if now >= time + then call_ timer f + else + with_lock_ timer + (fun timer -> + if timer.stop then raise Stopped; + (* time of the next scheduled event *) + let next_time = match TaskHeap.find_min timer.tasks with + | None -> max_float + | Some Job (d, _) -> d + in + (* insert task *) + timer.tasks <- TaskHeap.insert (Job (time, f)) timer.tasks; + (* see if the timer thread needs to be awaken earlier *) + if time < next_time then awaken_ timer + ) + +let after timer delay ~f = + assert (delay >= 0.); + let now = Unix.gettimeofday () in + at timer (now +. delay) ~f + +exception ExitEvery + +let every ?delay timer d ~f = + let rec run () = + try + ignore (f ()); + schedule() + with ExitEvery -> () (* stop *) + and schedule () = after timer d ~f:run in + match delay with + | None -> run() + | Some d -> after timer d ~f:run + +(*$R + let start = Unix.gettimeofday() in + let timer = create() in + let res = CCLock.create 0 in + let stop = ref 0. in + every timer 0.1 + ~f:(fun () -> + if CCLock.incr_then_get res > 5 then ( + stop := Unix.gettimeofday(); + raise ExitEvery + )); + Thread.delay 0.7; + OUnit.assert_equal ~printer:CCInt.to_string 6 (CCLock.get res); + OUnit.assert_bool "estimate delay" (abs_float (!stop -. start -. 0.5) < 0.1); +*) + +let active timer = not timer.stop + +(** Stop the given timer, cancelling pending tasks *) +let stop timer = + with_lock_ timer + (fun timer -> + if not timer.stop then ( + timer.stop <- true; + (* empty heap of tasks *) + timer.tasks <- TaskHeap.empty; + (* tell the thread to stop *) + awaken_ timer; + ) + ) + +(*$R + (* scenario: n := 1; n := n*4 ; n := n+2; res := n *) + let timer = create () in + let n = CCLock.create 1 in + let res = CCLock.create 0 in + after timer 0.6 + ~f:(fun () -> CCLock.update n (fun x -> x+2)); + ignore (Thread.create + (fun _ -> Thread.delay 0.8; CCLock.set res (CCLock.get n)) ()); + after timer 0.4 + ~f:(fun () -> CCLock.update n (fun x -> x * 4)); + Thread.delay 1. ; + OUnit.assert_equal 6 (CCLock.get res); +*) diff --git a/src/threads/CCTimer.mli b/src/threads/CCTimer.mli new file mode 100644 index 00000000..09591c12 --- /dev/null +++ b/src/threads/CCTimer.mli @@ -0,0 +1,43 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Event timer} + + Used to be part of [CCFuture] + @since NEXT_RELEASE *) + +type t +(** A scheduler for events. It runs in its own thread. *) + +val create : unit -> t +(** A new timer. *) + +val set_exn_handler : t -> (exn -> unit) -> unit +(** [set_exn_handler timer f] registers [f] so that any exception + raised by a task scheduled in [timer] is given to [f] *) + +exception Stopped + +val after : t -> float -> f:(unit -> _) -> unit +(** Call the callback [f] after the given number of seconds. + @raise Stopped if the timer was stopped *) + +val at : t -> float -> f:(unit -> _) -> unit +(** Create a future that evaluates to [()] at the given Unix timestamp + @raise Stopped if the timer was stopped *) + +exception ExitEvery + +val every : ?delay:float -> t -> float -> f:(unit -> _) -> unit +(** [every timer n ~f] calls [f ()] every [n] seconds. + [f()] can raise ExitEvery to stop the cycle. + @param delay if provided, the first call to [f ()] is delayed by + that many seconds. + @raise Stopped if the timer was stopped *) + +val stop : t -> unit +(** Stop the given timer, cancelling pending tasks. Idempotent. + From now on, calling most other operations on the timer will raise Stopped. *) + +val active : t -> bool +(** Returns [true] until [stop t] has been called. *) From ec70f865e4acfdf347bcc6a6ecca27dd5f43f72a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 26 Jan 2016 01:02:29 +0100 Subject: [PATCH 22/63] rename `CCFuture` into `CCPool`, expose the thread pool --- _oasis | 3 +- doc/intro.txt | 3 +- src/threads/CCFuture.ml | 622 --------------------------------------- src/threads/CCFuture.mli | 149 ---------- src/threads/CCPool.ml | 496 +++++++++++++++++++++++++++++++ src/threads/CCPool.mli | 150 ++++++++++ 6 files changed, 650 insertions(+), 773 deletions(-) delete mode 100644 src/threads/CCFuture.ml delete mode 100644 src/threads/CCFuture.mli create mode 100644 src/threads/CCPool.ml create mode 100644 src/threads/CCPool.mli diff --git a/_oasis b/_oasis index 29a479c7..dbc3fdea 100644 --- a/_oasis +++ b/_oasis @@ -114,7 +114,8 @@ Library "containers_bigarray" Library "containers_thread" Path: src/threads/ - Modules: CCFuture, CCLock, CCSemaphore, CCThread, CCBlockingQueue + Modules: CCPool, CCLock, CCSemaphore, CCThread, CCBlockingQueue, + CCTimer FindlibName: thread FindlibParent: containers Build$: flag(thread) diff --git a/doc/intro.txt b/doc/intro.txt index 5fbc2bf0..2344eccb 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -149,10 +149,11 @@ Moved to its own repository {!modules: CCBlockingQueue -CCFuture CCLock +CCPool CCSemaphore CCThread +CCTimer } diff --git a/src/threads/CCFuture.ml b/src/threads/CCFuture.ml deleted file mode 100644 index 9d5d0424..00000000 --- a/src/threads/CCFuture.ml +++ /dev/null @@ -1,622 +0,0 @@ -(* -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. -*) - -(** {1 Futures for concurrency} *) - -type 'a state = - | Done of 'a - | Waiting - | Failed of exn - -(** {2 Thread pool} *) -module Pool = struct - type job = - | Job1 : ('a -> unit) * 'a -> job - | Job2 : ('a -> 'b -> unit) * 'a * 'b -> job - | Job3 : ('a -> 'b -> 'c -> unit) * 'a * 'b * 'c -> job - | Job4 : ('a -> 'b -> 'c -> 'd -> unit) * 'a * 'b * 'c * 'd -> job - - type t = { - mutable stop : bool; (* indicate that threads should stop *) - mutex : Mutex.t; - jobs : job Queue.t; (* waiting jobs *) - mutable cur_size : int; (* total number of threads *) - max_size : int; - } (** Dynamic, growable thread pool *) - - let with_lock_ t f = - Mutex.lock t.mutex; - try - let x = f t in - Mutex.unlock t.mutex; - x - with e -> - Mutex.unlock t.mutex; - raise e - - type command = - | Process of job - | Die (* thread has no work to do *) - - let die pool = - assert (pool.cur_size > 0); - pool.cur_size <- pool.cur_size - 1; - Die - - (** Thread: entry point. They seek jobs in the queue *) - let rec serve pool = match with_lock_ pool get_next with - | Die -> () - | Process (Job1 (f, x)) -> ignore (f x); serve pool - | Process (Job2 (f, x, y)) -> ignore (f x y); serve pool - | Process (Job3 (f, x, y, z)) -> ignore (f x y z); serve pool - | Process (Job4 (f, x, y, z, w)) -> ignore (f x y z w); serve pool - - (* thread: seek what to do next (including dying) *) - and get_next pool = - if pool.stop then die pool - else if Queue.is_empty pool.jobs then die pool - else ( - let job = Queue.pop pool.jobs in - Process job - ) - - (** Create a pool with at most the given number of threads. [timeout] - is the time after which idle threads are killed. *) - let create ~max_size () = - let pool = { - stop = false; - cur_size = 0; - max_size; - jobs = Queue.create (); - mutex = Mutex.create (); - } in - pool - - exception PoolStopped - - let run_job pool job = - (* heuristic criterion for starting a new thread. We try to assess - whether there are many busy threads and many waiting tasks. - If there are many threads, it's less likely to start a new one *) - let should_start_thread p = - let num_q = Queue.length p.jobs in - let num_busy = p.cur_size in - let reached_max = p.cur_size = p.max_size in - num_q > 0 && not reached_max && (num_q > 2 * num_busy) - in - (* acquire lock and push job in queue *) - with_lock_ pool - (fun pool -> - if pool.stop then raise PoolStopped; - Queue.push job pool.jobs; - (* maybe start a thread *) - if should_start_thread pool then ( - pool.cur_size <- pool.cur_size + 1; - ignore (Thread.create serve pool) - )) - - (* run the function on the argument in the given pool *) - let run1 pool f x = run_job pool (Job1 (f, x)) - - let run2 pool f x y = run_job pool (Job2 (f, x, y)) - - let run3 pool f x y z = run_job pool (Job3 (f, x, y, z)) - - let run4 pool f x y z w = run_job pool (Job4 (f, x, y, z, w)) - - (* kill threads in the pool *) - let stop pool = - with_lock_ pool - (fun p -> - p.stop <- true; - Queue.clear p.jobs) -end - -(*$inject - open Infix -*) - -let pool = Pool.create ~max_size:50 () -(** Default pool of threads, should be ok for most uses. *) - -(** {2 Futures} *) - -type 'a handler = 'a state -> unit - -(** A proper future, with a delayed computation *) -type 'a cell = { - mutable state : 'a state; - mutable handlers : 'a handler list; (* handlers *) - mutex : Mutex.t; - condition : Condition.t; -} - -(** A future value of type 'a *) -type 'a t = - | Return of 'a - | FailNow of exn - | Run of 'a cell - -type 'a future = 'a t - -(** {2 Basic Future functions} *) - -let return x = Return x - -let fail e = FailNow e - -let create_cell () = { - state = Waiting; - handlers = []; - mutex = Mutex.create (); - condition = Condition.create (); -} - -let with_lock_ cell f = - Mutex.lock cell.mutex; - try - let x = f cell in - Mutex.unlock cell.mutex; - x - with e -> - Mutex.unlock cell.mutex; - raise e - -let set_done_ cell x = - with_lock_ cell - (fun cell -> match cell.state with - | Waiting -> (* set state and signal *) - cell.state <- Done x; - Condition.broadcast cell.condition; - List.iter (fun f -> f cell.state) cell.handlers - | _ -> assert false) - -let set_fail_ cell e = - with_lock_ cell - (fun cell -> match cell.state with - | Waiting -> - cell.state <- Failed e; - Condition.broadcast cell.condition; - List.iter (fun f -> f cell.state) cell.handlers - | _ -> assert false) - -let run_and_set1 cell f x = - try - let y = f x in - set_done_ cell y - with e -> - set_fail_ cell e - -let run_and_set2 cell f x y = - try - let z = f x y in - set_done_ cell z - with e -> - set_fail_ cell e - -let make1 f x = - let cell = create_cell() in - Pool.run3 pool run_and_set1 cell f x; - Run cell - -let make f = make1 f () - -(*$R - List.iter - (fun n -> - let l = Sequence.(1 -- n) |> Sequence.to_list in - let l = List.map (fun i -> - make - (fun () -> - Thread.delay 0.1; - 1 - )) l in - let l' = List.map get l in - OUnit.assert_equal n (List.fold_left (+) 0 l'); - ) - [ 10; 300 ] -*) - -let make2 f x y = - let cell = create_cell() in - Pool.run4 pool run_and_set2 cell f x y; - Run cell - -let get = function - | Return x -> x - | FailNow e -> raise e - | Run cell -> - let rec get_cell cell = match cell.state with - | Waiting -> - Condition.wait cell.condition cell.mutex; (* wait *) - get_cell cell - | Done x -> Mutex.unlock cell.mutex; x - | Failed e -> Mutex.unlock cell.mutex; raise e - in - Mutex.lock cell.mutex; - get_cell cell - -let state = function - | Return x -> Done x - | FailNow e -> Failed e - | Run cell -> - with_lock_ cell (fun cell -> cell.state) - -let is_done = function - | Return _ - | FailNow _ -> true - | Run cell -> - with_lock_ cell (fun c -> c.state <> Waiting) - -(** {2 Combinators *) - -let add_handler_ cell f = - with_lock_ cell - (fun cell -> match cell.state with - | Waiting -> cell.handlers <- f :: cell.handlers - | Done _ | Failed _ -> f cell.state - ) - -let on_finish fut k = match fut with - | Return x -> k (Done x) - | FailNow e -> k (Failed e) - | Run cell -> add_handler_ cell k - -let on_success fut k = - on_finish fut - (function - | Done x -> k x - | _ -> () - ) - -let on_failure fut k = - on_finish fut - (function - | Failed e -> k e - | _ -> () - ) - -let map f fut = match fut with - | Return x -> make1 f x - | FailNow e -> FailNow e - | Run cell -> - let cell' = create_cell() in - add_handler_ cell - (function - | Done x -> run_and_set1 cell' f x - | Failed e -> set_fail_ cell' e - | Waiting -> assert false - ); - Run cell' - -(*$R - let a = make (fun () -> 1) in - let b = map (fun x -> x+1) a in - let c = map (fun x -> x-1) b in - OUnit.assert_equal 1 (get c) -*) - -let flat_map f fut = match fut with - | Return x -> f x - | FailNow e -> FailNow e - | Run cell -> - let cell' = create_cell() in - add_handler_ cell - (function - | Done x -> - let fut' = f x in - on_finish fut' - (function - | Done y -> set_done_ cell' y - | Failed e -> set_fail_ cell' e - | Waiting -> assert false - ) - | Failed e -> set_fail_ cell' e - | Waiting -> assert false - ); - Run cell' - -let and_then fut f = flat_map (fun _ -> f ()) fut - -let sequence futures = - let n = List.length futures in - let state = CCLock.create (`WaitFor n) in - let results = Array.make n None in - let cell = create_cell() in - (* when all futures returned, collect results for future' *) - let send_result () = - let l = Array.map - (function - | None -> assert false - | Some x -> x - ) results - in - set_done_ cell (Array.to_list l) - in - (* wait for all to succeed or fail *) - List.iteri - (fun i fut -> - on_finish fut - (fun res -> - CCLock.update state - (fun st -> match res, st with - | Done _, `Failed -> st - | Done x, `WaitFor 1 -> results.(i) <- Some x; send_result (); `Done - | Done x, `WaitFor n -> results.(i) <- Some x; `WaitFor (n-1) - | Failed _, `Failed -> st - | Failed e, `WaitFor _ -> set_fail_ cell e; `Failed - | _, `Done -> assert false - | Waiting, _ -> assert false - ) - ) - ) futures; - Run cell - -(*$R - let l = CCList.(1 -- 10) in - let l' = l - |> List.map - (fun x -> make (fun () -> Thread.delay 0.2; x*10)) - |> sequence - |> map (List.fold_left (+) 0) - in - let expected = List.fold_left (fun acc x -> acc + 10 * x) 0 l in - OUnit.assert_equal expected (get l') -*) - -(*$R - let l = CCList.(1 -- 10) in - let l' = l - |> List.map - (fun x -> make (fun () -> Thread.delay 0.2; if x = 5 then raise Exit; x)) - |> sequence - |> map (List.fold_left (+) 0) - in - OUnit.assert_raises Exit (fun () -> get l') -*) - -let choose futures = - let cell = create_cell() in - let state = ref `Waiting in - (* add handlers to all futures *) - List.iter - (fun fut -> - on_finish fut - (fun res -> match res, !state with - | Done x, `Waiting -> state := `Done; set_done_ cell x - | Failed e, `Waiting -> state := `Done; set_fail_ cell e - | Waiting, _ -> assert false - | _, `Done -> () - ) - ) futures; - Run cell - -(** slurp the entire state of the file_descr into a string *) -let slurp ic = CCIO.read_all_bytes ic - -let read_chan ic = make1 slurp ic - -type subprocess_res = < - errcode : int; - stdout : Bytes.t; - stderr : Bytes.t; -> - -(** Spawn a sub-process with the given command [cmd] (and possibly input); - returns a future containing (returncode, stdout, stderr) *) -let spawn_process ?(stdin="") cmd : subprocess_res t = - make - (fun () -> - (* spawn subprocess *) - let out, inp, err = Unix.open_process_full cmd (Unix.environment ()) in - output_string inp stdin; - (* send stdin to command *) - flush inp; - close_out inp; - (* read output of process *) - let out' = slurp out in - let err' = slurp err in - (* wait for termination *) - let status = Unix.close_process_full (out,inp,err) in - (* get return code *) - let returncode = match status with - | Unix.WEXITED i -> i - | Unix.WSIGNALED i -> i - | Unix.WSTOPPED i -> i in - object - method errcode = returncode - method stdout = out' - method stderr = err' - end - ) - -let sleep time = make (fun () -> Thread.delay time) - -(*$R - let start = Unix.gettimeofday () in - let pause = 0.2 and n = 10 in - let l = CCList.(1 -- n) - |> List.map (fun _ -> make (fun () -> Thread.delay pause)) - in - List.iter get l; - let stop = Unix.gettimeofday () in - OUnit.assert_bool "some_parallelism" (stop -. start < float_of_int n *. pause); -*) - -(** {2 Event timer} *) - -module Timer = struct - module TaskHeap = CCHeap.Make(struct - type t = (float * unit cell) - let leq (f1,_)(f2,_) = f1 <= f2 - end) - - type t = { - mutable stop : bool; - mutable thread : Thread.t option; (* thread dedicated to the timer *) - mutable tasks : TaskHeap.t; - t_mutex : Mutex.t; - fifo_in : Unix.file_descr; - fifo_out : Unix.file_descr; - } (** A timer for events *) - - let standby_wait = 10. (* when no task is scheduled *) - let epsilon = 0.0001 (* accepted time diff for actions *) - - let with_lock_ t f = - Mutex.lock t.t_mutex; - try - let x = f t in - Mutex.unlock t.t_mutex; - x - with e -> - Mutex.unlock t.t_mutex; - raise e - - type command = - | Loop - | Wait of float - - let pop_task_ t = - let tasks, _ = TaskHeap.take_exn t.tasks in - t.tasks <- tasks - - (** Wait for next event, run it, and loop *) - let serve timer = - let buf = Bytes.make 1 '_' in - (* acquire lock, call [process_task] and do as it commands *) - let rec next () = match with_lock_ timer process_task with - | Loop -> next () - | Wait delay -> wait delay - (* check next task *) - and process_task timer = match TaskHeap.find_min timer.tasks with - | None -> Wait standby_wait - | Some (time, cell) -> - let now = Unix.gettimeofday () in - if now +. epsilon > time then ( - (* now! *) - pop_task_ timer; - set_done_ cell (); - Loop - ) else Wait (time -. now) - (* wait for [delay] seconds, or until something happens on fifo_in *) - and wait delay = - let read = Thread.wait_timed_read timer.fifo_in delay in - if read - then ignore (Unix.read timer.fifo_in buf 0 1); (* remove char *) - next () - in - next () - - (** A timer that runs in the given thread pool *) - let create () = - let fifo_in, fifo_out = Unix.pipe () in - let timer = { - stop = false; - thread = None; - tasks = TaskHeap.empty; - t_mutex = Mutex.create (); - fifo_in; - fifo_out; - } in - (* start a thread to process tasks *) - let t = Thread.create serve timer in - timer.thread <- Some t; - timer - - let underscore_ = Bytes.make 1 '_' - - (** [timerule_at s t act] will run [act] at the Unix echo [t] *) - let at timer time = - let now = Unix.gettimeofday () in - if now >= time - then return () - else ( - let cell = create_cell() in - with_lock_ timer - (fun timer -> - (* time of the next scheduled event *) - let next_time = match TaskHeap.find_min timer.tasks with - | None -> max_float - | Some (f, _) -> f - in - (* insert task *) - timer.tasks <- TaskHeap.insert (time, cell) timer.tasks; - (* see if the timer thread needs to be awaken earlier *) - if time < next_time - then ignore (Unix.single_write timer.fifo_out underscore_ 0 1) - ); - Run cell - ) - - let after timer delay = - assert (delay >= 0.); - let now = Unix.gettimeofday () in - at timer (now +. delay) - - (** Stop the given timer, cancelling pending tasks *) - let stop timer = - with_lock_ timer - (fun timer -> - if not timer.stop then ( - timer.stop <- true; - (* empty heap of tasks *) - timer.tasks <- TaskHeap.empty; - (* kill the thread *) - match timer.thread with - | None -> () - | Some t -> - Thread.kill t; - timer.thread <- None - ) - ) -end - -(*$R - let timer = Timer.create () in - let n = CCLock.create 1 in - let getter = make (fun () -> Thread.delay 0.8; CCLock.get n) in - let _ = - Timer.after timer 0.6 - >>= fun () -> CCLock.update n (fun x -> x+2); return() - in - let _ = - Timer.after timer 0.4 - >>= fun () -> CCLock.update n (fun x -> x * 4); return() - in - OUnit.assert_equal 6 (get getter); -*) - -module Infix = struct - let (>>=) x f = flat_map f x - let (>>) a f = and_then a f - let (>|=) a f = map f a -end - -include Infix - -(** {2 Low Level } *) - -let stop_pool () = Pool.stop pool diff --git a/src/threads/CCFuture.mli b/src/threads/CCFuture.mli deleted file mode 100644 index 0d2a1fb2..00000000 --- a/src/threads/CCFuture.mli +++ /dev/null @@ -1,149 +0,0 @@ -(* -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. -*) - -(** {1 Futures for concurrency} *) - -type 'a state = - | Done of 'a - | Waiting - | Failed of exn - -type 'a t -(** A future value of type 'a *) - -type 'a future = 'a t - -(** {2 Constructors} *) - -val return : 'a -> 'a t -(** Future that is already computed *) - -val fail : exn -> 'a t -(** Future that fails immediately *) - -val make : (unit -> 'a) -> 'a t -(** Create a future, representing a value that will be computed by - the function. If the function raises, the future will fail. *) - -val make1 : ('a -> 'b) -> 'a -> 'b t -val make2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c t - -(** {2 Basics} *) - -val get : 'a t -> 'a -(** Blocking get: wait for the future to be evaluated, and get the value, - or the exception that failed the future is returned. - raise e if the future failed with e *) - -val state : 'a t -> 'a state -(** State of the future *) - -val is_done : 'a t -> bool -(** Is the future evaluated (success/failure)? *) - -(** {2 Combinators} *) - -val on_success : 'a t -> ('a -> unit) -> unit -(** Attach a handler to be called upon success *) - -val on_failure : _ t -> (exn -> unit) -> unit -(** Attach a handler to be called upon failure *) - -val on_finish : 'a t -> ('a state -> unit) -> unit -(** Attach a handler to be called when the future is evaluated *) - -val flat_map : ('a -> 'b t) -> 'a t -> 'b t -(** Monadic combination of futures *) - -val and_then : 'a t -> (unit -> 'b t) -> 'b t -(** Wait for the first future to succeed, then launch the second *) - -val sequence : 'a t list -> 'a list t -(** Future that waits for all previous sequences to terminate. If any future - in the list fails, [sequence l] fails too. *) - -val choose : 'a t list -> 'a t -(** Choose among those futures (the first to terminate). Behaves like - the first future that terminates, by failing if the future fails *) - -val map : ('a -> 'b) -> 'a t -> 'b t -(** Maps the value inside the future. The function doesn't run in its - own task; if it can take time, use {!flat_map} *) - -(** {2 Helpers} *) - -val read_chan : in_channel -> Bytes.t t -(** Read the whole channel *) - -type subprocess_res = < - errcode : int; - stdout : Bytes.t; - stderr : Bytes.t; -> - -val spawn_process : ?stdin:string -> string -> subprocess_res t -(** Spawn a sub-process with the given command (and possibly input); - returns a future containing [(returncode, stdout, stderr)] *) - -val sleep : float -> unit t -(** Future that returns with success in the given amount of seconds. Blocks - the thread! If you need to wait on many events, consider - using {!Timer} *) - -(** {2 Event timer} *) - -module Timer : sig - type t - (** A scheduler for events. It runs in its own thread. *) - - val create : unit -> t - (** A new timer. *) - - val after : t -> float -> unit future - (** Create a future that waits for the given number of seconds, then - awakens with [()] *) - - val at : t -> float -> unit future - (** Create a future that evaluates to [()] at the given Unix timestamp *) - - val stop : t -> unit - (** Stop the given timer, cancelling pending tasks *) -end - -module Infix : sig - val (>>=) : 'a t -> ('a -> 'b t) -> 'b t - val (>>) : 'a t -> (unit -> 'b t) -> 'b t - val (>|=) : 'a t -> ('a -> 'b) -> 'b t -end - -val (>>=) : 'a t -> ('a -> 'b t) -> 'b t -val (>>) : 'a t -> (unit -> 'b t) -> 'b t -val (>|=) : 'a t -> ('a -> 'b) -> 'b t - -(** {2 Low level} *) - -val stop_pool : unit -> unit -(** Stop the thread pool *) - diff --git a/src/threads/CCPool.ml b/src/threads/CCPool.ml new file mode 100644 index 00000000..f33ca001 --- /dev/null +++ b/src/threads/CCPool.ml @@ -0,0 +1,496 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Thread Pool, and Futures} *) + +type +'a state = + | Done of 'a + | Waiting + | Failed of exn + +module type PARAM = sig + val max_size : int + (** Maximum number of threads in the pool *) +end + +exception Stopped + +(*$inject + module P = Make(struct let max_size = 30 end) + module Fut = P.Fut + open Fut.Infix +*) + +(** {2 Thread pool} *) +module Make(P : PARAM) = struct + type job = + | Job1 : ('a -> _) * 'a -> job + | Job2 : ('a -> 'b -> _) * 'a * 'b -> job + | Job3 : ('a -> 'b -> 'c -> _) * 'a * 'b * 'c -> job + | Job4 : ('a -> 'b -> 'c -> 'd -> _) * 'a * 'b * 'c * 'd -> job + + type t = { + mutable stop : bool; (* indicate that threads should stop *) + mutable exn_handler: (exn -> unit); + mutex : Mutex.t; + jobs : job Queue.t; (* waiting jobs *) + mutable cur_size : int; (* total number of threads *) + } (** Dynamic, growable thread pool *) + + let nop_ _ = () + + (* singleton pool *) + let pool = { + stop = false; + exn_handler = nop_; + cur_size = 0; + jobs = Queue.create (); + mutex = Mutex.create (); + } + + let set_exn_handler f = pool.exn_handler <- f + + let with_lock_ t f = + Mutex.lock t.mutex; + try + let x = f t in + Mutex.unlock t.mutex; + x + with e -> + Mutex.unlock t.mutex; + raise e + + (* next thing a thread should do *) + type command = + | Process of job + | Die (* thread has no work to do *) + + (* thread: seek what to do next (including dying). + Assumes the pool is locked. *) + let get_next_ pool = + if pool.stop || Queue.is_empty pool.jobs then ( + (* die: the thread would be idle otherwise *) + assert (pool.cur_size > 0); + pool.cur_size <- pool.cur_size - 1; + Die + ) else ( + let job = Queue.pop pool.jobs in + Process job + ) + + (* Thread: entry point. They seek jobs in the queue *) + let rec serve pool = + let cmd = with_lock_ pool get_next_ in + run_cmd cmd + + (* run a command *) + and run_cmd = function + | Die -> () + | Process (Job1 (f, x)) -> + begin try ignore (f x) with e -> pool.exn_handler e end; serve pool + | Process (Job2 (f, x, y)) -> + begin try ignore (f x y) with e -> pool.exn_handler e end; serve pool + | Process (Job3 (f, x, y, z)) -> + begin try ignore (f x y z) with e -> pool.exn_handler e end; serve pool + | Process (Job4 (f, x, y, z, w)) -> + begin try ignore (f x y z w) with e -> pool.exn_handler e end; serve pool + + (* heuristic criterion for starting a new thread. *) + let should_start_thread p = p.cur_size < P.max_size + + let incr_size_ p = p.cur_size <- p.cur_size +1 + + let run_job job = + (* acquire lock and push job in queue, or start thread directly + if the queue is empty *) + with_lock_ pool + (fun pool -> + if pool.stop then raise Stopped; + if Queue.is_empty pool.jobs && should_start_thread pool + then ( + pool.cur_size <- pool.cur_size + 1; + (* create the thread now, on [job], as it will not + break order *) + ignore (Thread.create run_cmd (Process job)) + ) else ( + assert (pool.cur_size > 0); + Queue.push job pool.jobs; + (* might want to process in the background *) + if should_start_thread pool then ( + incr_size_ pool; + ignore (Thread.create serve pool); + ) + )) + + (* run the function on the argument in the given pool *) + let run1 f x = run_job (Job1 (f, x)) + + let run f = run1 f () + + let run2 f x y = run_job (Job2 (f, x, y)) + + let run3 f x y z = run_job (Job3 (f, x, y, z)) + + let run4 f x y z w = run_job (Job4 (f, x, y, z, w)) + + let active () = not pool.stop + + (* kill threads in the pool *) + let stop () = + with_lock_ pool + (fun p -> + p.stop <- true; + Queue.clear p.jobs) + + (** {6 Futures} *) + module Fut = struct + type 'a handler = 'a state -> unit + + (** A proper future, with a delayed computation *) + type 'a cell = { + mutable state : 'a state; + mutable handlers : 'a handler list; (* handlers *) + f_mutex : Mutex.t; + condition : Condition.t; + } + + (** A future value of type 'a *) + type 'a t = + | Return of 'a + | FailNow of exn + | Run of 'a cell + + type 'a future = 'a t + + (** {2 Basic Future functions} *) + + let return x = Return x + + let fail e = FailNow e + + let create_cell () = { + state = Waiting; + handlers = []; + f_mutex = Mutex.create (); + condition = Condition.create (); + } + + let with_lock_ cell f = + Mutex.lock cell.f_mutex; + try + let x = f cell in + Mutex.unlock cell.f_mutex; + x + with e -> + Mutex.unlock cell.f_mutex; + raise e + + (* TODO: exception handler for handler errors *) + + let set_done_ cell x = + with_lock_ cell + (fun cell -> match cell.state with + | Waiting -> (* set state and signal *) + cell.state <- Done x; + Condition.broadcast cell.condition; + List.iter + (fun f -> try f cell.state with e -> pool.exn_handler e) + cell.handlers + | _ -> assert false) + + let set_fail_ cell e = + with_lock_ cell + (fun cell -> match cell.state with + | Waiting -> + cell.state <- Failed e; + Condition.broadcast cell.condition; + List.iter + (fun f -> try f cell.state with e -> pool.exn_handler e) + cell.handlers + | _ -> assert false) + + (* calls [f x], and put result or exception in [cell] *) + let run_and_set1 cell f x = + try + let y = f x in + set_done_ cell y + with e -> + set_fail_ cell e + + let run_and_set2 cell f x y = + try + let z = f x y in + set_done_ cell z + with e -> + set_fail_ cell e + + let make1 f x = + let cell = create_cell() in + run3 run_and_set1 cell f x; + Run cell + + let make f = make1 f () + + (*$R + List.iter + (fun n -> + let l = Sequence.(1 -- n) |> Sequence.to_list in + let l = List.rev_map (fun i -> + Fut.make + (fun () -> + Thread.delay 0.1; + 1 + )) l in + let l' = List.map Fut.get l in + OUnit.assert_equal n (List.fold_left (+) 0 l'); + ) + [ 10; 300; ] + *) + + let make2 f x y = + let cell = create_cell() in + run4 run_and_set2 cell f x y; + Run cell + + let get = function + | Return x -> x + | FailNow e -> raise e + | Run cell -> + let rec get_ cell = match cell.state with + | Waiting -> + Condition.wait cell.condition cell.f_mutex; (* wait *) + get_ cell + | Done x -> x + | Failed e -> raise e + in + with_lock_ cell get_ + + (* access the result without locking *) + let get_nolock_ = function + | Return x + | Run {state=Done x; _} -> x + | FailNow _ + | Run {state=(Failed _ | Waiting); _} -> assert false + + let state = function + | Return x -> Done x + | FailNow e -> Failed e + | Run cell -> + with_lock_ cell (fun cell -> cell.state) + + let is_done = function + | Return _ + | FailNow _ -> true + | Run cell -> + with_lock_ cell (fun c -> c.state <> Waiting) + + (** {2 Combinators *) + + let add_handler_ cell f = + with_lock_ cell + (fun cell -> match cell.state with + | Waiting -> cell.handlers <- f :: cell.handlers + | Done _ | Failed _ -> f cell.state) + + let on_finish fut k = match fut with + | Return x -> k (Done x) + | FailNow e -> k (Failed e) + | Run cell -> add_handler_ cell k + + let on_success fut k = + on_finish fut + (function + | Done x -> k x + | _ -> ()) + + let on_failure fut k = + on_finish fut + (function + | Failed e -> k e + | _ -> ()) + + let map f fut = match fut with + | Return x -> Return (f x) + | FailNow e -> FailNow e + | Run cell -> + let cell' = create_cell() in + add_handler_ cell + (function + | Done x -> run_and_set1 cell' f x + | Failed e -> set_fail_ cell' e + | Waiting -> assert false); + Run cell' + + (*$R + let a = Fut.make (fun () -> 1) in + let b = Fut.map (fun x -> x+1) a in + let c = Fut.map (fun x -> x-1) b in + OUnit.assert_equal 1 (Fut.get c) + *) + + (* same as {!map}, but schedules the computation of [f] in the pool *) + let map_async f fut = match fut with + | Return x -> make1 f x + | FailNow e -> FailNow e + | Run cell -> + let cell' = create_cell() in + add_handler_ cell + (function + | Done x -> run3 run_and_set1 cell' f x + | Failed e -> set_fail_ cell' e + | Waiting -> assert false); + Run cell' + + let flat_map f fut = match fut with + | Return x -> f x + | FailNow e -> FailNow e + | Run cell -> + let cell' = create_cell() in + add_handler_ cell + (function + | Done x -> + let fut' = f x in + on_finish fut' + (function + | Done y -> set_done_ cell' y + | Failed e -> set_fail_ cell' e + | Waiting -> assert false + ) + | Failed e -> set_fail_ cell' e + | Waiting -> assert false + ); + Run cell' + + let and_then fut f = flat_map (fun _ -> f ()) fut + + type _ array_or_list = + | A_ : 'a array -> 'a array_or_list + | L_ : 'a list -> 'a array_or_list + + let iter_aol + : type a. a array_or_list -> (a -> unit) -> unit + = fun aol f -> match aol with + | A_ a -> Array.iter f a + | L_ l -> List.iter f l + + (* [sequence_ l f] returns a future that waits for every element of [l] + to return of fail, and call [f ()] to obtain the result (as a closure) + in case every element succeeded (otherwise a failure is + returned automatically) *) + let sequence_ + : type a res. a t array_or_list -> (unit -> res) -> res t + = fun aol f -> + let n = match aol with + | A_ a -> Array.length a + | L_ l -> List.length l + in + assert (n>0); + let cell = create_cell() in + let n_err = CCLock.create 0 in (* number of failed threads *) + let n_ok = CCLock.create 0 in (* number of succeeding threads *) + iter_aol aol + (fun fut -> + on_finish fut + (function + | Failed e -> + let x = CCLock.incr_then_get n_err in + (* if first failure, then seal [cell]'s fate now *) + if x=1 then set_fail_ cell e + | Done _ -> + let x = CCLock.incr_then_get n_ok in + (* if [n] successes, then [cell] succeeds. Otherwise, some + job has not finished or some job has failed. *) + if x = n then ( + let res = f () in + set_done_ cell res + ) + | Waiting -> assert false)); + Run cell + + (* map an array of futures to a future array *) + let sequence_a a = match a with + | [||] -> return [||] + | _ -> + sequence_ (A_ a) + (fun () -> Array.map get_nolock_ a) + + let map_a f a = sequence_a (Array.map f a) + + let sequence_l l = match l with + | [] -> return [] + | _ :: _ -> + sequence_ (L_ l) (fun () -> List.map get_nolock_ l) + + (* reverse twice *) + let map_l f l = + let l = List.rev_map f l in + sequence_ (L_ l) + (fun () -> List.rev_map get_nolock_ l) + + (*$R + let l = CCList.(1 -- 50) in + let l' = l + |> List.map + (fun x -> Fut.make (fun () -> Thread.delay 0.1; x*10)) + |> Fut.sequence_l + |> Fut.map (List.fold_left (+) 0) + in + let expected = List.fold_left (fun acc x -> acc + 10 * x) 0 l in + OUnit.assert_equal expected (Fut.get l') + *) + + (*$R + let l = CCList.(1 -- 50) in + let l' = l + |> List.map + (fun x -> Fut.make (fun () -> Thread.delay 0.1; if x = 5 then raise Exit; x)) + |> Fut.sequence_l + |> Fut.map (List.fold_left (+) 0) + in + OUnit.assert_raises Exit (fun () -> Fut.get l') + *) + + let choose_ + : type a. a t array_or_list -> a t + = fun aol -> + let cell = create_cell() in + let is_done = CCLock.create false in + iter_aol aol + (fun fut -> + on_finish fut + (fun res -> match res with + | Waiting -> assert false + | Done x -> + let was_done = CCLock.get_then_clear is_done in + if not was_done then set_done_ cell x + | Failed e -> + let was_done = CCLock.get_then_clear is_done in + if not was_done then set_fail_ cell e)); + Run cell + + let choose_a a = choose_ (A_ a) + + let choose_l l = choose_ (L_ l) + + let sleep time = make1 Thread.delay time + + (*$R + let start = Unix.gettimeofday () in + let pause = 0.2 and n = 10 in + let l = CCList.(1 -- n) + |> List.map (fun _ -> Fut.make (fun () -> Thread.delay pause)) + in + List.iter Fut.get l; + let stop = Unix.gettimeofday () in + OUnit.assert_bool "some_parallelism" (stop -. start < float_of_int n *. pause); + *) + + module Infix = struct + let (>>=) x f = flat_map f x + let (>>) a f = and_then a f + let (>|=) a f = map f a + end + + include Infix + end +end diff --git a/src/threads/CCPool.mli b/src/threads/CCPool.mli new file mode 100644 index 00000000..94657788 --- /dev/null +++ b/src/threads/CCPool.mli @@ -0,0 +1,150 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Thread Pool, and Futures} + + Renamed and heavily updated from [CCFuture] + @since NEXT_RELEASE *) + +type +'a state = + | Done of 'a + | Waiting + | Failed of exn + +module type PARAM = sig + val max_size : int + (** Maximum number of threads in the pool *) +end + +exception Stopped + +(** {2 Create a new Pool} *) +module Make(P : PARAM) : sig + val run : (unit -> _) -> unit + (** [run f] schedules [f] for being executed in the thread pool *) + + val run1 : ('a -> _) -> 'a -> unit + (** [run1 f x] is similar to [run (fun () -> f x)] *) + + val run2 : ('a -> 'b -> _) -> 'a -> 'b -> unit + + val run3 : ('a -> 'b -> 'c -> _) -> 'a -> 'b -> 'c -> unit + + val set_exn_handler : (exn -> unit) -> unit + + val active : unit -> bool + (** [active ()] is true as long as [stop()] has not been called yet *) + + val stop : unit -> unit + (** After calling [stop ()], Most functions will raise Stopped. + This has the effect of preventing new tasks from being executed. *) + + (** {6 Futures} + + The futures are registration points for callbacks, storing a {!state}, + that are executed in the pool using {!run}. *) + module Fut : sig + type 'a t + (** A future value of type 'a *) + + type 'a future = 'a t + + (** {2 Constructors} *) + + val return : 'a -> 'a t + (** Future that is already computed *) + + val fail : exn -> 'a t + (** Future that fails immediately *) + + val make : (unit -> 'a) -> 'a t + (** Create a future, representing a value that will be computed by + the function. If the function raises, the future will fail. *) + + val make1 : ('a -> 'b) -> 'a -> 'b t + + val make2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c t + + (** {2 Basics} *) + + val get : 'a t -> 'a + (** Blocking get: wait for the future to be evaluated, and get the value, + or the exception that failed the future is returned. + raise e if the future failed with e *) + + val state : 'a t -> 'a state + (** State of the future *) + + val is_done : 'a t -> bool + (** Is the future evaluated (success/failure)? *) + + (** {2 Combinators} *) + + val on_success : 'a t -> ('a -> unit) -> unit + (** Attach a handler to be called upon success. + The handler should not call functions on the future. + Might be evaluated now if the future is already done. *) + + val on_failure : _ t -> (exn -> unit) -> unit + (** Attach a handler to be called upon failure. + The handler should not call any function on the future. + Might be evaluated now if the future is already done. *) + + val on_finish : 'a t -> ('a state -> unit) -> unit + (** Attach a handler to be called when the future is evaluated. + The handler should not call functions on the future. + Might be evaluated now if the future is already done. *) + + val flat_map : ('a -> 'b t) -> 'a t -> 'b t + (** Monadic combination of futures *) + + val and_then : 'a t -> (unit -> 'b t) -> 'b t + (** Wait for the first future to succeed, then launch the second *) + + val sequence_a : 'a t array -> 'a array t + (** Future that waits for all previous futures to terminate. If any future + in the array fails, [sequence_a l] fails too. *) + + val map_a : ('a -> 'b t) -> 'a array -> 'b array t + (** [map_l f a] maps [f] on every element of [a], and will return + the array of every result if all calls succeed, or an error otherwise. *) + + val sequence_l : 'a t list -> 'a list t + (** Future that waits for all previous futures to terminate. If any future + in the list fails, [sequence_l l] fails too. *) + + val map_l : ('a -> 'b t) -> 'a list -> 'b list t + (** [map_l f l] maps [f] on every element of [l], and will return + the list of every result if all calls succeed, or an error otherwise. *) + + val choose_a : 'a t array -> 'a t + (** Choose among those futures (the first to terminate). Behaves like + the first future that terminates, by failing if the future fails *) + + val choose_l : 'a t list -> 'a t + (** Choose among those futures (the first to terminate). Behaves like + the first future that terminates, by failing if the future fails *) + + val map : ('a -> 'b) -> 'a t -> 'b t + (** Maps the value inside the future. The function doesn't run in its + own task; if it can take time, use {!flat_map} or {!map_async} *) + + val map_async : ('a -> 'b) -> 'a t -> 'b t + (** Maps the value inside the future, to be computed in a separated job. *) + + val sleep : float -> unit t + (** Future that returns with success in the given amount of seconds. Blocks + the thread! If you need to wait on many events, consider + using {!CCTimer}. *) + + module Infix : sig + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t + val (>>) : 'a t -> (unit -> 'b t) -> 'b t + val (>|=) : 'a t -> ('a -> 'b) -> 'b t + end + + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t + val (>>) : 'a t -> (unit -> 'b t) -> 'b t + val (>|=) : 'a t -> ('a -> 'b) -> 'b t + end +end From 067e89b1fe17926a3614fb5db55959157596caa7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 26 Jan 2016 01:03:08 +0100 Subject: [PATCH 23/63] add `CCLock.{decr_then_get, get_then_{decr,set,clear}}` atomic updates for integers and bools --- src/threads/CCLock.ml | 56 ++++++++++++++++++++++++------------------ src/threads/CCLock.mli | 46 +++++++++++++++------------------- 2 files changed, 52 insertions(+), 50 deletions(-) diff --git a/src/threads/CCLock.ml b/src/threads/CCLock.ml index 1088c605..cd9aa456 100644 --- a/src/threads/CCLock.ml +++ b/src/threads/CCLock.ml @@ -1,28 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Utils around Mutex} *) @@ -162,7 +139,38 @@ let get_then_incr l = Mutex.unlock l.mutex; x +let decr_then_get l = + Mutex.lock l.mutex; + l.content <- l.content - 1; + let x = l.content in + Mutex.unlock l.mutex; + x + +let get_then_decr l = + Mutex.lock l.mutex; + let x = l.content in + l.content <- l.content - 1; + Mutex.unlock l.mutex; + x + (*$T let l = create 0 in 1 = incr_then_get l && 1 = get l let l = create 0 in 0 = get_then_incr l && 1 = get l + let l = create 10 in 9 = decr_then_get l && 9 = get l + let l = create 10 in 10 = get_then_decr l && 9 = get l *) + +let get_then_set l = + Mutex.lock l.mutex; + let x = l.content in + l.content <- true; + Mutex.unlock l.mutex; + x + +let get_then_clear l = + Mutex.lock l.mutex; + let x = l.content in + l.content <- false; + Mutex.unlock l.mutex; + x + diff --git a/src/threads/CCLock.mli b/src/threads/CCLock.mli index e1982e8f..ce973086 100644 --- a/src/threads/CCLock.mli +++ b/src/threads/CCLock.mli @@ -1,32 +1,11 @@ -(* -copyright (c) 2013-2014, 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 Utils around Mutex} -@since 0.8 *) + A value wrapped into a Mutex, for more safety. + + @since 0.8 *) type 'a t (** A value surrounded with a lock *) @@ -88,6 +67,21 @@ val incr_then_get : int t -> int @since NEXT_RELEASE *) val get_then_incr : int t -> int -(** [incr_then_get x] increments [x], and return its previous value +(** [get_then_incr x] increments [x], and return its previous value @since NEXT_RELEASE *) +val decr_then_get : int t -> int +(** [decr_then_get x] decrements [x], and return its new value + @since NEXT_RELEASE *) + +val get_then_decr : int t -> int +(** [get_then_decr x] decrements [x], and return its previous value + @since NEXT_RELEASE *) + +val get_then_set : bool t -> bool +(** [get_then_set b] sets [b] to [true], and return the old value + @since NEXT_RELEASE *) + +val get_then_clear : bool t -> bool +(** [get_then_clear b] sets [b] to [false], and return the old value + @since NEXT_RELEASE *) From b0c59e036bc8ea5f27491dbe8bac07727307cf64 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 26 Jan 2016 01:33:24 +0100 Subject: [PATCH 24/63] add appliative instance in `CCPool`, factor code --- src/threads/CCPool.ml | 59 +++++++++++++++++++++++++++++------------- src/threads/CCPool.mli | 14 ++++++++++ 2 files changed, 55 insertions(+), 18 deletions(-) diff --git a/src/threads/CCPool.ml b/src/threads/CCPool.ml index f33ca001..f4aca08e 100644 --- a/src/threads/CCPool.ml +++ b/src/threads/CCPool.ml @@ -309,17 +309,28 @@ module Make(P : PARAM) = struct | Failed e -> k e | _ -> ()) - let map f fut = match fut with - | Return x -> Return (f x) + let map_cell_ ~async f cell ~into:cell' = + add_handler_ cell + (function + | Done x -> + if async + then run3 run_and_set1 cell' f x + else run_and_set1 cell' f x + | Failed e -> set_fail_ cell' e + | Waiting -> assert false); + Run cell' + + let map_ ~async f fut = match fut with + | Return x -> + if async + then make1 f x + else Return (f x) | FailNow e -> FailNow e - | Run cell -> - let cell' = create_cell() in - add_handler_ cell - (function - | Done x -> run_and_set1 cell' f x - | Failed e -> set_fail_ cell' e - | Waiting -> assert false); - Run cell' + | Run cell -> map_cell_ ~async f cell ~into:(create_cell()) + + let map f fut = map_ ~async:false f fut + + let map_async f fut = map_ ~async:true f fut (*$R let a = Fut.make (fun () -> 1) in @@ -328,19 +339,30 @@ module Make(P : PARAM) = struct OUnit.assert_equal 1 (Fut.get c) *) - (* same as {!map}, but schedules the computation of [f] in the pool *) - let map_async f fut = match fut with - | Return x -> make1 f x - | FailNow e -> FailNow e - | Run cell -> - let cell' = create_cell() in - add_handler_ cell + let app_ ~async f x = match f, x with + | Return f, Return x -> + if async + then make1 f x + else Return (f x) + | FailNow e, _ + | _, FailNow e -> FailNow e + | Return f, Run x -> + map_cell_ ~async (fun x -> f x) x ~into:(create_cell()) + | Run f, Return x -> + map_cell_ ~async (fun f -> f x) f ~into:(create_cell()) + | Run f, Run x -> + let cell' = create_cell () in + add_handler_ f (function - | Done x -> run3 run_and_set1 cell' f x + | Done f -> ignore (map_cell_ ~async f x ~into:cell') | Failed e -> set_fail_ cell' e | Waiting -> assert false); Run cell' + let app f x = app_ ~async:false f x + + let app_async f x = app_ ~async:true f x + let flat_map f fut = match fut with | Return x -> f x | FailNow e -> FailNow e @@ -489,6 +511,7 @@ module Make(P : PARAM) = struct let (>>=) x f = flat_map f x let (>>) a f = and_then a f let (>|=) a f = map f a + let (<*>) = app end include Infix diff --git a/src/threads/CCPool.mli b/src/threads/CCPool.mli index 94657788..7f4ff9a8 100644 --- a/src/threads/CCPool.mli +++ b/src/threads/CCPool.mli @@ -132,6 +132,13 @@ module Make(P : PARAM) : sig val map_async : ('a -> 'b) -> 'a t -> 'b t (** Maps the value inside the future, to be computed in a separated job. *) + val app : ('a -> 'b) t -> 'a t -> 'b t + (** [app f x] applies the result of [f] to the result of [x] *) + + val app_async : ('a -> 'b) t -> 'a t -> 'b t + (** [app f x] applies the result of [f] to the result of [x], in + a separated job scheduled in the pool *) + val sleep : float -> unit t (** Future that returns with success in the given amount of seconds. Blocks the thread! If you need to wait on many events, consider @@ -141,10 +148,17 @@ module Make(P : PARAM) : sig val (>>=) : 'a t -> ('a -> 'b t) -> 'b t val (>>) : 'a t -> (unit -> 'b t) -> 'b t val (>|=) : 'a t -> ('a -> 'b) -> 'b t + val (<*>) : ('a -> 'b) t -> 'a t -> 'b t end val (>>=) : 'a t -> ('a -> 'b t) -> 'b t + val (>>) : 'a t -> (unit -> 'b t) -> 'b t + val (>|=) : 'a t -> ('a -> 'b) -> 'b t + (** Alias to {!map} *) + + val (<*>): ('a -> 'b) t -> 'a t -> 'b t + (** Alias to {!app} *) end end From a3e4ab5cc92ab6e8ad4e988936422244f6756243 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 26 Jan 2016 01:33:38 +0100 Subject: [PATCH 25/63] add benchs for `CCPool` --- benchs/run_benchs.ml | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index dea99e05..596433ae 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -1009,6 +1009,33 @@ module Thread = struct ; "naive", make naive, () ] + let fib_pool_ ~size n = + let module P = CCPool.Make(struct let max_size = size end) in + let open P.Fut.Infix in + let rec fib n = + if n<=1 then P.Fut.return 1 + else + let f1 = fib (n-1) + and f2 = fib (n-2) in + P.Fut.return (+) <*> f1 <*> f2 + in + P.Fut.get (fib n) + + let fib_manual n = + let rec fib n = + if n<= 1 then 1 + else fib (n-1) + fib (n-2) + in + fib n + + (* pool of size [size] *) + let bench_pool ~size n = + assert (fib_manual n = fib_pool_ ~size n); + B.throughputN 3 ~repeat + [ "sequential", fib_manual, n + ; "pool", fib_pool_ ~size, n + ] + let () = B.Tree.register ( let take_push = CCList.map (fun (size,senders,receivers) -> @@ -1028,7 +1055,9 @@ module Thread = struct "thread" @>>> ( take_push @ - [] + [ "fib_size5" @>> app_ints (bench_pool ~size:5) [10; 15; 30; 35] + ; "fib_size15" @>> app_ints (bench_pool ~size:15) [10; 15; 30; 35] + ] ) ) end From f95825a2e542c4f654301e30f0cda2b632294608 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 26 Jan 2016 01:45:14 +0100 Subject: [PATCH 26/63] more benchs --- benchs/run_benchs.ml | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index 596433ae..a4ab4dce 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -1036,6 +1036,23 @@ module Thread = struct ; "pool", fib_pool_ ~size, n ] + let bench_sequence ~size n = + let module P = CCPool.Make(struct let max_size = size end) in + let id_ x = Thread.delay 0.0001; x in + let mk_list() = CCList.init n (P.Fut.make1 id_) in + let mk_sequence () = + let l = mk_list() in + P.Fut.sequence_l l |> P.Fut.get + (* reserves a thread for the computation *) + and mk_blocking () = + let l = mk_list() in + P.Fut.make (fun () -> List.map P.Fut.get l) |> P.Fut.get + in + B.throughputN 3 ~repeat + [ "sequence", mk_sequence, () + ; "blocking", mk_blocking, () + ] + let () = B.Tree.register ( let take_push = CCList.map (fun (size,senders,receivers) -> @@ -1057,6 +1074,7 @@ module Thread = struct ( take_push @ [ "fib_size5" @>> app_ints (bench_pool ~size:5) [10; 15; 30; 35] ; "fib_size15" @>> app_ints (bench_pool ~size:15) [10; 15; 30; 35] + ; "sequence" @>> app_ints (bench_sequence ~size:15) [100; 500; 10_000; 100_000] ] ) ) From 663a3cd693763de90843e13482e65e315a6555b4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 26 Jan 2016 02:14:35 +0100 Subject: [PATCH 27/63] introduce a `min_size` in CCPool, to keep threads alive - in benchs, keep `min_size=0` for resource management (need to spawn lots of threads) --- benchs/run_benchs.ml | 4 +-- src/threads/CCPool.ml | 58 ++++++++++++++++++++++++++++++------------ src/threads/CCPool.mli | 3 +++ 3 files changed, 47 insertions(+), 18 deletions(-) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index a4ab4dce..a7c5c1d1 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -1010,7 +1010,7 @@ module Thread = struct ] let fib_pool_ ~size n = - let module P = CCPool.Make(struct let max_size = size end) in + let module P = CCPool.Make(struct let min_size = 0 let max_size = size end) in let open P.Fut.Infix in let rec fib n = if n<=1 then P.Fut.return 1 @@ -1037,7 +1037,7 @@ module Thread = struct ] let bench_sequence ~size n = - let module P = CCPool.Make(struct let max_size = size end) in + let module P = CCPool.Make(struct let min_size = 0 let max_size = size end) in let id_ x = Thread.delay 0.0001; x in let mk_list() = CCList.init n (P.Fut.make1 id_) in let mk_sequence () = diff --git a/src/threads/CCPool.ml b/src/threads/CCPool.ml index f4aca08e..86ea2bf5 100644 --- a/src/threads/CCPool.ml +++ b/src/threads/CCPool.ml @@ -9,6 +9,9 @@ type +'a state = | Failed of exn module type PARAM = sig + val min_size : int + (** Minimum number of threads in the pool *) + val max_size : int (** Maximum number of threads in the pool *) end @@ -16,7 +19,7 @@ end exception Stopped (*$inject - module P = Make(struct let max_size = 30 end) + module P = Make(struct let min_size = 0 let max_size = 30 end) module Fut = P.Fut open Fut.Infix *) @@ -33,8 +36,10 @@ module Make(P : PARAM) = struct mutable stop : bool; (* indicate that threads should stop *) mutable exn_handler: (exn -> unit); mutex : Mutex.t; + cond : Condition.t; jobs : job Queue.t; (* waiting jobs *) - mutable cur_size : int; (* total number of threads *) + mutable cur_size : int; (* total number of threads *) + mutable cur_idle : int; (* number of idle threads *) } (** Dynamic, growable thread pool *) let nop_ _ = () @@ -43,7 +48,9 @@ module Make(P : PARAM) = struct let pool = { stop = false; exn_handler = nop_; + cond = Condition.create(); cur_size = 0; + cur_idle = 0; jobs = Queue.create (); mutex = Mutex.create (); } @@ -60,20 +67,27 @@ module Make(P : PARAM) = struct Mutex.unlock t.mutex; raise e + let incr_size_ p = p.cur_size <- p.cur_size + 1 + let decr_size_ p = p.cur_size <- p.cur_size - 1 + (* next thing a thread should do *) type command = | Process of job + | Wait (* wait on condition *) | Die (* thread has no work to do *) (* thread: seek what to do next (including dying). Assumes the pool is locked. *) let get_next_ pool = - if pool.stop || Queue.is_empty pool.jobs then ( + if pool.stop + || (Queue.is_empty pool.jobs && pool.cur_size > P.min_size) then ( (* die: the thread would be idle otherwise *) assert (pool.cur_size > 0); - pool.cur_size <- pool.cur_size - 1; + decr_size_ pool; Die - ) else ( + ) + else if Queue.is_empty pool.jobs then Wait + else ( let job = Queue.pop pool.jobs in Process job ) @@ -86,6 +100,8 @@ module Make(P : PARAM) = struct (* run a command *) and run_cmd = function | Die -> () + | Wait -> + with_lock_ pool (fun p -> Condition.wait p.cond p.mutex) | Process (Job1 (f, x)) -> begin try ignore (f x) with e -> pool.exn_handler e end; serve pool | Process (Job2 (f, x, y)) -> @@ -95,10 +111,15 @@ module Make(P : PARAM) = struct | Process (Job4 (f, x, y, z, w)) -> begin try ignore (f x y z w) with e -> pool.exn_handler e end; serve pool - (* heuristic criterion for starting a new thread. *) - let should_start_thread p = p.cur_size < P.max_size + (* create a new worker thread *) + let launch_worker_ pool = ignore (Thread.create serve pool) - let incr_size_ p = p.cur_size <- p.cur_size +1 + (* launch the minimum required number of threads *) + let () = + for _i = 1 to P.min_size do launch_worker_ pool done + + (* heuristic criterion for starting a new thread. *) + let can_start_thread_ p = p.cur_size < P.max_size let run_job job = (* acquire lock and push job in queue, or start thread directly @@ -106,19 +127,21 @@ module Make(P : PARAM) = struct with_lock_ pool (fun pool -> if pool.stop then raise Stopped; - if Queue.is_empty pool.jobs && should_start_thread pool + if Queue.is_empty pool.jobs && can_start_thread_ pool && pool.cur_idle = 0 then ( - pool.cur_size <- pool.cur_size + 1; - (* create the thread now, on [job], as it will not - break order *) + (* create the thread now, on [job], as it will not break order of + jobs. We do not want to wait for the busy threads to do our task + if we are allowed to spawn a new thread. *) + incr_size_ pool; ignore (Thread.create run_cmd (Process job)) ) else ( - assert (pool.cur_size > 0); + (* cannot start thread, push and wait for some worker to pick it up *) Queue.push job pool.jobs; - (* might want to process in the background *) - if should_start_thread pool then ( + Condition.signal pool.cond; (* wake up *) + (* 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; - ignore (Thread.create serve pool); + launch_worker_ pool; ) )) @@ -142,6 +165,9 @@ module Make(P : PARAM) = struct p.stop <- true; Queue.clear p.jobs) + (* stop threads if pool is GC'd *) + let () = Gc.finalise (fun _ -> stop ()) pool + (** {6 Futures} *) module Fut = struct type 'a handler = 'a state -> unit diff --git a/src/threads/CCPool.mli b/src/threads/CCPool.mli index 7f4ff9a8..e00acc5e 100644 --- a/src/threads/CCPool.mli +++ b/src/threads/CCPool.mli @@ -12,6 +12,9 @@ type +'a state = | Failed of exn module type PARAM = sig + val min_size : int + (** Minimum number of threads in the pool *) + val max_size : int (** Maximum number of threads in the pool *) end From 1b73c54b07e4daf8b89fc19a3e3d7ab89be6a6e0 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 29 Jan 2016 10:08:42 +0100 Subject: [PATCH 28/63] deprecate `CCLinq` in favor of standalone `OLinq` --- src/advanced/CCLinq.mli | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/advanced/CCLinq.mli b/src/advanced/CCLinq.mli index cf21c35e..2261af3f 100644 --- a/src/advanced/CCLinq.mli +++ b/src/advanced/CCLinq.mli @@ -56,7 +56,9 @@ CCLinq.( - : `Ok () ]} -{b status: experimental} +{b DEPRECATED, use "OLinq" (standalone library) instead} + +{b status: deprecated} *) @@ -76,8 +78,6 @@ module PMap : sig val to_seq : ('a, 'b) t -> ('a * 'b) sequence - val to_list : ('a, 'b) t -> ('a * 'b) list - val map : ('b -> 'c) -> ('a, 'b) t -> ('a, 'c) t (** Transform values *) From 9e94f002e4ef0c6b7c7b7accc840f990c5d8fa45 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 29 Jan 2016 15:57:00 +0100 Subject: [PATCH 29/63] breaking: make type `CCHash.state` abstract --- src/core/CCHash.ml | 24 +------------------- src/core/CCHash.mli | 53 ++++++++++++--------------------------------- 2 files changed, 15 insertions(+), 62 deletions(-) diff --git a/src/core/CCHash.ml b/src/core/CCHash.ml index 9c7cb60c..42d15737 100644 --- a/src/core/CCHash.ml +++ b/src/core/CCHash.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 Hash combinators} *) diff --git a/src/core/CCHash.mli b/src/core/CCHash.mli index 09b2d473..cad92c1e 100644 --- a/src/core/CCHash.mli +++ b/src/core/CCHash.mli @@ -1,47 +1,22 @@ -(* -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: +(* This file is free software, part of containers. See file "license" for more details. *) -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -form must reproduce the above copyright notice, this list of conditions and the -following disclaimer in the documentation and/or other materials provided with -the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -*) - -(** {1 Hash combinators} - -Combination of hashes based on the Murmur Hash (64 bits). See -{{: https://sites.google.com/site/murmurhash/MurmurHash2_64.cpp?attredirects=0} this page} -*) +(** {1 Hash combinators} *) (** {2 Definitions} *) type t = int (** A hash value is a positive integer *) -type state = int64 -(** State required by the hash function *) +type state +(** State required by the hash function. + @since NEXT_RELEASE the state is abstract, for more flexibility *) type 'a hash_fun = 'a -> state -> state (** Hash function for values of type ['a], merging a fingerprint of the value into the state of type [t] *) -(** {2 Applying Murmur Hash} *) +(** {2 Applying Hash} *) val init : state (** Initial value *) @@ -55,11 +30,11 @@ val apply : 'a hash_fun -> 'a -> int (** {2 Basic Combinators} - Those combinators have been renamed in 0.13, so as to - remove the trailing "_". - They are now defined by the application of {!Make} + Those combinators have been renamed in 0.13, so as to + remove the trailing "_". + They are now defined by the application of {!Make} - *) +*) val bool_ : bool hash_fun (** @deprecated use {!bool} *) @@ -108,11 +83,11 @@ val klist : 'a hash_fun -> 'a klist hash_fun (** {2 Generic Hashing} - Parametrize over the state, and some primitives to hash basic types. - This can for instance be used for cryptographic hashing or - checksums such as MD5. + Parametrize over the state, and some primitives to hash basic types. + This can for instance be used for cryptographic hashing or + checksums such as MD5. - @since 0.13 *) + @since 0.13 *) module type HASH = sig type state From db67b19fe8f4f90cc78a0ef9c637dd4f8afcf58f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 18 Feb 2016 12:12:36 +0100 Subject: [PATCH 30/63] update some headers, formatting --- src/core/CCHashtbl.ml | 23 +-------------- src/core/CCHashtbl.mli | 25 +--------------- src/core/CCMap.ml | 65 +++++++++++++++--------------------------- src/core/CCMap.mli | 40 +++++++------------------- src/core/CCSet.ml | 53 +++++++++++----------------------- src/core/CCSet.mli | 38 ++++++------------------ 6 files changed, 61 insertions(+), 183 deletions(-) diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index 73819dd3..856dee9a 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -1,27 +1,6 @@ -(* -copyright (c) 2013-2014, 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: +(* This file is free software, part of containers. See file "license" for more details. *) -redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. redistributions in binary -form must reproduce the above copyright notice, this list of conditions and the -following disclaimer in the documentation and/or other materials provided with -the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -*) (** {1 Extension to the standard Hashtbl} *) diff --git a/src/core/CCHashtbl.mli b/src/core/CCHashtbl.mli index 826bc636..a2ea8850 100644 --- a/src/core/CCHashtbl.mli +++ b/src/core/CCHashtbl.mli @@ -1,28 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Extension to the standard Hashtbl} diff --git a/src/core/CCMap.ml b/src/core/CCMap.ml index 2dc4a5df..14f7f885 100644 --- a/src/core/CCMap.ml +++ b/src/core/CCMap.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Extensions of Standard Map} *) @@ -63,11 +41,13 @@ module type S = sig val to_list : 'a t -> (key * 'a) list - val pp : ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string -> - key printer -> 'a printer -> 'a t printer + val pp : + ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string -> + key printer -> 'a printer -> 'a t printer - val print : ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string -> - key formatter -> 'a formatter -> 'a t formatter + val print : + ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string -> + key formatter -> 'a formatter -> 'a t formatter end module Make(O : Map.OrderedType) = struct @@ -83,8 +63,8 @@ module Make(O : Map.OrderedType) = struct with Not_found -> f None in match x with - | None -> remove k m - | Some v' -> add k v' m + | None -> remove k m + | Some v' -> add k v' m let add_seq m s = let m = ref m in @@ -114,11 +94,11 @@ module Make(O : Map.OrderedType) = struct Buffer.add_string buf start; iter (fun k v -> - if !first then first := false else Buffer.add_string buf sep; - pp_k buf k; - Buffer.add_string buf arrow; - pp_v buf v - ) m; + if !first then first := false else Buffer.add_string buf sep; + pp_k buf k; + Buffer.add_string buf arrow; + pp_v buf v) + m; Buffer.add_string buf stop let print ?(start="[") ?(stop="]") ?(arrow="->") ?(sep=", ") pp_k pp_v fmt m = @@ -126,13 +106,14 @@ module Make(O : Map.OrderedType) = struct let first = ref true in iter (fun k v -> - if !first then first := false else ( - Format.pp_print_string fmt sep; - Format.pp_print_cut fmt () - ); - pp_k fmt k; - Format.pp_print_string fmt arrow; - pp_v fmt v; - ) m; + if !first then first := false + else ( + Format.pp_print_string fmt sep; + Format.pp_print_cut fmt () + ); + pp_k fmt k; + Format.pp_print_string fmt arrow; + pp_v fmt v) + m; Format.pp_print_string fmt stop end diff --git a/src/core/CCMap.mli b/src/core/CCMap.mli index 524e56d2..436a4d41 100644 --- a/src/core/CCMap.mli +++ b/src/core/CCMap.mli @@ -1,32 +1,10 @@ -(* -copyright (c) 2013-2014, 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 Extensions of Standard Map} -Provide useful functions and iterators on [Map.S] -@since 0.5 *) + Provide useful functions and iterators on [Map.S] + @since 0.5 *) type 'a sequence = ('a -> unit) -> unit type 'a printer = Buffer.t -> 'a -> unit @@ -66,13 +44,15 @@ module type S = sig val to_list : 'a t -> (key * 'a) list - val pp : ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string -> - key printer -> 'a printer -> 'a t printer + val pp : + ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string -> + key printer -> 'a printer -> 'a t printer - val print : ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string -> - key formatter -> 'a formatter -> 'a t formatter + val print : + ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string -> + key formatter -> 'a formatter -> 'a t formatter end module Make(O : Map.OrderedType) : S with type 'a t = 'a Map.Make(O).t - and type key = O.t + and type key = O.t diff --git a/src/core/CCSet.ml b/src/core/CCSet.ml index 83d14a10..f11d1981 100644 --- a/src/core/CCSet.ml +++ b/src/core/CCSet.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Wrapper around Set} *) @@ -46,11 +24,13 @@ module type S = sig val to_list : t -> elt list - val pp : ?start:string -> ?stop:string -> ?sep:string -> - elt printer -> t printer + val pp : + ?start:string -> ?stop:string -> ?sep:string -> + elt printer -> t printer - val print : ?start:string -> ?stop:string -> ?sep:string -> - elt formatter -> t formatter + val print : + ?start:string -> ?stop:string -> ?sep:string -> + elt formatter -> t formatter end module Make(O : Map.OrderedType) = struct @@ -76,9 +56,9 @@ module Make(O : Map.OrderedType) = struct Buffer.add_string buf start; iter (fun x -> - if !first then first := false else Buffer.add_string buf sep; - pp_x buf x; - ) m; + if !first then first := false else Buffer.add_string buf sep; + pp_x buf x) + m; Buffer.add_string buf stop let print ?(start="[") ?(stop="]") ?(sep=", ") pp_x fmt m = @@ -86,11 +66,12 @@ module Make(O : Map.OrderedType) = struct let first = ref true in iter (fun x -> - if !first then first := false else ( - Format.pp_print_string fmt sep; - Format.pp_print_cut fmt () - ); - pp_x fmt x; - ) m; + if !first then first := false + else ( + Format.pp_print_string fmt sep; + Format.pp_print_cut fmt () + ); + pp_x fmt x) + m; Format.pp_print_string fmt stop end diff --git a/src/core/CCSet.mli b/src/core/CCSet.mli index 435feb2d..1a8fd4ba 100644 --- a/src/core/CCSet.mli +++ b/src/core/CCSet.mli @@ -1,31 +1,9 @@ -(* -copyright (c) 2013-2014, 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 Wrapper around Set} -@since 0.9 *) + @since 0.9 *) type 'a sequence = ('a -> unit) -> unit type 'a printer = Buffer.t -> 'a -> unit @@ -48,13 +26,15 @@ module type S = sig val to_list : t -> elt list - val pp : ?start:string -> ?stop:string -> ?sep:string -> - elt printer -> t printer + val pp : + ?start:string -> ?stop:string -> ?sep:string -> + elt printer -> t printer - val print : ?start:string -> ?stop:string -> ?sep:string -> - elt formatter -> t formatter + val print : + ?start:string -> ?stop:string -> ?sep:string -> + elt formatter -> t formatter end module Make(O : Set.OrderedType) : S with type t = Set.Make(O).t - and type elt = O.t + and type elt = O.t From 708a92d027f6ec5634caaf8aca4fd3fab6f2c2e0 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 18 Feb 2016 12:21:21 +0100 Subject: [PATCH 31/63] add `{CCMap,CCHashtbl}.get_or` for lookup with default value --- src/core/CCHashtbl.ml | 32 +++++++++++++++++++++++++++++--- src/core/CCHashtbl.mli | 10 ++++++++++ src/core/CCMap.ml | 9 +++++++++ src/core/CCMap.mli | 5 +++++ 4 files changed, 53 insertions(+), 3 deletions(-) diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index 856dee9a..665ff329 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -1,7 +1,6 @@ (* This file is free software, part of containers. See file "license" for more details. *) - (** {1 Extension to the standard Hashtbl} *) type 'a sequence = ('a -> unit) -> unit @@ -15,6 +14,15 @@ let get tbl x = try Some (Hashtbl.find tbl x) with Not_found -> None +let get_or tbl x ~or_ = + try Hashtbl.find tbl x + with Not_found -> or_ + +(*$= + "c" (let tbl = of_list [1,"a"; 2,"b"] in get_or tbl 3 ~or_:"c") + "b" (let tbl = of_list [1,"a"; 2,"b"] in get_or tbl 2 ~or_:"c") +*) + let keys tbl k = Hashtbl.iter (fun key _ -> k key) tbl let values tbl k = Hashtbl.iter (fun _ v -> k v) tbl @@ -89,6 +97,11 @@ module type S = sig val get : 'a t -> key -> 'a option (** Safe version of {!Hashtbl.find} *) + val get_or : 'a t -> key -> or_:'a -> 'a + (** [get_or tbl k ~or_] returns the value associated to [k] if present, + and returns [or_] otherwise (if [k] doesn't belong in [tbl]) + @since NEXT_RELEASE *) + val keys : 'a t -> key sequence (** Iterate on keys (similar order as {!Hashtbl.iter}) *) @@ -96,11 +109,11 @@ module type S = sig (** Iterate on values in the table *) val keys_list : ('a, 'b) Hashtbl.t -> 'a list - (** [keys_list t] is the list of keys in [t]. + (** [keys t] is the list of keys in [t]. @since 0.8 *) val values_list : ('a, 'b) Hashtbl.t -> 'b list - (** [values_list t] is the list of values in [t]. + (** [values t] is the list of values in [t]. @since 0.8 *) val map_list : (key -> 'a -> 'b) -> 'a t -> 'b list @@ -131,6 +144,10 @@ module type S = sig @since 0.13 *) end +(*$inject + module T = Make(CCInt) +*) + module Make(X : Hashtbl.HashedType) : S with type key = X.t and type 'a t = 'a Hashtbl.Make(X).t = struct @@ -140,6 +157,15 @@ module Make(X : Hashtbl.HashedType) try Some (find tbl x) with Not_found -> None + let get_or tbl x ~or_ = + try find tbl x + with Not_found -> or_ + + (*$= + "c" (let tbl = T.of_list [1,"a"; 2,"b"] in T.get_or tbl 3 ~or_:"c") + "b" (let tbl = T.of_list [1,"a"; 2,"b"] in T.get_or tbl 2 ~or_:"c") + *) + let keys tbl k = iter (fun key _ -> k key) tbl let values tbl k = iter (fun _ v -> k v) tbl diff --git a/src/core/CCHashtbl.mli b/src/core/CCHashtbl.mli index a2ea8850..79bc22b8 100644 --- a/src/core/CCHashtbl.mli +++ b/src/core/CCHashtbl.mli @@ -15,6 +15,11 @@ type 'a printer = Format.formatter -> 'a -> unit val get : ('a,'b) Hashtbl.t -> 'a -> 'b option (** Safe version of {!Hashtbl.find} *) +val get_or : ('a,'b) Hashtbl.t -> 'a -> or_:'b -> 'b +(** [get_or tbl k ~or_] returns the value associated to [k] if present, + and returns [or_] otherwise (if [k] doesn't belong in [tbl]) + @since NEXT_RELEASE *) + val keys : ('a,'b) Hashtbl.t -> 'a sequence (** Iterate on keys (similar order as {!Hashtbl.iter}) *) @@ -64,6 +69,11 @@ module type S = sig val get : 'a t -> key -> 'a option (** Safe version of {!Hashtbl.find} *) + val get_or : 'a t -> key -> or_:'a -> 'a + (** [get_or tbl k ~or_] returns the value associated to [k] if present, + and returns [or_] otherwise (if [k] doesn't belong in [tbl]) + @since NEXT_RELEASE *) + val keys : 'a t -> key sequence (** Iterate on keys (similar order as {!Hashtbl.iter}) *) diff --git a/src/core/CCMap.ml b/src/core/CCMap.ml index 14f7f885..087eaaeb 100644 --- a/src/core/CCMap.ml +++ b/src/core/CCMap.ml @@ -13,6 +13,11 @@ module type S = sig val get : key -> 'a t -> 'a option (** Safe version of {!find} *) + val get_or : key -> 'a t -> or_:'a -> 'a + (** [get_or k m ~or_] returns the value associated to [k] if present, + and returns [or_] otherwise (if [k] doesn't belong in [m]) + @since NEXT_RELEASE *) + val update : key -> ('a option -> 'a option) -> 'a t -> 'a t (** [update k f m] calls [f (Some v)] if [find k m = v], otherwise it calls [f None]. In any case, if the result is [None] @@ -57,6 +62,10 @@ module Make(O : Map.OrderedType) = struct try Some (find k m) with Not_found -> None + let get_or k m ~or_ = + try find k m + with Not_found -> or_ + let update k f m = let x = try f (Some (find k m)) diff --git a/src/core/CCMap.mli b/src/core/CCMap.mli index 436a4d41..819ba2b6 100644 --- a/src/core/CCMap.mli +++ b/src/core/CCMap.mli @@ -16,6 +16,11 @@ module type S = sig val get : key -> 'a t -> 'a option (** Safe version of {!find} *) + val get_or : key -> 'a t -> or_:'a -> 'a + (** [get_or k m ~or_] returns the value associated to [k] if present, + and returns [or_] otherwise (if [k] doesn't belong in [m]) + @since NEXT_RELEASE *) + val update : key -> ('a option -> 'a option) -> 'a t -> 'a t (** [update k f m] calls [f (Some v)] if [find k m = v], otherwise it calls [f None]. In any case, if the result is [None] From 12fe3fdde3c49f8fa0372d55d733057bd437c45c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 18 Feb 2016 12:28:19 +0100 Subject: [PATCH 32/63] deprecation incoming for `CCHashtbl.{Counter,Default}` tables --- src/core/CCHashtbl.mli | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/core/CCHashtbl.mli b/src/core/CCHashtbl.mli index 79bc22b8..bcbb8187 100644 --- a/src/core/CCHashtbl.mli +++ b/src/core/CCHashtbl.mli @@ -121,7 +121,9 @@ module Make(X : Hashtbl.HashedType) : (** {2 Default Table} -A table with a default element for keys that were never added. *) + A table with a default element for keys that were never added. + + @deprecated since NEXT_RELEASE, should be merged into [Make] itself *) module type DEFAULT = sig type key @@ -155,7 +157,9 @@ end module MakeDefault(X : Hashtbl.HashedType) : DEFAULT with type key = X.t -(** {2 Count occurrences using a Hashtbl} *) +(** {2 Count occurrences using a Hashtbl} + + @deprecated since NEXT_RELEASE, should be merged into [Make] itself *) module type COUNTER = sig type elt From dcfbff782713fddaec2f60a7b85259dec1f5f099 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 18 Feb 2016 15:40:40 +0100 Subject: [PATCH 33/63] add `CCList.Assoc.mem` --- src/core/CCList.ml | 25 +++++++++++++++++-------- src/core/CCList.mli | 4 ++++ 2 files changed, 21 insertions(+), 8 deletions(-) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 0d23f6b9..9d32ba8d 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -793,15 +793,15 @@ let repeat i l = module Assoc = struct type ('a, 'b) t = ('a*'b) list - let get_exn ?(eq=(=)) l x = - let rec search eq l x = match l with - | [] -> raise Not_found - | (y,z)::l' -> - if eq x y then z else search eq l' x - in search eq l x + let rec search_exn eq l x = match l with + | [] -> raise Not_found + | (y,z)::l' -> + if eq x y then z else search_exn eq l' x - let get ?eq l x = - try Some (get_exn ?eq l x) + let get_exn ?(eq=(=)) l x = search_exn eq l x + + let get ?(eq=(=)) l x = + try Some (search_exn eq l x) with Not_found -> None (*$T @@ -826,6 +826,15 @@ module Assoc = struct Assoc.set [1,"1"; 2, "2"] 3 "3" |> List.sort Pervasives.compare \ = [1, "1"; 2, "2"; 3, "3"] *) + + let mem ?(eq=(=)) l x = + try ignore (search_exn eq l x); true + with Not_found -> false + + (*$T + Assoc.mem [1,"1"; 2,"2"; 3, "3"] 1 + not (Assoc.mem [1,"1"; 2,"2"; 3, "3"] 4) + *) end (** {2 Zipper} *) diff --git a/src/core/CCList.mli b/src/core/CCList.mli index bbb5ce2e..e2b04501 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -300,6 +300,10 @@ module Assoc : sig val set : ?eq:('a->'a->bool) -> ('a,'b) t -> 'a -> 'b -> ('a,'b) t (** Add the binding into the list (erase it if already present) *) + + val mem : ?eq:('a->'a->bool) -> ('a,_) t -> 'a -> bool + (** [mem l x] returns [true] iff [x] is a key in [l] + @since NEXT_RELEASE *) end (** {2 Zipper} *) From b8beed4587668a57086f351c112c4872453dc3ef Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 18 Feb 2016 15:49:53 +0100 Subject: [PATCH 34/63] add `CCList.Assoc.update` --- src/core/CCList.ml | 41 ++++++++++++++++++++++++++++++++++------- src/core/CCList.mli | 7 +++++++ 2 files changed, 41 insertions(+), 7 deletions(-) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 9d32ba8d..824c2706 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -25,6 +25,10 @@ of this software, even if advised of the possibility of such damage. (** {1 complements to list} *) +(*$inject + let lsort l = List.sort Pervasives.compare l +*) + type 'a t = 'a list let empty = [] @@ -811,14 +815,19 @@ module Assoc = struct Assoc.get [] 42 = None *) + (* search for a binding for [x] in [l], and calls [f x (Some v) rest] + or [f x None rest] depending on whether it finds the binding. + [rest] is the list of the other bindings *) + let rec search_set eq acc l x ~f = match l with + | [] -> f x None acc + | (x',y')::l' -> + if eq x x' + then f x (Some y') (List.rev_append acc l') + else search_set eq ((x',y')::acc) l' x ~f + let set ?(eq=(=)) l x y = - let rec search eq acc l x y = match l with - | [] -> (x,y)::acc - | (x',y')::l' -> - if eq x x' - then (x,y)::List.rev_append acc l' - else search eq ((x',y')::acc) l' x y - in search eq [] l x y + search_set eq [] l x + ~f:(fun x _ l -> (x,y)::l) (*$T Assoc.set [1,"1"; 2, "2"] 2 "two" |> List.sort Pervasives.compare \ @@ -835,6 +844,24 @@ module Assoc = struct Assoc.mem [1,"1"; 2,"2"; 3, "3"] 1 not (Assoc.mem [1,"1"; 2,"2"; 3, "3"] 4) *) + + let update ?(eq=(=)) l x ~f = + search_set eq [] l x + ~f:(fun x opt_y rest -> + match f opt_y with + | None -> rest (* drop *) + | Some y' -> (x,y') :: rest) + (*$= + [1,"1"; 2,"22"] \ + (Assoc.update [1,"1"; 2,"2"] 2 \ + ~f:(function Some "2" -> Some "22" | _ -> assert false) |> lsort) + [1,"1"; 3,"3"] \ + (Assoc.update [1,"1"; 2,"2"; 3,"3"] 2 \ + ~f:(function Some "2" -> None | _ -> assert false) |> lsort) + [1,"1"; 2,"2"; 3,"3"] \ + (Assoc.update [1,"1"; 2,"2"] 3 \ + ~f:(function None -> Some "3" | _ -> assert false) |> lsort) + *) end (** {2 Zipper} *) diff --git a/src/core/CCList.mli b/src/core/CCList.mli index e2b04501..5649d8f0 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -304,6 +304,13 @@ module Assoc : sig val mem : ?eq:('a->'a->bool) -> ('a,_) t -> 'a -> bool (** [mem l x] returns [true] iff [x] is a key in [l] @since NEXT_RELEASE *) + + val update : + ?eq:('a->'a->bool) -> ('a,'b) t -> 'a -> f:('b option -> 'b option) -> ('a,'b) t + (** [update l k ~f] updates [l] on the key [k], by calling [f (get l k)] + and removing [k] if it returns [None], mapping [k] to [v'] if it + returns [Some v'] + @since NEXT_RELEASE *) end (** {2 Zipper} *) From 12ca4020254dfa67fee589531db6c6c65d501c17 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 19 Feb 2016 14:10:29 +0100 Subject: [PATCH 35/63] provide "bold" style --- src/core/CCFormat.ml | 3 ++- src/core/CCFormat.mli | 1 + 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 1ed6853d..5aab90db 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -197,7 +197,8 @@ let style_of_tag_ s = match String.trim s with | "magenta" -> [`FG `Magenta] | "cyan" -> [`FG `Cyan] | "white" -> [`FG `White] - | "Black" -> [`FG `Black] + | "bold" -> [`Bold] + | "Black" -> [`FG `Black; `Bold] | "Red" -> [`FG `Red; `Bold] | "Green" -> [`FG `Green; `Bold] | "Yellow" -> [`FG `Yellow; `Bold] diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 4f7ee00f..caf22b4f 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -84,6 +84,7 @@ val map : ('a -> 'b) -> 'b printer -> 'a printer {- "magenta" } {- "cyan" } {- "white" } + {- "bold" bold font} {- "Black" bold black} {- "Red" bold red } {- "Green" bold green } From 526ea35495485b111ff6ff30b41c2c263d7b534c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 19 Feb 2016 16:34:01 +0100 Subject: [PATCH 36/63] add `CCFormat.sprintf_no_color` --- src/core/CCFormat.ml | 15 +++++++++++++-- src/core/CCFormat.mli | 4 ++++ 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 5aab90db..20d68887 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -276,18 +276,29 @@ let with_colorf s out fmt = (fun out -> Format.pp_close_tag out ()) out fmt -let sprintf format = +(* c: whether colors are enabled *) +let sprintf_ c format = let buf = Buffer.create 64 in let fmt = Format.formatter_of_buffer buf in - if !color_enabled then set_color_tag_handling fmt; + if c && !color_enabled then set_color_tag_handling fmt; Format.kfprintf (fun _fmt -> Format.pp_print_flush fmt (); Buffer.contents buf) fmt format +let sprintf fmt = sprintf_ true fmt +let sprintf_no_color fmt = sprintf_ false fmt + (*$T sprintf "yolo %s %d" "a b" 42 = "yolo a b 42" sprintf "%d " 0 = "0 " + sprintf_no_color "%d " 0 = "0 " +*) + +(*$R + set_color_default true; + assert_equal "\027[31myolo\027[0m" (sprintf "@{yolo@}"); + assert_equal "yolo" (sprintf_no_color "@{yolo@}"); *) let ksprintf ~f fmt = diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index caf22b4f..efbd6eeb 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -140,6 +140,10 @@ val sprintf : ('a, t, unit, string) format4 -> 'a (** Print into a string any format string that would usually be compatible with {!fprintf}. Similar to {!Format.asprintf}. *) +val sprintf_no_color : ('a, t, unit, string) format4 -> 'a +(** Similar to {!sprintf} but never prints colors + @since NEXT_RELEASE *) + val fprintf : t -> ('a, t, unit ) format -> 'a (** Alias to {!Format.fprintf} @since 0.14 *) From 52f585d27b9e1dd7b2703793131cd230d095d500 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 19 Feb 2016 19:44:39 +0100 Subject: [PATCH 37/63] headers --- src/data/CCMixmap.ml | 24 +----------------------- src/data/CCMixmap.mli | 24 +----------------------- src/data/CCMixset.ml | 24 +----------------------- src/data/CCMixset.mli | 24 +----------------------- src/data/CCMixtbl.ml | 24 +----------------------- src/data/CCMixtbl.mli | 24 +----------------------- 6 files changed, 6 insertions(+), 138 deletions(-) diff --git a/src/data/CCMixmap.ml b/src/data/CCMixmap.ml index 39a10501..110261b2 100644 --- a/src/data/CCMixmap.ml +++ b/src/data/CCMixmap.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Maps with Heterogeneous Values} *) diff --git a/src/data/CCMixmap.mli b/src/data/CCMixmap.mli index 6675a877..6499ce36 100644 --- a/src/data/CCMixmap.mli +++ b/src/data/CCMixmap.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Maps with Heterogeneous Values} diff --git a/src/data/CCMixset.ml b/src/data/CCMixset.ml index ff7320c3..3d049ae4 100644 --- a/src/data/CCMixset.ml +++ b/src/data/CCMixset.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2015, 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 Set of Heterogeneous Values} *) diff --git a/src/data/CCMixset.mli b/src/data/CCMixset.mli index cfc79d3d..7f7f2619 100644 --- a/src/data/CCMixset.mli +++ b/src/data/CCMixset.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2015, 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 Set of Heterogeneous Values} diff --git a/src/data/CCMixtbl.ml b/src/data/CCMixtbl.ml index 0ec48c58..84c8e75b 100644 --- a/src/data/CCMixtbl.ml +++ b/src/data/CCMixtbl.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Hash Table with Heterogeneous Keys} *) diff --git a/src/data/CCMixtbl.mli b/src/data/CCMixtbl.mli index 2c6eec78..a778fb4c 100644 --- a/src/data/CCMixtbl.mli +++ b/src/data/CCMixtbl.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Hash Table with Heterogeneous Keys} From 1993eabd21e9875115b0f5d77557063df4905c48 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 19 Feb 2016 19:58:21 +0100 Subject: [PATCH 38/63] breaking: change the API of CCMixmap - make it easier to use |> with CCMixmap - add test and example --- src/data/CCMixmap.ml | 42 ++++++++++++++++++++++++++++++++---------- src/data/CCMixmap.mli | 37 ++++++++++++++++++++++++++++++------- 2 files changed, 62 insertions(+), 17 deletions(-) diff --git a/src/data/CCMixmap.ml b/src/data/CCMixmap.ml index 110261b2..2373cd75 100644 --- a/src/data/CCMixmap.ml +++ b/src/data/CCMixmap.ml @@ -3,6 +3,28 @@ (** {1 Maps with Heterogeneous Values} *) +(*$R + let module M = CCMixmap.Make(CCInt) in + + let inj_int = CCMixmap.create_inj() in + let inj_str = CCMixmap.create_inj() in + let inj_list_int = CCMixmap.create_inj() in + + let m = + M.empty + |> M.add ~inj:inj_int 1 1 + |> M.add ~inj:inj_str 2 "2" + |> M.add ~inj:inj_list_int 3 [3;3;3] + in + + assert_equal (M.get ~inj:inj_int 1 m) (Some 1) ; + assert_equal (M.get ~inj:inj_str 1 m) None ; + assert_equal (M.get ~inj:inj_str 2 m) (Some "2") ; + assert_equal (M.get ~inj:inj_int 2 m) None ; + assert_equal (M.get ~inj:inj_list_int 3 m) (Some [3;3;3]) ; + assert_equal (M.get ~inj:inj_str 3 m) None ; +*) + type 'b injection = { get : (unit -> unit) -> 'b option; set : 'b -> (unit -> unit); @@ -28,14 +50,14 @@ module type S = sig val empty : t (** Empty map *) - val get : inj:'a injection -> t -> key -> 'a option + val get : inj:'a injection -> key -> t -> 'a option (** Get the value corresponding to this key, if it exists and belongs to the same key *) - val add : inj:'a injection -> t -> key -> 'a -> t + val add : inj:'a injection -> key -> 'a -> t -> t (** Bind the key to the value, using [inj] *) - val find : inj:'a injection -> t -> key -> 'a + val find : inj:'a injection -> key -> t -> 'a (** Find the value for the given key, which must be of the right type. @raise Not_found if either the key is not found, or if its value doesn't belong to the right type *) @@ -43,10 +65,10 @@ module type S = sig val cardinal : t -> int (** Number of bindings *) - val remove : t -> key -> t + val remove : key -> t -> t (** Remove the binding for this key *) - val mem : inj:_ injection-> t -> key -> bool + val mem : inj:_ injection-> key -> t -> bool (** Is the given key in the map, with the right type? *) val iter_keys : f:(key -> unit) -> t -> unit @@ -85,23 +107,23 @@ module Make(X : ORD) : S with type key = X.t = struct let empty = M.empty - let find ~inj map x = + let find ~inj x map = match inj.get (M.find x map) with | None -> raise Not_found | Some v -> v - let get ~inj map x = + let get ~inj x map = try inj.get (M.find x map) with Not_found -> None - let add ~inj map x y = + let add ~inj x y map = M.add x (inj.set y) map let cardinal = M.cardinal - let remove map x = M.remove x map + let remove = M.remove - let mem ~inj map x = + let mem ~inj x map = try inj.get (M.find x map) <> None with Not_found -> false diff --git a/src/data/CCMixmap.mli b/src/data/CCMixmap.mli index 6499ce36..4885dcb3 100644 --- a/src/data/CCMixmap.mli +++ b/src/data/CCMixmap.mli @@ -3,9 +3,32 @@ (** {1 Maps with Heterogeneous Values} -{b status: experimental} + {b status: experimental} -@since 0.9 *) + {[ + module M = CCMixmap.Make(CCInt) + + let inj_int = CCMixmap.create_inj() + let inj_str = CCMixmap.create_inj() + let inj_list_int = CCMixmap.create_inj() + + let m = + M.empty + |> M.add ~inj:inj_int 1 1 + |> M.add ~inj:inj_str 2 "2" + |> M.add ~inj:inj_list_int 3 [3;3;3] + + assert (M.get ~inj:inj_int 1 m = Some 1) + assert (M.get ~inj:inj_str 1 m = None) + assert (M.get ~inj:inj_str 2 m = Some "2") + assert (M.get ~inj:inj_int 2 m = None) + assert (M.get ~inj:inj_list_int 3 m = Some [3;3;3]) + assert (M.get ~inj:inj_str 3 m = None) + ]} + + @since 0.9 + @since NEXT_RELEASE change of API, the map is last argument to + make piping with [|>] easier. *) type 'a injection (** An accessor for values of type 'a in any map. Values put @@ -28,14 +51,14 @@ module type S = sig val empty : t (** Empty map *) - val get : inj:'a injection -> t -> key -> 'a option + val get : inj:'a injection -> key -> t -> 'a option (** Get the value corresponding to this key, if it exists and belongs to the same key *) - val add : inj:'a injection -> t -> key -> 'a -> t + val add : inj:'a injection -> key -> 'a -> t -> t (** Bind the key to the value, using [inj] *) - val find : inj:'a injection -> t -> key -> 'a + val find : inj:'a injection -> key -> t -> 'a (** Find the value for the given key, which must be of the right type. @raise Not_found if either the key is not found, or if its value doesn't belong to the right type *) @@ -43,10 +66,10 @@ module type S = sig val cardinal : t -> int (** Number of bindings *) - val remove : t -> key -> t + val remove : key -> t -> t (** Remove the binding for this key *) - val mem : inj:_ injection-> t -> key -> bool + val mem : inj:_ injection-> key -> t -> bool (** Is the given key in the map, with the right type? *) val iter_keys : f:(key -> unit) -> t -> unit From 34445bead0f5b2da26dcc3b1580c1c2a33a39b02 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 20 Feb 2016 23:24:24 +0100 Subject: [PATCH 39/63] replace headers in the rest of containers core --- src/core/CCArray.ml | 24 +----------------------- src/core/CCArray.mli | 24 +----------------------- src/core/CCBool.ml | 24 +----------------------- src/core/CCBool.mli | 24 +----------------------- src/core/CCError.ml | 24 +----------------------- src/core/CCError.mli | 24 +----------------------- src/core/CCFloat.ml | 24 +----------------------- src/core/CCFloat.mli | 24 +----------------------- src/core/CCFormat.ml | 24 +----------------------- src/core/CCFormat.mli | 24 +----------------------- src/core/CCFun.cppo.ml | 24 +----------------------- src/core/CCFun.mli | 24 +----------------------- src/core/CCHeap.ml | 24 +----------------------- src/core/CCHeap.mli | 24 +----------------------- src/core/CCIO.ml | 24 +----------------------- src/core/CCIO.mli | 24 +----------------------- src/core/CCInt.ml | 24 +----------------------- src/core/CCInt.mli | 24 +----------------------- src/core/CCList.ml | 24 +----------------------- src/core/CCList.mli | 24 +----------------------- src/core/CCOpt.ml | 24 +----------------------- src/core/CCOpt.mli | 24 +----------------------- src/core/CCPair.ml | 24 +----------------------- src/core/CCPair.mli | 24 +----------------------- src/core/CCPrint.ml | 24 +----------------------- src/core/CCPrint.mli | 24 +----------------------- src/core/CCRandom.ml | 24 +----------------------- src/core/CCRef.ml | 24 +----------------------- src/core/CCRef.mli | 24 +----------------------- src/core/CCString.cppo.ml | 24 +----------------------- src/core/CCString.mli | 24 +----------------------- src/core/CCVector.ml | 24 +----------------------- src/core/CCVector.mli | 24 +----------------------- src/core/containers.ml | 24 +----------------------- 34 files changed, 34 insertions(+), 782 deletions(-) diff --git a/src/core/CCArray.ml b/src/core/CCArray.ml index 6c1d2098..de3b8b43 100644 --- a/src/core/CCArray.ml +++ b/src/core/CCArray.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Array utils} *) diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index c23ed39e..dd87dd40 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Array utils} *) diff --git a/src/core/CCBool.ml b/src/core/CCBool.ml index 148961ac..c4eab0ed 100644 --- a/src/core/CCBool.ml +++ b/src/core/CCBool.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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. *) type t = bool diff --git a/src/core/CCBool.mli b/src/core/CCBool.mli index 28108f89..743b9c8c 100644 --- a/src/core/CCBool.mli +++ b/src/core/CCBool.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Basic Bool functions} *) diff --git a/src/core/CCError.ml b/src/core/CCError.ml index 3bc727ee..ab9af226 100644 --- a/src/core/CCError.ml +++ b/src/core/CCError.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Error Monad} *) diff --git a/src/core/CCError.mli b/src/core/CCError.mli index f7e5fa34..64bbf525 100644 --- a/src/core/CCError.mli +++ b/src/core/CCError.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Error Monad} diff --git a/src/core/CCFloat.ml b/src/core/CCFloat.ml index 75336d7f..6e4a5b56 100644 --- a/src/core/CCFloat.ml +++ b/src/core/CCFloat.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2014, Carmelo Piccione -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. *) type t = float type fpclass = Pervasives.fpclass = diff --git a/src/core/CCFloat.mli b/src/core/CCFloat.mli index 1cc33188..4fa7f9ab 100644 --- a/src/core/CCFloat.mli +++ b/src/core/CCFloat.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2014, Carmelo Piccione -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 Basic Float functions} @since 0.6.1 *) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 20d68887..cd12650e 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.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 Helpers for Format} *) diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index efbd6eeb..3bf7f622 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.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 Helpers for Format} diff --git a/src/core/CCFun.cppo.ml b/src/core/CCFun.cppo.ml index a1fad6ed..c14cdb84 100644 --- a/src/core/CCFun.cppo.ml +++ b/src/core/CCFun.cppo.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Basic Functions} *) diff --git a/src/core/CCFun.mli b/src/core/CCFun.mli index ab609916..9d6a8457 100644 --- a/src/core/CCFun.mli +++ b/src/core/CCFun.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Basic Functions} *) diff --git a/src/core/CCHeap.ml b/src/core/CCHeap.ml index 97bccb00..3cca9304 100644 --- a/src/core/CCHeap.ml +++ b/src/core/CCHeap.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 Leftist Heaps} *) diff --git a/src/core/CCHeap.mli b/src/core/CCHeap.mli index 169b12fd..c8c2a076 100644 --- a/src/core/CCHeap.mli +++ b/src/core/CCHeap.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 Leftist Heaps} following Okasaki *) diff --git a/src/core/CCIO.ml b/src/core/CCIO.ml index d0a7daf4..6eaaa6c9 100644 --- a/src/core/CCIO.ml +++ b/src/core/CCIO.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 IO Utils} *) diff --git a/src/core/CCIO.mli b/src/core/CCIO.mli index 442b832b..a29c0af6 100644 --- a/src/core/CCIO.mli +++ b/src/core/CCIO.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 IO Utils} diff --git a/src/core/CCInt.ml b/src/core/CCInt.ml index bc535eca..506ab79f 100644 --- a/src/core/CCInt.ml +++ b/src/core/CCInt.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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. *) type t = int diff --git a/src/core/CCInt.mli b/src/core/CCInt.mli index f81669f9..a07240c6 100644 --- a/src/core/CCInt.mli +++ b/src/core/CCInt.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Basic Int functions} *) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 824c2706..def7c977 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 complements to list} *) diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 5649d8f0..b665c918 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 complements to list} *) diff --git a/src/core/CCOpt.ml b/src/core/CCOpt.ml index 40d87580..fa2b7b30 100644 --- a/src/core/CCOpt.ml +++ b/src/core/CCOpt.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Options} *) diff --git a/src/core/CCOpt.mli b/src/core/CCOpt.mli index 699ea632..64d1c7f9 100644 --- a/src/core/CCOpt.mli +++ b/src/core/CCOpt.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Options} *) diff --git a/src/core/CCPair.ml b/src/core/CCPair.ml index f377a3f1..7b763cb5 100644 --- a/src/core/CCPair.ml +++ b/src/core/CCPair.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Tuple Functions} *) diff --git a/src/core/CCPair.mli b/src/core/CCPair.mli index 905ecce0..ca4a2c79 100644 --- a/src/core/CCPair.mli +++ b/src/core/CCPair.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Tuple Functions} *) diff --git a/src/core/CCPrint.ml b/src/core/CCPrint.ml index 22c24e1a..c0f1a4c7 100644 --- a/src/core/CCPrint.ml +++ b/src/core/CCPrint.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 Printer Combinators} diff --git a/src/core/CCPrint.mli b/src/core/CCPrint.mli index 3b88617d..bd6f5d85 100644 --- a/src/core/CCPrint.mli +++ b/src/core/CCPrint.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 Printer Combinators} diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index 3d762620..b6931915 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Random Generators} *) diff --git a/src/core/CCRef.ml b/src/core/CCRef.ml index 80861110..047b0e92 100644 --- a/src/core/CCRef.ml +++ b/src/core/CCRef.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 References} diff --git a/src/core/CCRef.mli b/src/core/CCRef.mli index 6c6e8cfe..fed1091e 100644 --- a/src/core/CCRef.mli +++ b/src/core/CCRef.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 References} @since 0.9 *) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 738a0c8b..dacda08b 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Basic String Utils} *) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index ac5ab4ca..b9201530 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Basic String Utils} diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 39f53715..6eb571e0 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.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 Growable, mutable vector} *) diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index b2c2a2b5..ea9088d9 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.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 Growable, mutable vector} *) diff --git a/src/core/containers.ml b/src/core/containers.ml index 5f5b4b05..d38654de 100644 --- a/src/core/containers.ml +++ b/src/core/containers.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Drop-In replacement to Stdlib} From d2fbd8dd77fe0dd5fa5da52033e4764368c066e8 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 20 Feb 2016 23:29:44 +0100 Subject: [PATCH 40/63] add `CCRandom.pick_{list,array}` --- src/core/CCRandom.ml | 18 ++++++++++++++++++ src/core/CCRandom.mli | 43 ++++++++++++++++--------------------------- 2 files changed, 34 insertions(+), 27 deletions(-) diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index b6931915..0df36850 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -37,6 +37,24 @@ let choose_exn l = let choose_return l = _choose_array (Array.of_list l) +exception Pick_from_empty + +let pick_list l = + let n = List.length l in + if n=0 then raise Pick_from_empty; + fun st -> + List.nth l (Random.State.int st n) + +(*$Q + Q.(list small_int) (fun l -> \ + List.mem (run (pick_list l)) l) +*) + +let pick_array a = + let n = Array.length a in + if n=0 then raise Pick_from_empty; + fun st -> Array.get a (Random.State.int st n) + let int i st = Random.State.int st i let small_int = int 100 diff --git a/src/core/CCRandom.mli b/src/core/CCRandom.mli index c0b8c604..78aa4977 100644 --- a/src/core/CCRandom.mli +++ b/src/core/CCRandom.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Random Generators} *) @@ -56,8 +34,7 @@ val delay : (unit -> 'a t) -> 'a t small_int >>= fun i -> return (name,i) ) ]} - @since 0.4 -*) + @since 0.4 *) val choose : 'a t list -> 'a option t (** Choose a generator within the list. *) @@ -81,13 +58,25 @@ val sample_without_replacement: (** [sample_without_replacement n g] makes a list of [n] elements which are all generated randomly using [g] with the added constraint that none of the generated random values are equal - @since 0.15 - *) + @since 0.15 *) val list_seq : 'a t list -> 'a list t (** Build random lists from lists of random generators @since 0.4 *) +exception Pick_from_empty +(** @since NEXT_RELEASE *) + +val pick_list : 'a list -> 'a t +(** Pick an element at random from the list + @raise Pick_from_empty if the list is empty + @since NEXT_RELEASE *) + +val pick_array : 'a array -> 'a t +(** Pick an element at random from the array + @raise Pick_from_empty if the array is empty + @since NEXT_RELEASE *) + val small_int : int t val int : int -> int t From b0b768b60ab3e9eec1b4c334cebf9d9e3f1a08ce Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 20 Feb 2016 23:36:48 +0100 Subject: [PATCH 41/63] add `CCIO.File.{read,write,append}` for quickly handling files --- src/core/CCIO.ml | 16 ++++++++++++++++ src/core/CCIO.mli | 24 ++++++++++++++++++++++++ 2 files changed, 40 insertions(+) diff --git a/src/core/CCIO.ml b/src/core/CCIO.ml index 6eaaa6c9..5de7ed60 100644 --- a/src/core/CCIO.ml +++ b/src/core/CCIO.ml @@ -260,6 +260,22 @@ module File = struct with exn -> `Error (Printexc.to_string exn) + let read_exn f = with_in f (read_all_ ~op:Ret_string ~size:4096) + + let read f = try `Ok (read_exn f) with e -> `Error (Printexc.to_string e) + + let append_exn f x = + with_out ~flags:[Open_append; Open_creat; Open_text] f + (fun oc -> output_string oc x; flush oc) + + let append f x = try `Ok (append_exn f x) with e -> `Error (Printexc.to_string e) + + let write_exn f x = + with_out f + (fun oc -> output_string oc x; flush oc) + + let write f x = try `Ok (write_exn f x) with e -> `Error (Printexc.to_string e) + let remove_noerr f = try Sys.remove f with _ -> () let read_dir_base d = diff --git a/src/core/CCIO.mli b/src/core/CCIO.mli index a29c0af6..b112b111 100644 --- a/src/core/CCIO.mli +++ b/src/core/CCIO.mli @@ -162,6 +162,30 @@ module File : sig @param recurse if true (default [false]), sub-directories are also explored *) + val read_exn : t -> string + (** Read the content of the given file, or raises some exception + @since NEXT_RELEASE *) + + val read : t -> string or_error + (** Read the content of the given file + @since NEXT_RELEASE *) + + val append_exn : t -> string -> unit + (** Append the given string into the given file, possibly raising + @since NEXT_RELEASE *) + + val append : t -> string -> unit or_error + (** Append the given string into the given file + @since NEXT_RELEASE *) + + val write_exn : t -> string -> unit + (** Write the given string into the given file, possibly raising + @since NEXT_RELEASE *) + + val write : t -> string -> unit or_error + (** Write the given string into the given file + @since NEXT_RELEASE *) + type walk_item = [`File | `Dir] * t val walk : t -> walk_item gen From 41536c6dd6cfa352b59bb662d542a40964e060d8 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 20 Feb 2016 23:38:03 +0100 Subject: [PATCH 42/63] fix test --- _tags | 22 +++++++++++++++------- src/core/CCRandom.ml | 2 +- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/_tags b/_tags index bdf2faa4..bcb2222e 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 0e7b7eeffb179d552ac9c060b7ab3be9) +# DO NOT EDIT (digest: 1681c391580688c2463b8457d464cf03) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -17,6 +17,7 @@ true: annot, bin_annot # Library containers "src/core/containers.cmxs": use_containers : package(bytes) +: package(result) # Library containers_io "src/io/containers_io.cmxs": use_containers_io : package(bytes) @@ -38,16 +39,19 @@ true: annot, bin_annot # Library containers_advanced "src/advanced/containers_advanced.cmxs": use_containers_advanced : package(bytes) +: package(result) : package(sequence) : use_containers # Library containers_bigarray "src/bigarray/containers_bigarray.cmxs": use_containers_bigarray : package(bigarray) : package(bytes) +: package(result) : use_containers # Library containers_thread "src/threads/containers_thread.cmxs": use_containers_thread : package(bytes) +: package(result) : package(threads) : use_containers # Library containers_top @@ -55,6 +59,7 @@ true: annot, bin_annot : package(bigarray) : package(bytes) : package(compiler-libs.common) +: package(result) : package(unix) : use_containers : use_containers_bigarray @@ -68,6 +73,7 @@ true: annot, bin_annot : package(bytes) : package(gen) : package(hamt) +: package(result) : package(sequence) : package(threads) : use_containers @@ -85,6 +91,7 @@ true: annot, bin_annot : use_containers_thread # Executable run_bench_hash : package(bytes) +: package(result) : use_containers # Executable run_qtest : package(QTest2Lib) @@ -92,6 +99,7 @@ true: annot, bin_annot : package(bytes) : package(gen) : package(oUnit) +: package(result) : package(sequence) : package(threads) : package(unix) @@ -110,6 +118,7 @@ true: annot, bin_annot : package(bytes) : package(gen) : package(oUnit) +: package(result) : package(sequence) : package(threads) : package(unix) @@ -123,25 +132,24 @@ true: annot, bin_annot : use_containers_string : use_containers_thread : use_containers_unix -# Executable id_sexp -: package(bytes) -: use_containers_sexp # Executable mem_measure "benchs/mem_measure.native": package(bytes) "benchs/mem_measure.native": package(hamt) +"benchs/mem_measure.native": package(result) "benchs/mem_measure.native": package(sequence) "benchs/mem_measure.native": package(unix) "benchs/mem_measure.native": use_containers "benchs/mem_measure.native": use_containers_data : package(bytes) : package(hamt) +: package(result) : package(sequence) : package(unix) : use_containers : use_containers_data -# Executable id_sexp2 -: package(bytes) -: use_containers_sexp +# Executable id_sexp +: package(bytes) +: use_containers_sexp : package(bytes) : use_containers_sexp # OASIS_STOP diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index 0df36850..9e0ad1fe 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -47,7 +47,7 @@ let pick_list l = (*$Q Q.(list small_int) (fun l -> \ - List.mem (run (pick_list l)) l) + l=[] || List.mem (run (pick_list l)) l) *) let pick_array a = From 1cf81c003184abac38c5aff3da13e35eec74ad69 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 21 Feb 2016 00:00:28 +0100 Subject: [PATCH 43/63] add `CCString.Split.{left,right}_exn` --- src/core/CCString.cppo.ml | 16 ++++++++++------ src/core/CCString.mli | 10 ++++++++++ 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index dacda08b..0574eab9 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -199,15 +199,19 @@ module Split = struct let seq ~by s = _mkseq ~by s _tuple3 let seq_cpy ~by s = _mkseq ~by s String.sub - let left ~by s = + let left_exn ~by s = let i = find ~sub:by s in - if i = ~-1 then None - else Some (String.sub s 0 i, String.sub s (i+1) (String.length s - i - 1)) + if i = ~-1 then raise Not_found + else String.sub s 0 i, String.sub s (i+1) (String.length s - i - 1) - let right ~by s = + 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 None - else Some (String.sub s 0 i, String.sub s (i+1) (String.length s - i - 1)) + if i = ~-1 then raise Not_found + else String.sub s 0 i, String.sub s (i+1) (String.length s - i - 1) + + let right ~by s = try Some (right_exn ~by s) with Not_found -> None end let compare_versions a b = diff --git a/src/core/CCString.mli b/src/core/CCString.mli index b9201530..dd2b82d5 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -299,6 +299,11 @@ module Split : sig the string @since 0.12 *) + val left_exn : by:string -> string -> string * string + (** Split on the first occurrence of [by] from the leftmost part of the string + @raise Not_found if [by] is not part of the string + @since NEXT_RELEASE *) + (*$T Split.left ~by:" " "ab cde f g " = Some ("ab", "cde f g ") Split.left ~by:"_" "abcde" = None @@ -309,6 +314,11 @@ module Split : sig the string @since 0.12 *) + val right_exn : by:string -> string -> string * string + (** Split on the first occurrence of [by] from the rightmost part of the string + @raise Not_found if [by] is not part of the string + @since NEXT_RELEASE *) + (*$T Split.right ~by:" " "ab cde f g" = Some ("ab cde f", "g") Split.right ~by:"_" "abcde" = None From bb37ea469db464bfb434c08291dda901a9304aef Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 21 Feb 2016 00:13:40 +0100 Subject: [PATCH 44/63] add `CCPair.make` --- src/core/CCPair.ml | 2 ++ src/core/CCPair.mli | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/src/core/CCPair.ml b/src/core/CCPair.ml index 7b763cb5..b222be6e 100644 --- a/src/core/CCPair.ml +++ b/src/core/CCPair.ml @@ -5,6 +5,8 @@ type ('a,'b) t = ('a * 'b) +let make x y = x,y + let map1 f (x,y) = f x,y let map2 f (x,y) = x,f y diff --git a/src/core/CCPair.mli b/src/core/CCPair.mli index ca4a2c79..a63d1f3e 100644 --- a/src/core/CCPair.mli +++ b/src/core/CCPair.mli @@ -5,6 +5,10 @@ type ('a,'b) t = ('a * 'b) +val make : 'a -> 'b -> ('a, 'b) t +(** Make a tuple from its components + @since NEXT_RELEASE *) + val map1 : ('a -> 'b) -> ('a * 'c) -> ('b * 'c) val map2 : ('a -> 'b) -> ('c * 'a) -> ('c * 'b) From 6dfd51d17d2530041a65102357c689c9fb062ce5 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 21 Feb 2016 16:40:32 +0100 Subject: [PATCH 45/63] deprecate `containers.bigarray` --- README.adoc | 2 +- doc/intro.txt | 1 + src/bigarray/CCArray1.mli | 4 +++- src/bigarray/CCBigstring.ml | 24 +----------------------- src/bigarray/CCBigstring.mli | 30 ++++++------------------------ 5 files changed, 12 insertions(+), 49 deletions(-) diff --git a/README.adoc b/README.adoc index 8689a4a3..26cbce77 100644 --- a/README.adoc +++ b/README.adoc @@ -31,7 +31,7 @@ What is _containers_? a LINQ-like query module, batch operations using GADTs, and others). - Utilities around the `unix` library in `containers.unix` (mainly to spawn sub-processes) -- A bigstring module using `bigarray` in `containers.bigarray` +- A bigstring module using `bigarray` in `containers.bigarray` (*deprecated*) - A lightweight S-expression printer and streaming parser in `containers.sexp` Some of the modules have been moved to their own repository (e.g. `sequence`, diff --git a/doc/intro.txt b/doc/intro.txt index 2344eccb..1b331182 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -126,6 +126,7 @@ CCParse {4 Bigarrays} +{b deprecated} (use package bigstring instead) Use bigarrays to hold large strings and map files directly into memory. {!modules: CCBigstring CCArray1} diff --git a/src/bigarray/CCArray1.mli b/src/bigarray/CCArray1.mli index ebde558e..4cb6fbea 100644 --- a/src/bigarray/CCArray1.mli +++ b/src/bigarray/CCArray1.mli @@ -25,7 +25,9 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (** {1 Bigarrays of dimension 1} - {b status: experimental} + {b NOTE this module will be removed soon and should not be depended upon} + + {b status: deprecated} @since 0.12 *) (** {2 used types} *) diff --git a/src/bigarray/CCBigstring.ml b/src/bigarray/CCBigstring.ml index a22fe168..4dcef050 100644 --- a/src/bigarray/CCBigstring.ml +++ b/src/bigarray/CCBigstring.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, 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 Interface to 1-dimension Bigarrays of bytes (char)} *) diff --git a/src/bigarray/CCBigstring.mli b/src/bigarray/CCBigstring.mli index 6eb0143b..5c8c6a9a 100644 --- a/src/bigarray/CCBigstring.mli +++ b/src/bigarray/CCBigstring.mli @@ -1,31 +1,13 @@ -(* -copyright (c) 2013-2014, 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 Interface to 1-dimension Bigarrays of bytes (char)} -@since 0.7 *) + @deprecated use the package [bigstring] instead. + + {b status: deprecated, do not use anymore} + + @since 0.7 *) type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t From 34b1a4f9ae7627b47db2995050c590ab7ab5b21a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 21 Feb 2016 17:15:27 +0100 Subject: [PATCH 46/63] add counter function in `CCHashtbl`, to replace `CCHashtbl.Counter` --- src/core/CCHashtbl.ml | 77 ++++++++++++++++++++++++++++++++++++++++-- src/core/CCHashtbl.mli | 54 +++++++++++++++++++++++++++++ 2 files changed, 129 insertions(+), 2 deletions(-) diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index 665ff329..d5089e6b 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -30,6 +30,20 @@ let values tbl k = Hashtbl.iter (fun _ v -> k v) tbl let keys_list tbl = Hashtbl.fold (fun k _ a -> k::a) tbl [] let values_list tbl = Hashtbl.fold (fun _ v a -> v::a) tbl [] +let incr ?(by=1) tbl x = + let n = get_or tbl x ~or_:0 in + if n+by <= 0 + then Hashtbl.remove tbl x + else Hashtbl.replace tbl x (n+by) + +let decr ?(by=1) tbl x = + try + let n = Hashtbl.find tbl x in + if n-by <= 0 + then Hashtbl.remove tbl x + else Hashtbl.replace tbl x (n-by) + with Not_found -> () + let map_list f h = Hashtbl.fold (fun x y acc -> f x y :: acc) @@ -42,9 +56,18 @@ let map_list f h = let to_seq tbl k = Hashtbl.iter (fun key v -> k (key,v)) tbl +let add_seq tbl seq = seq (fun (k,v) -> Hashtbl.add tbl k v) + let of_seq seq = let tbl = Hashtbl.create 32 in - seq (fun (k,v) -> Hashtbl.add tbl k v); + add_seq tbl seq; + tbl + +let add_seq_count tbl seq = seq (fun k -> incr tbl k) + +let of_seq_count seq = + let tbl = Hashtbl.create 32 in + add_seq_count tbl seq; tbl let to_list tbl = @@ -102,6 +125,19 @@ module type S = sig and returns [or_] otherwise (if [k] doesn't belong in [tbl]) @since NEXT_RELEASE *) + val incr : ?by:int -> int t -> key -> unit + (** [incr ?by tbl x] increments or initializes the counter associated with [x]. + If [get tbl x = None], then after update, [get tbl x = Some 1]; + otherwise, if [get tbl x = Some n], now [get tbl x = Some (n+1)]. + @param by if specified, the int value is incremented by [by] rather than 1 + @since NEXT_RELEASE *) + + val decr : ?by:int -> int t -> key -> unit + (** Same as {!incr} but substract 1 (or the value of [by]). + If the value reaches 0, the key is removed from the table. + This does nothing if the key is not already present in the table. + @since NEXT_RELEASE *) + val keys : 'a t -> key sequence (** Iterate on keys (similar order as {!Hashtbl.iter}) *) @@ -125,6 +161,20 @@ module type S = sig val of_seq : (key * 'a) sequence -> 'a t (** From the given bindings, added in order *) + val add_seq : 'a t -> (key * 'a) sequence -> unit + (** Add the corresponding pairs to the table, using {!Hashtbl.add}. + @since NEXT_RELEASE *) + + val add_seq_count : int t -> key sequence -> unit + (** [add_seq_count tbl seq] increments the count of each element of [seq] + by calling {!incr}. This is useful for counting how many times each + element of [seq] occurs. + @since NEXT_RELEASE *) + + val of_seq_count : key sequence -> int t + (** Similar to {!add_seq_count}, but allocates a new table and returns it + @since NEXT_RELEASE *) + val to_list : 'a t -> (key * 'a) list (** List of bindings (order unspecified) *) @@ -166,6 +216,20 @@ module Make(X : Hashtbl.HashedType) "b" (let tbl = T.of_list [1,"a"; 2,"b"] in T.get_or tbl 2 ~or_:"c") *) + let incr ?(by=1) tbl x = + let n = get_or tbl x ~or_:0 in + if n+by <= 0 + then remove tbl x + else replace tbl x (n+by) + + let decr ?(by=1) tbl x = + try + let n = find tbl x in + if n-by <= 0 + then remove tbl x + else replace tbl x (n-by) + with Not_found -> () + let keys tbl k = iter (fun key _ -> k key) tbl let values tbl k = iter (fun _ v -> k v) tbl @@ -188,9 +252,18 @@ module Make(X : Hashtbl.HashedType) let to_seq tbl k = iter (fun key v -> k (key,v)) tbl + let add_seq tbl seq = seq (fun (k,v) -> add tbl k v) + let of_seq seq = let tbl = create 32 in - seq (fun (k,v) -> add tbl k v); + add_seq tbl seq; + tbl + + let add_seq_count tbl seq = seq (fun k -> incr tbl k) + + let of_seq_count seq = + let tbl = create 32 in + add_seq_count tbl seq; tbl let to_list tbl = diff --git a/src/core/CCHashtbl.mli b/src/core/CCHashtbl.mli index bcbb8187..f6c88c28 100644 --- a/src/core/CCHashtbl.mli +++ b/src/core/CCHashtbl.mli @@ -37,12 +37,39 @@ val values_list : ('a, 'b) Hashtbl.t -> 'b list val map_list : ('a -> 'b -> 'c) -> ('a, 'b) Hashtbl.t -> 'c list (** Map on a hashtable's items, collect into a list *) +val incr : ?by:int -> ('a, int) Hashtbl.t -> 'a -> unit +(** [incr ?by tbl x] increments or initializes the counter associated with [x]. + If [get tbl x = None], then after update, [get tbl x = Some 1]; + otherwise, if [get tbl x = Some n], now [get tbl x = Some (n+1)]. + @param by if specified, the int value is incremented by [by] rather than 1 + @since NEXT_RELEASE *) + +val decr : ?by:int -> ('a, int) Hashtbl.t -> 'a -> unit +(** Same as {!incr} but substract 1 (or the value of [by]). + If the value reaches 0, the key is removed from the table. + This does nothing if the key is not already present in the table. + @since NEXT_RELEASE *) + val to_seq : ('a,'b) Hashtbl.t -> ('a * 'b) sequence (** Iterate on bindings in the table *) +val add_seq : ('a,'b) Hashtbl.t -> ('a * 'b) sequence -> unit +(** Add the corresponding pairs to the table, using {!Hashtbl.add}. + @since NEXT_RELEASE *) + val of_seq : ('a * 'b) sequence -> ('a,'b) Hashtbl.t (** From the given bindings, added in order *) +val add_seq_count : ('a, int) Hashtbl.t -> 'a sequence -> unit +(** [add_seq_count tbl seq] increments the count of each element of [seq] + by calling {!incr}. This is useful for counting how many times each + element of [seq] occurs. + @since NEXT_RELEASE *) + +val of_seq_count : 'a sequence -> ('a, int) Hashtbl.t +(** Similar to {!add_seq_count}, but allocates a new table and returns it + @since NEXT_RELEASE *) + val to_list : ('a,'b) Hashtbl.t -> ('a * 'b) list (** List of bindings (order unspecified) *) @@ -74,6 +101,19 @@ module type S = sig and returns [or_] otherwise (if [k] doesn't belong in [tbl]) @since NEXT_RELEASE *) + val incr : ?by:int -> int t -> key -> unit + (** [incr ?by tbl x] increments or initializes the counter associated with [x]. + If [get tbl x = None], then after update, [get tbl x = Some 1]; + otherwise, if [get tbl x = Some n], now [get tbl x = Some (n+1)]. + @param by if specified, the int value is incremented by [by] rather than 1 + @since NEXT_RELEASE *) + + val decr : ?by:int -> int t -> key -> unit + (** Same as {!incr} but substract 1 (or the value of [by]). + If the value reaches 0, the key is removed from the table. + This does nothing if the key is not already present in the table. + @since NEXT_RELEASE *) + val keys : 'a t -> key sequence (** Iterate on keys (similar order as {!Hashtbl.iter}) *) @@ -97,6 +137,20 @@ module type S = sig val of_seq : (key * 'a) sequence -> 'a t (** From the given bindings, added in order *) + val add_seq : 'a t -> (key * 'a) sequence -> unit + (** Add the corresponding pairs to the table, using {!Hashtbl.add}. + @since NEXT_RELEASE *) + + val add_seq_count : int t -> key sequence -> unit + (** [add_seq_count tbl seq] increments the count of each element of [seq] + by calling {!incr}. This is useful for counting how many times each + element of [seq] occurs. + @since NEXT_RELEASE *) + + val of_seq_count : key sequence -> int t + (** Similar to {!add_seq_count}, but allocates a new table and returns it + @since NEXT_RELEASE *) + val to_list : 'a t -> (key * 'a) list (** List of bindings (order unspecified) *) From 822a6d806c5a944716748d9b947db675a67df0d9 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 21 Feb 2016 17:16:22 +0100 Subject: [PATCH 47/63] bugfix: fix wrong signature of `CCHashtbl.Make.{keys,values}_list` --- src/core/CCHashtbl.ml | 8 ++++---- src/core/CCHashtbl.mli | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index d5089e6b..daf462e0 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -144,11 +144,11 @@ module type S = sig val values : 'a t -> 'a sequence (** Iterate on values in the table *) - val keys_list : ('a, 'b) Hashtbl.t -> 'a list + val keys_list : _ t -> key list (** [keys t] is the list of keys in [t]. @since 0.8 *) - val values_list : ('a, 'b) Hashtbl.t -> 'b list + val values_list : 'a t -> 'a list (** [values t] is the list of values in [t]. @since 0.8 *) @@ -234,8 +234,8 @@ module Make(X : Hashtbl.HashedType) let values tbl k = iter (fun _ v -> k v) tbl - let keys_list tbl = Hashtbl.fold (fun k _ a -> k::a) tbl [] - let values_list tbl = Hashtbl.fold (fun _ v a -> v::a) tbl [] + let keys_list tbl = fold (fun k _ a -> k::a) tbl [] + let values_list tbl = fold (fun _ v a -> v::a) tbl [] let map_list f h = fold diff --git a/src/core/CCHashtbl.mli b/src/core/CCHashtbl.mli index f6c88c28..b43e4b33 100644 --- a/src/core/CCHashtbl.mli +++ b/src/core/CCHashtbl.mli @@ -120,11 +120,11 @@ module type S = sig val values : 'a t -> 'a sequence (** Iterate on values in the table *) - val keys_list : ('a, 'b) Hashtbl.t -> 'a list + val keys_list : _ t -> key list (** [keys t] is the list of keys in [t]. @since 0.8 *) - val values_list : ('a, 'b) Hashtbl.t -> 'b list + val values_list : 'a t -> 'a list (** [values t] is the list of values in [t]. @since 0.8 *) From 485c6a11b549cfbcf29b73902ce11a9feceddae5 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 21 Feb 2016 17:19:19 +0100 Subject: [PATCH 48/63] test --- src/core/CCHashtbl.ml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index daf462e0..66971f1b 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -222,6 +222,20 @@ module Make(X : Hashtbl.HashedType) then remove tbl x else replace tbl x (n+by) + (*$R + let tbl = T.create 32 in + T.incr tbl 1 ; + T.incr tbl 2; + T.incr tbl 1; + assert_equal 2 (T.find tbl 1); + assert_equal 1 (T.find tbl 2); + assert_equal 2 (T.length tbl); + T.decr tbl 2; + assert_equal 0 (T.get_or tbl 2 ~or_:0); + assert_equal 1 (T.length tbl); + assert_bool "2 removed" (not (T.mem tbl 2)); + *) + let decr ?(by=1) tbl x = try let n = find tbl x in From 26298516b5e469dc040fc854a8059b5981e071b2 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 21 Feb 2016 21:26:02 +0100 Subject: [PATCH 49/63] add `CCHashtbl.add_list` --- src/core/CCHashtbl.ml | 13 +++++++++++++ src/core/CCHashtbl.mli | 10 ++++++++++ 2 files changed, 23 insertions(+) diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index 66971f1b..a2ec9922 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -30,6 +30,10 @@ let values tbl k = Hashtbl.iter (fun _ v -> k v) tbl let keys_list tbl = Hashtbl.fold (fun k _ a -> k::a) tbl [] let values_list tbl = Hashtbl.fold (fun _ v a -> v::a) tbl [] +let add_list tbl k v = + let l = try Hashtbl.find tbl k with Not_found -> [] in + Hashtbl.replace tbl k (v::l) + let incr ?(by=1) tbl x = let n = get_or tbl x ~or_:0 in if n+by <= 0 @@ -125,6 +129,11 @@ module type S = sig and returns [or_] otherwise (if [k] doesn't belong in [tbl]) @since NEXT_RELEASE *) + val add_list : 'a list t -> key -> 'a -> unit + (** [add_list tbl x y] adds [y] to the list [x] is bound to. If [x] is + not bound, it becomes bound to [[y]]. + @since NEXT_RELEASE *) + val incr : ?by:int -> int t -> key -> unit (** [incr ?by tbl x] increments or initializes the counter associated with [x]. If [get tbl x = None], then after update, [get tbl x = Some 1]; @@ -236,6 +245,10 @@ module Make(X : Hashtbl.HashedType) assert_bool "2 removed" (not (T.mem tbl 2)); *) + let add_list tbl k v = + let l = try find tbl k with Not_found -> [] in + replace tbl k (v::l) + let decr ?(by=1) tbl x = try let n = find tbl x in diff --git a/src/core/CCHashtbl.mli b/src/core/CCHashtbl.mli index b43e4b33..2e51e6bd 100644 --- a/src/core/CCHashtbl.mli +++ b/src/core/CCHashtbl.mli @@ -53,6 +53,11 @@ val decr : ?by:int -> ('a, int) Hashtbl.t -> 'a -> unit val to_seq : ('a,'b) Hashtbl.t -> ('a * 'b) sequence (** Iterate on bindings in the table *) +val add_list : ('a, 'b list) Hashtbl.t -> 'a -> 'b -> unit +(** [add_list tbl x y] adds [y] to the list [x] is bound to. If [x] is + not bound, it becomes bound to [[y]]. + @since NEXT_RELEASE *) + val add_seq : ('a,'b) Hashtbl.t -> ('a * 'b) sequence -> unit (** Add the corresponding pairs to the table, using {!Hashtbl.add}. @since NEXT_RELEASE *) @@ -101,6 +106,11 @@ module type S = sig and returns [or_] otherwise (if [k] doesn't belong in [tbl]) @since NEXT_RELEASE *) + val add_list : 'a list t -> key -> 'a -> unit + (** [add_list tbl x y] adds [y] to the list [x] is bound to. If [x] is + not bound, it becomes bound to [[y]]. + @since NEXT_RELEASE *) + val incr : ?by:int -> int t -> key -> unit (** [incr ?by tbl x] increments or initializes the counter associated with [x]. If [get tbl x = None], then after update, [get tbl x = Some 1]; From db1de6e6e666f726e7c09098c071c064a43a9281 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 21 Feb 2016 21:45:14 +0100 Subject: [PATCH 50/63] add `CCGraph.make` and utils --- src/data/CCGraph.ml | 10 ++++++++++ src/data/CCGraph.mli | 17 +++++++++++++++++ 2 files changed, 27 insertions(+) diff --git a/src/data/CCGraph.ml b/src/data/CCGraph.ml index f5a12a86..37a9da15 100644 --- a/src/data/CCGraph.ml +++ b/src/data/CCGraph.ml @@ -56,6 +56,16 @@ type ('v, 'e) t = { type ('v, 'e) graph = ('v, 'e) t +let make ~origin ~dest f = {origin; dest; children=f; } + +let make_labelled_tuple f = + make ~origin:(fun (x,_,_) -> x) ~dest:(fun (_,_,x) -> x) + (fun v yield -> f v (fun (l,v') -> yield (v,l,v'))) + +let make_tuple f = + make ~origin:fst ~dest:snd + (fun v yield -> f v (fun v' -> yield (v,v'))) + (** Mutable bitset for values of type ['v] *) type 'v tag_set = { get_tag: 'v -> bool; diff --git a/src/data/CCGraph.mli b/src/data/CCGraph.mli index 15911375..f4d47edf 100644 --- a/src/data/CCGraph.mli +++ b/src/data/CCGraph.mli @@ -76,6 +76,23 @@ type ('v, 'e) t = { type ('v, 'e) graph = ('v, 'e) t +val make : + origin:('e -> 'v) -> + dest:('e -> 'v) -> + ('v -> 'e sequence) -> ('v, 'e) t +(** Make a graph by providing its fields + @since NEXT_RELEASE *) + +val make_labelled_tuple : + ('v -> ('a * 'v) sequence) -> ('v, ('v * 'a * 'v)) t +(** Make a graph with edges being triples [(origin,label,dest)] + @since NEXT_RELEASE *) + +val make_tuple : + ('v -> 'v sequence) -> ('v, ('v * 'v)) t +(** Make a graph with edges being pairs [(origin,dest)] + @since NEXT_RELEASE *) + (** Mutable tags from values of type ['v] to tags of type [bool] *) type 'v tag_set = { get_tag: 'v -> bool; From 86f170f2135399ff71065d7a515e6387461ffb8c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 23 Feb 2016 14:19:14 +0100 Subject: [PATCH 51/63] small rename --- src/core/CCResult.ml | 4 ++-- src/core/CCResult.mli | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index ed05df1d..451a338a 100644 --- a/src/core/CCResult.ml +++ b/src/core/CCResult.ml @@ -58,11 +58,11 @@ let iter f e = match e with | Ok x -> f x | Error _ -> () -exception GetOnError +exception Get_error let get_exn = function | Ok x -> x - | Error _ -> raise GetOnError + | Error _ -> raise Get_error let catch e ~ok ~err = match e with | Ok x -> ok x diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index 565591b8..691dec3d 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -56,13 +56,13 @@ val map2 : ('a -> 'b) -> ('err1 -> 'err2) -> ('a, 'err1) t -> ('b, 'err2) t val iter : ('a -> unit) -> ('a, _) t -> unit (** Apply the function only in case of Ok *) -exception GetOnError +exception Get_error val get_exn : ('a, _) t -> 'a (** Extract the value [x] from [Ok x], fails otherwise. You should be careful with this function, and favor other combinators whenever possible. - @raise GetOnError if the value is an error. *) + @raise Get_error if the value is an error. *) val catch : ('a, 'err) t -> ok:('a -> 'b) -> err:('err -> 'b) -> 'b (** [catch e ~ok ~err] calls either [ok] or [err] depending on From 16ac701de17fff3501cd6706946aac279267ab27 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 23 Feb 2016 14:21:37 +0100 Subject: [PATCH 52/63] add `CCResult.{map_or,get_or}` --- src/core/CCResult.ml | 8 ++++++++ src/core/CCResult.mli | 6 ++++++ 2 files changed, 14 insertions(+) diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index 451a338a..57e48752 100644 --- a/src/core/CCResult.ml +++ b/src/core/CCResult.ml @@ -64,6 +64,14 @@ let get_exn = function | Ok x -> x | Error _ -> raise Get_error +let get_or e ~default = match e with + | Ok x -> x + | Error _ -> default + +let map_or f e ~default = match e with + | Ok x -> f x + | Error _ -> default + let catch e ~ok ~err = match e with | Ok x -> ok x | Error y -> err y diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index 691dec3d..411c2246 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -64,6 +64,12 @@ val get_exn : ('a, _) t -> 'a whenever possible. @raise Get_error if the value is an error. *) +val get_or : ('a, _) t -> default:'a -> 'a +(** [get_or e ~default] returns [x] if [e = Ok x], [default] otherwise *) + +val map_or : ('a -> 'b) -> ('a, 'b) t -> default:'b -> 'b +(** [map_or f e ~default] returns [f x] if [e = Ok x], [default] otherwise *) + val catch : ('a, 'err) t -> ok:('a -> 'b) -> err:('err -> 'b) -> 'b (** [catch e ~ok ~err] calls either [ok] or [err] depending on the value of [e]. *) From 23e3544adce9254fec1ffa30f4f446fb903120cf Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 23 Feb 2016 15:34:26 +0100 Subject: [PATCH 53/63] add `CCList.hd_tl` --- src/core/CCList.ml | 9 +++++++++ src/core/CCList.mli | 5 +++++ 2 files changed, 14 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index def7c977..bef9b423 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -454,6 +454,15 @@ let rec drop n l = match l with | _ when n=0 -> l | _::l' -> drop (n-1) l' +let hd_tl = function + | [] -> failwith "hd_tl" + | x :: l -> x, l + +(*$T + try ignore (hd_tl []); false with Failure _ -> true + hd_tl [1;2;3] = (1, [2;3]) +*) + let take_drop n l = take n l, drop n l let split = take_drop diff --git a/src/core/CCList.mli b/src/core/CCList.mli index b665c918..ef7e0d3d 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -106,6 +106,11 @@ val take : int -> 'a t -> 'a t val drop : int -> 'a t -> 'a t (** Drop the [n] first elements, keep the rest *) +val hd_tl : 'a t -> 'a * 'a t +(** [hd_tl (x :: l)] returns [hd, l]. + @raise Failure if the list is empty + @since NEXT_RELEASE *) + val take_drop : int -> 'a t -> 'a t * 'a t (** [take_drop n l] returns [l1, l2] such that [l1 @ l2 = l] and [length l1 = min (length l) n] *) From b3d7a0d6541592eb36774866603d99866e730244 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 23 Feb 2016 17:13:12 +0100 Subject: [PATCH 54/63] missing constraint in `CCSexpM.ID_MONAD` --- src/sexp/CCSexpM.mli | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/sexp/CCSexpM.mli b/src/sexp/CCSexpM.mli index 66186e75..a7c8c9a8 100644 --- a/src/sexp/CCSexpM.mli +++ b/src/sexp/CCSexpM.mli @@ -86,9 +86,10 @@ module MakeDecode(M : MONAD) : sig long enough or isn't a proper S-expression *) end -module ID_MONAD : MONAD +module ID_MONAD : MONAD with type 'a t = 'a (** The monad that just uses blocking calls as bind - @since 0.14 *) + @since 0.14 + ['a t = 'a] contraint is @since NEXT_RELEASE *) module D : module type of MakeDecode(ID_MONAD) (** Decoder that just blocks when input is not available From cb9dc595676f87ed275e961500a957322a425cae Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 24 Feb 2016 19:36:36 +0100 Subject: [PATCH 55/63] simplify .merlin --- .merlin | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/.merlin b/.merlin index dcf99f7b..3b321723 100644 --- a/.merlin +++ b/.merlin @@ -12,17 +12,7 @@ S src/bigarray S benchs S examples S tests -B _build/src/core -B _build/src/data/ -B _build/src/io -B _build/src/iter/ -B _build/src/advanced/ -B _build/src/lwt/ -B _build/src/sexp/ -B _build/src/threads/ -B _build/src/misc -B _build/src/string -B _build/src/bigarray +B _build/src/** B _build/benchs B _build/examples B _build/tests From 33b61e8babc14158665b99b9679394237a66ec09 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 24 Feb 2016 20:01:18 +0100 Subject: [PATCH 56/63] add `CCFormat.{h,v,hov,hv}box` printer combinators --- src/core/CCFormat.ml | 20 ++++++++++++++++++++ src/core/CCFormat.mli | 21 ++++++++++++++++++++- 2 files changed, 40 insertions(+), 1 deletion(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index cd12650e..8fd37a8e 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -89,6 +89,26 @@ let map f pp fmt x = pp fmt (f x); () +let vbox ?(i=0) pp out x = + Format.pp_open_vbox out i; + pp out x; + Format.pp_close_box out () + +let hovbox ?(i=0) pp out x = + Format.pp_open_hovbox out i; + pp out x; + Format.pp_close_box out () + +let hvbox ?(i=0) pp out x = + Format.pp_open_hvbox out i; + pp out x; + Format.pp_close_box out () + +let hbox pp out x = + Format.pp_open_hbox out (); + pp out x; + Format.pp_close_box out () + (** {2 IO} *) let output fmt pp x = pp fmt x diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 3bf7f622..8a328f77 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -44,7 +44,26 @@ val quad : 'a printer -> 'b printer -> 'c printer -> 'd printer -> ('a * 'b * 'c val map : ('a -> 'b) -> 'b printer -> 'a printer -(** {2 ASCII codes} +val vbox : ?i:int -> 'a printer -> 'a printer +(** Wrap the printer in a vertical box + @param i level of indentation within the box (default 0) + @since NEXT_RELEASE *) + +val hvbox : ?i:int -> 'a printer -> 'a printer +(** Wrap the printer in a horizontal/vertical box + @param i level of indentation within the box (default 0) + @since NEXT_RELEASE *) + +val hovbox : ?i:int -> 'a printer -> 'a printer +(** Wrap the printer in a horizontal or vertical box + @param i level of indentation within the box (default 0) + @since NEXT_RELEASE *) + +val hbox : 'a printer -> 'a printer +(** Wrap the printer in an horizontal box + @since NEXT_RELEASE *) + +(** {2 ANSI codes} Use ANSI escape codes https://en.wikipedia.org/wiki/ANSI_escape_code to put some colors on the terminal. From 5cdf59f30c3cb9edd07c346a8d895cc5d76c54cb Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 24 Feb 2016 20:37:56 +0100 Subject: [PATCH 57/63] add `CCOpt.map_or`, deprecating `CCopt.maybe` --- src/core/CCOpt.ml | 6 ++++-- src/core/CCOpt.mli | 8 +++++++- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/src/core/CCOpt.ml b/src/core/CCOpt.ml index fa2b7b30..4427e332 100644 --- a/src/core/CCOpt.ml +++ b/src/core/CCOpt.ml @@ -9,10 +9,12 @@ let map f = function | None -> None | Some x -> Some (f x) -let maybe f d = function - | None -> d +let map_or ~default f = function + | None -> default | Some x -> f x +let maybe f default = map_or ~default f + let is_some = function | None -> false | Some _ -> true diff --git a/src/core/CCOpt.mli b/src/core/CCOpt.mli index 64d1c7f9..f14ca823 100644 --- a/src/core/CCOpt.mli +++ b/src/core/CCOpt.mli @@ -9,7 +9,13 @@ val map : ('a -> 'b) -> 'a t -> 'b t (** Transform the element inside, if any *) val maybe : ('a -> 'b) -> 'b -> 'a t -> 'b -(** [maybe f x o] is [x] if [o] is [None], otherwise it's [f y] if [o = Some y] *) +(** [maybe f x o] is [x] if [o] is [None], + otherwise it's [f y] if [o = Some y] + @deprecated, use {!map_or} *) + +val map_or : default:'b -> ('a -> 'b) -> 'a t -> 'b +(** [map_or ~default f o] is [f x] if [o = Some x], [default otherwise] + @since NEXT_RELEASE *) val is_some : _ t -> bool From 903dac110bf180c8d56151615da83f101bd61d41 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 24 Feb 2016 20:38:22 +0100 Subject: [PATCH 58/63] add `{CCList,CCOpt}.Infix` modules --- src/core/CCList.ml | 9 +++++++++ src/core/CCList.mli | 15 +++++++++++++++ src/core/CCOpt.ml | 8 ++++++++ src/core/CCOpt.mli | 10 ++++++++++ 4 files changed, 42 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index bef9b423..76612fee 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -1081,6 +1081,15 @@ let of_klist l = in direct direct_depth_default_ l +module Infix = struct + let (>|=) = (>|=) + let (@) = (@) + let (<*>) = (<*>) + let (<$>) = (<$>) + let (>>=) = (>>=) + let (--) = (--) +end + (** {2 IO} *) let pp ?(start="[") ?(stop="]") ?(sep=", ") pp_item buf l = diff --git a/src/core/CCList.mli b/src/core/CCList.mli index ef7e0d3d..005507ae 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -465,6 +465,21 @@ val of_gen : 'a gen -> 'a t val to_klist : 'a t -> 'a klist val of_klist : 'a klist -> 'a t +(** {2 Infix Operators} + It is convenient to {!open CCList.Infix} to access the infix operators + without cluttering the scope too much. + + @since NEXT_RELEASE *) + +module Infix : sig + val (>|=) : 'a t -> ('a -> 'b) -> 'b t + val (@) : 'a t -> 'a t -> 'a t + val (<*>) : ('a -> 'b) t -> 'a t -> 'b t + val (<$>) : ('a -> 'b) -> 'a t -> 'b t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t + val (--) : int -> int -> int t +end + (** {2 IO} *) val pp : ?start:string -> ?stop:string -> ?sep:string -> diff --git a/src/core/CCOpt.ml b/src/core/CCOpt.ml index 4427e332..4753315d 100644 --- a/src/core/CCOpt.ml +++ b/src/core/CCOpt.ml @@ -123,6 +123,14 @@ let of_list = function | x::_ -> Some x | [] -> None +module Infix = struct + let (>|=) = (>|=) + let (>>=) = (>>=) + let (<*>) = (<*>) + let (<$>) = (<$>) + let (<+>) = (<+>) +end + type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option type 'a printer = Buffer.t -> 'a -> unit diff --git a/src/core/CCOpt.mli b/src/core/CCOpt.mli index f14ca823..63c763a8 100644 --- a/src/core/CCOpt.mli +++ b/src/core/CCOpt.mli @@ -93,6 +93,16 @@ val (<+>) : 'a t -> 'a t -> 'a t val choice : 'a t list -> 'a t (** [choice] returns the first non-[None] element of the list, or [None] *) +(** {2 Infix Operators} + @since NEXT_RELEASE *) + +module Infix : sig + val (>|=) : 'a t -> ('a -> 'b) -> 'b t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t + val (<*>) : ('a -> 'b) t -> 'a t -> 'b t + val (<$>) : ('a -> 'b) -> 'a t -> 'b t + val (<+>) : 'a t -> 'a t -> 'a t +end (** {2 Conversion and IO} *) From ac6900976a18a4585a3579ed80fff368f9844eb7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 24 Feb 2016 21:46:01 +0100 Subject: [PATCH 59/63] add a printer into CCHeap --- src/core/CCHeap.ml | 12 ++++++++++++ src/core/CCHeap.mli | 4 ++++ 2 files changed, 16 insertions(+) diff --git a/src/core/CCHeap.ml b/src/core/CCHeap.ml index 3cca9304..fb47a491 100644 --- a/src/core/CCHeap.ml +++ b/src/core/CCHeap.ml @@ -5,6 +5,7 @@ type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option +type 'a printer = Format.formatter -> 'a -> unit type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list] @@ -127,6 +128,9 @@ module type S = sig val to_gen : t -> elt gen val to_tree : t -> elt ktree + + val print : ?sep:string -> elt printer -> t printer + (** @since NEXT_RELEASE *) end module Make(E : PARTIAL_ORD) : S with type elt = E.t = struct @@ -273,4 +277,12 @@ module Make(E : PARTIAL_ORD) : S with type elt = E.t = struct let rec to_tree h () = match h with | E -> `Nil | N (_, x, l, r) -> `Node(x, [to_tree l; to_tree r]) + + let print ?(sep=",") pp_elt out h = + let first=ref true in + iter + (fun x -> + if !first then first := false else Format.fprintf out "%s@," sep; + pp_elt out x) + h end diff --git a/src/core/CCHeap.mli b/src/core/CCHeap.mli index c8c2a076..2466ced5 100644 --- a/src/core/CCHeap.mli +++ b/src/core/CCHeap.mli @@ -7,6 +7,7 @@ type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list] +type 'a printer = Format.formatter -> 'a -> unit module type PARTIAL_ORD = sig type t @@ -78,6 +79,9 @@ module type S = sig val to_gen : t -> elt gen val to_tree : t -> elt ktree + + val print : ?sep:string -> elt printer -> t printer + (** @since NEXT_RELEASE *) end module Make(E : PARTIAL_ORD) : S with type elt = E.t From 8a3b559970442f17d854373afae69e6464361735 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 24 Feb 2016 21:38:52 +0100 Subject: [PATCH 60/63] breaking: change the signature of `CCHeap.{of_gen,of_seq,of_klist}` --- src/core/CCHeap.ml | 49 ++++++++++++++++++++++++++++++++++----------- src/core/CCHeap.mli | 24 ++++++++++++++++++---- 2 files changed, 57 insertions(+), 16 deletions(-) diff --git a/src/core/CCHeap.ml b/src/core/CCHeap.ml index fb47a491..fae8dcd9 100644 --- a/src/core/CCHeap.ml +++ b/src/core/CCHeap.ml @@ -57,7 +57,7 @@ end (*$QR & ~count:30 Q.(list_of_size Gen.(return 1_000) int) (fun l -> (* put elements into a heap *) - let h = H.of_seq H.empty (Sequence.of_list l) in + let h = H.of_seq (Sequence.of_list l) in OUnit.assert_equal 1_000 (H.size h); let l' = extract_list h in is_sorted l' @@ -113,18 +113,34 @@ module type S = sig val size : t -> int (** Number of elements (linear complexity) *) - (** {2 Conversions} *) + (** {2 Conversions} + + The interface of [of_gen], [of_seq], [of_klist] + has changed @since NEXT_RELEASE (the old signatures + are now [add_seq], [add_gen], [add_klist]) *) val to_list : t -> elt list + + val add_list : t -> elt list -> t (** @since NEXT_RELEASE *) + val of_list : elt list -> t - val of_seq : t -> elt sequence -> t + val add_seq : t -> elt sequence -> t (** @since NEXT_RELEASE *) + + val of_seq : elt sequence -> t + val to_seq : t -> elt sequence - val of_klist : t -> elt klist -> t + val add_klist : t -> elt klist -> t (** @since NEXT_RELEASE *) + + val of_klist : elt klist -> t + val to_klist : t -> elt klist - val of_gen : t -> elt gen -> t + val add_gen : t -> elt gen -> t (** @since NEXT_RELEASE *) + + val of_gen : elt gen -> t + val to_gen : t -> elt gen val to_tree : t -> elt ktree @@ -222,20 +238,26 @@ module Make(E : PARTIAL_ORD) : S with type elt = E.t = struct x::aux (aux acc l) r in aux [] h - let of_list l = List.fold_left add empty l + let add_list h l = List.fold_left add h l - let of_seq h seq = + let of_list l = add_list empty l + + let add_seq h seq = let h = ref h in seq (fun x -> h := insert x !h); !h + let of_seq seq = add_seq empty seq + let to_seq h k = iter k h - let rec of_klist h l = match l() with + let rec add_klist h l = match l() with | `Nil -> h | `Cons (x, l') -> let h' = add h x in - of_klist h' l' + add_klist h' l' + + let of_klist l = add_klist empty l let to_klist h = let rec next stack () = match stack with @@ -246,10 +268,12 @@ module Make(E : PARTIAL_ORD) : S with type elt = E.t = struct in next [h] - let rec of_gen h g = match g () with + let rec add_gen h g = match g () with | None -> h | Some x -> - of_gen (add h x) g + add_gen (add h x) g + + let of_gen g = add_gen empty g let to_gen h = let stack = Stack.create () in @@ -267,7 +291,8 @@ module Make(E : PARTIAL_ORD) : S with type elt = E.t = struct (*$Q Q.(list int) (fun l -> \ - extract_list (H.of_list l) = extract_list (H.of_gen H.empty (CCList.to_gen l))) + extract_list (H.of_list l) = \ + extract_list (H.of_gen (CCList.to_gen l))) Q.(list int) (fun l -> \ let h = H.of_list l in \ (H.to_gen h |> CCList.of_gen |> List.sort Pervasives.compare) \ diff --git a/src/core/CCHeap.mli b/src/core/CCHeap.mli index 2466ced5..ca588e5a 100644 --- a/src/core/CCHeap.mli +++ b/src/core/CCHeap.mli @@ -64,18 +64,34 @@ module type S = sig val size : t -> int (** Number of elements (linear complexity) *) - (** {2 Conversions} *) + (** {2 Conversions} + + The interface of [of_gen], [of_seq], [of_klist] + has changed @since NEXT_RELEASE (the old signatures + are now [add_seq], [add_gen], [add_klist]) *) val to_list : t -> elt list + + val add_list : t -> elt list -> t (** @since NEXT_RELEASE *) + val of_list : elt list -> t - val of_seq : t -> elt sequence -> t + val add_seq : t -> elt sequence -> t (** @since NEXT_RELEASE *) + + val of_seq : elt sequence -> t + val to_seq : t -> elt sequence - val of_klist : t -> elt klist -> t + val add_klist : t -> elt klist -> t (** @since NEXT_RELEASE *) + + val of_klist : elt klist -> t + val to_klist : t -> elt klist - val of_gen : t -> elt gen -> t + val add_gen : t -> elt gen -> t (** @since NEXT_RELEASE *) + + val of_gen : elt gen -> t + val to_gen : t -> elt gen val to_tree : t -> elt ktree From 6674f5750b7fa13e2a28c748950fa637b1289932 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 24 Feb 2016 21:21:52 +0100 Subject: [PATCH 61/63] add a tutorial file --- .gitignore | 1 + README.adoc | 4 +- TUTORIAL.adoc | 175 ++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 179 insertions(+), 1 deletion(-) create mode 100644 TUTORIAL.adoc diff --git a/.gitignore b/.gitignore index 8f50b9ea..8d2ffd6d 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,4 @@ TAGS *.docdir setup.* qtest* +*.html diff --git a/README.adoc b/README.adoc index 26cbce77..175483da 100644 --- a/README.adoc +++ b/README.adoc @@ -4,7 +4,7 @@ image::media/logo.png[logo] -What is _containers_? +What is _containers_? (take a look at the link:TUTORIAL.adoc[tutorial]!) - A usable, reasonably well-designed library that extends OCaml's standard library (in 'src/core/', packaged under `containers` in ocamlfind. Modules @@ -55,6 +55,8 @@ See link:CHANGELOG.adoc[this file]. == Use +Start with the link:TUTORIAL.adoc[tutorial] + You can either build and install the library (see <>), or just copy files to your own project. The last solution has the benefits that you don't have additional dependencies nor build complications (and it may enable diff --git a/TUTORIAL.adoc b/TUTORIAL.adoc new file mode 100644 index 00000000..205a0153 --- /dev/null +++ b/TUTORIAL.adoc @@ -0,0 +1,175 @@ += Tutorial +:source-highlighter: pygments + +This tutorial contains a few examples to illustrate the features and +usage of containers. We assume containers is installed and that +the library is loaded, e.g. with: + +[source,OCaml] +---- +#require "containers";; +---- + +We will start with a few list helpers, then look at other parts of +the library, including printers, maps, etc. + +[source,OCaml] +---- + +(* quick reminder of this awesome standard operator *) +# (|>) ;; +- : 'a -> ('a -> 'b) -> 'b = + +# open CCList.Infix;; + +# let l = 1 -- 100;; +val l : int list = [1; 2; .....] + +# l + |> CCList.filter_map + (fun x-> if x mod 3=0 then Some (float x) else None) + |> CCList.take 5 ;; +- : float list = [3.; 6.; 9.; 12.; 15.] + +# let l2 = l |> CCList.take_while (fun x -> x<10) ;; +val l2 : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9] + +(* an extension of Map.Make, compatible with Map.Make(CCInt) *) +# module IntMap = CCMap.Make(CCInt);; + +(* conversions using the "sequence" type, fast iterators that are + pervasively used in containers. Combinators can be found + in the opam library "sequence". *) +# let map = + l2 + |> List.map (fun x -> x, string_of_int x) + |> CCList.to_seq + |> IntMap.of_seq;; +val map : string CCIntMap.t = + +(* check the type *) +# CCList.to_seq ;; +- : 'a list -> 'a sequence = +# IntMap.of_seq ;; +- : (int * 'a) CCMap.sequence -> 'a IntMap.t = + +(* we can print, too *) +# Format.printf "@[<2>map =@ @[%a@]@]@." + (IntMap.print CCFormat.int CCFormat.string_quoted) + map;; +map = + [1 --> "1", 2 --> "2", 3 --> "3", 4 --> "4", 5 --> "5", 6 --> "6", + 7 --> "7", 8 --> "8", 9 --> "9"] +- : unit = () + +(* options are good *) +# IntMap.get 3 map |> CCOpt.map (fun s->s ^ s);; +- : string option = Some "33" + +---- + +== New types: `CCVector`, `CCHeap`, `CCError`, `CCResult` + +Containers also contains (!) a few datatypes that are not from the standard +library but that are useful in a lot of situations: + +CCVector:: + A resizable array, with a mutability parameter. A value of type + `('a, CCVector.ro) CCVector.t` is an immutable vector of values of type `'a`, + whereas a `('a, CCVector.rw) CCVector.t` is a mutable vector that + can be modified. This way, vectors can be used in a quite functional + way, using operations such as `map` or `flat_map`, or in a more + imperative way. +CCHeap:: + A priority queue (currently, leftist heaps) functorized over + a module `sig val t val leq : t -> t -> bool` that provides a type `t` + and a partial order `leq` on `t`. +CCError:: + An error type for making error handling more explicit (an error monad, + really, if you're not afraid of the "M"-word). It is similar to the + more recent `CCResult`, but works with polymorphic variants for + compatibility with the numerous libraries that use the same type, + that is, `type ('a, 'b) CCError.t = [`Ok of 'a | `Error of 'b]`. +CCResult:: + It uses the new `result` type from the standard library (or from + the retrocompatibility package on opam), and presents an interface + similar to `CCError`. In an indeterminate amount of time, it will + totally replace `CCError`. + +Now for a few examples: + +[source,OCaml] +---- + +(* create a new empty vector. It is mutable, for otherwise it would + not be very useful. *) +# CCVector.create;; +- : unit -> ('a, CCVector.rw) CCVector.t = + +(* init, similar to Array.init, can be used to produce a + vector that is mutable OR immutable (see the 'mut parameter?) *) +# CCVector.init ;; +- : int -> (int -> 'a) -> ('a, 'mut) CCVector.t = c + +(* use the infix (--) operator for creating a range. Notice + that v is a vector of integer but its mutability is not + decided yet. *) +# let v = CCVector.(1 -- 10);; +val v : (int, '_a) CCVector.t = + +# Format.printf "v = @[%a@]@." (CCVector.print CCInt.print) v;; +v = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] + +(* now let's mutate v *) +# CCVector.push v 42;; +- : unit = () + +(* now v is a mutable vector *) +# v;; +- : (int, CCVector.rw) CCVector.t = + +(* functional combinators! *) +# let v2 = v + |> CCVector.map (fun x-> x+1) + |> CCVector.filter (fun x-> x mod 2=0) + |> CCVector.rev ;; +val v2 : (int, '_a) CCVector.t = + +# Format.printf "v2 = @[%a@]@." (CCVector.print CCInt.print) v2;; +v2 = [10, 8, 6, 4, 2] + +(* let's transfer to a heap *) +# module IntHeap = CCHeap.Make(struct type t = int let leq = (<=) end);; + +# let h = v2 |> CCVector.to_seq |> IntHeap.of_seq ;; +val h : IntHeap.t = + +(* We can print the content of h + (printing is not necessarily in order, though) *) +# Format.printf "h = [@[%a@]]@." (IntHeap.print CCInt.print) h;; +h = [2,4,6,8,10] + +(* we can remove the first element, which also returns a new heap + that does not contain it — CCHeap is a functional data structure *) +# IntHeap.take h;; +- : (IntHeap.t * int) option = Some (, 2) + +# let h', x = IntHeap.take_exn h ;; +val h' : IntHeap.t = +val x : int = 2 + +(* see, 2 is removed *) +# IntHeap.to_list h' ;; +- : int list = [4; 6; 8; 10] + +---- + +=== To go further: containers.data + +There is also a sub-library called `containers.data`, with lots of +more specialized data-structures. +The documentation contains the API for all the modules +(see link:README.adoc[the readme]); they also provide +interface to `sequence` and, as the rest of containers, minimize +dependencies over other modules. + From 8524f43120e1679fc1bb71b998bdfe4477fc2a23 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 24 Feb 2016 21:53:33 +0100 Subject: [PATCH 62/63] detail --- TUTORIAL.adoc | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/TUTORIAL.adoc b/TUTORIAL.adoc index 205a0153..9d973e18 100644 --- a/TUTORIAL.adoc +++ b/TUTORIAL.adoc @@ -10,6 +10,8 @@ the library is loaded, e.g. with: #require "containers";; ---- +== Basics + We will start with a few list helpers, then look at other parts of the library, including printers, maps, etc. @@ -164,7 +166,7 @@ val x : int = 2 ---- -=== To go further: containers.data +== To go further: containers.data There is also a sub-library called `containers.data`, with lots of more specialized data-structures. From a2179d4355d7f3f66c029c3f412cfbdcd93f783e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 24 Feb 2016 22:08:26 +0100 Subject: [PATCH 63/63] prepare for 0.16 --- CHANGELOG.adoc | 58 ++++++++++++++++++++++++++++++++- _oasis | 2 +- src/core/CCFormat.mli | 14 ++++---- src/core/CCFun.mli | 4 +-- src/core/CCHash.mli | 2 +- src/core/CCHashtbl.ml | 14 ++++---- src/core/CCHashtbl.mli | 32 +++++++++--------- src/core/CCHeap.ml | 12 +++---- src/core/CCHeap.mli | 12 +++---- src/core/CCIO.mli | 12 +++---- src/core/CCList.mli | 10 +++--- src/core/CCMap.ml | 2 +- src/core/CCMap.mli | 2 +- src/core/CCOpt.mli | 4 +-- src/core/CCPair.mli | 2 +- src/core/CCRandom.mli | 6 ++-- src/core/CCResult.mli | 2 +- src/core/CCString.mli | 4 +-- src/data/CCGraph.mli | 6 ++-- src/data/CCMixmap.mli | 2 +- src/sexp/CCSexpM.mli | 2 +- src/threads/CCBlockingQueue.mli | 2 +- src/threads/CCLock.mli | 14 ++++---- src/threads/CCPool.mli | 2 +- src/threads/CCThread.mli | 4 +-- src/threads/CCTimer.mli | 2 +- src/unix/CCUnix.mli | 16 ++++----- 27 files changed, 150 insertions(+), 94 deletions(-) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index e2ec92c3..ba78c33c 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -1,5 +1,61 @@ = Changelog +== 0.16 + +=== breaking + +- change the signature of `CCHeap.{of_gen,of_seq,of_klist}` +- change the API of `CCMixmap` +- make type `CCHash.state` abstract (used to be `int64`) +- optional argument `~eq` to `CCGraph.Dot.pp` +- rename `CCFuture` into `CCPool` + +=== deprecations + +- deprecate `containers.bigarray` +- deprecate `CCHashtbl.{Counter,Default}` tables +- deprecate `CCLinq` in favor of standalone `OLinq` (to be released) + +=== bugfixes + +- fix wrong signature of `CCHashtbl.Make.{keys,values}_list` +- missing constraint in `CCSexpM.ID_MONAD` + +=== new features + +- add a tutorial file +- add a printer into CCHeap +- add `{CCList,CCOpt}.Infix` modules +- add `CCOpt.map_or`, deprecating `CCopt.maybe` +- add `CCFormat.sprintf_no_color` +- add `CCFormat.{h,v,hov,hv}box` printer combinators +- add `CCFormat.{with_color, with_colorf}` +- add `CCList.hd_tl` +- add `CCResult.{map_or,get_or}` +- add `CCGraph.make` and utils +- add `CCHashtbl.add_list` +- add counter function in `CCHashtbl`, to replace `CCHashtbl.Counter` +- add `CCPair.make` +- add `CCString.Split.{left,right}_exn` +- add `CCIO.File.{read,write,append}` for quickly handling files +- add `CCRandom.pick_{list,array}` +- add `CCList.Assoc.update` +- add `CCList.Assoc.mem` +- add `{CCMap,CCHashtbl}.get_or` for lookup with default value +- add `CCLock.{decr_then_get, get_then_{decr,set,clear}}` +- rename `CCFuture` into `CCPool`, expose the thread pool +- split `CCTimer` out of `CCFuture`, a standalone 1-thread timer +- move `CCThread.Queue` into `CCBlockingQueue` +- add `CCResult`, with dependency on `result` for retrocompat +- add `CCThread.spawn{1,2}` +- add many helpers in `CCUnix` (for sockets, files, and processes) +- add `CCFun.finally{1,2}`, convenience around `finally` +- add `CCLock.update_map` +- add `CCLock.{incr_then_get,get_then_incr}` +- add breaking space in `CCFormat.{pair,triple,quad}` +- update `examples/id_sexp` so it can read on stdin +- add `CCList.fold_map2` + == 0.15 === breaking changes @@ -15,7 +71,7 @@ - add `CCMap.{keys,values}` - add wip `CCAllocCache`, an allocation cache for short-lived arrays - add `CCError.{join,both}` applicative functions for CCError -- opam: depend on ocamlbuild +- opam: depend on ecamlbuild - work on `CCRandom` by octachron: * add an uniformity test * Make `split_list` uniform diff --git a/_oasis b/_oasis index dbc3fdea..bc9f6985 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: containers -Version: 0.15 +Version: 0.16 Homepage: https://github.com/c-cube/ocaml-containers Authors: Simon Cruanes License: BSD-2-clause diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 8a328f77..e678a779 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -47,21 +47,21 @@ val map : ('a -> 'b) -> 'b printer -> 'a printer val vbox : ?i:int -> 'a printer -> 'a printer (** Wrap the printer in a vertical box @param i level of indentation within the box (default 0) - @since NEXT_RELEASE *) + @since 0.16 *) val hvbox : ?i:int -> 'a printer -> 'a printer (** Wrap the printer in a horizontal/vertical box @param i level of indentation within the box (default 0) - @since NEXT_RELEASE *) + @since 0.16 *) val hovbox : ?i:int -> 'a printer -> 'a printer (** Wrap the printer in a horizontal or vertical box @param i level of indentation within the box (default 0) - @since NEXT_RELEASE *) + @since 0.16 *) val hbox : 'a printer -> 'a printer (** Wrap the printer in an horizontal box - @since NEXT_RELEASE *) + @since 0.16 *) (** {2 ANSI codes} @@ -117,13 +117,13 @@ 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} - @since NEXT_RELEASE *) + @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} - @since NEXT_RELEASE *) + @since 0.16 *) (** {2 IO} *) @@ -139,7 +139,7 @@ val sprintf : ('a, t, unit, string) format4 -> 'a val sprintf_no_color : ('a, t, unit, string) format4 -> 'a (** Similar to {!sprintf} but never prints colors - @since NEXT_RELEASE *) + @since 0.16 *) val fprintf : t -> ('a, t, unit ) format -> 'a (** Alias to {!Format.fprintf} diff --git a/src/core/CCFun.mli b/src/core/CCFun.mli index 9d6a8457..7d731708 100644 --- a/src/core/CCFun.mli +++ b/src/core/CCFun.mli @@ -58,12 +58,12 @@ val finally : h:(unit -> _) -> f:(unit -> 'a) -> 'a val finally1 : h:(unit -> _) -> ('a -> 'b) -> 'a -> 'b (** [finally1 ~h f x] is the same as [f x], but after the computation, [h ()] is called whether [f x] rose an exception or not. - @since NEXT_RELEASE *) + @since 0.16 *) val finally2 : h:(unit -> _) -> ('a -> 'b -> 'c) -> 'a -> 'b -> 'c (** [finally2 ~h f x y] is the same as [f x y], but after the computation, [h ()] is called whether [f x y] rose an exception or not. - @since NEXT_RELEASE *) + @since 0.16 *) (** {2 Monad} diff --git a/src/core/CCHash.mli b/src/core/CCHash.mli index cad92c1e..3b5620d2 100644 --- a/src/core/CCHash.mli +++ b/src/core/CCHash.mli @@ -10,7 +10,7 @@ type t = int type state (** State required by the hash function. - @since NEXT_RELEASE the state is abstract, for more flexibility *) + @since 0.16 the state is abstract, for more flexibility *) type 'a hash_fun = 'a -> state -> state (** Hash function for values of type ['a], merging a fingerprint of the diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index a2ec9922..d81c780b 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -127,25 +127,25 @@ module type S = sig val get_or : 'a t -> key -> or_:'a -> 'a (** [get_or tbl k ~or_] returns the value associated to [k] if present, and returns [or_] otherwise (if [k] doesn't belong in [tbl]) - @since NEXT_RELEASE *) + @since 0.16 *) val add_list : 'a list t -> key -> 'a -> unit (** [add_list tbl x y] adds [y] to the list [x] is bound to. If [x] is not bound, it becomes bound to [[y]]. - @since NEXT_RELEASE *) + @since 0.16 *) val incr : ?by:int -> int t -> key -> unit (** [incr ?by tbl x] increments or initializes the counter associated with [x]. If [get tbl x = None], then after update, [get tbl x = Some 1]; otherwise, if [get tbl x = Some n], now [get tbl x = Some (n+1)]. @param by if specified, the int value is incremented by [by] rather than 1 - @since NEXT_RELEASE *) + @since 0.16 *) val decr : ?by:int -> int t -> key -> unit (** Same as {!incr} but substract 1 (or the value of [by]). If the value reaches 0, the key is removed from the table. This does nothing if the key is not already present in the table. - @since NEXT_RELEASE *) + @since 0.16 *) val keys : 'a t -> key sequence (** Iterate on keys (similar order as {!Hashtbl.iter}) *) @@ -172,17 +172,17 @@ module type S = sig val add_seq : 'a t -> (key * 'a) sequence -> unit (** Add the corresponding pairs to the table, using {!Hashtbl.add}. - @since NEXT_RELEASE *) + @since 0.16 *) val add_seq_count : int t -> key sequence -> unit (** [add_seq_count tbl seq] increments the count of each element of [seq] by calling {!incr}. This is useful for counting how many times each element of [seq] occurs. - @since NEXT_RELEASE *) + @since 0.16 *) val of_seq_count : key sequence -> int t (** Similar to {!add_seq_count}, but allocates a new table and returns it - @since NEXT_RELEASE *) + @since 0.16 *) val to_list : 'a t -> (key * 'a) list (** List of bindings (order unspecified) *) diff --git a/src/core/CCHashtbl.mli b/src/core/CCHashtbl.mli index 2e51e6bd..1016245f 100644 --- a/src/core/CCHashtbl.mli +++ b/src/core/CCHashtbl.mli @@ -18,7 +18,7 @@ val get : ('a,'b) Hashtbl.t -> 'a -> 'b option val get_or : ('a,'b) Hashtbl.t -> 'a -> or_:'b -> 'b (** [get_or tbl k ~or_] returns the value associated to [k] if present, and returns [or_] otherwise (if [k] doesn't belong in [tbl]) - @since NEXT_RELEASE *) + @since 0.16 *) val keys : ('a,'b) Hashtbl.t -> 'a sequence (** Iterate on keys (similar order as {!Hashtbl.iter}) *) @@ -42,13 +42,13 @@ val incr : ?by:int -> ('a, int) Hashtbl.t -> 'a -> unit If [get tbl x = None], then after update, [get tbl x = Some 1]; otherwise, if [get tbl x = Some n], now [get tbl x = Some (n+1)]. @param by if specified, the int value is incremented by [by] rather than 1 - @since NEXT_RELEASE *) + @since 0.16 *) val decr : ?by:int -> ('a, int) Hashtbl.t -> 'a -> unit (** Same as {!incr} but substract 1 (or the value of [by]). If the value reaches 0, the key is removed from the table. This does nothing if the key is not already present in the table. - @since NEXT_RELEASE *) + @since 0.16 *) val to_seq : ('a,'b) Hashtbl.t -> ('a * 'b) sequence (** Iterate on bindings in the table *) @@ -56,11 +56,11 @@ val to_seq : ('a,'b) Hashtbl.t -> ('a * 'b) sequence val add_list : ('a, 'b list) Hashtbl.t -> 'a -> 'b -> unit (** [add_list tbl x y] adds [y] to the list [x] is bound to. If [x] is not bound, it becomes bound to [[y]]. - @since NEXT_RELEASE *) + @since 0.16 *) val add_seq : ('a,'b) Hashtbl.t -> ('a * 'b) sequence -> unit (** Add the corresponding pairs to the table, using {!Hashtbl.add}. - @since NEXT_RELEASE *) + @since 0.16 *) val of_seq : ('a * 'b) sequence -> ('a,'b) Hashtbl.t (** From the given bindings, added in order *) @@ -69,11 +69,11 @@ val add_seq_count : ('a, int) Hashtbl.t -> 'a sequence -> unit (** [add_seq_count tbl seq] increments the count of each element of [seq] by calling {!incr}. This is useful for counting how many times each element of [seq] occurs. - @since NEXT_RELEASE *) + @since 0.16 *) val of_seq_count : 'a sequence -> ('a, int) Hashtbl.t (** Similar to {!add_seq_count}, but allocates a new table and returns it - @since NEXT_RELEASE *) + @since 0.16 *) val to_list : ('a,'b) Hashtbl.t -> ('a * 'b) list (** List of bindings (order unspecified) *) @@ -104,25 +104,25 @@ module type S = sig val get_or : 'a t -> key -> or_:'a -> 'a (** [get_or tbl k ~or_] returns the value associated to [k] if present, and returns [or_] otherwise (if [k] doesn't belong in [tbl]) - @since NEXT_RELEASE *) + @since 0.16 *) val add_list : 'a list t -> key -> 'a -> unit (** [add_list tbl x y] adds [y] to the list [x] is bound to. If [x] is not bound, it becomes bound to [[y]]. - @since NEXT_RELEASE *) + @since 0.16 *) val incr : ?by:int -> int t -> key -> unit (** [incr ?by tbl x] increments or initializes the counter associated with [x]. If [get tbl x = None], then after update, [get tbl x = Some 1]; otherwise, if [get tbl x = Some n], now [get tbl x = Some (n+1)]. @param by if specified, the int value is incremented by [by] rather than 1 - @since NEXT_RELEASE *) + @since 0.16 *) val decr : ?by:int -> int t -> key -> unit (** Same as {!incr} but substract 1 (or the value of [by]). If the value reaches 0, the key is removed from the table. This does nothing if the key is not already present in the table. - @since NEXT_RELEASE *) + @since 0.16 *) val keys : 'a t -> key sequence (** Iterate on keys (similar order as {!Hashtbl.iter}) *) @@ -149,17 +149,17 @@ module type S = sig val add_seq : 'a t -> (key * 'a) sequence -> unit (** Add the corresponding pairs to the table, using {!Hashtbl.add}. - @since NEXT_RELEASE *) + @since 0.16 *) val add_seq_count : int t -> key sequence -> unit (** [add_seq_count tbl seq] increments the count of each element of [seq] by calling {!incr}. This is useful for counting how many times each element of [seq] occurs. - @since NEXT_RELEASE *) + @since 0.16 *) val of_seq_count : key sequence -> int t (** Similar to {!add_seq_count}, but allocates a new table and returns it - @since NEXT_RELEASE *) + @since 0.16 *) val to_list : 'a t -> (key * 'a) list (** List of bindings (order unspecified) *) @@ -187,7 +187,7 @@ module Make(X : Hashtbl.HashedType) : A table with a default element for keys that were never added. - @deprecated since NEXT_RELEASE, should be merged into [Make] itself *) + @deprecated since 0.16, should be merged into [Make] itself *) module type DEFAULT = sig type key @@ -223,7 +223,7 @@ module MakeDefault(X : Hashtbl.HashedType) : DEFAULT with type key = X.t (** {2 Count occurrences using a Hashtbl} - @deprecated since NEXT_RELEASE, should be merged into [Make] itself *) + @deprecated since 0.16, should be merged into [Make] itself *) module type COUNTER = sig type elt diff --git a/src/core/CCHeap.ml b/src/core/CCHeap.ml index fae8dcd9..3e66c36a 100644 --- a/src/core/CCHeap.ml +++ b/src/core/CCHeap.ml @@ -116,28 +116,28 @@ module type S = sig (** {2 Conversions} The interface of [of_gen], [of_seq], [of_klist] - has changed @since NEXT_RELEASE (the old signatures + has changed @since 0.16 (the old signatures are now [add_seq], [add_gen], [add_klist]) *) val to_list : t -> elt list - val add_list : t -> elt list -> t (** @since NEXT_RELEASE *) + val add_list : t -> elt list -> t (** @since 0.16 *) val of_list : elt list -> t - val add_seq : t -> elt sequence -> t (** @since NEXT_RELEASE *) + val add_seq : t -> elt sequence -> t (** @since 0.16 *) val of_seq : elt sequence -> t val to_seq : t -> elt sequence - val add_klist : t -> elt klist -> t (** @since NEXT_RELEASE *) + val add_klist : t -> elt klist -> t (** @since 0.16 *) val of_klist : elt klist -> t val to_klist : t -> elt klist - val add_gen : t -> elt gen -> t (** @since NEXT_RELEASE *) + val add_gen : t -> elt gen -> t (** @since 0.16 *) val of_gen : elt gen -> t @@ -146,7 +146,7 @@ module type S = sig val to_tree : t -> elt ktree val print : ?sep:string -> elt printer -> t printer - (** @since NEXT_RELEASE *) + (** @since 0.16 *) end module Make(E : PARTIAL_ORD) : S with type elt = E.t = struct diff --git a/src/core/CCHeap.mli b/src/core/CCHeap.mli index ca588e5a..551f99b5 100644 --- a/src/core/CCHeap.mli +++ b/src/core/CCHeap.mli @@ -67,28 +67,28 @@ module type S = sig (** {2 Conversions} The interface of [of_gen], [of_seq], [of_klist] - has changed @since NEXT_RELEASE (the old signatures + has changed @since 0.16 (the old signatures are now [add_seq], [add_gen], [add_klist]) *) val to_list : t -> elt list - val add_list : t -> elt list -> t (** @since NEXT_RELEASE *) + val add_list : t -> elt list -> t (** @since 0.16 *) val of_list : elt list -> t - val add_seq : t -> elt sequence -> t (** @since NEXT_RELEASE *) + val add_seq : t -> elt sequence -> t (** @since 0.16 *) val of_seq : elt sequence -> t val to_seq : t -> elt sequence - val add_klist : t -> elt klist -> t (** @since NEXT_RELEASE *) + val add_klist : t -> elt klist -> t (** @since 0.16 *) val of_klist : elt klist -> t val to_klist : t -> elt klist - val add_gen : t -> elt gen -> t (** @since NEXT_RELEASE *) + val add_gen : t -> elt gen -> t (** @since 0.16 *) val of_gen : elt gen -> t @@ -97,7 +97,7 @@ module type S = sig val to_tree : t -> elt ktree val print : ?sep:string -> elt printer -> t printer - (** @since NEXT_RELEASE *) + (** @since 0.16 *) end module Make(E : PARTIAL_ORD) : S with type elt = E.t diff --git a/src/core/CCIO.mli b/src/core/CCIO.mli index b112b111..92e6a119 100644 --- a/src/core/CCIO.mli +++ b/src/core/CCIO.mli @@ -164,27 +164,27 @@ module File : sig val read_exn : t -> string (** Read the content of the given file, or raises some exception - @since NEXT_RELEASE *) + @since 0.16 *) val read : t -> string or_error (** Read the content of the given file - @since NEXT_RELEASE *) + @since 0.16 *) val append_exn : t -> string -> unit (** Append the given string into the given file, possibly raising - @since NEXT_RELEASE *) + @since 0.16 *) val append : t -> string -> unit or_error (** Append the given string into the given file - @since NEXT_RELEASE *) + @since 0.16 *) val write_exn : t -> string -> unit (** Write the given string into the given file, possibly raising - @since NEXT_RELEASE *) + @since 0.16 *) val write : t -> string -> unit or_error (** Write the given string into the given file - @since NEXT_RELEASE *) + @since 0.16 *) type walk_item = [`File | `Dir] * t diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 005507ae..ee60436a 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -51,7 +51,7 @@ val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list val fold_map2 : ('acc -> 'a -> 'b -> 'acc * 'c) -> 'acc -> 'a list -> 'b list -> 'acc * 'c list (** [fold_map2] is to [fold_map] what [List.map2] is to [List.map]. @raise Invalid_argument if the lists do not have the same length - @since NEXT_RELEASE *) + @since 0.16 *) val fold_flat_map : ('acc -> 'a -> 'acc * 'b list) -> 'acc -> 'a list -> 'acc * 'b list (** [fold_flat_map f acc l] is a [fold_left]-like function, but it also maps the @@ -109,7 +109,7 @@ val drop : int -> 'a t -> 'a t val hd_tl : 'a t -> 'a * 'a t (** [hd_tl (x :: l)] returns [hd, l]. @raise Failure if the list is empty - @since NEXT_RELEASE *) + @since 0.16 *) val take_drop : int -> 'a t -> 'a t * 'a t (** [take_drop n l] returns [l1, l2] such that [l1 @ l2 = l] and @@ -286,14 +286,14 @@ module Assoc : sig val mem : ?eq:('a->'a->bool) -> ('a,_) t -> 'a -> bool (** [mem l x] returns [true] iff [x] is a key in [l] - @since NEXT_RELEASE *) + @since 0.16 *) val update : ?eq:('a->'a->bool) -> ('a,'b) t -> 'a -> f:('b option -> 'b option) -> ('a,'b) t (** [update l k ~f] updates [l] on the key [k], by calling [f (get l k)] and removing [k] if it returns [None], mapping [k] to [v'] if it returns [Some v'] - @since NEXT_RELEASE *) + @since 0.16 *) end (** {2 Zipper} *) @@ -469,7 +469,7 @@ val of_klist : 'a klist -> 'a t It is convenient to {!open CCList.Infix} to access the infix operators without cluttering the scope too much. - @since NEXT_RELEASE *) + @since 0.16 *) module Infix : sig val (>|=) : 'a t -> ('a -> 'b) -> 'b t diff --git a/src/core/CCMap.ml b/src/core/CCMap.ml index 087eaaeb..d8a69a32 100644 --- a/src/core/CCMap.ml +++ b/src/core/CCMap.ml @@ -16,7 +16,7 @@ module type S = sig val get_or : key -> 'a t -> or_:'a -> 'a (** [get_or k m ~or_] returns the value associated to [k] if present, and returns [or_] otherwise (if [k] doesn't belong in [m]) - @since NEXT_RELEASE *) + @since 0.16 *) val update : key -> ('a option -> 'a option) -> 'a t -> 'a t (** [update k f m] calls [f (Some v)] if [find k m = v], diff --git a/src/core/CCMap.mli b/src/core/CCMap.mli index 819ba2b6..f03b59ff 100644 --- a/src/core/CCMap.mli +++ b/src/core/CCMap.mli @@ -19,7 +19,7 @@ module type S = sig val get_or : key -> 'a t -> or_:'a -> 'a (** [get_or k m ~or_] returns the value associated to [k] if present, and returns [or_] otherwise (if [k] doesn't belong in [m]) - @since NEXT_RELEASE *) + @since 0.16 *) val update : key -> ('a option -> 'a option) -> 'a t -> 'a t (** [update k f m] calls [f (Some v)] if [find k m = v], diff --git a/src/core/CCOpt.mli b/src/core/CCOpt.mli index 63c763a8..2bdbee8e 100644 --- a/src/core/CCOpt.mli +++ b/src/core/CCOpt.mli @@ -15,7 +15,7 @@ val maybe : ('a -> 'b) -> 'b -> 'a t -> 'b val map_or : default:'b -> ('a -> 'b) -> 'a t -> 'b (** [map_or ~default f o] is [f x] if [o = Some x], [default otherwise] - @since NEXT_RELEASE *) + @since 0.16 *) val is_some : _ t -> bool @@ -94,7 +94,7 @@ val (<+>) : 'a t -> 'a t -> 'a t val choice : 'a t list -> 'a t (** [choice] returns the first non-[None] element of the list, or [None] *) (** {2 Infix Operators} - @since NEXT_RELEASE *) + @since 0.16 *) module Infix : sig val (>|=) : 'a t -> ('a -> 'b) -> 'b t diff --git a/src/core/CCPair.mli b/src/core/CCPair.mli index a63d1f3e..a86c017c 100644 --- a/src/core/CCPair.mli +++ b/src/core/CCPair.mli @@ -7,7 +7,7 @@ type ('a,'b) t = ('a * 'b) val make : 'a -> 'b -> ('a, 'b) t (** Make a tuple from its components - @since NEXT_RELEASE *) + @since 0.16 *) val map1 : ('a -> 'b) -> ('a * 'c) -> ('b * 'c) diff --git a/src/core/CCRandom.mli b/src/core/CCRandom.mli index 78aa4977..ee6b4237 100644 --- a/src/core/CCRandom.mli +++ b/src/core/CCRandom.mli @@ -65,17 +65,17 @@ val list_seq : 'a t list -> 'a list t @since 0.4 *) exception Pick_from_empty -(** @since NEXT_RELEASE *) +(** @since 0.16 *) val pick_list : 'a list -> 'a t (** Pick an element at random from the list @raise Pick_from_empty if the list is empty - @since NEXT_RELEASE *) + @since 0.16 *) val pick_array : 'a array -> 'a t (** Pick an element at random from the array @raise Pick_from_empty if the array is empty - @since NEXT_RELEASE *) + @since 0.16 *) val small_int : int t diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index 411c2246..1a72e3a3 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -5,7 +5,7 @@ Uses the new "result" type from OCaml 4.03. - @since NEXT_RELEASE *) + @since 0.16 *) type 'a sequence = ('a -> unit) -> unit type 'a equal = 'a -> 'a -> bool diff --git a/src/core/CCString.mli b/src/core/CCString.mli index dd2b82d5..c036700e 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -302,7 +302,7 @@ module Split : sig val left_exn : by:string -> string -> string * string (** Split on the first occurrence of [by] from the leftmost part of the string @raise Not_found if [by] is not part of the string - @since NEXT_RELEASE *) + @since 0.16 *) (*$T Split.left ~by:" " "ab cde f g " = Some ("ab", "cde f g ") @@ -317,7 +317,7 @@ module Split : sig val right_exn : by:string -> string -> string * string (** Split on the first occurrence of [by] from the rightmost part of the string @raise Not_found if [by] is not part of the string - @since NEXT_RELEASE *) + @since 0.16 *) (*$T Split.right ~by:" " "ab cde f g" = Some ("ab cde f", "g") diff --git a/src/data/CCGraph.mli b/src/data/CCGraph.mli index f4d47edf..22bc1233 100644 --- a/src/data/CCGraph.mli +++ b/src/data/CCGraph.mli @@ -81,17 +81,17 @@ val make : dest:('e -> 'v) -> ('v -> 'e sequence) -> ('v, 'e) t (** Make a graph by providing its fields - @since NEXT_RELEASE *) + @since 0.16 *) val make_labelled_tuple : ('v -> ('a * 'v) sequence) -> ('v, ('v * 'a * 'v)) t (** Make a graph with edges being triples [(origin,label,dest)] - @since NEXT_RELEASE *) + @since 0.16 *) val make_tuple : ('v -> 'v sequence) -> ('v, ('v * 'v)) t (** Make a graph with edges being pairs [(origin,dest)] - @since NEXT_RELEASE *) + @since 0.16 *) (** Mutable tags from values of type ['v] to tags of type [bool] *) type 'v tag_set = { diff --git a/src/data/CCMixmap.mli b/src/data/CCMixmap.mli index 4885dcb3..a238b375 100644 --- a/src/data/CCMixmap.mli +++ b/src/data/CCMixmap.mli @@ -27,7 +27,7 @@ ]} @since 0.9 - @since NEXT_RELEASE change of API, the map is last argument to + @since 0.16 change of API, the map is last argument to make piping with [|>] easier. *) type 'a injection diff --git a/src/sexp/CCSexpM.mli b/src/sexp/CCSexpM.mli index a7c8c9a8..b16fe259 100644 --- a/src/sexp/CCSexpM.mli +++ b/src/sexp/CCSexpM.mli @@ -89,7 +89,7 @@ end module ID_MONAD : MONAD with type 'a t = 'a (** The monad that just uses blocking calls as bind @since 0.14 - ['a t = 'a] contraint is @since NEXT_RELEASE *) + ['a t = 'a] contraint is @since 0.16 *) module D : module type of MakeDecode(ID_MONAD) (** Decoder that just blocks when input is not available diff --git a/src/threads/CCBlockingQueue.mli b/src/threads/CCBlockingQueue.mli index fabd441d..003110b1 100644 --- a/src/threads/CCBlockingQueue.mli +++ b/src/threads/CCBlockingQueue.mli @@ -6,7 +6,7 @@ This queue has a limited size. Pushing a value on the queue when it is full will block. - @since NEXT_RELEASE *) + @since 0.16 *) type 'a t (** Safe-thread queue for values of type ['a] *) diff --git a/src/threads/CCLock.mli b/src/threads/CCLock.mli index ce973086..75e4b07c 100644 --- a/src/threads/CCLock.mli +++ b/src/threads/CCLock.mli @@ -42,7 +42,7 @@ val update : 'a t -> ('a -> 'a) -> unit val update_map : 'a t -> ('a -> 'a * 'b) -> 'b (** [update_map l f] computes [x', y = f (get l)], then puts [x'] in [l] and returns [y] - @since NEXT_RELEASE *) + @since 0.16 *) val mutex : _ t -> Mutex.t (** Underlying mutex *) @@ -64,24 +64,24 @@ val decr : int t -> unit val incr_then_get : int t -> int (** [incr_then_get x] increments [x], and return its new value - @since NEXT_RELEASE *) + @since 0.16 *) val get_then_incr : int t -> int (** [get_then_incr x] increments [x], and return its previous value - @since NEXT_RELEASE *) + @since 0.16 *) val decr_then_get : int t -> int (** [decr_then_get x] decrements [x], and return its new value - @since NEXT_RELEASE *) + @since 0.16 *) val get_then_decr : int t -> int (** [get_then_decr x] decrements [x], and return its previous value - @since NEXT_RELEASE *) + @since 0.16 *) val get_then_set : bool t -> bool (** [get_then_set b] sets [b] to [true], and return the old value - @since NEXT_RELEASE *) + @since 0.16 *) val get_then_clear : bool t -> bool (** [get_then_clear b] sets [b] to [false], and return the old value - @since NEXT_RELEASE *) + @since 0.16 *) diff --git a/src/threads/CCPool.mli b/src/threads/CCPool.mli index e00acc5e..9697c6d1 100644 --- a/src/threads/CCPool.mli +++ b/src/threads/CCPool.mli @@ -4,7 +4,7 @@ (** {1 Thread Pool, and Futures} Renamed and heavily updated from [CCFuture] - @since NEXT_RELEASE *) + @since 0.16 *) type +'a state = | Done of 'a diff --git a/src/threads/CCThread.mli b/src/threads/CCThread.mli index d33f8fd4..fe54e6f8 100644 --- a/src/threads/CCThread.mli +++ b/src/threads/CCThread.mli @@ -12,11 +12,11 @@ val spawn : (unit -> _) -> t val spawn1 : ('a -> _) -> 'a -> t (** [spawn1 f x] is like [spawn (fun () -> f x)]. - @since NEXT_RELEASE *) + @since 0.16 *) val spawn2 : ('a -> 'b -> _) -> 'a -> 'b -> t (** [spawn2 f x y] is like [spawn (fun () -> f x y)]. - @since NEXT_RELEASE *) + @since 0.16 *) val detach : (unit -> 'a) -> unit (** [detach f] is the same as [ignore (spawn f)] *) diff --git a/src/threads/CCTimer.mli b/src/threads/CCTimer.mli index 09591c12..f0068cf8 100644 --- a/src/threads/CCTimer.mli +++ b/src/threads/CCTimer.mli @@ -4,7 +4,7 @@ (** {1 Event timer} Used to be part of [CCFuture] - @since NEXT_RELEASE *) + @since 0.16 *) type t (** A scheduler for events. It runs in its own thread. *) diff --git a/src/unix/CCUnix.mli b/src/unix/CCUnix.mli index 3eb47145..82b29502 100644 --- a/src/unix/CCUnix.mli +++ b/src/unix/CCUnix.mli @@ -114,25 +114,25 @@ val with_in : ?mode:int -> ?flags:Unix.open_flag list -> on the input channel. When the function raises or returns, the channel is closed. @param flags opening flags. [Unix.O_RDONLY] is used in any cases - @since NEXT_RELEASE *) + @since 0.16 *) val with_out : ?mode:int -> ?flags:Unix.open_flag list -> string -> f:(out_channel -> 'a) -> 'a (** Same as {!with_in} but for an output channel @param flags opening flags (default [[Unix.O_CREAT; Unix.O_TRUNC]]) [Unix.O_WRONLY] is used in any cases. - @since NEXT_RELEASE *) + @since 0.16 *) val with_process_in : string -> f:(in_channel -> 'a) -> 'a (** Open a subprocess and obtain a handle to its stdout - @since NEXT_RELEASE *) + @since 0.16 *) val with_process_out : string -> f:(out_channel -> 'a) -> 'a (** Open a subprocess and obtain a handle to its stdin - @since NEXT_RELEASE *) + @since 0.16 *) (** Handle to a subprocess. - @since NEXT_RELEASE *) + @since 0.16 *) type process_full = < stdin: out_channel; stdout: in_channel; @@ -143,11 +143,11 @@ type process_full = < val with_process_full : ?env:string array -> string -> f:(process_full -> 'a) -> 'a (** Open a subprocess and obtain a handle to its channels. @param env environment to pass to the subprocess. - @since NEXT_RELEASE *) + @since 0.16 *) val with_connection : Unix.sockaddr -> f:(in_channel -> out_channel -> 'a) -> 'a (** Wrap {!Unix.open_connection} with a handler - @since NEXT_RELEASE *) + @since 0.16 *) exception ExitServer @@ -155,7 +155,7 @@ val establish_server : Unix.sockaddr -> f:(in_channel -> out_channel -> _) -> un (** Listen on the address and calls the handler in a blocking fashion. Using {!Thread} is recommended if handlers might take time. The callback should raise {!ExitServer} to stop the loop. - @since NEXT_RELEASE *) + @since 0.16 *) (** {2 Infix Functions} *)