From 719d048f570a98334679d32c83797b54b68abade Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 7 Mar 2017 09:24:03 +0100 Subject: [PATCH 01/56] add `CCFormat.flush` --- src/core/CCFormat.ml | 1 + src/core/CCFormat.mli | 4 ++++ 2 files changed, 5 insertions(+) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index a4850947..d68f53d3 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -37,6 +37,7 @@ let int32 fmt n = Format.fprintf fmt "%ld" n let int64 fmt n = Format.fprintf fmt "%Ld" n let nativeint fmt n = Format.fprintf fmt "%nd" n let string_quoted fmt s = Format.fprintf fmt "\"%s\"" s +let flush = Format.pp_print_flush let list ?(sep=return ",@ ") pp fmt l = let rec pp_list l = match l with diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 3880dcfd..02be1976 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -28,6 +28,10 @@ val int32 : int32 printer (** @since 0.14 *) val int64 : int64 printer (** @since 0.14 *) val nativeint : nativeint printer (** @since 0.14 *) +val flush : unit printer +(** Alias to {!Format.pp_print_flush}. + @since NEXT_RELEASE *) + val string_quoted : string printer (** Similar to {!CCString.print}. @since 0.14 *) From ae6d81a9a428d885c5ba70cf9bff8c81d301d17f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 7 Mar 2017 09:24:10 +0100 Subject: [PATCH 02/56] add `CCFormat.of_chan` --- src/core/CCFormat.ml | 12 ++++++++++++ src/core/CCFormat.mli | 10 ++++++++++ 2 files changed, 22 insertions(+) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index d68f53d3..03e68bb1 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -135,6 +135,18 @@ let fprintf = Format.fprintf let stdout = Format.std_formatter let stderr = Format.err_formatter +let of_chan = Format.formatter_of_out_channel + +let with_out_chan oc f = + let fmt = of_chan oc in + try + let x = f fmt in + Format.pp_print_flush fmt (); + x + with e -> + Format.pp_print_flush fmt (); + raise e + let tee a b = let fa = Format.pp_get_formatter_out_functions a () in let fb = Format.pp_get_formatter_out_functions b () in diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 02be1976..fdbe2be5 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -184,6 +184,16 @@ val with_color_sf : string -> ('a, t, unit, string) format4 -> 'a val output : t -> 'a printer -> 'a -> unit val to_string : 'a printer -> 'a -> string +val of_chan : out_channel -> t +(** Alias to {!Format.formatter_of_out_channel} + @since NEXT_RELEASE *) + +val with_out_chan : out_channel -> (t -> 'a) -> 'a +(** [with_out_chan oc f] turns [oc] into a formatter [fmt], and call [f fmt]. + Behaves like [f fmt] from then on, but whether the call to [f] fails + or returns, [fmt] is flushed before the call terminates. + @since NEXT_RELEASE *) + val stdout : t val stderr : t From a45d8c46a6e926ae1f48acf0bd1917c01a3eaf2c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 7 Mar 2017 09:35:52 +0100 Subject: [PATCH 03/56] add `CCUnix.with_file_lock` for locking whole files --- src/unix/CCUnix.ml | 43 +++++++++++++++++++++++++++++++++++++++++++ src/unix/CCUnix.mli | 9 +++++++++ 2 files changed, 52 insertions(+) diff --git a/src/unix/CCUnix.ml b/src/unix/CCUnix.ml index 216522a3..4d2b4d55 100644 --- a/src/unix/CCUnix.ml +++ b/src/unix/CCUnix.ml @@ -224,6 +224,49 @@ let establish_server sockaddr ~f = continue := false done + +(** {6 Locking} *) + +let with_file_lock ~kind filename f = + let lock_file = Unix.openfile filename [Unix.O_CREAT; Unix.O_WRONLY] 0o644 in + let lock_action = match kind with + | `Read -> Unix.F_RLOCK + | `Write -> Unix.F_LOCK + in + Unix.lockf lock_file lock_action 0; + try + let x = f () in + Unix.lockf lock_file Unix.F_ULOCK 0; + Unix.close lock_file; + x + with e -> + Unix.lockf lock_file Unix.F_ULOCK 0; + Unix.close lock_file; + raise e + +(*$R + let m = 200 in + let n = 50 in + let write_atom filename s = + with_file_lock ~kind:`Write filename + (fun () -> + CCIO.with_out ~flags:[Open_append; Open_creat] + filename (fun oc -> output_string oc s; flush oc)) + in + let f filename = + for j=1 to m do + write_atom filename "foo\n" + done + in + CCIO.File.with_temp ~prefix:"containers_" ~suffix:".txt" + (fun filename -> + let a = Array.init n (fun _ -> Thread.create f filename) in + Array.iter Thread.join a; + let lines = CCIO.with_in filename CCIO.read_lines_l in + assert_equal ~printer:string_of_int (n * m) (List.length lines); + assert_bool "all valid" (List.for_all ((=) "foo") lines)) +*) + module Infix = struct let (?|) fmt = call_full fmt diff --git a/src/unix/CCUnix.mli b/src/unix/CCUnix.mli index 237df841..6e6be9a2 100644 --- a/src/unix/CCUnix.mli +++ b/src/unix/CCUnix.mli @@ -161,6 +161,15 @@ val establish_server : Unix.sockaddr -> f:(in_channel -> out_channel -> _) -> un The callback should raise {!ExitServer} to stop the loop. @since 0.16 *) +val with_file_lock : kind:[`Read|`Write] -> string -> (unit -> 'a) -> 'a +(** [with_file_lock ~kind filename f] puts a lock on the offset 0 + of the file named [filename], calls [f] and returns its result after + the file is unlocked. If [f ()] raises an exception the exception is + re-raised after the file is unlocked. + + @param kind specifies whether the lock is read-only or read-write. + @since NEXT_RELEASE *) + (** {2 Infix Functions} *) module Infix : sig From 4aa507c7bf643a08c947b9cdfeebc32305edba7b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 7 Mar 2017 09:36:07 +0100 Subject: [PATCH 04/56] small fix in readme --- README.adoc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.adoc b/README.adoc index 23e5502b..669e979a 100644 --- a/README.adoc +++ b/README.adoc @@ -12,7 +12,7 @@ map/fold_right/append, and additional functions on lists). Alternatively, `open Containers` will bring enhanced versions of the standard modules into scope. -image:https://ci.cedeela.fr/buildStatus/icon?job=containers[alt="Build Status", link="http://ci.cedeela.fr/job/containers/"] +image::https://ci.cedeela.fr/buildStatus/icon?job=containers[alt="Build Status", link="http://ci.cedeela.fr/job/containers/"] toc::[] From ff53571a3be87653877404240d4444bf09487230 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 9 Mar 2017 21:21:44 +0100 Subject: [PATCH 05/56] add `CCList.{cartesian_product,map_product_l}` --- src/core/CCList.ml | 42 ++++++++++++++++++++++++++++++++++++++++-- src/core/CCList.mli | 20 ++++++++++++++++++++ 2 files changed, 60 insertions(+), 2 deletions(-) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index d5bb6fad..abb44b36 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -277,8 +277,8 @@ let fold_product f acc l1 l2 = (fun acc x1 -> List.fold_left (fun acc x2 -> f acc x1 x2) - acc l2 - ) acc l1 + acc l2) + acc l1 let diagonal l = let rec gen acc l = match l with @@ -329,6 +329,44 @@ let pure = return let (<*>) funs l = product (fun f x -> f x) funs l +let cartesian_product l = + (* [left]: elements picked so far + [right]: sets to pick elements from + [acc]: accumulator for the result, to pass to continuation + [k]: continuation *) + let rec prod_rec left right k acc = match right with + | [] -> k acc (List.rev left) + | l1 :: tail -> + List.fold_left + (fun acc x -> prod_rec (x::left) tail k acc) + acc l1 + in + prod_rec [] l (fun acc l' -> l' :: acc) [] + +(*$inject + let cmp_lii_unord l1 l2 : bool = + List.sort CCOrd.compare l1 = List.sort CCOrd.compare l2 +*) + +(*$= & ~printer:Q.Print.(list (list int)) ~cmp:cmp_lii_unord + [[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]] \ + (cartesian_product [[1;2];[3];[4;5;6]]) + [] (cartesian_product [[1;2];[];[4;5;6]]) + [[]] (cartesian_product []) + [[1;3;4;5;6];[2;3;4;5;6]] \ + (cartesian_product [[1;2];[3];[4];[5];[6]]) +*) + +(* cartesian product of lists of lists *) +let map_product_l f l = + let l = List.map f l in + cartesian_product l + +(*$Q + Q.(list_of_size Gen.(1--4) (list_of_size Gen.(0--4) small_int)) (fun l-> \ + cmp_lii_unord (cartesian_product l) (map_product_l CCFun.id l)) +*) + let sorted_merge ?(cmp=Pervasives.compare) l1 l2 = let rec recurse cmp acc l1 l2 = match l1,l2 with | [], _ -> List.rev_append acc l2 diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 3d5a316b..360a0687 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -83,6 +83,26 @@ val product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t val fold_product : ('c -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c (** Fold on the cartesian product *) +val cartesian_product : 'a t t -> 'a t t +(** + For example: + {[ + # cartesian_product [[1;2];[3];[4;5;6]] = + [[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]];; + # cartesian_product [[1;2];[];[4;5;6]] = [];; + # cartesian_product [[1;2];[3];[4];[5];[6]] = + [[1;3;4;5;6];[2;3;4;5;6]];; + ]} + invariant: [cartesian_product l = map_product id l]. + @since NEXT_RELEASE *) + +val map_product_l : ('a -> 'b list) -> 'a list -> 'b list list +(** [map_product_l f l] maps each element of [l] to a list of + objects of type ['b] using [f]. + We obtain [[l1;l2;…;ln]] where [length l=n] and [li : 'b list]. + Then, it returns all the ways of picking exactly one element per [li]. + @since NEXT_RELEASE *) + val diagonal : 'a t -> ('a * 'a) t (** All pairs of distinct positions of the list. [list_diagonal l] will return the list of [List.nth i l, List.nth j l] if [i < j]. *) From 6e97ee8c7cfb478251545f786fa57ffdc0d9c165 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 9 Mar 2017 21:29:40 +0100 Subject: [PATCH 06/56] add `CCList.scan_left` --- src/core/CCList.ml | 20 ++++++++++++++++++++ src/core/CCList.mli | 5 +++++ 2 files changed, 25 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index abb44b36..f4f3b9ea 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -152,6 +152,26 @@ let fold_map f acc l = fold_map (fun acc x -> x::acc, x) [] l = (List.rev l, l)) *) +let scan_left f acc l = + let rec aux f acc l_acc l = match l with + | [] -> List.rev l_acc + | x :: tail -> + let acc = f acc x in + let l_acc = acc :: l_acc in + aux f acc l_acc tail + in + aux f acc [acc] l + +(*$= & ~printer:Q.Print.(list int) + [0;1;3;6] (scan_left (+) 0 [1;2;3]) + [0] (scan_left (+) 0 []) +*) + +(*$Q + Q.(list int) (fun l -> \ + List.length l + 1 = List.length (scan_left (+) 0 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 diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 360a0687..e8a06c5c 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -48,6 +48,11 @@ val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list list to another list. @since 0.14 *) +val scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc list +(** [scan_left f acc l] returns the list [[acc; f acc x0; f (f acc x0) x1; …]] + where [x0], [x1], etc. are the elements of [l] + @since NEXT_RELEASE *) + 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 From d135f73c7656de3a0453214c424da616a3a33dc6 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 9 Mar 2017 21:41:38 +0100 Subject: [PATCH 07/56] add `CCArray.{fold_map,scan_left}` (close #101) --- src/core/CCArray.ml | 42 ++++++++++++++++++++++++++++++++++++++++++ src/core/CCArray.mli | 11 +++++++++++ 2 files changed, 53 insertions(+) diff --git a/src/core/CCArray.ml b/src/core/CCArray.ml index 85e152c8..8785019c 100644 --- a/src/core/CCArray.ml +++ b/src/core/CCArray.ml @@ -71,6 +71,48 @@ let fold_while f acc a = fold_while (fun acc b -> if b then acc+1, `Continue else acc, `Stop) 0 (Array.of_list [true;true;false;true]) = 2 *) +let fold_map f acc a = + let n = length a in + (* need special case for initializing the result *) + if n = 0 then acc, [||] + else ( + let acc, b0 = f acc a.(0) in + let res = Array.make n b0 in + let acc = ref acc in + for i = 1 to n-1 do + let new_acc, b = f !acc a.(i) in + acc := new_acc; + res.(i) <- b; + done; + !acc, res + ) + +(*$= + (6, [|"1"; "2"; "3"|]) \ + (fold_map (fun acc x->acc+x, string_of_int x) 0 [|1;2;3|]) +*) + +(*$Q + Q.(array int) (fun a -> \ + fold_map (fun acc x -> x::acc, x) [] a = (List.rev @@ Array.to_list a, a)) +*) + +let scan_left f acc a = + let n = length a in + let res = Array.make (n+1) acc in + Array.iteri + (fun i x -> + let new_acc = f res.(i) x in + res.(i+1) <- new_acc) + a; + res + +(*$= & ~printer:Q.Print.(array int) + [|0;1;3;6|] (scan_left (+) 0 [|1;2;3|]) + [|0|] (scan_left (+) 0 [||]) +*) + + let iter = Array.iter let iteri = Array.iteri diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index 611d7b9f..42ad6925 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -41,6 +41,17 @@ val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a indicated by the accumulator @since 0.8 *) +val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a t -> 'acc * 'b t +(** [fold_map f acc a] is a [fold_left]-like function, but it also maps the + array to another array. + @since NEXT_RELEASE *) + +val scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc t +(** [scan_left f acc a] returns the array + [ [|acc; f acc x0; f (f acc a.(0)) a.(1); …|] ] + @since NEXT_RELEASE *) + + val iter : ('a -> unit) -> 'a t -> unit val iteri : (int -> 'a -> unit) -> 'a t -> unit From 48bb1e24c61c7a60e80c4ab1e03f367210021afd Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 9 Mar 2017 22:51:33 +0100 Subject: [PATCH 08/56] update header, and use more `(==)` in `CCIntMap` --- src/data/CCIntMap.ml | 34 ++++++++-------------------------- src/data/CCIntMap.mli | 24 +----------------------- 2 files changed, 9 insertions(+), 49 deletions(-) diff --git a/src/data/CCIntMap.ml b/src/data/CCIntMap.ml index d076769a..2fde434e 100644 --- a/src/data/CCIntMap.ml +++ b/src/data/CCIntMap.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 Map specialized for Int keys} *) @@ -259,7 +237,7 @@ let update k f t = let doubleton k1 v1 k2 v2 = add k1 v1 (singleton k2 v2) -let rec equal ~eq a b = match a, b with +let rec equal ~eq a b = a==b || match a, b with | E, E -> true | L (ka, va), L (kb, vb) -> ka = kb && eq va vb | N (pa, sa, la, ra), N (pb, sb, lb, rb) -> @@ -308,7 +286,9 @@ let choose t = try Some (choose_exn t) with Not_found -> None -let rec union f t1 t2 = match t1, t2 with +let rec union f t1 t2 = + if t1==t2 then t1 + else match t1, t2 with | E, o | o, E -> o | L (k, v), o | o, L (k, v) -> @@ -361,7 +341,9 @@ let rec union f t1 t2 = match t1, t2 with equal ~eq:(=) (of_list l) (union (fun _ a _ -> a) (of_list l)(of_list l))) *) -let rec inter f a b = match a, b with +let rec inter f a b = + if a==b then a + else match a, b with | E, _ | _, E -> E | L (k, v), o | o, L (k, v) -> diff --git a/src/data/CCIntMap.mli b/src/data/CCIntMap.mli index 7518fa4d..ab7445ea 100644 --- a/src/data/CCIntMap.mli +++ b/src/data/CCIntMap.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 Map specialized for Int keys} From ef651342eb6b0c0637fa8f800bf6dc4e87d08556 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 10 Mar 2017 21:33:40 +0100 Subject: [PATCH 09/56] add `CCString.split_on_char` --- src/core/CCString.cppo.ml | 14 ++++++++++++++ src/core/CCString.mli | 4 ++++ 2 files changed, 18 insertions(+) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 0758d71c..cbf78bc5 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -388,6 +388,20 @@ module Split = struct let right ~by s = try Some (right_exn ~by s) with Not_found -> None end +let split_on_char c s: _ list = + Split.list_cpy ~by:(String.make 1 c) s + +(*$= & ~printer:Q.Print.(list string) + ["a"; "few"; "words"; "from"; "our"; "sponsors"] \ + (split_on_char ' ' "a few words from our sponsors") +*) + +(*$Q + Q.(printable_string) (fun s -> \ + let s = split_on_char ' ' s |> String.concat " " in \ + s = split_on_char ' ' s |> String.concat " ") +*) + let compare_versions a b = let of_int s = try Some (int_of_string s) with _ -> None in let rec cmp_rec a b = match a(), b() with diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 85aa5a6d..184862cf 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -495,6 +495,10 @@ module Split : sig *) end +val split_on_char : char -> string -> string list +(** Split the string along the given char + @since NEXT_RELEASE *) + (** {2 Utils} *) val compare_versions : string -> string -> int From 97abfe600eef33af393cc1e64f8edbb6dc0d0b84 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 14 Mar 2017 11:16:11 +0100 Subject: [PATCH 10/56] use boxes in `CCFormat.Dump` for tuples --- src/core/CCFormat.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 03e68bb1..97590cf6 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -384,12 +384,12 @@ module Dump = struct let option pp out x = match x with | None -> Format.pp_print_string out "None" | Some x -> Format.fprintf out "Some %a" pp x - let pair p1 p2 = within "(" ")" (pair p1 p2) - let triple p1 p2 p3 = within "(" ")" (triple p1 p2 p3) - let quad p1 p2 p3 p4 = within "(" ")" (quad p1 p2 p3 p4) + let pair p1 p2 = within "(" ")" (hovbox (pair p1 p2)) + let triple p1 p2 p3 = within "(" ")" (hovbox (triple p1 p2 p3)) + let quad p1 p2 p3 p4 = within "(" ")" (hovbox (quad p1 p2 p3 p4)) let result' pok perror out = function - | Result.Ok x -> Format.fprintf out "(Ok %a)" pok x - | Result.Error e -> Format.fprintf out "(Error %a)" perror e + | Result.Ok x -> Format.fprintf out "(@[Ok %a@])" pok x + | Result.Error e -> Format.fprintf out "(@[Error %a@])" perror e let result pok = result' pok string let to_string = to_string end From b5be1d71a9154a19b8d9b03ff017f74046192f37 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 14 Mar 2017 22:45:11 +0100 Subject: [PATCH 11/56] bugfix and test for `CCZipper.is_focused` (closes #102) --- src/data/CCZipper.ml | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/data/CCZipper.ml b/src/data/CCZipper.ml index 44a92db4..b978838b 100644 --- a/src/data/CCZipper.ml +++ b/src/data/CCZipper.ml @@ -15,8 +15,12 @@ let to_list (l,r) = List.rev_append l r let to_rev_list (l,r) = List.rev_append r l +(*$inject + let zip_gen = Q.(pair (small_list int)(small_list int)) + *) + (*$Q - Q.(pair (list small_int)(list small_int)) (fun z -> \ + zip_gen (fun z -> \ to_list z = List.rev (to_rev_list z)) *) @@ -51,13 +55,18 @@ let modify f z = match z with end let is_focused = function - | _, [] -> true - | _ -> false + | _, _::_ -> true + | _, [] -> false let focused = function | _, x::_ -> Some x | _, [] -> None +(*$Q + zip_gen (fun g -> \ + is_focused g = (focused g |> CCOpt.is_some)) +*) + let focused_exn = function | _, x::_ -> x | _, [] -> raise Not_found From 923e83b0fc4f919a9b746c7be2ebf99378db5a3f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 16 Mar 2017 10:27:00 +0100 Subject: [PATCH 12/56] make tests faster --- src/core/CCArray.ml | 2 +- src/core/CCArray_slice.ml | 4 ++-- src/threads/CCPool.ml | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/CCArray.ml b/src/core/CCArray.ml index 8785019c..eb525f64 100644 --- a/src/core/CCArray.ml +++ b/src/core/CCArray.ml @@ -183,7 +183,7 @@ let sort_ranking cmp a = *) (*$Q - Q.(array printable_string) (fun a -> \ + Q.(array_of_size Gen.(0--50) printable_string) (fun a -> \ let b = sort_ranking String.compare a in \ let a_sorted = sorted String.compare a in \ a = Array.map (Array.get a_sorted) b) diff --git a/src/core/CCArray_slice.ml b/src/core/CCArray_slice.ml index e8ddac56..fcbe1204 100644 --- a/src/core/CCArray_slice.ml +++ b/src/core/CCArray_slice.ml @@ -306,7 +306,7 @@ let sort_ranking cmp a = *) (*$Q - Q.(array printable_string) (fun a -> \ + Q.(array_of_size Gen.(0--50) printable_string) (fun a -> \ Array.length a > 10 ==> ( Array.length a > 10 && \ let s = make a 5 ~len:5 in \ let b = sort_indices String.compare s in \ @@ -325,7 +325,7 @@ let sort_indices cmp a = _sort_indices cmp a.arr a.i a.j *) (*$Q - Q.(array printable_string) (fun a -> \ + Q.(array_of_size Gen.(0--60) printable_string) (fun a -> \ Array.length a > 10 ==> ( Array.length a > 10 && \ let s = make a 5 ~len:5 in \ let b = sort_ranking String.compare s in \ diff --git a/src/threads/CCPool.ml b/src/threads/CCPool.ml index 2bd4101a..1863e2a8 100644 --- a/src/threads/CCPool.ml +++ b/src/threads/CCPool.ml @@ -503,7 +503,7 @@ module Make(P : PARAM) = struct let l = CCList.(1--10_000) |> List.rev_map - (fun x-> Fut.make (fun () -> Thread.yield(); fib (x mod 30))) + (fun x-> Fut.make (fun () -> Thread.yield(); fib (x mod 20))) |> Fut.(map_l (fun x->x>|= fun x->x+1)) in OUnit.assert_bool "not done" (Fut.state l = Waiting); From 6573a2dd4a1c54eac6e6ba445f853035d946f89e Mon Sep 17 00:00:00 2001 From: glennsl Date: Sat, 25 Mar 2017 23:46:14 +0100 Subject: [PATCH 13/56] Add map_lazy, or_, or_lazy, to_result, to_result_lazy and of_result to CCOpt --- AUTHORS.adoc | 1 + src/core/CCOpt.ml | 26 ++++++++++++++++++++++++-- src/core/CCOpt.mli | 23 ++++++++++++++++++++++- 3 files changed, 47 insertions(+), 3 deletions(-) diff --git a/AUTHORS.adoc b/AUTHORS.adoc index 007ed5ce..fd3da2dc 100644 --- a/AUTHORS.adoc +++ b/AUTHORS.adoc @@ -18,3 +18,4 @@ - Roma Sokolov (@little-arhat) - Malcolm Matalka (`orbitz`) - David Sheets (@dsheets) +- Glenn Slotte (glennsl) diff --git a/src/core/CCOpt.ml b/src/core/CCOpt.ml index 355473c2..396ce37e 100644 --- a/src/core/CCOpt.ml +++ b/src/core/CCOpt.ml @@ -13,6 +13,10 @@ let map_or ~default f = function | None -> default | Some x -> f x +let map_lazy default_fn f = function + | None -> default_fn () + | Some x -> f x + let is_some = function | None -> false | Some _ -> true @@ -54,10 +58,16 @@ let (<*>) f x = match f, x with let (<$>) = map -let (<+>) a b = match a with - | None -> b +let or_ ~else_ a = match a with + | None -> else_ | Some _ -> a +let or_lazy ~else_ a = match a with + | None -> else_ () + | Some _ -> a + +let (<+>) a b = or_ ~else_:b a + let choice l = List.fold_left (<+>) None l let map2 f o1 o2 = match o1, o2 with @@ -137,6 +147,18 @@ let of_list = function | x::_ -> Some x | [] -> None +let to_result err = function + | None -> Error err + | Some x -> Ok x + +let to_result_lazy err_fn = function + | None -> Error (err_fn ()) + | Some x -> Ok x + +let of_result = function + | Error _ -> None + | Ok x -> Some x + module Infix = struct let (>|=) = (>|=) let (>>=) = (>>=) diff --git a/src/core/CCOpt.mli b/src/core/CCOpt.mli index 1281fbe1..19c7eead 100644 --- a/src/core/CCOpt.mli +++ b/src/core/CCOpt.mli @@ -9,9 +9,13 @@ val map : ('a -> 'b) -> 'a t -> 'b t (** Transform the element inside, if any *) val map_or : default:'b -> ('a -> 'b) -> 'a t -> 'b -(** [map_or ~default f o] is [f x] if [o = Some x], [default otherwise] +(** [map_or ~default f o] is [f x] if [o = Some x], [default] otherwise @since 0.16 *) +val map_lazy : (unit -> 'b) -> ('a -> 'b) -> 'a t -> 'b +(** [map_lazy default_fn f o] if [f o] if [o = Some x], [default_fn ()] otherwise + @since NEXT_RELEASE *) + val is_some : _ t -> bool val is_none : _ t -> bool @@ -94,6 +98,14 @@ val (<$>) : ('a -> 'b) -> 'a t -> 'b t (** {2 Alternatives} *) +val or_ : else_:('a t) -> 'a t -> 'a t +(** [or_ ~else_ a] is [a] if [a] is [Some _], [else_] otherwise + @since NEXT_RELEASE *) + +val or_lazy : else_:(unit -> 'a t) -> 'a t -> 'a t +(** [or_lazy else_ a] is [a] if [a] is [Some _], [else_ ()] otherwise + @since NEXT_RELEASE *) + val (<+>) : 'a t -> 'a t -> 'a t (** [a <+> b] is [a] if [a] is [Some _], [b] otherwise *) @@ -118,6 +130,15 @@ val to_list : 'a t -> 'a list val of_list : 'a list -> 'a t (** Head of list, or [None] *) +val to_result : 'e -> 'a t -> ('a, 'e) Result.result +(** @since NEXT_RELEASE *) + +val to_result_lazy : (unit -> 'e) -> 'a t -> ('a, 'e) Result.result +(** @since NEXT_RELEASE *) + +val of_result : ('a, _) Result.result -> 'a t +(** @since NEXT_RELEASE *) + type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option type 'a printer = Format.formatter -> 'a -> unit From 7e8c7235bcaf8f6378e9feef4fcabdfbcddd4f89 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 26 Mar 2017 00:36:45 +0100 Subject: [PATCH 14/56] use `result` package for retrocompat --- src/core/CCOpt.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/core/CCOpt.ml b/src/core/CCOpt.ml index 396ce37e..36154caf 100644 --- a/src/core/CCOpt.ml +++ b/src/core/CCOpt.ml @@ -148,16 +148,16 @@ let of_list = function | [] -> None let to_result err = function - | None -> Error err - | Some x -> Ok x + | None -> Result.Error err + | Some x -> Result.Ok x let to_result_lazy err_fn = function - | None -> Error (err_fn ()) - | Some x -> Ok x + | None -> Result.Error (err_fn ()) + | Some x -> Result.Ok x let of_result = function - | Error _ -> None - | Ok x -> Some x + | Result.Error _ -> None + | Result.Ok x -> Some x module Infix = struct let (>|=) = (>|=) From e6221d7e5044fd73d4fa6051044c8c6f9eef6c11 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 27 Mar 2017 21:05:37 +0200 Subject: [PATCH 15/56] add test --- src/data/CCBV.ml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/data/CCBV.ml b/src/data/CCBV.ml index a9704052..f00d69f2 100644 --- a/src/data/CCBV.ml +++ b/src/data/CCBV.ml @@ -378,6 +378,13 @@ type 'a sequence = ('a -> unit) -> unit let to_seq bv k = iter_true bv k +(*$Q + Q.(small_int) (fun i -> \ + let i = max 1 i in \ + let bv = create ~size:i true in \ + i = (to_seq bv |> Sequence.length)) + *) + let of_seq seq = let l = ref [] and maxi = ref 0 in seq (fun x -> l := x :: !l; maxi := max !maxi x); From f27f7757de56db546048c4980009c4fa216ef221 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 27 Mar 2017 22:06:37 +0200 Subject: [PATCH 16/56] add `CCResult.add_ctx{,f}` for replacing stack traces --- src/core/CCResult.ml | 16 ++++++++++++++++ src/core/CCResult.mli | 14 ++++++++++++++ 2 files changed, 30 insertions(+) diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index 9e4228ea..c5283735 100644 --- a/src/core/CCResult.ml +++ b/src/core/CCResult.ml @@ -31,6 +31,22 @@ let fail_fprintf format = (fun out -> Format.pp_print_flush out (); fail (Buffer.contents buf)) out format +let add_ctx msg x = match x with + | Error e -> Error (e ^ "\ncontext:" ^ msg) + | Ok x -> Ok x + +let add_ctxf msg = + let buf = Buffer.create 64 in + let out = Format.formatter_of_buffer buf in + Format.kfprintf + (fun out e -> Format.pp_print_flush out (); add_ctx (Buffer.contents buf) e) + out msg + +(*$= + (Error "error\ncontext:message(number 42, foo: true)") \ + (add_ctxf "message(number %d, foo: %B)" 42 true (Error "error")) +*) + let of_exn e = let msg = Printexc.to_string e in Error msg diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index f236274c..9dc02bad 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -42,6 +42,20 @@ 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 add_ctx : string -> ('a, string) t -> ('a, string) t +(** [add_ctx msg] leaves [Ok x] untouched, but transforms + [Error s] into [Error s'] where [s'] contains the additional + context given by [msg] + @since NEXT_RELEASE *) + +val add_ctxf : ('a, Format.formatter, unit, ('b, string) t -> ('b, string) t) format4 -> 'a +(** [add_ctxf format_message] is similar to {!add_ctx} but with + {!Format} for printing the message (eagerly). + Example: {[ + add_ctxf "message(number %d, foo: %B)" 42 true (Error "error)" + ]} + @since NEXT_RELEASE *) + val map : ('a -> 'b) -> ('a, 'err) t -> ('b, 'err) t (** Map on success *) From 670d2dbd4b7546e0eb9d97d7172c094181075c82 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 29 Mar 2017 17:20:17 +0200 Subject: [PATCH 17/56] build unix support by default --- _oasis | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/_oasis b/_oasis index da9c443b..b3f54836 100644 --- a/_oasis +++ b/_oasis @@ -26,7 +26,7 @@ Description: Flag "unix" Description: Build the containers.unix library (depends on Unix) - Default: false + Default: true Flag "thread" Description: Build modules that depend on threads From 47abc78a519bad7abdd3d64d15a23f964e0b4e04 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 29 Mar 2017 17:26:31 +0200 Subject: [PATCH 18/56] add `CCString.Sub.get` --- src/core/CCString.cppo.ml | 4 ++++ src/core/CCString.mli | 24 ++++++++++++++++++++++++ 2 files changed, 28 insertions(+) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index cbf78bc5..1f88b308 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -748,6 +748,10 @@ module Sub = struct let length (_,_,l) = l + let get (s,i,l) j = + if j<0 || j>= l then invalid_arg "CCString.Sub.get"; + String.unsafe_get s (i+j) + let blit (a1,i1,len1) o1 a2 o2 len = if o1+len>len1 then invalid_arg "CCString.Sub.blit"; blit a1 (i1+o1) a2 o2 len diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 184862cf..137e6b10 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -574,6 +574,11 @@ module Sub : sig val sub : t -> int -> int -> t (** Sub-slice *) + val get : t -> int -> char + (** [get s i] gets the [i]-th element, or fails + @raise Invalid_argument if the index is not within [0... length -1] + @since NEXT_RELEASE *) + include S with type t := t (*$T @@ -587,4 +592,23 @@ module Sub : sig let sub = Sub.make " abc " 1 ~len:3 in \ "\"abc\"" = (CCFormat.to_string Sub.print sub) *) + + (*$= & ~printer:(String.make 1) + 'b' Sub.(get (make "abc" 1 ~len:2) 0) + 'c' Sub.(get (make "abc" 1 ~len:2) 1) + *) + + (*$QR + Q.(printable_string_of_size Gen.(3--10)) (fun s -> + let open Sequence.Infix in + begin + (0 -- (length s-2) + >|= fun i -> i, Sub.make s i ~len:(length s-i)) + >>= fun (i,sub) -> + (0 -- (Sub.length sub-1) >|= fun j -> i,j,sub) + end + |> Sequence.for_all + (fun (i,j,sub) -> Sub.get sub j = s.[i+j])) + *) + end From e0287b9efeac90338f017188fe69e84cd261e8d8 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 29 Mar 2017 17:40:19 +0200 Subject: [PATCH 19/56] add `CCInt.range{,',by}` for iterating on integer ranges --- src/core/CCInt.ml | 73 ++++++++++++++++++++++++++++++++++++++++++++++ src/core/CCInt.mli | 26 +++++++++++++++++ 2 files changed, 99 insertions(+) diff --git a/src/core/CCInt.ml b/src/core/CCInt.ml index d4a3bae4..6efcc11f 100644 --- a/src/core/CCInt.ml +++ b/src/core/CCInt.ml @@ -39,6 +39,7 @@ let pow a b = type 'a printer = Format.formatter -> 'a -> unit type 'a random_gen = Random.State.t -> 'a +type 'a sequence = ('a -> unit) -> unit let random n st = Random.State.int st n let random_small = random 100 @@ -96,6 +97,76 @@ let to_string_binary n = Q.int (fun n -> n = int_of_string (to_string_binary n)) *) +let range_by ~step i j yield = + let rec range i j yield = + if i=j then yield i + else ( + yield i; + range (i+step) j yield + ) + in + if step = 0 then + raise (Invalid_argument "CCList.range_by") + else if (if step > 0 then i>j else i Sequence.to_list) + [] (range_by ~step:1 5 0 |> Sequence.to_list) + [] (range_by ~step:2 1 0 |> Sequence.to_list) + [0;2;4] (range_by ~step:2 0 4 |> Sequence.to_list) + [0;2;4] (range_by ~step:2 0 5 |> Sequence.to_list) + [0] (range_by ~step:~-1 0 0 |> Sequence.to_list) + [] (range_by ~step:~-1 0 5 |> Sequence.to_list) + [] (range_by ~step:~-2 0 1 |> Sequence.to_list) + [5;3;1] (range_by ~step:~-2 5 1 |> Sequence.to_list) + [5;3;1] (range_by ~step:~-2 5 0 |> Sequence.to_list) + [0] (range_by ~step:max_int 0 2 |> Sequence.to_list) +*) + +(*$Q + Q.(pair small_int small_int) (fun (i,j) -> \ + let i = min i j and j = max i j in \ + CCList.equal CCInt.equal \ + (CCInt.range_by ~step:1 i j |> Sequence.to_list) \ + (CCInt.range i j |> Sequence.to_list) ) +*) + +let range i j yield = + let rec up i j yield = + if i=j then yield i + else ( + yield i; + up (i+1) j yield + ) + and down i j yield = + if i=j then yield i + else ( + yield i; + down (i-1) j yield + ) + in + if i<=j then up i j yield else down i j yield + +(*$= & ~printer:Q.Print.(list int) + [0;1;2;3;4;5] (range 0 5 |> Sequence.to_list) + [0] (range 0 0 |> Sequence.to_list) + [5;4;3;2] (range 5 2 |> Sequence.to_list) +*) + +let range' i j yield = + if i Sequence.to_list) + [0;1;2;3;4] (range' 0 5 |> Sequence.to_list) + [5;4;3] (range' 5 2 |> Sequence.to_list) +*) + + module Infix = struct let (=) = Pervasives.(=) let (<>) = Pervasives.(<>) @@ -103,6 +174,8 @@ module Infix = struct let (>) = Pervasives.(>) let (<=) = Pervasives.(<=) let (>=) = Pervasives.(>=) + let (--) = range + let (--^) = range' end include Infix let min = min diff --git a/src/core/CCInt.mli b/src/core/CCInt.mli index 88d4abd7..c38b8818 100644 --- a/src/core/CCInt.mli +++ b/src/core/CCInt.mli @@ -25,6 +25,7 @@ val pow : t -> t -> t type 'a printer = Format.formatter -> 'a -> unit type 'a random_gen = Random.State.t -> 'a +type 'a sequence = ('a -> unit) -> unit val random : int -> t random_gen val random_small : t random_gen @@ -51,6 +52,23 @@ val min : t -> t -> t val max : t -> t -> t (** @since 0.17 *) +val range_by : step:t -> t -> t -> t sequence +(** [range_by ~step i j] iterates on integers from [i] to [j] included, + where the difference between successive elements is [step]. + use a negative [step] for a decreasing list. + @raise Invalid_argument if [step=0] + @since NEXT_RELEASE *) + +val range : t -> t -> t sequence +(** [range i j] iterates on integers from [i] to [j] included . It works + both for decreasing and increasing ranges + @since NEXT_RELEASE *) + +val range' : t -> t -> t sequence +(** Same as {!range} but the second bound is excluded. + For instance [range' 0 5 = Sequence.of_list [0;1;2;3;4]] + @since NEXT_RELEASE *) + (** {2 Infix Operators} @since 0.17 *) @@ -72,6 +90,14 @@ module Infix : sig val (>=) : t -> t -> bool (** @since 0.17 *) + + val (--) : t -> t -> t sequence + (** Alias to {!range} + @since NEXT_RELEASE *) + + val (--^) : t -> t -> t sequence + (** Alias to {!range'} + @since NEXT_RELEASE *) end include module type of Infix From ee69bdcab8a433990de35860eb4bba50df033972 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 3 Apr 2017 15:32:26 +0200 Subject: [PATCH 20/56] add `CCFormat.with_color_ksf` for colored printing --- src/core/CCFormat.ml | 6 ++++-- src/core/CCFormat.mli | 10 ++++++++++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 97590cf6..da23915e 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -324,7 +324,7 @@ let sprintf_ c format = fmt format -let with_color_sf s fmt = +let with_color_ksf ~f s fmt = let buf = Buffer.create 64 in let out = Format.formatter_of_buffer buf in if !color_enabled then set_color_tag_handling out; @@ -333,9 +333,11 @@ let with_color_sf s fmt = (fun out -> Format.pp_close_tag out (); Format.pp_print_flush out (); - Buffer.contents buf) + f (Buffer.contents buf)) out fmt +let with_color_sf s fmt = with_color_ksf ~f:(fun s->s) s fmt + let sprintf fmt = sprintf_ true fmt let sprintf_no_color fmt = sprintf_ false fmt let sprintf_dyn_color ~colors fmt = sprintf_ colors fmt diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index fdbe2be5..0687d90b 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -179,6 +179,16 @@ val with_color_sf : string -> ('a, t, unit, string) format4 -> 'a {b status: experimental} @since 0.21 *) +val with_color_ksf : f:(string -> 'b) -> string -> ('a, t, unit, 'b) format4 -> 'a +(** [with_color_ksf "Blue" ~f "%s %d" "yolo" 42] will behave like + {!ksprintf}, but wrapping the content with the given style + Example: + the following with raise [Failure] with a colored message + {[ + CCFormat.with_color_ksf "red" ~f:failwith "%a" CCFormat.Dump.(list int) [1;2;3];; + ]} + @since NEXT_RELEASE *) + (** {2 IO} *) val output : t -> 'a printer -> 'a -> unit From 02b2a21e33315a2c4932fb0010d21ecc59e2fb83 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 5 Apr 2017 10:43:37 +0200 Subject: [PATCH 21/56] add `CCResult.fold_ok` (closes #107) --- src/core/CCResult.ml | 9 +++++++++ src/core/CCResult.mli | 8 ++++++-- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index c5283735..c44ab774 100644 --- a/src/core/CCResult.ml +++ b/src/core/CCResult.ml @@ -114,6 +114,15 @@ let fold ~ok ~error x = match x with | Ok x -> ok x | Error s -> error s +let fold_ok f acc r = match r with + | Ok x -> f acc x + | Error _ -> acc + +(*$= + 42 (fold_ok (+) 2 (Ok 40)) + 40 (fold_ok (+) 40 (Error "foo")) + *) + let is_ok = function | Ok _ -> true | Error _ -> false diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index 9dc02bad..0f3f00f6 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -101,9 +101,13 @@ 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]. *) -val is_ok : ('a, 'err) t -> bool -(** Return true if Ok/ +val fold_ok : ('a -> 'b -> 'a) -> 'a -> ('b, _) t -> 'a +(** [fold_ok f acc r] will compute [f acc x] if [r=Ok x], + and return [acc] otherwise, as if the result were a mere option. + @since NEXT_RELEASE *) +val is_ok : ('a, 'err) t -> bool +(** Return true if Ok @since 1.0 *) val is_error : ('a, 'err) t -> bool From 08bc15dd8c74d3c170e3fabec23ffaba4b658d80 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 9 Apr 2017 15:11:12 +0200 Subject: [PATCH 22/56] add module `CCEqual` --- _oasis | 2 +- doc/intro.txt | 1 + src/core/CCEqual.ml | 49 ++++++++++++++++++++++++++++++++++++++++++++ src/core/CCEqual.mli | 39 +++++++++++++++++++++++++++++++++++ 4 files changed, 90 insertions(+), 1 deletion(-) create mode 100644 src/core/CCEqual.ml create mode 100644 src/core/CCEqual.mli diff --git a/_oasis b/_oasis index b3f54836..19753b57 100644 --- a/_oasis +++ b/_oasis @@ -42,7 +42,7 @@ Library "containers" CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray, CCRef, CCSet, CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat, CCIO, CCInt64, CCChar, CCResult, CCParse, CCArray_slice, - CCListLabels, CCArrayLabels, + CCListLabels, CCArrayLabels, CCEqual, Containers BuildDepends: bytes, result # BuildDepends: bytes, bisect_ppx diff --git a/doc/intro.txt b/doc/intro.txt index 461a5ece..72eb19d2 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -30,6 +30,7 @@ CCArrayLabels CCArray_slice CCBool CCChar +CCEqual CCFloat CCFormat CCFun diff --git a/src/core/CCEqual.ml b/src/core/CCEqual.ml new file mode 100644 index 00000000..9bcafb7e --- /dev/null +++ b/src/core/CCEqual.ml @@ -0,0 +1,49 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Equality Combinators} *) + +type 'a t = 'a -> 'a -> bool + +let poly = (=) + +let int = (=) +let string = (=) +let bool = (=) +let float = (=) + +let rec list f l1 l2 = match l1, l2 with + | [], [] -> true + | [], _ | _, [] -> false + | x1::l1', x2::l2' -> f x1 x2 && list f l1' l2' + +let array eq a b = + let rec aux i = + if i = Array.length a then true + else eq a.(i) b.(i) && aux (i+1) + in + Array.length a = Array.length b + && + aux 0 + +let option f o1 o2 = match o1, o2 with + | None, None -> true + | Some _, None + | None, Some _ -> false + | Some x, Some y -> f x y + +let pair f g (x1,y1)(x2,y2) = f x1 x2 && g y1 y2 +let triple f g h (x1,y1,z1)(x2,y2,z2) = f x1 x2 && g y1 y2 && h z1 z2 + +let map f eq x y = eq (f x) (f y) + +(*$Q + Q.(let p = small_list (pair small_int bool) in pair p p) (fun (l1,l2) -> \ + CCEqual.(list (pair int bool)) l1 l2 = (l1=l2)) +*) + +module Infix = struct + let (>|=) x f = map f x +end + +include Infix diff --git a/src/core/CCEqual.mli b/src/core/CCEqual.mli new file mode 100644 index 00000000..6eb5fa9d --- /dev/null +++ b/src/core/CCEqual.mli @@ -0,0 +1,39 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Equality Combinators} *) + +(** @since NEXT_RELEASE *) + +type 'a t = 'a -> 'a -> bool +(** Equality function. Must be transitive, symmetric, and reflexive. *) + +val poly : 'a t +(** Standard polymorphic equality *) + +val int : int t +val string : string t +val bool : bool t +val float : float t + +val list : 'a t -> 'a list t +val array : 'a t -> 'a array t + +val option : 'a t -> 'a option t +val pair : 'a t -> 'b t -> ('a * 'b) t +val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t + +val map : ('a -> 'b) -> 'b t -> 'a t +(** [map f eq] is the equality function that, given objects [x] and [y], + projects [x] and [y] using [f] (e.g. using a record field) and then + compares those projections with [eq]. + Example: + [map fst int] compares values of type [(int * 'a)] by their + first component. *) + +val (>|=) : 'b t -> ('a -> 'b) -> 'a t +(** Infix equivalent of {!map} *) + +module Infix : sig + val (>|=) : 'b t -> ('a -> 'b) -> 'a t +end From c7b1afca8252982c3300fd573bbf3ba6e041e4b1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 10 Apr 2017 10:31:54 +0200 Subject: [PATCH 23/56] missing alias --- src/core/containers.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/core/containers.ml b/src/core/containers.ml index 1373d929..399cee45 100644 --- a/src/core/containers.ml +++ b/src/core/containers.ml @@ -26,6 +26,7 @@ module Char = struct include Char include (CCChar : module type of CCChar with type t := t) end +module Equal = CCEqual module Float = CCFloat module Format = struct include Format From af6cd08ff464ebbf7f5eee6507408559bb97c72d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 13 Apr 2017 15:23:22 +0200 Subject: [PATCH 24/56] fix too restrictive type in `CCResult` --- src/core/CCResult.ml | 8 ++++++++ src/core/CCResult.mli | 4 ++-- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index c44ab774..0d00755c 100644 --- a/src/core/CCResult.ml +++ b/src/core/CCResult.ml @@ -24,6 +24,10 @@ let fail_printf format = (fun buf -> fail (Buffer.contents buf)) buf format +(*$T + (Error "ohno 42") = (fail_printf "ohno %d" 42) +*) + let fail_fprintf format = let buf = Buffer.create 64 in let out = Format.formatter_of_buffer buf in @@ -31,6 +35,10 @@ let fail_fprintf format = (fun out -> Format.pp_print_flush out (); fail (Buffer.contents buf)) out format +(*$T + (Error "ohno 42") = (fail_fprintf "ohno %d" 42) +*) + let add_ctx msg x = match x with | Error e -> Error (e ^ "\ncontext:" ^ msg) | Ok x -> Ok x diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index 0f3f00f6..9c6a9b49 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -34,11 +34,11 @@ val of_exn_trace : exn -> ('a, string) t 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 +val fail_printf : ('a, Buffer.t, unit, ('b, 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 +val fail_fprintf : ('a, Format.formatter, unit, ('b, string) t) format4 -> 'a (** [fail_printf format] uses [format] to obtain an error message and then returns [Error msg] *) From b70a8d875e43251c3d1aa60c3d603d8b4d9fd3b5 Mon Sep 17 00:00:00 2001 From: Leonid Rozenberg Date: Mon, 17 Apr 2017 19:00:39 -0400 Subject: [PATCH 25/56] One is _a_ megalomaniac --- README.adoc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.adoc b/README.adoc index 669e979a..d9451e23 100644 --- a/README.adoc +++ b/README.adoc @@ -23,7 +23,7 @@ Containers is: - A usable, reasonably well-designed library that extends OCaml's standard library (in 'src/core/', packaged under `containers` in ocamlfind. Modules are totally independent and are prefixed with `CC` (for "containers-core" - or "companion-cube" because I'm megalomaniac). This part should be + or "companion-cube" because I'm a megalomaniac). This part should be usable and should work. For instance, `CCList` contains functions and lists including safe versions of `map` and `append`. It also provides a drop-in replacement to the standard library, in the module From 404fede54a57ec088dad38899342663ae575af59 Mon Sep 17 00:00:00 2001 From: LemonBoy Date: Tue, 18 Apr 2017 10:45:28 +0200 Subject: [PATCH 26/56] Add a tail-recursive implementation of List.combine Closes #108. --- AUTHORS.adoc | 1 + src/core/CCList.ml | 20 ++++++++++++++++++++ src/core/CCList.mli | 4 ++++ 3 files changed, 25 insertions(+) diff --git a/AUTHORS.adoc b/AUTHORS.adoc index fd3da2dc..755da15b 100644 --- a/AUTHORS.adoc +++ b/AUTHORS.adoc @@ -19,3 +19,4 @@ - Malcolm Matalka (`orbitz`) - David Sheets (@dsheets) - Glenn Slotte (glennsl) +- @LemonBoy diff --git a/src/core/CCList.ml b/src/core/CCList.ml index f4f3b9ea..9ac2f6b7 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -339,6 +339,26 @@ let partition_map f l = assert_equal [1;3] l2 *) +let combine l1 l2 = + let rec direct i l1 l2 = match l1, l2 with + | ([], []) -> [] + | _ when i=0 -> safe l1 l2 [] + | (x1::l1', x2::l2') -> (x1, x2) :: direct (i-1) l1' l2' + | (_, _) -> invalid_arg "CCList.combine" + and safe l1 l2 acc = match l1, l2 with + | ([], []) -> List.rev acc + | (x1::l1', x2::l2') -> safe l1' l2' @@ (x1, x2) :: acc + | (_, _) -> invalid_arg "CCList.combine" + in + direct direct_depth_default_ l1 l2 + +(*$T + try ignore (combine [1] []); false with Invalid_argument _ -> true + try ignore (combine (1--1001) (1--1002)); false with Invalid_argument _ -> true + combine [1;2;3] [3;2;1] = List.combine [1;2;3] [3;2;1] + combine (1 -- 100_000) (1 -- 100_000) = List.combine (1 -- 100_000) (1 -- 100_000) +*) + let return x = [x] let (>>=) l f = flat_map f l diff --git a/src/core/CCList.mli b/src/core/CCList.mli index e8a06c5c..1c7489de 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -72,6 +72,10 @@ val init : int -> (int -> 'a) -> 'a t (** Similar to {!Array.init} @since 0.6 *) +val combine : ('a list) -> ('b list) -> ('a * 'b) list +(** Similar to {!List.combine} but tail-recursive + @since NEXT_RELEASE *) + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool From 6d728d5ce73f2f1b73cef7fedd953edf3fa799e6 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 18 Apr 2017 14:05:55 +0200 Subject: [PATCH 27/56] add a small test --- src/core/CCList.ml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 9ac2f6b7..5d84d136 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -359,6 +359,13 @@ let combine l1 l2 = combine (1 -- 100_000) (1 -- 100_000) = List.combine (1 -- 100_000) (1 -- 100_000) *) +(*$Q + Q.(let p = small_list int in pair p p)(fun (l1,l2) -> \ + if List.length l1=List.length l2 \ + then CCList.combine l1 l2 = List.combine l1 l2 \ + else Q.assume_fail() ) + *) + let return x = [x] let (>>=) l f = flat_map f l From 990b7b7b81d62d16309e744301f39898953d0fe4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 18 Apr 2017 20:55:03 +0200 Subject: [PATCH 28/56] style --- src/core/CCList.mli | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 1c7489de..df85ca5f 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -3,6 +3,12 @@ (** {1 complements to list} *) +type 'a sequence = ('a -> unit) -> unit +type 'a gen = unit -> 'a option +type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] +type 'a printer = Format.formatter -> 'a -> unit +type 'a random_gen = Random.State.t -> 'a + type 'a t = 'a list val empty : 'a t @@ -72,8 +78,9 @@ val init : int -> (int -> 'a) -> 'a t (** Similar to {!Array.init} @since 0.6 *) -val combine : ('a list) -> ('b list) -> ('a * 'b) list -(** Similar to {!List.combine} but tail-recursive +val combine : 'a list -> 'b list -> ('a * 'b) list +(** Similar to {!List.combine} but tail-recursive. + @raise Invalid_argument if the lists have distinct lengths. @since NEXT_RELEASE *) val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int @@ -437,12 +444,6 @@ end (** {2 Conversions} *) -type 'a sequence = ('a -> unit) -> unit -type 'a gen = unit -> 'a option -type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] -type 'a printer = Format.formatter -> 'a -> unit -type 'a random_gen = Random.State.t -> 'a - val random : 'a random_gen -> 'a t random_gen val random_non_empty : 'a random_gen -> 'a t random_gen val random_len : int -> 'a random_gen -> 'a t random_gen From f294ce163477cae70105a7f19a8c9de7d82c37c3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 18 Apr 2017 20:58:38 +0200 Subject: [PATCH 29/56] add `CCList.combine_gen` (close #110) --- src/core/CCList.ml | 19 +++++++++++++++++++ src/core/CCList.mli | 7 +++++++ 2 files changed, 26 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 5d84d136..1a0ab160 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -366,6 +366,25 @@ let combine l1 l2 = else Q.assume_fail() ) *) +let combine_gen l1 l2 = + let l1 = ref l1 in + let l2 = ref l2 in + fun () -> match !l1, !l2 with + | [], _ + | _, [] -> None + | x1 :: tail1, x2 :: tail2 -> + l1 := tail1; + l2 := tail2; + Some (x1,x2) + +(*$Q + Q.(let p = small_list int in pair p p)(fun (l1,l2) -> \ + let n = min (List.length l1) (List.length l2) in \ + let res1 = combine (take n l1) (take n l2) in \ + let res2 = combine_gen l1 l2 |> of_gen in \ + res1 = res2) + *) + let return x = [x] let (>>=) l f = flat_map f l diff --git a/src/core/CCList.mli b/src/core/CCList.mli index df85ca5f..46fbeff4 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -83,6 +83,13 @@ val combine : 'a list -> 'b list -> ('a * 'b) list @raise Invalid_argument if the lists have distinct lengths. @since NEXT_RELEASE *) +val combine_gen : 'a list -> 'b list -> ('a * 'b) gen +(** Lazy version of {!combine}. + Unlike {!combine}, it does not fail if the lists have different + lengths; + instead, the output has as many pairs as the smallest input list. + @since NEXT_RELEASE *) + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool From fc6682b1c175fd5e13e1102663d83c25c1e4d270 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 18 Apr 2017 21:19:37 +0200 Subject: [PATCH 30/56] add `CCFormat.{newline,substring}` --- src/core/CCFormat.ml | 5 +++++ src/core/CCFormat.mli | 11 +++++++++++ 2 files changed, 16 insertions(+) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index da23915e..f82cbebe 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -39,6 +39,11 @@ let nativeint fmt n = Format.fprintf fmt "%nd" n let string_quoted fmt s = Format.fprintf fmt "\"%s\"" s let flush = Format.pp_print_flush +let newline = Format.pp_force_newline + +let substring out (s,i,len): unit = + string out (String.sub s i len) + let list ?(sep=return ",@ ") pp fmt l = let rec pp_list l = match l with | x::((_::_) as l) -> diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 0687d90b..a40e20a2 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -23,6 +23,17 @@ val bool : bool printer val float3 : float printer (* 3 digits after . *) val float : float printer +val newline : unit printer +(** Force newline (see {!Format.pp_force_newline}) + @since NEXT_RELEASE *) + +val substring : (string * int * int) printer +(** Print the substring [(s,i,len)], where [i] is the offset + in [s] and [len] the number of bytes in the substring. + @raise Invalid_argument if the triple [(s,i,len)] does not + describe a proper substring. + @since NEXT_RELEASE *) + val char : char printer (** @since 0.14 *) val int32 : int32 printer (** @since 0.14 *) val int64 : int64 printer (** @since 0.14 *) From 9cca745fcf37ceb168c75cb58fcde5bd6da193ea Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 18 Apr 2017 21:19:50 +0200 Subject: [PATCH 31/56] add `CCFormat.text` (close #111) --- src/core/CCFormat.ml | 41 +++++++++++++++++++++++++++++++++++++++++ src/core/CCFormat.mli | 6 ++++++ 2 files changed, 47 insertions(+) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index f82cbebe..12bd744d 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -44,6 +44,47 @@ let newline = Format.pp_force_newline let substring out (s,i,len): unit = string out (String.sub s i len) +let text out (s:string): unit = + let len = String.length s in + let i = ref 0 in + let search_ c = + try Some (String.index_from s !i c) with Not_found -> None + in + while !i < len do + let j_newline = search_ '\n' in + let j_space = search_ ' ' in + let on_newline j = + substring out (s, !i, j - !i); + newline out (); + i := j + 1 + and on_space j = + substring out (s, !i, j - !i); + Format.pp_print_space out (); + i := j + 1 + in + begin match j_newline, j_space with + | None, None -> + (* done *) + substring out (s, !i, len - !i); + i := len + | Some j, None -> on_newline j + | None, Some j -> on_space j + | Some j1, Some j2 -> + if j1CCFormat.sprintf "%S" s) + "a\nb\nc" (sprintf_no_color "@[%a@]%!" text "a b c") + "a b\nc" (sprintf_no_color "@[%a@]%!" text "a b\nc") + *) + +(*$Q + Q.(printable_string) (fun s -> \ + sprintf_no_color "@[%a@]%!" text s = \ + sprintf_no_color "@[%a@]%!" Format.pp_print_text s) +*) + let list ?(sep=return ",@ ") pp fmt l = let rec pp_list l = match l with | x::((_::_) as l) -> diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index a40e20a2..847de339 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -34,6 +34,12 @@ val substring : (string * int * int) printer describe a proper substring. @since NEXT_RELEASE *) +val text : string printer +(** Print string, but replacing spaces with breaks and newlines + with {!newline}. + See [pp_print_text] on recent versions of OCaml. + @since NEXT_RELEASE *) + val char : char printer (** @since 0.14 *) val int32 : int32 printer (** @since 0.14 *) val int64 : int64 printer (** @since 0.14 *) From c725543faa9a50fb8983a30bf6a3e572df54941e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 18 Apr 2017 21:23:18 +0200 Subject: [PATCH 32/56] add alias `CCString.split` (close #115) --- src/core/CCString.cppo.ml | 2 ++ src/core/CCString.mli | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 1f88b308..37b29b65 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -402,6 +402,8 @@ let split_on_char c s: _ list = s = split_on_char ' ' s |> String.concat " ") *) +let split = Split.list_cpy + let compare_versions a b = let of_int s = try Some (int_of_string s) with _ -> None in let rec cmp_rec a b = match a(), b() with diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 137e6b10..bbf59ddc 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -499,6 +499,10 @@ val split_on_char : char -> string -> string list (** Split the string along the given char @since NEXT_RELEASE *) +val split : by:string -> string -> string list +(** Alias to {!Split.list_cpy} + @since NEXT_RELEASE *) + (** {2 Utils} *) val compare_versions : string -> string -> int From 1b200ff695a1aec9f276346047d6f86c56655420 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 18 Apr 2017 21:41:44 +0200 Subject: [PATCH 33/56] add `CCstring.equal_caseless` (close #112) --- src/core/CCString.cppo.ml | 22 ++++++++++------------ src/core/CCString.mli | 27 +++++++++++++++++++++++++++ 2 files changed, 37 insertions(+), 12 deletions(-) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 37b29b65..71a01709 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -391,17 +391,6 @@ end let split_on_char c s: _ list = Split.list_cpy ~by:(String.make 1 c) s -(*$= & ~printer:Q.Print.(list string) - ["a"; "few"; "words"; "from"; "our"; "sponsors"] \ - (split_on_char ' ' "a few words from our sponsors") -*) - -(*$Q - Q.(printable_string) (fun s -> \ - let s = split_on_char ' ' s |> String.concat " " in \ - s = split_on_char ' ' s |> String.concat " ") -*) - let split = Split.list_cpy let compare_versions a b = @@ -721,7 +710,16 @@ let lowercase_ascii = map CCChar.lowercase_ascii #endif - +let equal_caseless s1 s2: bool = + let char_lower c = + if c >= 'A' && c <= 'Z' + then Char.unsafe_chr (Char. code c + 32) + else c + in + String.length s1 = String.length s2 && + for_all2 + (fun c1 c2 -> Char.equal (char_lower c1) (char_lower c2)) + s1 s2 let pp buf s = Buffer.add_char buf '"'; diff --git a/src/core/CCString.mli b/src/core/CCString.mli index bbf59ddc..b167e824 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -399,6 +399,22 @@ val uppercase_ascii : string -> string val lowercase_ascii : string -> string (** See {!String}. @since 0.18 *) +val equal_caseless : string -> string -> bool +(** Comparison without respect to {b ascii} lowercase. + @since NEXT_RELEASE *) + +(*$T + equal_caseless "foo" "FoO" + equal_caseless "helLo" "HEllO" +*) + +(*$Q + Q.(pair printable_string printable_string) (fun (s1,s2) -> \ + equal_caseless s1 s2 = equal (lowercase_ascii s1)(lowercase_ascii s2)) + Q.(printable_string) (fun s -> equal_caseless s s) + Q.(printable_string) (fun s -> equal_caseless (uppercase_ascii s) s) +*) + (** {2 Finding} A relatively efficient algorithm for finding sub-strings @@ -499,6 +515,17 @@ val split_on_char : char -> string -> string list (** Split the string along the given char @since NEXT_RELEASE *) +(*$= & ~printer:Q.Print.(list string) + ["a"; "few"; "words"; "from"; "our"; "sponsors"] \ + (split_on_char ' ' "a few words from our sponsors") +*) + +(*$Q + Q.(printable_string) (fun s -> \ + let s = split_on_char ' ' s |> String.concat " " in \ + s = (split_on_char ' ' s |> String.concat " ")) +*) + val split : by:string -> string -> string list (** Alias to {!Split.list_cpy} @since NEXT_RELEASE *) From 0c7280a8f4c0450022968a52fd2ac4bc53517991 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 18 Apr 2017 21:46:38 +0200 Subject: [PATCH 34/56] remove test that depends on 4.02 --- src/core/CCFormat.ml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 12bd744d..431f7850 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -79,12 +79,6 @@ let text out (s:string): unit = "a b\nc" (sprintf_no_color "@[%a@]%!" text "a b\nc") *) -(*$Q - Q.(printable_string) (fun s -> \ - sprintf_no_color "@[%a@]%!" text s = \ - sprintf_no_color "@[%a@]%!" Format.pp_print_text s) -*) - let list ?(sep=return ",@ ") pp fmt l = let rec pp_list l = match l with | x::((_::_) as l) -> From fcd987f1c025abe1dad236224d801476187460d8 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 18 Apr 2017 21:47:32 +0200 Subject: [PATCH 35/56] fix test --- src/core/CCString.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index b167e824..ca640222 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -410,7 +410,7 @@ val equal_caseless : string -> string -> bool (*$Q Q.(pair printable_string printable_string) (fun (s1,s2) -> \ - equal_caseless s1 s2 = equal (lowercase_ascii s1)(lowercase_ascii s2)) + equal_caseless s1 s2 = (lowercase_ascii s1=lowercase_ascii s2)) Q.(printable_string) (fun s -> equal_caseless s s) Q.(printable_string) (fun s -> equal_caseless (uppercase_ascii s) s) *) From 6c8de1bc6432b0dc48b87d5166cdc542f8a5430a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 18 Apr 2017 22:04:37 +0200 Subject: [PATCH 36/56] small fix --- src/core/CCString.cppo.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 71a01709..9592a53d 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -718,7 +718,7 @@ let equal_caseless s1 s2: bool = in String.length s1 = String.length s2 && for_all2 - (fun c1 c2 -> Char.equal (char_lower c1) (char_lower c2)) + (fun c1 c2 -> char_lower c1 = char_lower c2) s1 s2 let pp buf s = From d8a55a98b9ef052d3c7cff150c78ed40a79cab33 Mon Sep 17 00:00:00 2001 From: Leonid Rozenberg Date: Wed, 19 Apr 2017 02:15:09 -0400 Subject: [PATCH 37/56] Size tracking implementation --- src/data/CCBV.ml | 313 +++++++++++++++++++++++++++++++--------------- src/data/CCBV.mli | 38 ++++-- 2 files changed, 240 insertions(+), 111 deletions(-) diff --git a/src/data/CCBV.ml b/src/data/CCBV.ml index f00d69f2..144661d4 100644 --- a/src/data/CCBV.ml +++ b/src/data/CCBV.ml @@ -1,80 +1,117 @@ -(* This file is free software, part of containers. See file "license" for more details. *) - (** {2 Imperative Bitvectors} *) -let __width = Sys.word_size - 2 +let __width = Sys.word_size - 1 -(* int with [n] ones *) -let rec __shift bv n = - if n = 0 - then bv - else __shift ((bv lsl 1) lor 1) (n-1) +(** We use OCamls ints to store the bits. We index them from the + least significant bit. We create masks to zero out the most significant + bits that aren't used to store values. *) +let __lsb_masks = + let a = Array.make (__width + 1) 0 in + for i = 1 to __width do + a.(i) <- a.(i-1) lor (1 lsl (i - 1)) + done; + a -(* only ones *) -let __all_ones = __shift 0 __width - -type t = { - mutable a : int array; -} - -let empty () = { a = [| |] } - -let create ~size default = - if size = 0 then { a = [| |] } - else begin - let n = if size mod __width = 0 then size / __width else (size / __width) + 1 in - let arr = if default - then Array.make n __all_ones - else Array.make n 0 - in - (* adjust last bits *) - if default && (size mod __width) <> 0 - then arr.(n-1) <- __shift 0 (size - (n-1) * __width); - { a = arr } - end - -(*$T - create ~size:17 true |> cardinal = 17 - create ~size:32 true |> cardinal= 32 - create ~size:132 true |> cardinal = 132 - create ~size:200 false |> cardinal = 0 - create ~size:29 true |> to_sorted_list = CCList.range 0 28 -*) - -let copy bv = { a=Array.copy bv.a; } - -(*$Q - (Q.list Q.small_int) (fun l -> \ - let bv = of_list l in to_list bv = to_list (copy bv)) -*) - -let length bv = Array.length bv.a - -let resize bv len = - if len > Array.length bv.a - then begin - let a' = Array.make len 0 in - Array.blit bv.a 0 a' 0 (Array.length bv.a); - bv.a <- a' - end +let __all_ones = __lsb_masks.(__width) (* count the 1 bits in [n]. See https://en.wikipedia.org/wiki/Hamming_weight *) let __count_bits n = let rec recurse count n = if n = 0 then count else recurse (count+1) (n land (n-1)) in - if n < 0 - then recurse 1 (n lsr 1) (* only on unsigned *) - else recurse 0 n + recurse 0 n + +(* Can I access the "private" members in testing? $Q + (Q.int_bound (Sys.word_size - 1)) (fun i -> __count_bits __lsb_masks.(i) = i) +*) + +type t = { + mutable a : int array; + mutable size : int; +} + +let length t = t.size + +let empty () = { a = [| |] ; size = 0 } + +let __to_array_legnth size = + if size mod __width = 0 then size / __width else (size / __width) + 1 + +let create ~size default = + if size = 0 then { a = [| |] ; size } + else begin + let n = __to_array_legnth size in + let arr = if default + then Array.make n __all_ones + else Array.make n 0 + in + (* adjust last bits *) + let r = size mod __width in + if default && r <> 0 + then Array.unsafe_set arr (n-1) __lsb_masks.(r); + { a = arr; size } + end + +(*$Q + (Q.pair Q.small_int Q.bool) (fun (size, b) -> create ~size b |> length = size) +*) + +(*$T + create ~size:17 true |> cardinal = 17 + create ~size:32 true |> cardinal = 32 + create ~size:132 true |> cardinal = 132 + create ~size:200 false |> cardinal = 0 + create ~size:29 true |> to_sorted_list = CCList.range 0 28 +*) + +let copy bv = { a = Array.copy bv.a ; size = bv.size } + +(*$Q + (Q.list Q.small_int) (fun l -> \ + let bv = of_list l in to_list bv = to_list (copy bv)) +*) + +let capacity bv = __width * Array.length bv.a let cardinal bv = let n = ref 0 in - for i = 0 to length bv - 1 do + for i = 0 to Array.length bv.a - 1 do n := !n + __count_bits bv.a.(i) done; !n +(*$Q + Q.small_int (fun size -> create ~size true |> cardinal = size) +*) + +let __really_resize bv ~desired ~current size = + let a' = Array.make desired 0 in + Array.blit bv.a 0 a' 0 current; + bv.a <- a'; + bv.size <- size + +let __grow bv size = + if size <= capacity bv (* within capacity *) + then bv.size <- size + else (* beyond capacity *) + let desired = __to_array_legnth size in + let current = Array.length bv.a in + __really_resize bv ~desired ~current size + +let __shrink bv size = + let desired = __to_array_legnth size in + let current = Array.length bv.a in + __really_resize bv ~desired ~current size + +let resize bv size = + if size < 0 then invalid_arg "resize: negative size" else + if size < bv.size (* shrink *) + then __shrink bv size + else if size = bv.size + then () + else __grow bv size + (*$R let bv1 = CCBV.create ~size:87 true in assert_equal ~printer:string_of_int 87 (CCBV.cardinal bv1); @@ -94,12 +131,12 @@ let is_empty bv = false let get bv i = - let n = i / __width in - if n < Array.length bv.a - then - let i = i - n * __width in - bv.a.(n) land (1 lsl i) <> 0 - else false + if i < 0 then invalid_arg "get: negative index" else + let n = i / __width in + let i = i mod __width in + if n < Array.length bv.a + then (Array.unsafe_get bv.a n) land (1 lsl i) <> 0 + else false (*$R let bv = CCBV.create ~size:99 false in @@ -118,11 +155,11 @@ let get bv i = *) let set bv i = - let n = i / __width in - if n >= Array.length bv.a - then resize bv (n+1); - let i = i - n * __width in - bv.a.(n) <- bv.a.(n) lor (1 lsl i) + if i < 0 then invalid_arg "set: negative index" else + let n = i / __width in + let j = i mod __width in + if i >= bv.size then __grow bv i; + Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lor (1 lsl j)) (*$T let bv = create ~size:3 false in set bv 0; get bv 0 @@ -130,22 +167,22 @@ let set bv i = *) let reset bv i = - let n = i / __width in - if n >= Array.length bv.a - then resize bv (n+1); - let i = i - n * __width in - bv.a.(n) <- bv.a.(n) land (lnot (1 lsl i)) + if i < 0 then invalid_arg "reset: negative index" else + let n = i / __width in + let j = i mod __width in + if i >= bv.size then __grow bv i; + Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) land (lnot (1 lsl j))) (*$T let bv = create ~size:3 false in set bv 0; reset bv 0; not (get bv 0) *) let flip bv i = - let n = i / __width in - if n >= Array.length bv.a - then resize bv (n+1); - let i = i - n * __width in - bv.a.(n) <- bv.a.(n) lxor (1 lsl i) + if i < 0 then invalid_arg "reset: negative index" else + let n = i / __width in + let j = i mod __width in + if i >= bv.size then __grow bv i; + Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lxor (1 lsl j)) (*$R let bv = of_list [1;10; 11; 30] in @@ -163,7 +200,7 @@ let flip bv i = *) let clear bv = - Array.iteri (fun i _ -> bv.a.(i) <- 0) bv.a + Array.fill bv.a 0 (Array.length bv.a) 0 (*$T let bv = create ~size:37 true in cardinal bv = 37 && (clear bv; cardinal bv= 0) @@ -242,8 +279,9 @@ let to_list bv = let to_sorted_list bv = List.rev (to_list bv) +(* Interpret these as indices. *) let of_list l = - let size = List.fold_left max 0 l in + let size = (List.fold_left max 0 l) + 1 in let bv = create ~size false in List.iter (fun i -> set bv i) l; bv @@ -276,18 +314,61 @@ let filter bv p = to_sorted_list bv = [2;4;6] *) +let negate_self b = + let len = Array.length b.a in + for n = 0 to len - 1 do + Array.unsafe_set b.a n (lnot (Array.unsafe_get b.a n)) + done; + let r = b.size mod __width in + if r <> 0 then + let l = Array.length b.a - 1 in + Array.unsafe_set b.a l (__lsb_masks.(r) land (Array.unsafe_get b.a l)) + +(*$T + let v = of_list [1;2;5;7;] in negate_self v; \ + cardinal v = (List.length [0;3;4;6]) +*) + +let negate b = + let a = Array.map (lnot) b.a in + let r = b.size mod __width in + if r <> 0 then begin + let l = Array.length b.a - 1 in + Array.unsafe_set a l (__lsb_masks.(r) land (Array.unsafe_get a l)) + end; + { a ; size = b.size } + +(*$Q + Q.small_int (fun size -> create ~size false |> negate |> cardinal = size) +*) + +(* Underlying size grows for union. *) let union_into ~into bv = - if length into < length bv - then resize into (length bv); - let len = Array.length bv.a in - for i = 0 to len - 1 do - into.a.(i) <- into.a.(i) lor bv.a.(i) + if into.size < bv.size + then __grow into bv.size; + for i = 0 to (Array.length into.a) - 1 do + Array.unsafe_set into.a i + ((Array.unsafe_get into.a i) lor (Array.unsafe_get bv.a i)) done -let union bv1 bv2 = - let bv = copy bv1 in - union_into ~into:bv bv2; - bv +(* To avoid potentially 2 passes, figure out what we need to copy. *) +let union b1 b2 = + if b1.size <= b2.size + then begin + let into = copy b2 in + for i = 0 to (Array.length b1.a) - 1 do + Array.unsafe_set into.a i + ((Array.unsafe_get into.a i) lor (Array.unsafe_get b1.a i)) + done; + into + end else begin + let into = copy b1 in + for i = 0 to (Array.length b1.a) - 1 do + Array.unsafe_set into.a i + ((Array.unsafe_get into.a i) lor (Array.unsafe_get b2.a i)) + done; + into + end (*$R let bv1 = CCBV.of_list [1;2;3;4] in @@ -302,22 +383,32 @@ let union bv1 bv2 = union (of_list [1;2;3;4;5]) (of_list [7;3;5;6]) |> to_sorted_list = CCList.range 1 7 *) +(* Underlying size shrinks for inter. *) let inter_into ~into bv = - let n = min (length into) (length bv) in - for i = 0 to n - 1 do - into.a.(i) <- into.a.(i) land bv.a.(i) + if into.size > bv.size + then __shrink into bv.size; + for i = 0 to (Array.length into.a) - 1 do + Array.unsafe_set into.a i + ((Array.unsafe_get into.a i) land (Array.unsafe_get bv.a i)) done -let inter bv1 bv2 = - if length bv1 < length bv2 - then - let bv = copy bv1 in - let () = inter_into ~into:bv bv2 in - bv - else - let bv = copy bv2 in - let () = inter_into ~into:bv bv1 in - bv +let inter b1 b2 = + if b1.size <= b2.size + then begin + let into = copy b1 in + for i = 0 to (Array.length b1.a) - 1 do + Array.unsafe_set into.a i + ((Array.unsafe_get into.a i) land (Array.unsafe_get b2.a i)) + done; + into + end else begin + let into = copy b2 in + for i = 0 to (Array.length b2.a) - 1 do + Array.unsafe_set into.a i + ((Array.unsafe_get into.a i) land (Array.unsafe_get b1.a i)) + done; + into + end (*$T inter (of_list [1;2;3;4]) (of_list [2;4;6;1]) |> to_sorted_list = [1;2;4] @@ -331,6 +422,20 @@ let inter bv1 bv2 = assert_equal [3;4] l; *) +(* Underlying size depends on the 'in_' set for diff, so we don't change + it's size! *) +let diff_into ~into bv = + let n = min (Array.length into.a) (Array.length bv.a) in + for i = 0 to n - 1 do + Array.unsafe_set into.a i + ((Array.unsafe_get into.a i) land (lnot (Array.unsafe_get bv.a i))) + done + +let diff ~in_ not_in = + let into = copy in_ in + diff_into ~into not_in; + into + let select bv arr = let l = ref [] in begin try diff --git a/src/data/CCBV.mli b/src/data/CCBV.mli index 36bb217f..414d50c2 100644 --- a/src/data/CCBV.mli +++ b/src/data/CCBV.mli @@ -21,14 +21,19 @@ val copy : t -> t (** Copy of bitvector *) val cardinal : t -> int -(** Number of bits set *) +(** Number of set bits. *) val length : t -> int -(** Length of underlying array *) +(** Length of underlying bitvector. *) + +val capacity : t -> int +(** The number of bits this bitvector can store without resizing. *) val resize : t -> int -> unit -(** Resize the BV so that it has at least the given physical length - [resize bv n] should make [bv] able to store [(Sys.word_size - 2)* n] bits *) +(** Resize the BV so that it has the specified length. This can grow or shrink + the underlying bitvector. + + @raise Invalid_arg on negative sizes. *) val is_empty : t -> bool (** Any bit set? *) @@ -62,7 +67,10 @@ val to_sorted_list : t -> int list increasing order *) val of_list : int list -> t -(** From a list of true bits *) +(** From a list of true bits. + + The bits are interpreted as indices into the returned bitvector, so the final + bitvector will have [length t] equal to 1 more than max of list indices. *) val first : t -> int (** First set bit, or @@ -72,11 +80,21 @@ val filter : t -> (int -> bool) -> unit (** [filter bv p] only keeps the true bits of [bv] whose [index] satisfies [p index] *) +val negate_self : t -> unit +(** [negate_self t] flips all of the bits in [t]. *) + +val negate : t -> t +(** [negate t] returns a copy of [t] with all of the bits flipped. *) + val union_into : into:t -> t -> unit -(** [union ~into bv] sets [into] to the union of itself and [bv]. *) +(** [union ~into bv] sets [into] to the union of itself and [bv]. + + Note that [into] will grow to accammodate the union. *) val inter_into : into:t -> t -> unit -(** [inter ~into bv] sets [into] to the intersection of itself and [bv] *) +(** [inter ~into bv] sets [into] to the intersection of itself and [bv] + + Note that [into] will shrink to accammodate the union. *) val union : t -> t -> t (** [union bv1 bv2] returns the union of the two sets *) @@ -84,6 +102,12 @@ val union : t -> t -> t val inter : t -> t -> t (** [inter bv1 bv2] returns the intersection of the two sets *) +val diff_into : into:t -> t -> unit +(** [diff ~into t] Modify [into] with only the bits set but not in [t]. *) + +val diff : in_:t -> t -> t +(** [diff ~in_ t] Return those bits found [in_] but not in [t]. *) + val select : t -> 'a array -> 'a list (** [select arr bv] selects the elements of [arr] whose index corresponds to a true bit in [bv]. If [bv] is too short, elements of [arr] From 8460b01f2f78624a31f62af89427a0bbea0a8fc3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 19 Apr 2017 17:36:53 +0200 Subject: [PATCH 38/56] fix hair-raising english mistake --- README.adoc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.adoc b/README.adoc index 669e979a..d9451e23 100644 --- a/README.adoc +++ b/README.adoc @@ -23,7 +23,7 @@ Containers is: - A usable, reasonably well-designed library that extends OCaml's standard library (in 'src/core/', packaged under `containers` in ocamlfind. Modules are totally independent and are prefixed with `CC` (for "containers-core" - or "companion-cube" because I'm megalomaniac). This part should be + or "companion-cube" because I'm a megalomaniac). This part should be usable and should work. For instance, `CCList` contains functions and lists including safe versions of `map` and `append`. It also provides a drop-in replacement to the standard library, in the module From f90f73f671dc82af197d010f4ed23c7dda033e24 Mon Sep 17 00:00:00 2001 From: Leonid Rozenberg Date: Wed, 19 Apr 2017 12:26:47 -0400 Subject: [PATCH 39/56] Incorporate reviewier feedback. Also added style elements from PR#116. --- src/data/CCBV.ml | 212 ++++++++++++++++++++++++++-------------------- src/data/CCBV.mli | 58 ++++++++----- 2 files changed, 160 insertions(+), 110 deletions(-) diff --git a/src/data/CCBV.ml b/src/data/CCBV.ml index 144661d4..179e482b 100644 --- a/src/data/CCBV.ml +++ b/src/data/CCBV.ml @@ -1,29 +1,30 @@ (** {2 Imperative Bitvectors} *) -let __width = Sys.word_size - 1 +let width_ = Sys.word_size - 1 (** We use OCamls ints to store the bits. We index them from the least significant bit. We create masks to zero out the most significant - bits that aren't used to store values. *) -let __lsb_masks = - let a = Array.make (__width + 1) 0 in - for i = 1 to __width do + bits that aren't used to store values. This is necessary when we are + constructing or negating a bit vector. *) +let lsb_masks_ = + let a = Array.make (width_ + 1) 0 in + for i = 1 to width_ do a.(i) <- a.(i-1) lor (1 lsl (i - 1)) done; a -let __all_ones = __lsb_masks.(__width) +let all_ones_ = lsb_masks_.(width_) (* count the 1 bits in [n]. See https://en.wikipedia.org/wiki/Hamming_weight *) -let __count_bits n = +let count_bits_ n = let rec recurse count n = if n = 0 then count else recurse (count+1) (n land (n-1)) in recurse 0 n (* Can I access the "private" members in testing? $Q - (Q.int_bound (Sys.word_size - 1)) (fun i -> __count_bits __lsb_masks.(i) = i) + (Q.int_bound (Sys.word_size - 1)) (fun i -> count_bits_ lsb_masks_.(i) = i) *) type t = { @@ -35,23 +36,24 @@ let length t = t.size let empty () = { a = [| |] ; size = 0 } -let __to_array_legnth size = - if size mod __width = 0 then size / __width else (size / __width) + 1 +let array_length_of_size size = + if size mod width_ = 0 then size / width_ else (size / width_) + 1 let create ~size default = - if size = 0 then { a = [| |] ; size } - else begin - let n = __to_array_legnth size in - let arr = if default - then Array.make n __all_ones + if size = 0 then { a = [| |]; size } + else ( + let n = capa_of_size size in + let a = if default + then Array.make n all_ones_ else Array.make n 0 in (* adjust last bits *) - let r = size mod __width in - if default && r <> 0 - then Array.unsafe_set arr (n-1) __lsb_masks.(r); - { a = arr; size } - end + let r = size mod width_ in + if default && r <> 0 then ( + Array.unsafe_set a (n-1) lsb_masks_.(r); + ); + { a; size } + ) (*$Q (Q.pair Q.small_int Q.bool) (fun (size, b) -> create ~size b |> length = size) @@ -65,52 +67,69 @@ let create ~size default = create ~size:29 true |> to_sorted_list = CCList.range 0 28 *) -let copy bv = { a = Array.copy bv.a ; size = bv.size } +let copy bv = { bv with a = Array.copy bv.a } (*$Q (Q.list Q.small_int) (fun l -> \ let bv = of_list l in to_list bv = to_list (copy bv)) *) -let capacity bv = __width * Array.length bv.a +let capacity bv = width_ * Array.length bv.a + +(* iterate on words of width (at most) [width_] *) +let iter_words ~f bv: unit = + if bv.size = 0 then () + else ( + let len = array_length_of_size bv.size in + assert (len>0); + for i = 0 to len-1 do + let word = Array.unsafe_get a i in + f i word + done; + if r <> 0 then f (len-1) (Array.unsafe_get a (len-1) land lsb_masks_.(r)); + ) let cardinal bv = - let n = ref 0 in - for i = 0 to Array.length bv.a - 1 do - n := !n + __count_bits bv.a.(i) - done; - !n + if bv.size = 0 then 0 + else ( + let n = ref 0 in + for i = 0 to Array.length bv.a - 1 do + n := !n + count_bits_ bv.a.(i) (* MSB of last element are all 0 *) + done; + !n + ) (*$Q Q.small_int (fun size -> create ~size true |> cardinal = size) *) -let __really_resize bv ~desired ~current size = +let really_resize_ bv ~desired ~current size = let a' = Array.make desired 0 in Array.blit bv.a 0 a' 0 current; bv.a <- a'; bv.size <- size -let __grow bv size = +let grow_ bv size = if size <= capacity bv (* within capacity *) then bv.size <- size - else (* beyond capacity *) - let desired = __to_array_legnth size in + else ( (* beyond capacity *) + let desired = array_length_of_size size in let current = Array.length bv.a in - __really_resize bv ~desired ~current size + really_resize_ bv ~desired ~current size + ) -let __shrink bv size = - let desired = __to_array_legnth size in +let shrink_ bv size = + let desired = array_length_of_size size in let current = Array.length bv.a in - __really_resize bv ~desired ~current size + really_resize_ bv ~desired ~current size let resize bv size = if size < 0 then invalid_arg "resize: negative size" else if size < bv.size (* shrink *) - then __shrink bv size + then shrink_ bv size else if size = bv.size then () - else __grow bv size + else grow_ bv size (*$R let bv1 = CCBV.create ~size:87 true in @@ -124,19 +143,19 @@ let resize bv size = let is_empty bv = try for i = 0 to Array.length bv.a - 1 do - if bv.a.(i) <> 0 then raise Exit + if bv.a.(i) <> 0 then raise Exit (* MSB of last element are all 0 *) done; true with Exit -> false let get bv i = - if i < 0 then invalid_arg "get: negative index" else - let n = i / __width in - let i = i mod __width in - if n < Array.length bv.a - then (Array.unsafe_get bv.a n) land (1 lsl i) <> 0 - else false + if i < 0 then invalid_arg "get: negative index"; + let n = i / width_ in + let i = i mod width_ in + if n < Array.length bv.a + then (Array.unsafe_get bv.a n) land (1 lsl i) <> 0 + else false (*$R let bv = CCBV.create ~size:99 false in @@ -155,11 +174,13 @@ let get bv i = *) let set bv i = - if i < 0 then invalid_arg "set: negative index" else - let n = i / __width in - let j = i mod __width in - if i >= bv.size then __grow bv i; + if i < 0 then invalid_arg "set: negative index" + else ( + let n = i / width_ in + let j = i mod width_ in + if i >= bv.size then grow_ bv i; Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lor (1 lsl j)) + ) (*$T let bv = create ~size:3 false in set bv 0; get bv 0 @@ -167,36 +188,40 @@ let set bv i = *) let reset bv i = - if i < 0 then invalid_arg "reset: negative index" else - let n = i / __width in - let j = i mod __width in - if i >= bv.size then __grow bv i; + if i < 0 then invalid_arg "reset: negative index" + else ( + let n = i / width_ in + let j = i mod width_ in + if i >= bv.size then grow_ bv i; Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) land (lnot (1 lsl j))) + ) (*$T let bv = create ~size:3 false in set bv 0; reset bv 0; not (get bv 0) *) let flip bv i = - if i < 0 then invalid_arg "reset: negative index" else - let n = i / __width in - let j = i mod __width in - if i >= bv.size then __grow bv i; + if i < 0 then invalid_arg "reset: negative index" + else ( + let n = i / width_ in + let j = i mod width_ in + if i >= bv.size then grow_ bv i; Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lxor (1 lsl j)) + ) (*$R let bv = of_list [1;10; 11; 30] in flip bv 10; - assert_equal [1;11;30] (to_sorted_list bv); - assert_equal false (get bv 10); + assert_equal ~printer:Q.Print.(list int) [1;11;30] (to_sorted_list bv); + assert_equal ~printer:Q.Print.bool false (get bv 10); flip bv 10; - assert_equal true (get bv 10); + assert_equal ~printer:Q.Print.bool true (get bv 10); flip bv 5; - assert_equal [1;5;10;11;30] (to_sorted_list bv); - assert_equal true (get bv 5); + assert_equal ~printer:Q.Print.(list int) [1;5;10;11;30] (to_sorted_list bv); + assert_equal ~printer:Q.Print.bool true (get bv 5); flip bv 100; - assert_equal [1;5;10;11;30;100] (to_sorted_list bv); - assert_equal true (get bv 100); + assert_equal ~printer:Q.Print.(list int) [1;5;10;11;30;100] (to_sorted_list bv); + assert_equal ~printer:Q.Print.bool true (get bv 100); *) let clear bv = @@ -216,11 +241,17 @@ let clear bv = let iter bv f = let len = Array.length bv.a in - for n = 0 to len - 1 do - let j = __width * n in - for i = 0 to __width - 1 do + for n = 0 to len - 2 do + let j = width_ * n in + for i = 0 to width_ - 1 do f (j+i) (bv.a.(n) land (1 lsl i) <> 0) done + done; + let j = max 0 (width_ * (len - 2)) in + let r = size mod width_ in + let final_length = if r = 0 then width_ else r in + for i = 0 to final_length - 1 do + f (j + i) (bv.a.(len - 1) land (i lsl i) <> 0) done (*$R @@ -232,14 +263,7 @@ let iter bv f = *) let iter_true bv f = - let len = Array.length bv.a in - for n = 0 to len - 1 do - let j = __width * n in - for i = 0 to __width - 1 do - if bv.a.(n) land (1 lsl i) <> 0 - then f (j+i) - done - done + iter bv (fun i b -> if b then f i else ()) (*$T of_list [1;5;7] |> iter_true |> Sequence.to_list |> List.sort CCOrd.compare = [1;5;7] @@ -294,15 +318,19 @@ let of_list l = exception FoundFirst of int -let first bv = +let first_exn bv = try iter_true bv (fun i -> raise (FoundFirst i)); raise Not_found with FoundFirst i -> i +let first bv = + try Some (first_exn bv) + with Not_found -> None + (*$T - of_list [50; 10; 17; 22; 3; 12] |> first = 3 + of_list [50; 10; 17; 22; 3; 12] |> first = Some 3 *) let filter bv p = @@ -319,10 +347,10 @@ let negate_self b = for n = 0 to len - 1 do Array.unsafe_set b.a n (lnot (Array.unsafe_get b.a n)) done; - let r = b.size mod __width in + let r = b.size mod width_ in if r <> 0 then let l = Array.length b.a - 1 in - Array.unsafe_set b.a l (__lsb_masks.(r) land (Array.unsafe_get b.a l)) + Array.unsafe_set b.a l (lsb_masks_.(r) land (Array.unsafe_get b.a l)) (*$T let v = of_list [1;2;5;7;] in negate_self v; \ @@ -331,10 +359,10 @@ let negate_self b = let negate b = let a = Array.map (lnot) b.a in - let r = b.size mod __width in + let r = b.size mod width_ in if r <> 0 then begin let l = Array.length b.a - 1 in - Array.unsafe_set a l (__lsb_masks.(r) land (Array.unsafe_get a l)) + Array.unsafe_set a l (lsb_masks_.(r) land (Array.unsafe_get a l)) end; { a ; size = b.size } @@ -345,7 +373,7 @@ let negate b = (* Underlying size grows for union. *) let union_into ~into bv = if into.size < bv.size - then __grow into bv.size; + then grow_ into bv.size; for i = 0 to (Array.length into.a) - 1 do Array.unsafe_set into.a i ((Array.unsafe_get into.a i) lor (Array.unsafe_get bv.a i)) @@ -354,21 +382,21 @@ let union_into ~into bv = (* To avoid potentially 2 passes, figure out what we need to copy. *) let union b1 b2 = if b1.size <= b2.size - then begin + then ( let into = copy b2 in for i = 0 to (Array.length b1.a) - 1 do Array.unsafe_set into.a i ((Array.unsafe_get into.a i) lor (Array.unsafe_get b1.a i)) done; into - end else begin + ) else ( let into = copy b1 in for i = 0 to (Array.length b1.a) - 1 do Array.unsafe_set into.a i ((Array.unsafe_get into.a i) lor (Array.unsafe_get b2.a i)) done; into - end + ) (*$R let bv1 = CCBV.of_list [1;2;3;4] in @@ -386,7 +414,7 @@ let union b1 b2 = (* Underlying size shrinks for inter. *) let inter_into ~into bv = if into.size > bv.size - then __shrink into bv.size; + then shrink_ into bv.size; for i = 0 to (Array.length into.a) - 1 do Array.unsafe_set into.a i ((Array.unsafe_get into.a i) land (Array.unsafe_get bv.a i)) @@ -394,21 +422,21 @@ let inter_into ~into bv = let inter b1 b2 = if b1.size <= b2.size - then begin + then ( let into = copy b1 in for i = 0 to (Array.length b1.a) - 1 do Array.unsafe_set into.a i ((Array.unsafe_get into.a i) land (Array.unsafe_get b2.a i)) done; into - end else begin + ) else ( let into = copy b2 in for i = 0 to (Array.length b2.a) - 1 do Array.unsafe_set into.a i ((Array.unsafe_get into.a i) land (Array.unsafe_get b1.a i)) done; into - end + ) (*$T inter (of_list [1;2;3;4]) (of_list [2;4;6;1]) |> to_sorted_list = [1;2;4] @@ -431,7 +459,7 @@ let diff_into ~into bv = ((Array.unsafe_get into.a i) land (lnot (Array.unsafe_get bv.a i))) done -let diff ~in_ not_in = +let diff in_ not_in = let into = copy in_ in diff_into ~into not_in; into @@ -474,10 +502,12 @@ let selecti bv arr = assert_equal [("b",1); ("c",2); ("f",5)] l; *) -(*$T +(*$= & ~printer:Q.Print.(list (pair int int)) selecti (of_list [1;4;3]) [| 0;1;2;3;4;5;6;7;8 |] \ + [1,1; 3,3; 4,4] (selecti (of_list [1;4;3]) [| 0;1;2;3;4;5;6;7;8 |] \ |> List.sort CCOrd.compare = [1, 1; 3,3; 4,4] -*) + |> List.sort CCOrd.compare) + *) type 'a sequence = ('a -> unit) -> unit diff --git a/src/data/CCBV.mli b/src/data/CCBV.mli index 414d50c2..4d0e4bae 100644 --- a/src/data/CCBV.mli +++ b/src/data/CCBV.mli @@ -3,9 +3,13 @@ (** {2 Imperative Bitvectors} - The size of the bitvector is rounded up to the multiple of 30 or 62. - In other words some functions such as {!iter} might iterate on more - bits than what was originally asked for. + {b BREAKING CHANGES} since NEXT_RELEASE: + size is now stored along with the bitvector. Some functions have + a new signature. + + The size of the bitvector used to be rounded up to the multiple of 30 or 62. + In other words some functions such as {!iter} would iterate on more + bits than what was originally asked for. This is not the case anymore. *) type t @@ -21,13 +25,18 @@ val copy : t -> t (** Copy of bitvector *) val cardinal : t -> int -(** Number of set bits. *) +(** Number of bits set to one, seen as a set of bits. *) val length : t -> int -(** Length of underlying bitvector. *) +(** Size of underlying bitvector. + This is not related to the underlying implementation. + Changed at NEXT_RELEASE +*) val capacity : t -> int -(** The number of bits this bitvector can store without resizing. *) +(** The number of bits this bitvector can store without resizing. + + @since NEXT_RELEASE *) val resize : t -> int -> unit (** Resize the BV so that it has the specified length. This can grow or shrink @@ -36,19 +45,19 @@ val resize : t -> int -> unit @raise Invalid_arg on negative sizes. *) val is_empty : t -> bool -(** Any bit set? *) +(** Are there any true bits? *) val set : t -> int -> unit -(** Set i-th bit. *) +(** Set i-th bit, extending the bitvector if needed. *) val get : t -> int -> bool (** Is the i-th bit true? Returns false if the index is too high*) val reset : t -> int -> unit -(** Set i-th bit to 0 *) +(** Set i-th bit to 0, extending the bitvector if needed. *) val flip : t -> int -> unit -(** Flip i-th bit *) +(** Flip i-th bit, extending the bitvector if needed. *) val clear : t -> unit (** Set every bit to 0 *) @@ -72,16 +81,23 @@ val of_list : int list -> t The bits are interpreted as indices into the returned bitvector, so the final bitvector will have [length t] equal to 1 more than max of list indices. *) -val first : t -> int -(** First set bit, or - @raise Not_found if all bits are 0 *) +val first : t -> int option +(** First set bit, or return None. + changed type at NEXT_RELEASE *) + +val first_exn : t -> int + (** First set bit, or + @raise Not_found if all bits are 0 + @since NEXT_RELEASE *) val filter : t -> (int -> bool) -> unit (** [filter bv p] only keeps the true bits of [bv] whose [index] satisfies [p index] *) val negate_self : t -> unit -(** [negate_self t] flips all of the bits in [t]. *) +(** [negate_self t] flips all of the bits in [t]. + + @since NEXT_RELEASE *) val negate : t -> t (** [negate t] returns a copy of [t] with all of the bits flipped. *) @@ -89,12 +105,12 @@ val negate : t -> t val union_into : into:t -> t -> unit (** [union ~into bv] sets [into] to the union of itself and [bv]. - Note that [into] will grow to accammodate the union. *) + Also updates the length of [into] to be at least [length bv]. *) val inter_into : into:t -> t -> unit (** [inter ~into bv] sets [into] to the intersection of itself and [bv] - Note that [into] will shrink to accammodate the union. *) + Also updates the length of [into] to be at most [length bv]. *) val union : t -> t -> t (** [union bv1 bv2] returns the union of the two sets *) @@ -103,10 +119,14 @@ val inter : t -> t -> t (** [inter bv1 bv2] returns the intersection of the two sets *) val diff_into : into:t -> t -> unit -(** [diff ~into t] Modify [into] with only the bits set but not in [t]. *) +(** [diff ~into t] Modify [into] with only the bits set but not in [t]. -val diff : in_:t -> t -> t -(** [diff ~in_ t] Return those bits found [in_] but not in [t]. *) + @since NEXT_RELEASE *) + +val diff : t -> t -> t +(** [diff t1 t2] Return those bits found [t1] but not in [t2]. + + @since NEXT_RELEASE *) val select : t -> 'a array -> 'a list (** [select arr bv] selects the elements of [arr] whose index From 2b148f0055827dd3dac4e110c6a360216d14d2d9 Mon Sep 17 00:00:00 2001 From: Leonid Rozenberg Date: Wed, 19 Apr 2017 12:29:23 -0400 Subject: [PATCH 40/56] Add self to authors --- AUTHORS.adoc | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS.adoc b/AUTHORS.adoc index fd3da2dc..9ac9544e 100644 --- a/AUTHORS.adoc +++ b/AUTHORS.adoc @@ -19,3 +19,4 @@ - Malcolm Matalka (`orbitz`) - David Sheets (@dsheets) - Glenn Slotte (glennsl) +- Leonid Rozenberg (@rleonid) From 0b53ed01a33599b2718142eefda4c362b404f2c5 Mon Sep 17 00:00:00 2001 From: Leonid Rozenberg Date: Wed, 19 Apr 2017 14:52:13 -0400 Subject: [PATCH 41/56] Merge and bug fix pass --- src/data/CCBV.ml | 29 +++++++---------------------- 1 file changed, 7 insertions(+), 22 deletions(-) diff --git a/src/data/CCBV.ml b/src/data/CCBV.ml index 179e482b..94decfdb 100644 --- a/src/data/CCBV.ml +++ b/src/data/CCBV.ml @@ -42,7 +42,7 @@ let array_length_of_size size = let create ~size default = if size = 0 then { a = [| |]; size } else ( - let n = capa_of_size size in + let n = array_length_of_size size in let a = if default then Array.make n all_ones_ else Array.make n 0 @@ -76,19 +76,6 @@ let copy bv = { bv with a = Array.copy bv.a } let capacity bv = width_ * Array.length bv.a -(* iterate on words of width (at most) [width_] *) -let iter_words ~f bv: unit = - if bv.size = 0 then () - else ( - let len = array_length_of_size bv.size in - assert (len>0); - for i = 0 to len-1 do - let word = Array.unsafe_get a i in - f i word - done; - if r <> 0 then f (len-1) (Array.unsafe_get a (len-1) land lsb_masks_.(r)); - ) - let cardinal bv = if bv.size = 0 then 0 else ( @@ -178,7 +165,7 @@ let set bv i = else ( let n = i / width_ in let j = i mod width_ in - if i >= bv.size then grow_ bv i; + if i >= bv.size then grow_ bv (i+1); Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lor (1 lsl j)) ) @@ -192,7 +179,7 @@ let reset bv i = else ( let n = i / width_ in let j = i mod width_ in - if i >= bv.size then grow_ bv i; + if i >= bv.size then grow_ bv (i+1); Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) land (lnot (1 lsl j))) ) @@ -205,7 +192,7 @@ let flip bv i = else ( let n = i / width_ in let j = i mod width_ in - if i >= bv.size then grow_ bv i; + if i >= bv.size then grow_ bv (i+1); Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lxor (1 lsl j)) ) @@ -247,11 +234,11 @@ let iter bv f = f (j+i) (bv.a.(n) land (1 lsl i) <> 0) done done; - let j = max 0 (width_ * (len - 2)) in - let r = size mod width_ in + let j = width_ * (len - 1) in + let r = bv.size mod width_ in let final_length = if r = 0 then width_ else r in for i = 0 to final_length - 1 do - f (j + i) (bv.a.(len - 1) land (i lsl i) <> 0) + f (j + i) (bv.a.(len - 1) land (1 lsl i) <> 0) done (*$R @@ -503,9 +490,7 @@ let selecti bv arr = *) (*$= & ~printer:Q.Print.(list (pair int int)) - selecti (of_list [1;4;3]) [| 0;1;2;3;4;5;6;7;8 |] \ [1,1; 3,3; 4,4] (selecti (of_list [1;4;3]) [| 0;1;2;3;4;5;6;7;8 |] \ - |> List.sort CCOrd.compare = [1, 1; 3,3; 4,4] |> List.sort CCOrd.compare) *) From 84a537efbd861669948ad0586989d4c62ab28a5b Mon Sep 17 00:00:00 2001 From: Leonid Rozenberg Date: Wed, 19 Apr 2017 15:27:35 -0400 Subject: [PATCH 42/56] Add test for diff --- src/data/CCBV.ml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/data/CCBV.ml b/src/data/CCBV.ml index 94decfdb..e8e6d043 100644 --- a/src/data/CCBV.ml +++ b/src/data/CCBV.ml @@ -451,6 +451,14 @@ let diff in_ not_in = diff_into ~into not_in; into +(*$T + diff (of_list [1;2;3]) (of_list [1;2;3]) |> to_list = []; + diff (of_list [1;2;3]) (of_list [1;2;3;4]) |> to_list = []; + diff (of_list [1;2;3;4]) (of_list [1;2;3]) |> to_list = [4]; + diff (of_list [1;2;3]) (of_list [1;2;3;400]) |> to_list = []; + diff (of_list [1;2;3;400]) (of_list [1;2;3]) |> to_list = [400]; +*) + let select bv arr = let l = ref [] in begin try From 93568949e6ca7bf8b1c5b6b6d2689c7c2186a0cc Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 19 Apr 2017 22:08:56 +0200 Subject: [PATCH 43/56] annotations in `CCEqual`, for optimization --- src/core/CCEqual.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/CCEqual.ml b/src/core/CCEqual.ml index 9bcafb7e..90c98cbc 100644 --- a/src/core/CCEqual.ml +++ b/src/core/CCEqual.ml @@ -7,10 +7,10 @@ type 'a t = 'a -> 'a -> bool let poly = (=) -let int = (=) -let string = (=) -let bool = (=) -let float = (=) +let int : int t = (=) +let string : string t = (=) +let bool : bool t = (=) +let float : float t = (=) let rec list f l1 l2 = match l1, l2 with | [], [] -> true From 71ad95044ff4f900a6f6878f8ed66426f3c779b4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 19 Apr 2017 22:09:46 +0200 Subject: [PATCH 44/56] missing function --- src/core/CCEqual.ml | 1 + src/core/CCEqual.mli | 1 + 2 files changed, 2 insertions(+) diff --git a/src/core/CCEqual.ml b/src/core/CCEqual.ml index 90c98cbc..f879bd05 100644 --- a/src/core/CCEqual.ml +++ b/src/core/CCEqual.ml @@ -11,6 +11,7 @@ let int : int t = (=) let string : string t = (=) let bool : bool t = (=) let float : float t = (=) +let unit () () = true let rec list f l1 l2 = match l1, l2 with | [], [] -> true diff --git a/src/core/CCEqual.mli b/src/core/CCEqual.mli index 6eb5fa9d..8c1d4adc 100644 --- a/src/core/CCEqual.mli +++ b/src/core/CCEqual.mli @@ -15,6 +15,7 @@ val int : int t val string : string t val bool : bool t val float : float t +val unit : unit t val list : 'a t -> 'a list t val array : 'a t -> 'a array t From 57d460ecde169f536a0421816f48cb4f036fd0a9 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 19 Apr 2017 22:28:02 +0200 Subject: [PATCH 45/56] style --- src/data/CCBV.ml | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/src/data/CCBV.ml b/src/data/CCBV.ml index e8e6d043..305421a2 100644 --- a/src/data/CCBV.ml +++ b/src/data/CCBV.ml @@ -24,7 +24,7 @@ let count_bits_ n = recurse 0 n (* Can I access the "private" members in testing? $Q - (Q.int_bound (Sys.word_size - 1)) (fun i -> count_bits_ lsb_masks_.(i) = i) + (Q.int_bound (Sys.word_size - 1)) (fun i -> count_bits_ lsb_masks_.(i) = i) *) type t = { @@ -81,7 +81,7 @@ let cardinal bv = else ( let n = ref 0 in for i = 0 to Array.length bv.a - 1 do - n := !n + count_bits_ bv.a.(i) (* MSB of last element are all 0 *) + n := !n + count_bits_ bv.a.(i) (* MSB of last element are all 0 *) done; !n ) @@ -97,11 +97,13 @@ let really_resize_ bv ~desired ~current size = bv.size <- size let grow_ bv size = - if size <= capacity bv (* within capacity *) + if size <= capacity bv (* within capacity *) then bv.size <- size - else ( (* beyond capacity *) + else ( + (* beyond capacity *) let desired = array_length_of_size size in let current = Array.length bv.a in + assert (desired > current); really_resize_ bv ~desired ~current size ) @@ -111,8 +113,8 @@ let shrink_ bv size = really_resize_ bv ~desired ~current size let resize bv size = - if size < 0 then invalid_arg "resize: negative size" else - if size < bv.size (* shrink *) + if size < 0 then invalid_arg "resize: negative size"; + if size < bv.size (* shrink *) then shrink_ bv size else if size = bv.size then () @@ -347,10 +349,10 @@ let negate_self b = let negate b = let a = Array.map (lnot) b.a in let r = b.size mod width_ in - if r <> 0 then begin + if r <> 0 then ( let l = Array.length b.a - 1 in Array.unsafe_set a l (lsb_masks_.(r) land (Array.unsafe_get a l)) - end; + ); { a ; size = b.size } (*$Q @@ -359,8 +361,9 @@ let negate b = (* Underlying size grows for union. *) let union_into ~into bv = - if into.size < bv.size - then grow_ into bv.size; + if into.size < bv.size then ( + grow_ into bv.size; + ); for i = 0 to (Array.length into.a) - 1 do Array.unsafe_set into.a i ((Array.unsafe_get into.a i) lor (Array.unsafe_get bv.a i)) @@ -400,8 +403,9 @@ let union b1 b2 = (* Underlying size shrinks for inter. *) let inter_into ~into bv = - if into.size > bv.size - then shrink_ into bv.size; + if into.size > bv.size then ( + shrink_ into bv.size; + ); for i = 0 to (Array.length into.a) - 1 do Array.unsafe_set into.a i ((Array.unsafe_get into.a i) land (Array.unsafe_get bv.a i)) @@ -438,7 +442,7 @@ let inter b1 b2 = *) (* Underlying size depends on the 'in_' set for diff, so we don't change - it's size! *) + it's size! *) let diff_into ~into bv = let n = min (Array.length into.a) (Array.length bv.a) in for i = 0 to n - 1 do @@ -500,7 +504,7 @@ let selecti bv arr = (*$= & ~printer:Q.Print.(list (pair int int)) [1,1; 3,3; 4,4] (selecti (of_list [1;4;3]) [| 0;1;2;3;4;5;6;7;8 |] \ |> List.sort CCOrd.compare) - *) +*) type 'a sequence = ('a -> unit) -> unit @@ -511,7 +515,7 @@ let to_seq bv k = iter_true bv k let i = max 1 i in \ let bv = create ~size:i true in \ i = (to_seq bv |> Sequence.length)) - *) +*) let of_seq seq = let l = ref [] and maxi = ref 0 in From 77ed135493ab9e9b4edd27f430bc5216430ba2bd Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 19 Apr 2017 22:30:30 +0200 Subject: [PATCH 46/56] add a comment about contributing (close #106); update makefile --- Makefile | 2 +- README.adoc | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 296149db..2775f558 100644 --- a/Makefile +++ b/Makefile @@ -128,7 +128,7 @@ update_next_tag: devel: ./configure --enable-bench --enable-tests --enable-unix \ - --enable-bigarray --enable-thread --enable-advanced + --enable-thread make all watch: diff --git a/README.adoc b/README.adoc index d9451e23..41b378f3 100644 --- a/README.adoc +++ b/README.adoc @@ -143,6 +143,9 @@ A few guidelines: - add `@since` tags for new functions; - add tests if possible (using `qtest`). +It is helpful to run `make devel` to enable everything. Some dependencies +are required, you'll need `opam install benchmark qcheck qtest sequence`. + Powered by image:http://oasis.forge.ocamlcore.org/oasis-badge.png[alt="OASIS", style="border: none;", link="http://oasis.forge.ocamlcore.org/"] [[tutorial]] From 9aa5d08f9672022b46c638dc89821cc1fc0d1f44 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 19 Apr 2017 22:38:59 +0200 Subject: [PATCH 47/56] more doc (close #118) --- src/core/CCFloat.mli | 14 +++++++++++++- src/core/CCInt64.mli | 8 ++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/src/core/CCFloat.mli b/src/core/CCFloat.mli index 92cc925b..0e57b997 100644 --- a/src/core/CCFloat.mli +++ b/src/core/CCFloat.mli @@ -68,11 +68,23 @@ val sign_exn : t -> int @since 0.7 *) val to_int : t -> int +(** Alias to {!int_of_float}. + Unspecified if outside of the range of integers. *) + val of_int : int -> t +(** Alias to {!float_of_int} *) val to_string : t -> string -val of_string : string -> t +val of_string_exn : string -> t +(** Alias to {!float_of_string} + @raise Failure in case of failure + @since NEXT_RELEASE *) + +val of_string : string -> t +(** Alias to {!float_of_string}. + @deprecated since NEXT_RELEASE, use {!of_string_exn} instead + @raise Failure in case of failure *) val equal_precision : epsilon:t -> t -> t -> bool (** Equality with allowed error up to a non negative epsilon value *) diff --git a/src/core/CCInt64.mli b/src/core/CCInt64.mli index f53b2a5f..fbec7199 100644 --- a/src/core/CCInt64.mli +++ b/src/core/CCInt64.mli @@ -53,24 +53,32 @@ val to_int : t -> int val of_int : int -> t option val of_int_exn : int -> t +(** Alias to {!Int64.of_int} + @raise Failure in case of failure *) val to_int32 : t -> int32 val of_int32 : int32 -> t option val of_int32_exn : int32 -> t +(** Alias to {!Int64.of_int32} + @raise Failure in case of failure *) val to_nativeint : t -> nativeint val of_nativeint : nativeint -> t option val of_nativeint_exn : nativeint -> t +(** Alias to {!Int64.of_nativeint} + @raise Failure in case of failure *) val to_float : t -> float val of_float : float -> t option val of_float_exn : float -> t +(** Alias to {!Int64.of_float} + @raise Failure in case of failure *) val to_string : t -> string From 8d01cf3cc2931eeb18f61f9971c1df2b6d05e073 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 19 Apr 2017 22:45:41 +0200 Subject: [PATCH 48/56] missing fun --- src/core/CCFloat.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/core/CCFloat.ml b/src/core/CCFloat.ml index c835b400..2e7fcc41 100644 --- a/src/core/CCFloat.ml +++ b/src/core/CCFloat.ml @@ -73,6 +73,7 @@ let to_int (a:float) = Pervasives.int_of_float a let of_int (a:int) = Pervasives.float_of_int a let to_string (a:float) = Pervasives.string_of_float a +let of_string_exn (a:string) = Pervasives.float_of_string a let of_string (a:string) = Pervasives.float_of_string a From 81ed6139cad6dfcd3c3a4c7ba33c338238be3766 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 24 Apr 2017 20:20:37 +0200 Subject: [PATCH 49/56] add `CCList.take_drop_while` (close #120) --- src/core/CCList.ml | 23 +++++++++++++++++++++++ src/core/CCList.mli | 4 ++++ 2 files changed, 27 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 1a0ab160..6861d538 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -700,6 +700,29 @@ let rec drop_while p l = match l with take_while f l @ drop_while f l = l) *) +let take_drop_while p l = + let rec direct i p l = match l with + | [] -> [], [] + | _ when i=0 -> safe p [] l + | x :: tail -> + if p x + then + let l1, l2 = direct (i-1) p tail in + x :: l1, l2 + else [], l + and safe p acc l = match l with + | [] -> List.rev acc, [] + | x :: tail -> + if p x then safe p (x::acc) tail else List.rev acc, l + in + direct direct_depth_default_ p l + +(*$Q + Q.(pair (fun1 small_int bool) (list small_int)) (fun (f,l) -> \ + let l1,l2 = take_drop_while f l in \ + (l1 = take_while f l) && (l2 = drop_while f l)) +*) + let last n l = let len = List.length l in if len < n then l else drop (len-n) l diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 46fbeff4..f90ddef8 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -197,6 +197,10 @@ val take_while : ('a -> bool) -> 'a t -> 'a t val drop_while : ('a -> bool) -> 'a t -> 'a t (** @since 0.13 *) +val take_drop_while : ('a -> bool) -> 'a t -> 'a t * 'a t +(** [take_drop_while p l = take_while p l, drop_while p l] + @since NEXT_RELEASE *) + val last : int -> 'a t -> 'a t (** [last n l] takes the last [n] elements of [l] (or less if [l] doesn't have that many elements *) From 43bccceac7acd55b9b5dd85f052b457759fe399e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Apr 2017 22:31:11 +0200 Subject: [PATCH 50/56] add test and bugfix for `CCBV` --- src/data/CCBV.ml | 44 ++++++++++++++++++++++++++++++++------------ 1 file changed, 32 insertions(+), 12 deletions(-) diff --git a/src/data/CCBV.ml b/src/data/CCBV.ml index 305421a2..74ea2e7a 100644 --- a/src/data/CCBV.ml +++ b/src/data/CCBV.ml @@ -229,28 +229,48 @@ let clear bv = *) let iter bv f = - let len = Array.length bv.a in + let len = array_length_of_size bv.size in + assert (len <= Array.length bv.a); for n = 0 to len - 2 do let j = width_ * n in for i = 0 to width_ - 1 do f (j+i) (bv.a.(n) land (1 lsl i) <> 0) done done; - let j = width_ * (len - 1) in - let r = bv.size mod width_ in - let final_length = if r = 0 then width_ else r in - for i = 0 to final_length - 1 do - f (j + i) (bv.a.(len - 1) land (1 lsl i) <> 0) - done + if bv.size > 0 then ( + let j = width_ * (len - 1) in + let r = bv.size mod width_ in + let final_length = if r = 0 then width_ else r in + for i = 0 to final_length - 1 do + f (j + i) (bv.a.(len - 1) land (1 lsl i) <> 0) + done + ) (*$R - let bv = create ~size:30 false in - set bv 5; - let n = ref 0 in - iter bv (fun i b -> incr n; assert_equal b (i=5)); - assert_bool "at least 30" (!n >= 30) + List.iter + (fun size -> + let bv = create ~size false in + set bv 5; + let n = ref 0 in + iter bv (fun i b -> incr n; assert_equal b (i=5)); + assert_bool "exactly size" (!n = size)) + [30; 100; 255; 256;10_000] *) +(*$= & ~printer:Q.Print.(list (pair int bool)) + [] (iter (create ~size:0 false) |> Sequence.zip |> Sequence.to_list) + [0, false; 1, true; 2, false] \ + (iter (let bv = create ~size:3 false in set bv 1; bv) |> Sequence.zip |> Sequence.to_list) +*) + +(*$Q + Q.(small_int) (fun n -> \ + assert (n >= 0); \ + let bv = create ~size:n true in \ + let l = iter bv |> Sequence.zip |> Sequence.to_list in \ + List.length l = n && List.for_all (fun (_,b) -> b) l) + *) + let iter_true bv f = iter bv (fun i b -> if b then f i else ()) From 883eb611f0a0399f411f83660561ca75562aa34e Mon Sep 17 00:00:00 2001 From: Fabian Date: Fri, 28 Apr 2017 14:40:15 -0500 Subject: [PATCH 51/56] Implement CCInt.floor_div and CCInt.rem --- src/core/CCInt.ml | 72 ++++++++++++++++++++++++++++++++++++++++++++++ src/core/CCInt.mli | 10 +++++++ 2 files changed, 82 insertions(+) diff --git a/src/core/CCInt.ml b/src/core/CCInt.ml index 6efcc11f..522c37ed 100644 --- a/src/core/CCInt.ml +++ b/src/core/CCInt.ml @@ -37,6 +37,78 @@ let pow a b = pow 0 1 = 0 *) +let floor_div a n = + if a < 0 && n >= 0 then + (a + 1) / n - 1 + else if a > 0 && n < 0 then + (a - 1) / n - 1 + else + a / n + +(*$T + (floor_div 3 5 = 0) + (floor_div 5 5 = 1) + (floor_div 12 5 = 2) + (floor_div 0 5 = 0) + (floor_div (-1) 5 = -1) + (floor_div (-5) 5 = -1) + (floor_div (-12) 5 = -3) + + (floor_div 0 (-5) = 0) + (floor_div 3 (-5) = -1) + (floor_div 5 (-5) = -1) + (floor_div 9 (-5) = -2) + (floor_div (-2) (-5) = 0) + (floor_div (-8) (-5) = 1) + + try ignore (floor_div 12 0); false with Division_by_zero -> true + try ignore (floor_div (-12) 0); false with Division_by_zero -> true +*) + +(*$Q + (Q.pair Q.small_signed_int Q.pos_int) \ + (fun (n, m) -> floor_div n m = int_of_float @@ floor (float n /. float m)) + (Q.pair Q.small_signed_int Q.pos_int) \ + (fun (n, m) -> floor_div n (-m) = int_of_float @@ floor (float n /. float (-m))) +*) + +let rem a n = + let y = a mod n in + if (y < 0) <> (n < 0) && y <> 0 then + y + n + else + y + +(*$T + (rem 3 5 = 3) + (rem 5 5 = 0) + (rem 9 5 = 4) + (rem (-1) 5 = 4) + (rem (-5) 5 = 0) + (rem (-9) 5 = 1) + (rem 0 5 = 0) + + (rem 0 (-5) = 0) + (rem 3 (-5) = -2) + (rem 5 (-5) = 0) + (rem 9 (-5) = -1) + (rem (-2) (-5) = -2) + (rem (-8) (-5) = -3) + + try ignore (rem 12 0); false with Division_by_zero -> true + try ignore (rem (-12) 0); false with Division_by_zero -> true +*) + +(*$Q + (Q.pair Q.int Q.pos_int) (fun (n, m) -> let y = rem n m in y >= 0 && y < m) + (Q.pair Q.int Q.pos_int) (fun (n, m) -> let y = rem n (-m) in y > (-m) && y <= 0) +*) + +(*$Q + (Q.pair Q.int Q.pos_int) (fun (n, m) -> n = m * floor_div n m + rem n m) + (Q.pair Q.int Q.pos_int) (fun (n, m) -> n = (-m) * floor_div n (-m) + rem n (-m)) +*) + type 'a printer = Format.formatter -> 'a -> unit type 'a random_gen = Random.State.t -> 'a type 'a sequence = ('a -> unit) -> unit diff --git a/src/core/CCInt.mli b/src/core/CCInt.mli index c38b8818..7c9146ff 100644 --- a/src/core/CCInt.mli +++ b/src/core/CCInt.mli @@ -23,6 +23,16 @@ val pow : t -> t -> t Raises [Invalid_argument] if [a = b = 0] or [b] < 0. @since 0.11 *) +val floor_div : t -> t -> t +(** [floor_div a n] is integer division rounding towards negative infinity. + It satisfies [a = m * floor_div a n + rem a n]. + @since NEXT_RELEASE *) + +val rem : t -> t -> t +(** [rem a n] is the remainder of dividing [a] by [n], with the same + sign as [n]. + @since NEXT_RELEASE *) + type 'a printer = Format.formatter -> 'a -> unit type 'a random_gen = Random.State.t -> 'a type 'a sequence = ('a -> unit) -> unit From 0408466bd9cd60c19ff629552df8dd1fc6e36c95 Mon Sep 17 00:00:00 2001 From: Fabian Date: Fri, 28 Apr 2017 15:22:32 -0500 Subject: [PATCH 52/56] More tests for floor_div and rem --- src/core/CCInt.ml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/core/CCInt.ml b/src/core/CCInt.ml index 522c37ed..eb37fccc 100644 --- a/src/core/CCInt.ml +++ b/src/core/CCInt.ml @@ -48,6 +48,7 @@ let floor_div a n = (*$T (floor_div 3 5 = 0) (floor_div 5 5 = 1) + (floor_div 20 5 = 4) (floor_div 12 5 = 2) (floor_div 0 5 = 0) (floor_div (-1) 5 = -1) @@ -58,8 +59,10 @@ let floor_div a n = (floor_div 3 (-5) = -1) (floor_div 5 (-5) = -1) (floor_div 9 (-5) = -2) + (floor_div 20 (-5) = -4) (floor_div (-2) (-5) = 0) (floor_div (-8) (-5) = 1) + (floor_div (-35) (-5) = 7) try ignore (floor_div 12 0); false with Division_by_zero -> true try ignore (floor_div (-12) 0); false with Division_by_zero -> true @@ -85,6 +88,7 @@ let rem a n = (rem 9 5 = 4) (rem (-1) 5 = 4) (rem (-5) 5 = 0) + (rem (-20) 5 = 0) (rem (-9) 5 = 1) (rem 0 5 = 0) @@ -94,6 +98,7 @@ let rem a n = (rem 9 (-5) = -1) (rem (-2) (-5) = -2) (rem (-8) (-5) = -3) + (rem (-35) (-5) = 0) try ignore (rem 12 0); false with Division_by_zero -> true try ignore (rem (-12) 0); false with Division_by_zero -> true From 75e3962ba197032dc937bf13a172df00aa60da95 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 1 May 2017 16:38:44 +0200 Subject: [PATCH 53/56] make many modules extensions of stdlib (close #109) for : Random Array List ArrayLabels ListLabels Char String --- benchs/run_benchs.ml | 4 +--- src/core/CCArray.ml | 2 ++ src/core/CCArray.mli | 2 ++ src/core/CCArrayLabels.ml | 2 ++ src/core/CCArrayLabels.mli | 2 ++ src/core/CCChar.ml | 3 +-- src/core/CCChar.mli | 2 +- src/core/CCList.ml | 2 ++ src/core/CCList.mli | 2 ++ src/core/CCListLabels.ml | 2 ++ src/core/CCListLabels.mli | 2 ++ src/core/CCRandom.ml | 2 ++ src/core/CCRandom.mli | 2 ++ src/core/CCString.cppo.ml | 2 ++ src/core/CCString.mli | 2 ++ src/core/containers.ml | 41 +++++++------------------------------- 16 files changed, 34 insertions(+), 40 deletions(-) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index 9fb59a6c..c6a59626 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -432,9 +432,7 @@ module Tbl = struct let arg_make : type a. a key_type -> (module KEY with type t = a) * string = function | Int -> (module CCInt), "int" - | Str -> - let module S = struct type t = string include CCString end in - (module S : KEY with type t = string), "string" + | Str -> (module CCString : KEY with type t = string), "string" let sprintf = Printf.sprintf diff --git a/src/core/CCArray.ml b/src/core/CCArray.ml index eb525f64..44d93b16 100644 --- a/src/core/CCArray.ml +++ b/src/core/CCArray.ml @@ -18,6 +18,8 @@ type 'a printer = Format.formatter -> 'a -> unit (** {2 Arrays} *) +include Array + type 'a t = 'a array let empty = [| |] diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index 42ad6925..6676d1ed 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -13,6 +13,8 @@ type 'a printer = Format.formatter -> 'a -> unit (** {2 Arrays} *) +include module type of Array + type 'a t = 'a array val empty : 'a t diff --git a/src/core/CCArrayLabels.ml b/src/core/CCArrayLabels.ml index 85e152c8..f6573cb8 100644 --- a/src/core/CCArrayLabels.ml +++ b/src/core/CCArrayLabels.ml @@ -18,6 +18,8 @@ type 'a printer = Format.formatter -> 'a -> unit (** {2 Arrays} *) +include ArrayLabels + type 'a t = 'a array let empty = [| |] diff --git a/src/core/CCArrayLabels.mli b/src/core/CCArrayLabels.mli index 36f3d4ea..fdf3784b 100644 --- a/src/core/CCArrayLabels.mli +++ b/src/core/CCArrayLabels.mli @@ -13,6 +13,8 @@ type 'a printer = Format.formatter -> 'a -> unit (** {2 Arrays} *) +include module type of ArrayLabels + type 'a t = 'a array val empty : 'a t diff --git a/src/core/CCChar.ml b/src/core/CCChar.ml index 848594a0..55900bd6 100644 --- a/src/core/CCChar.ml +++ b/src/core/CCChar.ml @@ -4,10 +4,9 @@ @since 0.14 *) -type t = char +include Char let equal (a:char) b = a=b -let compare = Char.compare let pp = Buffer.add_char let print = Format.pp_print_char diff --git a/src/core/CCChar.mli b/src/core/CCChar.mli index 55ebca0d..2100a900 100644 --- a/src/core/CCChar.mli +++ b/src/core/CCChar.mli @@ -4,7 +4,7 @@ @since 0.14 *) -type t = char +include module type of Char val equal : t -> t -> bool val compare : t -> t -> int diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 6861d538..82eb60a9 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -9,6 +9,8 @@ type 'a t = 'a list +include List + let empty = [] let is_empty = function diff --git a/src/core/CCList.mli b/src/core/CCList.mli index f90ddef8..4a5138d6 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -9,6 +9,8 @@ type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] type 'a printer = Format.formatter -> 'a -> unit type 'a random_gen = Random.State.t -> 'a +include module type of List + type 'a t = 'a list val empty : 'a t diff --git a/src/core/CCListLabels.ml b/src/core/CCListLabels.ml index d5bb6fad..61df2913 100644 --- a/src/core/CCListLabels.ml +++ b/src/core/CCListLabels.ml @@ -7,6 +7,8 @@ let lsort l = List.sort Pervasives.compare l *) +include ListLabels + type 'a t = 'a list let empty = [] diff --git a/src/core/CCListLabels.mli b/src/core/CCListLabels.mli index bfa81d21..09125956 100644 --- a/src/core/CCListLabels.mli +++ b/src/core/CCListLabels.mli @@ -3,6 +3,8 @@ (** {1 complements to list} *) +include module type of ListLabels + type 'a t = 'a list val empty : 'a t diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index be36f30e..bcc83111 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -3,6 +3,8 @@ (** {1 Random Generators} *) +include Random + type state = Random.State.t type 'a t = state -> 'a diff --git a/src/core/CCRandom.mli b/src/core/CCRandom.mli index e43da782..ffb32cfb 100644 --- a/src/core/CCRandom.mli +++ b/src/core/CCRandom.mli @@ -3,6 +3,8 @@ (** {1 Random Generators} *) +include module type of Random + type state = Random.State.t type 'a t = state -> 'a diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 9592a53d..a4c66419 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -7,6 +7,8 @@ type 'a gen = unit -> 'a option type 'a sequence = ('a -> unit) -> unit type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] +include String + module type S = sig type t diff --git a/src/core/CCString.mli b/src/core/CCString.mli index ca640222..5cfc2599 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -48,6 +48,8 @@ end (** {2 Strings} *) +include module type of String + val equal : string -> string -> bool val compare : string -> string -> int diff --git a/src/core/containers.ml b/src/core/containers.ml index 399cee45..6c3234b5 100644 --- a/src/core/containers.ml +++ b/src/core/containers.ml @@ -1,25 +1,10 @@ (* This file is free software, part of containers. See file "license" for more details. *) -(** {1 Drop-In replacement to Stdlib} +(** {1 Drop-In replacement to Stdlib} *) - This module is meant to be opened if one doesn't want to use both, say, - [List] and [CCList]. Instead, [List] is now an alias to - {[struct - include List - include CCList - end - ]} -*) - -module Array = struct - include Array - include CCArray -end -module ArrayLabels = struct - include ArrayLabels - include CCArrayLabels -end +module Array = CCArray +module ArrayLabels = CCArrayLabels module Array_slice = CCArray_slice module Bool = CCBool module Char = struct @@ -50,14 +35,8 @@ module Hashtbl = struct module Make' = CCHashtbl.Make end module Heap = CCHeap -module List = struct - include List - include CCList -end -module ListLabels = struct - include ListLabels - include CCListLabels -end +module List = CCList +module ListLabels = CCListLabels module Map = struct module type OrderedType = Map.OrderedType include CCMap @@ -66,10 +45,7 @@ module Option = CCOpt module Ord = CCOrd module Pair = CCPair module Parse = CCParse -module Random = struct - include Random - include CCRandom -end +module Random = CCRandom module Ref = CCRef module Result = struct include Result @@ -79,8 +55,5 @@ module Set = struct module type OrderedType = Set.OrderedType include CCSet end -module String = struct - include String - include CCString -end +module String = CCString module Vector = CCVector From 5d5909459faa857a002bc347d82022e3a428b923 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 1 May 2017 16:41:26 +0200 Subject: [PATCH 54/56] details --- src/core/CCString.mli | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 5cfc2599..9e7c1d23 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -114,8 +114,7 @@ val of_array : char array -> string val to_array : string -> char array val find : ?start:int -> sub:string -> string -> int -(** Find [sub] in string, returns its first index or [-1]. - Should only be used with very small [sub] *) +(** Find [sub] in string, returns its first index or [-1]. *) (*$= & ~printer:string_of_int 1 (find ~sub:"bc" "abcd") @@ -643,5 +642,4 @@ module Sub : sig |> Sequence.for_all (fun (i,j,sub) -> Sub.get sub j = s.[i+j])) *) - end From 465b5992e8a71065a24c7e495cf1520579df52c7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 1 May 2017 16:47:26 +0200 Subject: [PATCH 55/56] add `CCString.{l,r}trim` (close #121) --- src/core/CCString.cppo.ml | 15 +++++++++++++++ src/core/CCString.mli | 26 ++++++++++++++++++++++++++ 2 files changed, 41 insertions(+) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index a4c66419..9fa460c8 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -652,6 +652,21 @@ let exists p s = try iter (fun c -> if p c then raise MyExit) s; false with MyExit -> true +(* notion of whitespace for trim *) +let is_space_ = function + | ' ' | '\012' | '\n' | '\r' | '\t' -> true + | _ -> false + +let ltrim s = + let i = ref 0 in + while !i < length s && is_space_ (unsafe_get s !i) do incr i done; + if !i > 0 then sub s !i (length s - !i) else s + +let rtrim s = + let i = ref (length s-1) in + while !i >= 0 && is_space_ (unsafe_get s !i) do decr i done; + if !i < length s-1 then sub s 0 (!i+1) else s + let map2 f s1 s2 = if length s1 <> length s2 then invalid_arg "CCString.map2"; init (String.length s1) (fun i -> f s1.[i] s2.[i]) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 9e7c1d23..98be782f 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -351,6 +351,32 @@ val exists : (char -> bool) -> string -> bool include S with type t := string +val ltrim : t -> t +(** trim space on the left (see {!String.trim} for more details) + @since NEXT_RELEASE *) + +val rtrim : t -> t +(** trim space on the right (see {!String.trim} for more details) + @since NEXT_RELEASE *) + +(*$= & ~printer:id + "abc " (ltrim " abc ") + " abc" (rtrim " abc ") +*) + +(*$Q + Q.(printable_string) (fun s -> \ + String.trim s = (s |> ltrim |> rtrim)) + Q.(printable_string) (fun s -> ltrim s = ltrim (ltrim s)) + Q.(printable_string) (fun s -> rtrim s = rtrim (rtrim s)) + Q.(printable_string) (fun s -> \ + let s' = ltrim s in \ + if s'="" then Q.assume_fail() else s'.[0] <> ' ') + Q.(printable_string) (fun s -> \ + let s' = rtrim s in \ + if s'="" then Q.assume_fail() else s'.[String.length s'-1] <> ' ') + *) + (** {2 Operations on 2 strings} *) val map2 : (char -> char -> char) -> string -> string -> string From 3ab610ba0ebc995aedd87b64bc0fd4ef6e2cf6e0 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 1 May 2017 16:59:25 +0200 Subject: [PATCH 56/56] prepapre for 1.2 --- CHANGELOG.adoc | 36 ++++++++++++++++++++++++++++++++++++ _oasis | 2 +- src/core/CCArray.mli | 4 ++-- src/core/CCEqual.mli | 2 +- src/core/CCFloat.mli | 4 ++-- src/core/CCFormat.mli | 14 +++++++------- src/core/CCInt.mli | 14 +++++++------- src/core/CCList.mli | 12 ++++++------ src/core/CCOpt.mli | 12 ++++++------ src/core/CCResult.mli | 6 +++--- src/core/CCString.mli | 12 ++++++------ src/data/CCBV.mli | 16 ++++++++-------- src/unix/CCUnix.mli | 2 +- 13 files changed, 86 insertions(+), 50 deletions(-) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index 65cc9a2c..9a36f8c5 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -1,5 +1,41 @@ = Changelog +== 1.2 + +- make many modules extensions of stdlib (close #109) + the modules are: `String List ListLabels Array ArrayLabels Char Random` +- add `CCString.{l,r}trim` (close #121) +- add `CCInt.floor_div` and `CCInt.rem` +- add test and bugfix for `CCBV` +- add `CCList.take_drop_while` (close #120) +- add `CCstring.equal_caseless` (close #112) +- add alias `CCString.split` (close #115) +- add `CCFormat.text` (close #111) +- add `CCFormat.{newline,substring}` +- add `CCList.combine_gen` (close #110) +- add module `CCEqual` +- add `CCResult.fold_ok` (closes #107) +- add `CCFormat.with_color_ksf` for colored printing +- add `CCInt.range{,',by}` for iterating on integer ranges +- add `CCString.Sub.get` +- add `CCResult.add_ctx{,f}` for replacing stack traces +- add `CCString.split_on_char` +- add `CCArray.{fold_map,scan_left}` (close #101) +- add `CCList.scan_left` +- add `CCList.{cartesian_product,map_product_l}` +- add `CCUnix.with_file_lock` for locking whole files +- add `CCFormat.of_chan` +- add `CCFormat.flush` +- Add `{map_lazy, or_, or_lazy, to_result, to_result_lazy, of_result}` to `CCOpt` + +- annotations in `CCEqual`, for optimization +- Add a tail-recursive implementation of `List.combine` +- fix too restrictive type in `CCResult` +- build unix support by default +- bugfix and test for `CCZipper.is_focused` (closes #102) +- use boxes in `CCFormat.Dump` for tuples +- update header, and use more `(==)` in `CCIntMap` + == 1.1 **bugfixes**: diff --git a/_oasis b/_oasis index 19753b57..aaf86b7b 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: containers -Version: 1.1 +Version: 1.2 Homepage: https://github.com/c-cube/ocaml-containers Authors: Simon Cruanes License: BSD-2-clause diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index 6676d1ed..e8d5c8e2 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -46,12 +46,12 @@ val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a t -> 'acc * 'b t (** [fold_map f acc a] is a [fold_left]-like function, but it also maps the array to another array. - @since NEXT_RELEASE *) + @since 1.2 *) val scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc t (** [scan_left f acc a] returns the array [ [|acc; f acc x0; f (f acc a.(0)) a.(1); …|] ] - @since NEXT_RELEASE *) + @since 1.2 *) val iter : ('a -> unit) -> 'a t -> unit diff --git a/src/core/CCEqual.mli b/src/core/CCEqual.mli index 8c1d4adc..94230bfa 100644 --- a/src/core/CCEqual.mli +++ b/src/core/CCEqual.mli @@ -3,7 +3,7 @@ (** {1 Equality Combinators} *) -(** @since NEXT_RELEASE *) +(** @since 1.2 *) type 'a t = 'a -> 'a -> bool (** Equality function. Must be transitive, symmetric, and reflexive. *) diff --git a/src/core/CCFloat.mli b/src/core/CCFloat.mli index 0e57b997..a0c25034 100644 --- a/src/core/CCFloat.mli +++ b/src/core/CCFloat.mli @@ -79,11 +79,11 @@ val to_string : t -> string val of_string_exn : string -> t (** Alias to {!float_of_string} @raise Failure in case of failure - @since NEXT_RELEASE *) + @since 1.2 *) val of_string : string -> t (** Alias to {!float_of_string}. - @deprecated since NEXT_RELEASE, use {!of_string_exn} instead + @deprecated since 1.2, use {!of_string_exn} instead @raise Failure in case of failure *) val equal_precision : epsilon:t -> t -> t -> bool diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 847de339..f55662e4 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -25,20 +25,20 @@ val float : float printer val newline : unit printer (** Force newline (see {!Format.pp_force_newline}) - @since NEXT_RELEASE *) + @since 1.2 *) val substring : (string * int * int) printer (** Print the substring [(s,i,len)], where [i] is the offset in [s] and [len] the number of bytes in the substring. @raise Invalid_argument if the triple [(s,i,len)] does not describe a proper substring. - @since NEXT_RELEASE *) + @since 1.2 *) val text : string printer (** Print string, but replacing spaces with breaks and newlines with {!newline}. See [pp_print_text] on recent versions of OCaml. - @since NEXT_RELEASE *) + @since 1.2 *) val char : char printer (** @since 0.14 *) val int32 : int32 printer (** @since 0.14 *) @@ -47,7 +47,7 @@ val nativeint : nativeint printer (** @since 0.14 *) val flush : unit printer (** Alias to {!Format.pp_print_flush}. - @since NEXT_RELEASE *) + @since 1.2 *) val string_quoted : string printer (** Similar to {!CCString.print}. @@ -204,7 +204,7 @@ val with_color_ksf : f:(string -> 'b) -> string -> ('a, t, unit, 'b) format4 -> {[ CCFormat.with_color_ksf "red" ~f:failwith "%a" CCFormat.Dump.(list int) [1;2;3];; ]} - @since NEXT_RELEASE *) + @since 1.2 *) (** {2 IO} *) @@ -213,13 +213,13 @@ val to_string : 'a printer -> 'a -> string val of_chan : out_channel -> t (** Alias to {!Format.formatter_of_out_channel} - @since NEXT_RELEASE *) + @since 1.2 *) val with_out_chan : out_channel -> (t -> 'a) -> 'a (** [with_out_chan oc f] turns [oc] into a formatter [fmt], and call [f fmt]. Behaves like [f fmt] from then on, but whether the call to [f] fails or returns, [fmt] is flushed before the call terminates. - @since NEXT_RELEASE *) + @since 1.2 *) val stdout : t val stderr : t diff --git a/src/core/CCInt.mli b/src/core/CCInt.mli index 7c9146ff..30f9dddc 100644 --- a/src/core/CCInt.mli +++ b/src/core/CCInt.mli @@ -26,12 +26,12 @@ val pow : t -> t -> t val floor_div : t -> t -> t (** [floor_div a n] is integer division rounding towards negative infinity. It satisfies [a = m * floor_div a n + rem a n]. - @since NEXT_RELEASE *) + @since 1.2 *) val rem : t -> t -> t (** [rem a n] is the remainder of dividing [a] by [n], with the same sign as [n]. - @since NEXT_RELEASE *) + @since 1.2 *) type 'a printer = Format.formatter -> 'a -> unit type 'a random_gen = Random.State.t -> 'a @@ -67,17 +67,17 @@ val range_by : step:t -> t -> t -> t sequence where the difference between successive elements is [step]. use a negative [step] for a decreasing list. @raise Invalid_argument if [step=0] - @since NEXT_RELEASE *) + @since 1.2 *) val range : t -> t -> t sequence (** [range i j] iterates on integers from [i] to [j] included . It works both for decreasing and increasing ranges - @since NEXT_RELEASE *) + @since 1.2 *) val range' : t -> t -> t sequence (** Same as {!range} but the second bound is excluded. For instance [range' 0 5 = Sequence.of_list [0;1;2;3;4]] - @since NEXT_RELEASE *) + @since 1.2 *) (** {2 Infix Operators} @@ -103,11 +103,11 @@ module Infix : sig val (--) : t -> t -> t sequence (** Alias to {!range} - @since NEXT_RELEASE *) + @since 1.2 *) val (--^) : t -> t -> t sequence (** Alias to {!range'} - @since NEXT_RELEASE *) + @since 1.2 *) end include module type of Infix diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 4a5138d6..686d154c 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -59,7 +59,7 @@ val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list val scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc list (** [scan_left f acc l] returns the list [[acc; f acc x0; f (f acc x0) x1; …]] where [x0], [x1], etc. are the elements of [l] - @since NEXT_RELEASE *) + @since 1.2 *) 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]. @@ -83,14 +83,14 @@ val init : int -> (int -> 'a) -> 'a t val combine : 'a list -> 'b list -> ('a * 'b) list (** Similar to {!List.combine} but tail-recursive. @raise Invalid_argument if the lists have distinct lengths. - @since NEXT_RELEASE *) + @since 1.2 *) val combine_gen : 'a list -> 'b list -> ('a * 'b) gen (** Lazy version of {!combine}. Unlike {!combine}, it does not fail if the lists have different lengths; instead, the output has as many pairs as the smallest input list. - @since NEXT_RELEASE *) + @since 1.2 *) val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int @@ -119,14 +119,14 @@ val cartesian_product : 'a t t -> 'a t t [[1;3;4;5;6];[2;3;4;5;6]];; ]} invariant: [cartesian_product l = map_product id l]. - @since NEXT_RELEASE *) + @since 1.2 *) val map_product_l : ('a -> 'b list) -> 'a list -> 'b list list (** [map_product_l f l] maps each element of [l] to a list of objects of type ['b] using [f]. We obtain [[l1;l2;…;ln]] where [length l=n] and [li : 'b list]. Then, it returns all the ways of picking exactly one element per [li]. - @since NEXT_RELEASE *) + @since 1.2 *) val diagonal : 'a t -> ('a * 'a) t (** All pairs of distinct positions of the list. [list_diagonal l] will @@ -201,7 +201,7 @@ val drop_while : ('a -> bool) -> 'a t -> 'a t val take_drop_while : ('a -> bool) -> 'a t -> 'a t * 'a t (** [take_drop_while p l = take_while p l, drop_while p l] - @since NEXT_RELEASE *) + @since 1.2 *) val last : int -> 'a t -> 'a t (** [last n l] takes the last [n] elements of [l] (or less if diff --git a/src/core/CCOpt.mli b/src/core/CCOpt.mli index 19c7eead..c5caa5a6 100644 --- a/src/core/CCOpt.mli +++ b/src/core/CCOpt.mli @@ -14,7 +14,7 @@ val map_or : default:'b -> ('a -> 'b) -> 'a t -> 'b val map_lazy : (unit -> 'b) -> ('a -> 'b) -> 'a t -> 'b (** [map_lazy default_fn f o] if [f o] if [o = Some x], [default_fn ()] otherwise - @since NEXT_RELEASE *) + @since 1.2 *) val is_some : _ t -> bool @@ -100,11 +100,11 @@ val (<$>) : ('a -> 'b) -> 'a t -> 'b t val or_ : else_:('a t) -> 'a t -> 'a t (** [or_ ~else_ a] is [a] if [a] is [Some _], [else_] otherwise - @since NEXT_RELEASE *) + @since 1.2 *) val or_lazy : else_:(unit -> 'a t) -> 'a t -> 'a t (** [or_lazy else_ a] is [a] if [a] is [Some _], [else_ ()] otherwise - @since NEXT_RELEASE *) + @since 1.2 *) val (<+>) : 'a t -> 'a t -> 'a t (** [a <+> b] is [a] if [a] is [Some _], [b] otherwise *) @@ -131,13 +131,13 @@ val of_list : 'a list -> 'a t (** Head of list, or [None] *) val to_result : 'e -> 'a t -> ('a, 'e) Result.result -(** @since NEXT_RELEASE *) +(** @since 1.2 *) val to_result_lazy : (unit -> 'e) -> 'a t -> ('a, 'e) Result.result -(** @since NEXT_RELEASE *) +(** @since 1.2 *) val of_result : ('a, _) Result.result -> 'a t -(** @since NEXT_RELEASE *) +(** @since 1.2 *) type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index 9c6a9b49..c0e7b63e 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -46,7 +46,7 @@ val add_ctx : string -> ('a, string) t -> ('a, string) t (** [add_ctx msg] leaves [Ok x] untouched, but transforms [Error s] into [Error s'] where [s'] contains the additional context given by [msg] - @since NEXT_RELEASE *) + @since 1.2 *) val add_ctxf : ('a, Format.formatter, unit, ('b, string) t -> ('b, string) t) format4 -> 'a (** [add_ctxf format_message] is similar to {!add_ctx} but with @@ -54,7 +54,7 @@ val add_ctxf : ('a, Format.formatter, unit, ('b, string) t -> ('b, string) t) fo Example: {[ add_ctxf "message(number %d, foo: %B)" 42 true (Error "error)" ]} - @since NEXT_RELEASE *) + @since 1.2 *) val map : ('a -> 'b) -> ('a, 'err) t -> ('b, 'err) t (** Map on success *) @@ -104,7 +104,7 @@ val fold : ok:('a -> 'b) -> error:('err -> 'b) -> ('a, 'err) t -> 'b val fold_ok : ('a -> 'b -> 'a) -> 'a -> ('b, _) t -> 'a (** [fold_ok f acc r] will compute [f acc x] if [r=Ok x], and return [acc] otherwise, as if the result were a mere option. - @since NEXT_RELEASE *) + @since 1.2 *) val is_ok : ('a, 'err) t -> bool (** Return true if Ok diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 98be782f..83fde8c7 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -353,11 +353,11 @@ include S with type t := string val ltrim : t -> t (** trim space on the left (see {!String.trim} for more details) - @since NEXT_RELEASE *) + @since 1.2 *) val rtrim : t -> t (** trim space on the right (see {!String.trim} for more details) - @since NEXT_RELEASE *) + @since 1.2 *) (*$= & ~printer:id "abc " (ltrim " abc ") @@ -428,7 +428,7 @@ val lowercase_ascii : string -> string val equal_caseless : string -> string -> bool (** Comparison without respect to {b ascii} lowercase. - @since NEXT_RELEASE *) + @since 1.2 *) (*$T equal_caseless "foo" "FoO" @@ -540,7 +540,7 @@ end val split_on_char : char -> string -> string list (** Split the string along the given char - @since NEXT_RELEASE *) + @since 1.2 *) (*$= & ~printer:Q.Print.(list string) ["a"; "few"; "words"; "from"; "our"; "sponsors"] \ @@ -555,7 +555,7 @@ val split_on_char : char -> string -> string list val split : by:string -> string -> string list (** Alias to {!Split.list_cpy} - @since NEXT_RELEASE *) + @since 1.2 *) (** {2 Utils} *) @@ -635,7 +635,7 @@ module Sub : sig val get : t -> int -> char (** [get s i] gets the [i]-th element, or fails @raise Invalid_argument if the index is not within [0... length -1] - @since NEXT_RELEASE *) + @since 1.2 *) include S with type t := t diff --git a/src/data/CCBV.mli b/src/data/CCBV.mli index 4d0e4bae..247aafee 100644 --- a/src/data/CCBV.mli +++ b/src/data/CCBV.mli @@ -3,7 +3,7 @@ (** {2 Imperative Bitvectors} - {b BREAKING CHANGES} since NEXT_RELEASE: + {b BREAKING CHANGES} since 1.2: size is now stored along with the bitvector. Some functions have a new signature. @@ -30,13 +30,13 @@ val cardinal : t -> int val length : t -> int (** Size of underlying bitvector. This is not related to the underlying implementation. - Changed at NEXT_RELEASE + Changed at 1.2 *) val capacity : t -> int (** The number of bits this bitvector can store without resizing. - @since NEXT_RELEASE *) + @since 1.2 *) val resize : t -> int -> unit (** Resize the BV so that it has the specified length. This can grow or shrink @@ -83,12 +83,12 @@ val of_list : int list -> t val first : t -> int option (** First set bit, or return None. - changed type at NEXT_RELEASE *) + changed type at 1.2 *) val first_exn : t -> int (** First set bit, or @raise Not_found if all bits are 0 - @since NEXT_RELEASE *) + @since 1.2 *) val filter : t -> (int -> bool) -> unit (** [filter bv p] only keeps the true bits of [bv] whose [index] @@ -97,7 +97,7 @@ val filter : t -> (int -> bool) -> unit val negate_self : t -> unit (** [negate_self t] flips all of the bits in [t]. - @since NEXT_RELEASE *) + @since 1.2 *) val negate : t -> t (** [negate t] returns a copy of [t] with all of the bits flipped. *) @@ -121,12 +121,12 @@ val inter : t -> t -> t val diff_into : into:t -> t -> unit (** [diff ~into t] Modify [into] with only the bits set but not in [t]. - @since NEXT_RELEASE *) + @since 1.2 *) val diff : t -> t -> t (** [diff t1 t2] Return those bits found [t1] but not in [t2]. - @since NEXT_RELEASE *) + @since 1.2 *) val select : t -> 'a array -> 'a list (** [select arr bv] selects the elements of [arr] whose index diff --git a/src/unix/CCUnix.mli b/src/unix/CCUnix.mli index 6e6be9a2..3515f0de 100644 --- a/src/unix/CCUnix.mli +++ b/src/unix/CCUnix.mli @@ -168,7 +168,7 @@ val with_file_lock : kind:[`Read|`Write] -> string -> (unit -> 'a) -> 'a re-raised after the file is unlocked. @param kind specifies whether the lock is read-only or read-write. - @since NEXT_RELEASE *) + @since 1.2 *) (** {2 Infix Functions} *)