From 29118df5f4478b5e29bd400c352421c25fb6d5af Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 2 Feb 2018 08:10:41 -0600 Subject: [PATCH 01/20] opam detail --- containers.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/containers.opam b/containers.opam index 59a6d54aa..c6a0c1aed 100644 --- a/containers.opam +++ b/containers.opam @@ -7,7 +7,7 @@ build: [ ["jbuilder" "build" "-p" name "-j" jobs] ] build-doc: [ "jbuilder" "build" "@doc" ] -build-test: [ "jbuilder" "runtest" ] +build-test: [ "jbuilder" "runtest" "-p" name "-j" jobs] depends: [ "jbuilder" {build} "result" From a0a8954231407fe0686463d7a1951cdc70d144ed Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 28 Jan 2018 22:37:44 -0600 Subject: [PATCH 02/20] proper deps in dune --- qtest/jbuild | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/qtest/jbuild b/qtest/jbuild index 8a027a969..8f48e6862 100644 --- a/qtest/jbuild +++ b/qtest/jbuild @@ -6,7 +6,7 @@ (rule ((targets (run_qtest.ml)) - (deps (make.bc)) + (deps (make.bc (files_recursively_in ../src))) ;(libraries (qtest qcheck)) (action (run ./make.bc -target ${@})) From b340c3dc6cc3b55933692f09d8eaca0d6dd5b1ae Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 2 Feb 2018 09:14:43 -0600 Subject: [PATCH 03/20] update deps --- containers.opam | 2 ++ 1 file changed, 2 insertions(+) diff --git a/containers.opam b/containers.opam index c6a0c1aed..86a309a69 100644 --- a/containers.opam +++ b/containers.opam @@ -18,6 +18,8 @@ depopts: [ "qtest" { test } "qcheck" { test } "oUnit" { test } + "sequence" { test } + "gen" { test } "odoc" { doc } ] conflicts: [ From 04d10c271198042e72dd87c57ee6b4c515745695 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 3 Feb 2018 15:38:47 -0600 Subject: [PATCH 04/20] makefile help --- Makefile | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 1d9c7cb65..e925f0989 100644 --- a/Makefile +++ b/Makefile @@ -5,7 +5,7 @@ build: jbuilder build @install test: build - jbuilder runtest --no-buffer + jbuilder runtest --no-buffer --force clean: jbuilder clean @@ -28,6 +28,12 @@ update_next_tag: sed -i "s/NEXT_VERSION/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli) sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli) +release: update_next_tag + @echo "release version $(VERSION)..." + git tag -f $(VERSION) ; git push origin :$(VERSION) ; git push origin $(VERSION) + opam publish prepare https://github.com/c-cube/qcheck/archive/$(VERSION).tar.gz + @echo "review the release, then type 'opam publish submit qcheck.$(VERSION)/'" + watch: while find src/ benchs/ -print0 | xargs -0 inotifywait -e delete_self -e modify ; do \ echo "============ at `date` ==========" ; \ From 5b6b71373c3670ebe1aef1dad7d699a3e9f6998b Mon Sep 17 00:00:00 2001 From: rand00 Date: Sun, 4 Feb 2018 17:30:29 +0100 Subject: [PATCH 05/20] CCRAL: Fixed bug in drop_tree_. --- src/data/CCRAL.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index f025bf53a..a8e7422dc 100644 --- a/src/data/CCRAL.ml +++ b/src/data/CCRAL.ml @@ -337,7 +337,7 @@ and drop_tree_ ~size n t tail = match t with | Node (_,l,r) -> if n=1 then append_tree_ l (append_tree_ r tail) else - let size' = size/2 in + let size' = if size mod 2 <> 0 then (size/2)+1 else size/2 in if n-1 < size' then drop_tree_ ~size:size' (n-1) l (append_tree_ r tail) else drop_tree_ ~size:size' (n-1-size') r tail From 710266e09cffb6083ff7a381206bee43f154811b Mon Sep 17 00:00:00 2001 From: Dave Aitken Date: Sun, 4 Feb 2018 17:34:30 +0000 Subject: [PATCH 06/20] Don't reverse twice in CCList.repeat --- src/core/CCList.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 3da6407f0..acbcc57bf 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -1253,11 +1253,15 @@ let replicate i x = else aux (x::acc) (i-1) in aux [] i + +(*$T + repeat 2 [1;2;3] = [1;2;3;1;2;3] +*) + let repeat i l = - let l' = List.rev l in let rec aux acc i = if i = 0 then List.rev acc - else aux (List.rev_append l' acc) (i-1) + else aux (List.rev_append l acc) (i-1) in aux [] i module Assoc = struct From cfb8e55ebab5970a30bb1a99a3b8c2c599099c88 Mon Sep 17 00:00:00 2001 From: rand00 Date: Sun, 4 Feb 2018 18:54:56 +0100 Subject: [PATCH 07/20] CCRAL: drop: Added test for bugfix. --- src/data/CCRAL.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index a8e7422dc..351e687b7 100644 --- a/src/data/CCRAL.ml +++ b/src/data/CCRAL.ml @@ -342,6 +342,10 @@ and drop_tree_ ~size n t tail = match t with then drop_tree_ ~size:size' (n-1) l (append_tree_ r tail) else drop_tree_ ~size:size' (n-1-size') r tail +(*$T + of_list [1;2;3] |> drop 2 |> length = 1 +*) + let drop_while ~f l = let rec aux p st = match st with | St_nil -> Nil From 47c5c41a968a82fb0503de2cdaa19b1fe64877dd Mon Sep 17 00:00:00 2001 From: rand00 Date: Sun, 4 Feb 2018 18:55:37 +0100 Subject: [PATCH 08/20] Added Rand to authors --- AUTHORS.adoc | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS.adoc b/AUTHORS.adoc index 5d6d131c6..0d996399a 100644 --- a/AUTHORS.adoc +++ b/AUTHORS.adoc @@ -25,3 +25,4 @@ - Fabian Hemmer (copy) - Maciej Woś (@lostman) - Orbifx (Stavros Polymenis) +- Rand (@rand00) \ No newline at end of file From 60596e54086c9d9c9c91facfa0606b4703329f0a Mon Sep 17 00:00:00 2001 From: Dave Aitken Date: Sun, 4 Feb 2018 17:56:07 +0000 Subject: [PATCH 09/20] Update authors list --- AUTHORS.adoc | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS.adoc b/AUTHORS.adoc index 5d6d131c6..839603bd4 100644 --- a/AUTHORS.adoc +++ b/AUTHORS.adoc @@ -25,3 +25,4 @@ - Fabian Hemmer (copy) - Maciej Woś (@lostman) - Orbifx (Stavros Polymenis) +- Dave Aitken (@actionshrimp) \ No newline at end of file From 6b48fe873eb08ecf0ba0747bf9dacc1d6ecde2a9 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 4 Feb 2018 12:05:58 -0600 Subject: [PATCH 10/20] add another test --- src/core/CCList.ml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index acbcc57bf..20e9c77d0 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -1258,6 +1258,12 @@ let replicate i x = repeat 2 [1;2;3] = [1;2;3;1;2;3] *) +(*$Q + Q.(pair small_int (list int)) (fun (n,l) -> \ + if n>0 then repeat n l = flat_map (fun _ -> l) (1--n) \ + else Q.assume_fail()) + *) + let repeat i l = let rec aux acc i = if i = 0 then List.rev acc From 5814f23d16bc7230aac55b8f7a8fc33a5b03032b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 4 Feb 2018 12:36:09 -0600 Subject: [PATCH 11/20] add more tests to `CCRAL` and others --- src/core/CCList.ml | 2 +- src/data/CCRAL.ml | 31 +++++++++++++++++++++++++++++++ 2 files changed, 32 insertions(+), 1 deletion(-) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 20e9c77d0..7ee178c1f 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -1259,7 +1259,7 @@ let replicate i x = *) (*$Q - Q.(pair small_int (list int)) (fun (n,l) -> \ + Q.(pair small_int (small_list int)) (fun (n,l) -> \ if n>0 then repeat n l = flat_map (fun _ -> l) (1--n) \ else Q.assume_fail()) *) diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index 351e687b7..3126cf227 100644 --- a/src/data/CCRAL.ml +++ b/src/data/CCRAL.ml @@ -257,6 +257,13 @@ let flat_map f l = append l acc ) +(*$Q + Q.(pair (fun1 Observable.int (list int)) (list int)) (fun (f,l) -> \ + let f x = Q.Fn.apply f x in \ + let f' x = f x |> of_list in \ + of_list l |> flat_map f' |> to_list = CCList.(flat_map f l)) + *) + let flatten l = fold_rev ~f:(fun acc l -> append l acc) ~x:empty l (*$T @@ -264,6 +271,11 @@ let flatten l = fold_rev ~f:(fun acc l -> append l acc) ~x:empty l of_list [1;2;3;] *) +(*$Q + Q.(small_list (small_list int)) (fun l -> \ + of_list l |> map ~f:of_list |> flatten |> to_list = CCList.flatten l) + *) + let app funs l = fold_rev ~x:empty funs ~f:(fun acc f -> @@ -307,6 +319,11 @@ and take_tree_ ~size n t = match t with take 0 (of_list CCList.(1--10)) |> to_list = [] *) +(*$Q + Q.(pair small_int (list int)) (fun (n,l) -> \ + of_list l |> take n |> to_list = CCList.take n l) +*) + let take_while ~f l = (* st: stack of subtrees *) let rec aux p st = match st with @@ -323,6 +340,9 @@ let take_while ~f l = Q.(list int) (fun l -> \ let f x = x mod 7 <> 0 in \ of_list l |> take_while ~f |> to_list = CCList.take_while f l) + Q.(pair (fun1 Observable.int bool) (list int)) (fun (f,l) -> \ + let f x = Q.Fn.apply f x in \ + of_list l |> take_while ~f |> to_list = CCList.take_while f l) *) let rec drop n l = match l with @@ -346,6 +366,11 @@ and drop_tree_ ~size n t tail = match t with of_list [1;2;3] |> drop 2 |> length = 1 *) +(*$Q + Q.(pair small_int (list int)) (fun (n,l) -> \ + of_list l |> drop n |> to_list = CCList.drop n l) +*) + let drop_while ~f l = let rec aux p st = match st with | St_nil -> Nil @@ -410,6 +435,12 @@ let repeat n l = in aux n l empty + +(*$Q + Q.(pair small_int (list int)) (fun (n,l) -> \ + of_list l |> repeat n |> to_list = CCList.(repeat n l)) + *) + let range i j = let rec aux i j acc = if i=j then cons i acc From 27c768eebfb983452e58d0f3b150d2c9c4e1fbb5 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 4 Feb 2018 12:36:52 -0600 Subject: [PATCH 12/20] fix bug in `CCRAL.drop` (see #184) --- src/data/CCRAL.ml | 33 +++++++++++++++++++++++---------- 1 file changed, 23 insertions(+), 10 deletions(-) diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index 3126cf227..6a2147692 100644 --- a/src/data/CCRAL.ml +++ b/src/data/CCRAL.ml @@ -345,22 +345,35 @@ let take_while ~f l = of_list l |> take_while ~f |> to_list = CCList.take_while f l) *) +(* drop [n < size] elements from [t] *) +let rec drop_tree_ ~size n t tail = match t with + | _ when n=0 -> tail + | Leaf _ -> + assert (n=1); + tail + | Node (_,left,right) -> + if n=1 then append_tree_ left (append_tree_ right tail) + else ( + assert (size mod 2 = 1); + let size_sub = size/2 in (* size of subtrees *) + let n = n-1 in + if n = size_sub then ( + append_tree_ right tail (* drop element and left tree *) + ) else if n < size_sub then ( + (* drop element and part of left tree *) + drop_tree_ ~size:size_sub n left (append_tree_ right tail) + ) else ( + (* drop element, left tree, and part of right tree *) + drop_tree_ ~size:size_sub (n-size_sub) right tail + ) + ) + let rec drop n l = match l with | _ when n=0 -> l | Nil -> Nil | Cons (size, t, tl) -> if n >= size then drop (n-size) tl else drop_tree_ ~size n t tl -and drop_tree_ ~size n t tail = match t with - | _ when n=0 -> tail - | Leaf _ -> tail - | Node (_,l,r) -> - if n=1 then append_tree_ l (append_tree_ r tail) - else - let size' = if size mod 2 <> 0 then (size/2)+1 else size/2 in - if n-1 < size' - then drop_tree_ ~size:size' (n-1) l (append_tree_ r tail) - else drop_tree_ ~size:size' (n-1-size') r tail (*$T of_list [1;2;3] |> drop 2 |> length = 1 From 3ab9cd58e17ee221ef440781dba5c22d19c7e631 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 5 Feb 2018 08:56:01 -0600 Subject: [PATCH 13/20] with compat >= 4.02, use `Format.pp_print_text` directly --- src/core/CCFormat.ml | 30 +----------------------------- 1 file changed, 1 insertion(+), 29 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 965ff9edf..5698c57b2 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -46,35 +46,7 @@ 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") From 24592bf926f4bf775f504cc88287c3dfd5340289 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 5 Feb 2018 08:58:32 -0600 Subject: [PATCH 14/20] CCFormat: fix support of unrecognized styles --- src/core/CCFormat.ml | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 5698c57b2..4d173037b 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -238,6 +238,8 @@ let ansi_l_to_str_ = function Buffer.add_string buf "m"; Buffer.contents buf +exception No_such_style + (* parse a tag *) let style_of_tag_ s = match String.trim s with | "reset" -> [`Reset] @@ -258,7 +260,7 @@ let style_of_tag_ s = match String.trim s with | "Magenta" -> [`FG `Magenta; `Bold] | "Cyan" -> [`FG `Cyan; `Bold] | "White" -> [`FG `White; `Bold] - | s -> failwith ("unknown style: " ^ s) + | _ -> raise No_such_style let color_enabled = ref false @@ -268,20 +270,21 @@ let mark_open_tag st ~or_else s = let style = style_of_tag_ s in Stack.push style st; if !color_enabled then ansi_l_to_str_ style else "" - with Not_found -> or_else s + with No_such_style -> or_else s let mark_close_tag st ~or_else s = - try - let _ = style_of_tag_ s in (* check if it's indeed about color *) - let style = - try - ignore (Stack.pop st); (* pop current style (if well-scoped...) *) - Stack.top st (* look at previous style *) - with Stack.Empty -> - [`Reset] - in - if !color_enabled then ansi_l_to_str_ style else "" - with Not_found -> or_else s + (* check if it's indeed about color *) + match style_of_tag_ s with + | _ -> + let style = + try + ignore (Stack.pop st); (* pop current style (if well-scoped...) *) + Stack.top st (* look at previous style *) + with Stack.Empty -> + [`Reset] + in + if !color_enabled then ansi_l_to_str_ style else "" + | exception No_such_style -> or_else s (* add color handling to formatter [ppf] *) let set_color_tag_handling ppf = From 3e2fbce3ee0726a26be5c99870000d8670997001 Mon Sep 17 00:00:00 2001 From: nathan moreau Date: Wed, 7 Feb 2018 14:36:03 +0100 Subject: [PATCH 15/20] Comments - few changes --- src/core/CCArray.mli | 4 +- src/core/CCFormat.ml | 6 +- src/core/CCFormat.mli | 5 - src/core/CCHashtbl.mli | 2 + src/core/CCHeap.mli | 8 +- src/core/CCList.ml | 3 + src/core/CCList.mli | 21 +-- src/core/CCListLabels.mli | 8 +- src/core/CCParse.ml | 97 ++++++++++++ src/core/CCParse.mli | 98 ------------ src/core/CCString.ml | 315 ++++++++++++++++++++++++++++++++++++- src/core/CCString.mli | 318 +------------------------------------- src/core/CCVector.mli | 2 +- src/data/CCZipper.ml | 11 ++ src/data/CCZipper.mli | 10 -- src/unix/CCUnix.ml | 18 +++ src/unix/CCUnix.mli | 18 --- 17 files changed, 471 insertions(+), 473 deletions(-) diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index 4fe5d32de..46784348a 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -222,7 +222,9 @@ val random_choose : 'a t -> 'a random_gen @raise Not_found if the array/slice is empty. *) val to_seq : 'a t -> 'a sequence -(** Return a [sequence] of the elements of an array. *) +(** Return a [sequence] of the elements of an array. + The input array is shared with the sequence and modifications of it will result + in modification of the sequence. *) val to_gen : 'a t -> 'a gen (** Return a [gen] of the elements of an array. *) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 4d173037b..b03250dc2 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -386,7 +386,11 @@ let ksprintf ~f fmt = (fun _ -> Format.pp_print_flush out (); f (Buffer.contents buf)) out fmt - +(*$= & ~printer:CCFormat.(to_string (opt string)) + (Some "hello world") \ + (ksprintf "hello %a" CCFormat.string "world" ~f:(fun s -> Some s)) +*) + module Dump = struct type 'a t = 'a printer let unit = unit diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 6430bc939..c750e9e32 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -271,11 +271,6 @@ val ksprintf : and then calls [f] on the resulting string. @since 0.14 *) -(*$= & ~printer:CCFormat.(to_string (opt string)) - (Some "hello world") \ - (ksprintf "hello %a" CCFormat.string "world" ~f:(fun s -> Some s)) -*) - val to_file : string -> ('a, t, unit, unit) format4 -> 'a (** Print to the given file. *) diff --git a/src/core/CCHashtbl.mli b/src/core/CCHashtbl.mli index 31c28970b..c4f712f49 100644 --- a/src/core/CCHashtbl.mli +++ b/src/core/CCHashtbl.mli @@ -31,6 +31,7 @@ module Poly : sig val keys_list : ('a, 'b) Hashtbl.t -> 'a list (** [keys_list t] is the list of keys in [t]. + If the key is in the Hashtable multiple times, all occurrences will be returned. @since 0.8 *) val values_list : ('a, 'b) Hashtbl.t -> 'b list @@ -150,6 +151,7 @@ module type S = sig val keys_list : _ t -> key list (** [keys_list t] is the list of keys in [t]. + If the key is in the Hashtable multiple times, all occurrences will be returned. @since 0.8 *) val values_list : 'a t -> 'a list diff --git a/src/core/CCHeap.mli b/src/core/CCHeap.mli index 6606c76ee..cb53ddd84 100644 --- a/src/core/CCHeap.mli +++ b/src/core/CCHeap.mli @@ -97,13 +97,13 @@ module type S = sig @since 0.16 *) val of_list : elt list -> t - (** [of_list l] is [add_list empty l]. *) + (** [of_list l] is [add_list empty l]. Complexity: [O(n log n)]. *) val add_seq : t -> elt sequence -> t (** @since 0.16 *) (** Similar to {!add_list}. *) val of_seq : elt sequence -> t - (** Build a heap from a given [sequence]. *) + (** Build a heap from a given [sequence]. Complexity: [O(n log n)]. *) val to_seq : t -> elt sequence (** Return a [sequence] of the elements of the heap. *) @@ -115,7 +115,7 @@ module type S = sig val add_klist : t -> elt klist -> t (** @since 0.16 *) val of_klist : elt klist -> t - (** Build a heap from a given [klist]. *) + (** Build a heap from a given [klist]. Complexity: [O(n log n)]. *) val to_klist : t -> elt klist (** Return a [klist] of the elements of the heap. *) @@ -123,7 +123,7 @@ module type S = sig val add_gen : t -> elt gen -> t (** @since 0.16 *) val of_gen : elt gen -> t - (** Build a heap from a given [gen]. *) + (** Build a heap from a given [gen]. Complexity: [O(n log n)]. *) val to_gen : t -> elt gen (** Return a [gen] of the elements of the heap. *) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 7ee178c1f..2f1655997 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -620,6 +620,9 @@ let sorted_insert ~cmp ?(uniq=false) x l = aux cmp uniq x [] l (*$Q + Q.(pair small_int (list small_int)) (fun (x,l) -> \ + let l = List.sort Pervasives.compare l in \ + is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare x l)) Q.(pair small_int (list small_int)) (fun (x,l) -> \ let l = List.sort Pervasives.compare l in \ is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare ~uniq:true x l)) diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 58041c2fe..92d19d98b 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -339,13 +339,7 @@ val sorted_insert : cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a l @param uniq if true and [x] is already in sorted position in [l], then [x] is not duplicated. Default [false] ([x] will be inserted in any case). @since 0.17 *) - -(*$Q - Q.(pair small_int (list small_int)) (fun (x,l) -> \ - let l = List.sort Pervasives.compare l in \ - is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare x l)) -*) - + val uniq_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list (** [uniq_succ l] removes duplicate elements that occur one next to the other. Examples: @@ -376,7 +370,7 @@ val iteri2 : (int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit @since 2.0 *) val foldi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b -(** Like [fold] but it also passes in the index of each element to the folded function. *) +(** Like [fold] but it also passes in the index of each element to the folded function. Tail-recursive. *) val foldi2 : ('c -> int -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c (** Fold on two lists, with index. @@ -596,19 +590,22 @@ val to_seq : 'a t -> 'a sequence (** Return a [sequence] of the elements of the list. *) val of_seq : 'a sequence -> 'a t -(** Build a list from a given [sequence]. *) +(** Build a list from a given [sequence]. + In the result, elements appear in the same order as they did in the source [sequence]. *) val to_gen : 'a t -> 'a gen (** Return a [gen] of the elements of the list. *) val of_gen : 'a gen -> 'a t -(** Build a list from a given [gen]. *) +(** Build a list from a given [gen]. + In the result, elements appear in the same order as they did in the source [gen]. *) val to_klist : 'a t -> 'a klist (** Return a [klist] of the elements of the list. *) val of_klist : 'a klist -> 'a t -(** Build a list from a given [klist]. *) +(** Build a list from a given [klist]. + In the result, elements appear in the same order as they did in the source [klist]. *) (** {2 Infix Operators} It is convenient to {!open CCList.Infix} to access the infix operators @@ -646,5 +643,3 @@ end val pp : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a t printer (** Print the contents of a list. *) - -(** {2 Lists of pairs} *) diff --git a/src/core/CCListLabels.mli b/src/core/CCListLabels.mli index e0618a42b..6477295ec 100644 --- a/src/core/CCListLabels.mli +++ b/src/core/CCListLabels.mli @@ -232,12 +232,6 @@ val sorted_insert : cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a l [x] is not duplicated. Default [false] ([x] will be inserted in any case). @since 0.17 *) -(*$Q - Q.(pair small_int (list small_int)) (fun (x,l) -> \ - let l = List.sort Pervasives.compare l in \ - is_sorted (sorted_insert x l)) -*) - val uniq_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list (** [uniq_succ l] removes duplicate elements that occur one next to the other. Examples: @@ -263,7 +257,7 @@ val iteri : f:(int -> 'a -> unit) -> 'a t -> unit itself as second argument. *) val foldi : f:('b -> int -> 'a -> 'b) -> init:'b -> 'a t -> 'b -(** Like [fold] but it also passes in the index of each element to the folded function. *) +(** Like [fold] but it also passes in the index of each element to the folded function. Tail-recursive. *) val get_at_idx : int -> 'a t -> 'a option (** Get by index in the list. diff --git a/src/core/CCParse.ml b/src/core/CCParse.ml index b66d0e6ab..2570a5125 100644 --- a/src/core/CCParse.ml +++ b/src/core/CCParse.ml @@ -3,6 +3,103 @@ (** {1 Very Simple Parser Combinators} *) +(*$inject + module T = struct + type tree = L of int | N of tree * tree + end + open T + open Result + + let mk_leaf x = L x + let mk_node x y = N(x,y) + + let ptree = fix @@ fun self -> + skip_space *> + ( (try_ (char '(') *> (pure mk_node <*> self <*> self) <* char ')') + <|> + (U.int >|= mk_leaf) ) + + let ptree' = fix_memo @@ fun self -> + skip_space *> + ( (try_ (char '(') *> (pure mk_node <*> self <*> self) <* char ')') + <|> + (U.int >|= mk_leaf) ) + + let rec pptree = function + | N (a,b) -> Printf.sprintf "N (%s, %s)" (pptree a) (pptree b) + | L x -> Printf.sprintf "L %d" x + + let errpptree = function + | Ok x -> "Ok " ^ pptree x + | Error s -> "Error " ^ s +*) + +(*$= & ~printer:errpptree + (Ok (N (L 1, N (L 2, L 3)))) \ + (parse_string ptree "(1 (2 3))" ) + (Ok (N (N (L 1, L 2), N (L 3, N (L 4, L 5))))) \ + (parse_string ptree "((1 2) (3 (4 5)))" ) + (Ok (N (L 1, N (L 2, L 3)))) \ + (parse_string ptree' "(1 (2 3))" ) + (Ok (N (N (L 1, L 2), N (L 3, N (L 4, L 5))))) \ + (parse_string ptree' "((1 2) (3 (4 5)))" ) +*) + +(*$R + let p = U.list ~sep:"," U.word in + let printer = function + | Ok l -> "Ok " ^ CCFormat.(to_string (list string)) l + | Error s -> "Error " ^ s + in + assert_equal ~printer + (Ok ["abc"; "de"; "hello"; "world"]) + (parse_string p "[abc , de, hello ,world ]"); +*) + +(*$R + let test n = + let p = CCParse.(U.list ~sep:"," U.int) in + + let l = CCList.(1 -- n) in + let l_printed = + CCFormat.(to_string (within "[" "]" (list ~sep:(return ",") int))) l in + + let l' = CCParse.parse_string_exn p l_printed in + + assert_equal ~printer:Q.Print.(list int) l l' + in + test 100_000; + test 400_000; + +*) + +(*$R + let open CCParse.Infix in + let module P = CCParse in + + let parens p = P.try_ (P.char '(') *> p <* P.char ')' in + let add = P.char '+' *> P.return (+) in + let sub = P.char '-' *> P.return (-) in + let mul = P.char '*' *> P.return ( * ) in + let div = P.char '/' *> P.return ( / ) in + let integer = + P.chars1_if (function '0'..'9'->true|_->false) >|= int_of_string in + + let chainl1 e op = + P.fix (fun r -> + e >>= fun x -> P.try_ (op <*> P.return x <*> r) <|> P.return x) in + + let expr : int P.t = + P.fix (fun expr -> + let factor = parens expr <|> integer in + let term = chainl1 factor (mul <|> div) in + chainl1 term (add <|> sub)) in + + assert_equal (Ok 6) (P.parse_string expr "4*1+2"); + assert_equal (Ok 12) (P.parse_string expr "4*(1+2)"); + () +*) + type 'a or_error = ('a, string) Result.result type line_num = int diff --git a/src/core/CCParse.mli b/src/core/CCParse.mli index 3ebf1961c..b18d35d07 100644 --- a/src/core/CCParse.mli +++ b/src/core/CCParse.mli @@ -48,104 +48,6 @@ *) -(*$inject - module T = struct - type tree = L of int | N of tree * tree - end - open T - open Result - - let mk_leaf x = L x - let mk_node x y = N(x,y) - - let ptree = fix @@ fun self -> - skip_space *> - ( (try_ (char '(') *> (pure mk_node <*> self <*> self) <* char ')') - <|> - (U.int >|= mk_leaf) ) - - let ptree' = fix_memo @@ fun self -> - skip_space *> - ( (try_ (char '(') *> (pure mk_node <*> self <*> self) <* char ')') - <|> - (U.int >|= mk_leaf) ) - - let rec pptree = function - | N (a,b) -> Printf.sprintf "N (%s, %s)" (pptree a) (pptree b) - | L x -> Printf.sprintf "L %d" x - - let errpptree = function - | Ok x -> "Ok " ^ pptree x - | Error s -> "Error " ^ s -*) - -(*$= & ~printer:errpptree - (Ok (N (L 1, N (L 2, L 3)))) \ - (parse_string ptree "(1 (2 3))" ) - (Ok (N (N (L 1, L 2), N (L 3, N (L 4, L 5))))) \ - (parse_string ptree "((1 2) (3 (4 5)))" ) - (Ok (N (L 1, N (L 2, L 3)))) \ - (parse_string ptree' "(1 (2 3))" ) - (Ok (N (N (L 1, L 2), N (L 3, N (L 4, L 5))))) \ - (parse_string ptree' "((1 2) (3 (4 5)))" ) -*) - -(*$R - let p = U.list ~sep:"," U.word in - let printer = function - | Ok l -> "Ok " ^ CCFormat.(to_string (list string)) l - | Error s -> "Error " ^ s - in - assert_equal ~printer - (Ok ["abc"; "de"; "hello"; "world"]) - (parse_string p "[abc , de, hello ,world ]"); -*) - -(*$R - let test n = - let p = CCParse.(U.list ~sep:"," U.int) in - - let l = CCList.(1 -- n) in - let l_printed = - CCFormat.(to_string (within "[" "]" (list ~sep:(return ",") int))) l in - - let l' = CCParse.parse_string_exn p l_printed in - - assert_equal ~printer:Q.Print.(list int) l l' - in - test 100_000; - test 400_000; - -*) - -(*$R - let open CCParse.Infix in - let module P = CCParse in - - let parens p = P.try_ (P.char '(') *> p <* P.char ')' in - let add = P.char '+' *> P.return (+) in - let sub = P.char '-' *> P.return (-) in - let mul = P.char '*' *> P.return ( * ) in - let div = P.char '/' *> P.return ( / ) in - let integer = - P.chars1_if (function '0'..'9'->true|_->false) >|= int_of_string in - - let chainl1 e op = - P.fix (fun r -> - e >>= fun x -> P.try_ (op <*> P.return x <*> r) <|> P.return x) in - - let expr : int P.t = - P.fix (fun expr -> - let factor = parens expr <|> integer in - let term = chainl1 factor (mul <|> div) in - chainl1 term (add <|> sub)) in - - assert_equal (Ok 6) (P.parse_string expr "4*1+2"); - assert_equal (Ok 12) (P.parse_string expr "4*(1+2)"); - () -*) - - type 'a or_error = ('a, string) Result.result type line_num = int diff --git a/src/core/CCString.ml b/src/core/CCString.ml index 219cd554a..829954e44 100644 --- a/src/core/CCString.ml +++ b/src/core/CCString.ml @@ -13,6 +13,11 @@ let init n f = let buf = Bytes.init n f in Bytes.unsafe_to_string buf +(*$T + init 3 (fun i -> [|'a'; 'b'; 'c'|].(i)) = "abc" + init 0 (fun _ -> assert false) = "" +*) + let uppercase_ascii = String.map CCChar.uppercase_ascii let lowercase_ascii = String.map CCChar.lowercase_ascii @@ -71,6 +76,17 @@ let rev s = let n = length s in init n (fun i -> s.[n-i-1]) +(*$Q + Q.printable_string (fun s -> s = rev (rev s)) + Q.printable_string (fun s -> length s = length (rev s)) +*) + +(*$= + "abc" (rev "cba") + "" (rev "") + " " (rev " ") +*) + let rec _to_list s acc i len = if len=0 then List.rev acc else _to_list s (s.[i]::acc) (i+1) (len-1) @@ -259,6 +275,19 @@ let find ?(start=0) ~sub = let pattern = Find.compile sub in fun s -> Find.find ~start ~pattern s +(*$= & ~printer:string_of_int + 1 (find ~sub:"bc" "abcd") + ~-1 (find ~sub:"bc" "abd") + 1 (find ~sub:"a" "_a_a_a_") + 6 (find ~sub:"a" ~start:5 "a1a234a") +*) + +(*$Q & ~count:10_000 + Q.(pair printable_string printable_string) (fun (s1,s2) -> \ + let i = find ~sub:s2 s1 in \ + i < 0 || String.sub s1 i (length s2) = s2) +*) + let find_all ?(start=0) ~sub = let pattern = Find.compile sub in fun s -> @@ -278,12 +307,38 @@ let find_all_l ?start ~sub s = in aux [] (find_all ?start ~sub s) +(*$= & ~printer:Q.Print.(list int) + [1; 6] (find_all_l ~sub:"bc" "abc aabc aab") + [] (find_all_l ~sub:"bc" "abd") + [76] (find_all_l ~sub:"aaaaaa" \ + "aabbaabbaaaaabbbbabababababbbbabbbabbaaababbbaaabaabbaabbaaaabbababaaaabbaabaaaaaabbbaaaabababaabaaabbaabaaaabbababbaabbaaabaabbabababbbaabababaaabaaababbbaaaabbbaabaaababbabaababbaabbaaaaabababbabaababbbaaabbabbabababaaaabaaababaaaaabbabbaabbabbbbbbbbbbbbbbaabbabbbbbabbaaabbabbbbabaaaaabbababbbaaaa") +*) + let mem ?start ~sub s = find ?start ~sub s >= 0 +(*$T + mem ~sub:"bc" "abcd" + not (mem ~sub:"a b" "abcd") +*) + let rfind ~sub = let pattern = Find.rcompile sub in fun s -> Find.rfind ~start:(String.length s-1) ~pattern s +(*$= & ~printer:string_of_int + 1 (rfind ~sub:"bc" "abcd") + ~-1 (rfind ~sub:"bc" "abd") + 5 (rfind ~sub:"a" "_a_a_a_") + 4 (rfind ~sub:"bc" "abcdbcd") + 6 (rfind ~sub:"a" "a1a234a") +*) + +(*$Q & ~count:10_000 + Q.(pair printable_string printable_string) (fun (s1,s2) -> \ + let i = rfind ~sub:s2 s1 in \ + i < 0 || String.sub s1 i (length s2) = s2) +*) + (* Replace substring [s.[pos]....s.[pos+len-1]] by [by] in [s] *) let replace_at_ ~pos ~len ~by s = let b = Buffer.create (length s + length by - len) in @@ -321,6 +376,16 @@ let replace ?(which=`All) ~sub ~by s = done; Buffer.contents b +(*$= & ~printer:CCFun.id + (replace ~which:`All ~sub:"a" ~by:"b" "abcdabcd") "bbcdbbcd" + (replace ~which:`Left ~sub:"a" ~by:"b" "abcdabcd") "bbcdabcd" + (replace ~which:`Right ~sub:"a" ~by:"b" "abcdabcd") "abcdbbcd" + (replace ~which:`All ~sub:"ab" ~by:"hello" " abab cdabb a") \ + " hellohello cdhellob a" + (replace ~which:`Left ~sub:"ab" ~by:"nope" " a b c d ") " a b c d " + (replace ~sub:"a" ~by:"b" "1aa234a") "1bb234b" +*) + module Split = struct type drop_if_empty = { first: bool; @@ -379,6 +444,12 @@ module Split = struct let list_cpy ?(drop=default_drop) ~by s = _mklist ~drop ~by s String.sub + (*$T + Split.list_cpy ~by:"," "aa,bb,cc" = ["aa"; "bb"; "cc"] + Split.list_cpy ~by:"--" "a--b----c--" = ["a"; "b"; ""; "c"; ""] + Split.list_cpy ~by:" " "hello world aie" = ["hello"; ""; "world"; "aie"] + *) + let _mkklist ~drop ~by s k = let by = Find.compile by in let rec make state () = match _split ~by s state with @@ -414,6 +485,14 @@ module Split = struct let left ~by s = try Some (left_exn ~by s) with Not_found -> None + (*$T + Split.left ~by:" " "ab cde f g " = Some ("ab", "cde f g ") + Split.left ~by:"__" "a__c__e_f" = Some ("a", "c__e_f") + Split.left ~by:"_" "abcde" = None + Split.left ~by:"bb" "abbc" = Some ("a", "c") + Split.left ~by:"a_" "abcde" = None + *) + let right_exn ~by s = let i = rfind ~sub:by s in if i = ~-1 then raise Not_found @@ -422,11 +501,30 @@ module Split = struct String.sub s 0 i, String.sub s right (String.length s - right) let right ~by s = try Some (right_exn ~by s) with Not_found -> None + + (*$T + Split.right ~by:" " "ab cde f g" = Some ("ab cde f", "g") + Split.right ~by:"__" "a__c__e_f" = Some ("a__c", "e_f") + Split.right ~by:"_" "abcde" = None + Split.right ~by:"a_" "abcde" = None + *) + end let split_on_char c s: _ list = Split.list_cpy ~drop:Split.no_drop ~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 ~by s = Split.list_cpy ~by s let compare_versions a b = @@ -448,6 +546,20 @@ let compare_versions a b = in cmp_rec (Split.gen_cpy ~by:"." a) (Split.gen_cpy ~by:"." b) +(*$T + compare_versions "0.1.3" "0.1" > 0 + compare_versions "10.1" "2.0" > 0 + compare_versions "0.1.alpha" "0.1" > 0 + compare_versions "0.3.dev" "0.4" < 0 + compare_versions "0.foo" "0.0" < 0 + compare_versions "1.2.3.4" "01.2.4.3" < 0 +*) + +(*$Q + Q.(pair printable_string printable_string) (fun (a,b) -> \ + CCOrd.equiv (compare_versions a b) (CCOrd.opp compare_versions b a)) +*) + type nat_chunk = | NC_char of char | NC_int of int @@ -486,6 +598,25 @@ let compare_natural a b = in cmp_rec (chunks a) (chunks b) +(*$T + compare_natural "foo1" "foo2" < 0 + compare_natural "foo11" "foo2" > 0 + compare_natural "foo11" "foo11" = 0 + compare_natural "foo011" "foo11" = 0 + compare_natural "foo1a" "foo1b" < 0 + compare_natural "foo1a1" "foo1a2" < 0 + compare_natural "foo1a17" "foo1a2" > 0 +*) + +(*Q + (Q.pair printable_string printable_string) (fun (a,b) -> \ + CCOrd.opp (compare_natural a b) = compare_natural b a) + (Q.printable_string) (fun a -> compare_natural a a = 0) + (Q.triple printable_string printable_string printable_string) (fun (a,b,c) -> \ + if compare_natural a b < 0 && compare_natural b c < 0 \ + then compare_natural a c < 0 else Q.assume_fail()) +*) + let edit_distance s1 s2 = if length s1 = 0 then length s2 @@ -518,6 +649,35 @@ let edit_distance s1 s2 = v1.(length s2) end +(*$Q + Q.(string_of_size Gen.(0 -- 30)) (fun s -> \ + edit_distance s s = 0) +*) + +(* test that building a from s, and mutating one char of s, yields + a string s' that is accepted by a. + + --> generate triples (s, i, c) where c is a char, s a non empty string + and i a valid index in s. +*) + +(*$QR + ( + let gen = Q.Gen.( + 3 -- 10 >>= fun len -> + 0 -- (len-1) >>= fun i -> + string_size (return len) >>= fun s -> + char >|= fun c -> (s,i,c) + ) in + let small (s,_,_) = String.length s in + Q.make ~small gen + ) + (fun (s,i,c) -> + let s' = Bytes.of_string s in + Bytes.set s' i c; + edit_distance s (Bytes.to_string s') <= 1) +*) + let repeat s n = assert (n>=0); let len = String.length s in @@ -536,6 +696,16 @@ let prefix ~pre s = check 0 ) +(*$T + prefix ~pre:"aab" "aabcd" + not (prefix ~pre:"ab" "aabcd") + not (prefix ~pre:"abcd" "abc") + prefix ~pre:"abc" "abcde" + prefix ~pre:"" "" + prefix ~pre:"" "abc" + prefix ~pre:"abc" "abc" +*) + let suffix ~suf s = let len = String.length suf in if len > String.length s then false @@ -549,6 +719,14 @@ let suffix ~suf s = check 0 ) +(*$T + suffix ~suf:"cd" "abcd" + suffix ~suf:"" "" + suffix ~suf:"" "abc" + not (suffix ~suf:"cd" "abcde") + not (suffix ~suf:"abcd" "cd") +*) + let take n s = if n < String.length s then String.sub s 0 n @@ -561,16 +739,34 @@ let drop n s = let take_drop n s = take n s, drop n s +(*$= + ("ab", "cd") (take_drop 2 "abcd") + ("abc", "") (take_drop 3 "abc") + ("abc", "") (take_drop 5 "abc") +*) + let chop_suffix ~suf s = if suffix ~suf s then Some (String.sub s 0 (String.length s-String.length suf)) else None +(*$= & ~printer:Q.Print.(option string) + (Some "ab") (chop_suffix ~suf:"cd" "abcd") + None (chop_suffix ~suf:"cd" "abcde") + None (chop_suffix ~suf:"abcd" "cd") +*) + let chop_prefix ~pre s = if prefix ~pre s then Some (String.sub s (String.length pre) (String.length s-String.length pre)) else None +(*$= & ~printer:Q.Print.(option string) + (Some "cd") (chop_prefix ~pre:"aab" "aabcd") + None (chop_prefix ~pre:"ab" "aabcd") + None (chop_prefix ~pre:"abcd" "abc") +*) + let blit = String.blit let fold f acc s = @@ -588,6 +784,15 @@ let pad ?(side=`Left) ?(c=' ') n s = | `Left -> init n (fun i -> if i < pad_len then c else s.[i-pad_len]) | `Right -> init n (fun i -> if i < len_s then s.[i] else c) +(*$= & ~printer:Q.Print.string + " 42" (pad 4 "42") + "0042" (pad ~c:'0' 4 "42") + "4200" (pad ~side:`Right ~c:'0' 4 "42") + "hello" (pad 4 "hello") + "aaa" (pad ~c:'a' 3 "") + "aaa" (pad ~side:`Right ~c:'a' 3 "") +*) + let _to_gen s i0 len = let i = ref i0 in fun () -> @@ -639,9 +844,14 @@ let of_list l = List.iter (Buffer.add_char buf) l; Buffer.contents buf +(*$T + of_list ['a'; 'b'; 'c'] = "abc" + of_list [] = "" +*) + let of_array a = init (Array.length a) (fun i -> a.(i)) - + let to_array s = Array.init (String.length s) (fun i -> s.[i]) @@ -649,6 +859,14 @@ let lines_gen s = Split.gen_cpy ~drop:{Split.first=false; last=true} ~by:"\n" s let lines s = Split.list_cpy ~drop:{Split.first=false; last=true} ~by:"\n" s +(*$= & ~printer:Q.Print.(list @@ Printf.sprintf "%S") + ["ab"; "c"] (lines "ab\nc") + ["ab"; "c"] (lines "ab\nc\n") + [] (lines "") + [""] (lines "\n") + [""; "a"] (lines "\na") +*) + let concat_gen_buf ~sep g : Buffer.t = let b = Buffer.create 256 in let rec aux ~first () = match g () with @@ -683,10 +901,32 @@ let unlines_gen g = Buffer.add_char buf '\n'; Buffer.contents buf +(*$= & ~printer:CCFun.id + "" (unlines []) + "ab\nc\n" (unlines ["ab"; "c"]) +*) + +(*$Q + Q.printable_string (fun s -> trim (unlines (lines s)) = trim s) + Q.printable_string (fun s -> trim (unlines_gen (lines_gen s)) = trim s) +*) + +(*$Q + Q.(list string) (fun l -> \ + let l = unlines l |> lines in \ + l = (unlines l |> lines)) +*) + let set s i c = if i<0 || i>= String.length s then invalid_arg "CCString.set"; init (String.length s) (fun j -> if i=j then c else s.[j]) +(*$T + set "abcd" 1 '_' = "a_cd" + set "abcd" 0 '-' = "-bcd" + (try ignore (set "abc" 5 '_'); false with Invalid_argument _ -> true) +*) + let iter = String.iter let filter_map f s = @@ -698,6 +938,11 @@ let filter_map f s = s; Buffer.contents buf +(*$= & ~printer:Q.Print.string + "bcef" (filter_map \ + (function 'c' -> None | c -> Some (Char.chr (Char.code c + 1))) "abcde") +*) + let filter f s = let buf = Buffer.create (String.length s) in iter @@ -705,6 +950,14 @@ let filter f s = s; Buffer.contents buf +(*$= & ~printer:Q.Print.string + "abde" (filter (function 'c' -> false | _ -> true) "abcdec") +*) + +(*$Q + Q.printable_string (fun s -> filter (fun _ -> true) s = s) +*) + let flat_map ?sep f s = let buf = Buffer.create (String.length s) in iteri @@ -743,6 +996,24 @@ let rtrim s = 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 +(*$= & ~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] <> ' ') +*) + 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]) @@ -783,6 +1054,18 @@ let equal_caseless s1 s2: bool = (fun c1 c2 -> CCChar.equal (CCChar.lowercase_ascii c1) (CCChar.lowercase_ascii c2)) s1 s2 +(*$T + equal_caseless "foo" "FoO" + equal_caseless "helLo" "HEllO" +*) + +(*$Q + Q.(pair printable_string printable_string) (fun (s1,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) +*) + let pp_buf buf s = Buffer.add_char buf '"'; Buffer.add_string buf s; @@ -824,6 +1107,36 @@ module Sub = struct else fold_rec f (f acc s.[i]) s (i+1) j in fold_rec f acc s i (i+len) + (*$T + let s = Sub.make "abcde" 1 3 in \ + Sub.fold (fun acc x -> x::acc) [] s = ['d'; 'c'; 'b'] + Sub.make "abcde" 1 3 |> Sub.copy = "bcd" + Sub.full "abcde" |> Sub.copy = "abcde" + *) + + (*$T + let sub = Sub.make " abc " 1 ~len:3 in \ + "\"abc\"" = (CCFormat.to_string Sub.pp 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])) + *) + let to_gen (s,i,len) = _to_gen s i len let to_seq (s,i,len) k = for i=i to i+len-1 do k s.[i] done diff --git a/src/core/CCString.mli b/src/core/CCString.mli index ad4e181fe..611b15ea5 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -78,26 +78,10 @@ val init : int -> (int -> char) -> string (** Analog to [Array.init]. @since 0.3.3 *) -(*$T - init 3 (fun i -> [|'a'; 'b'; 'c'|].(i)) = "abc" - init 0 (fun _ -> assert false) = "" -*) - val rev : string -> string (** [rev s] returns the reverse of [s]. @since 0.17 *) -(*$Q - Q.printable_string (fun s -> s = rev (rev s)) - Q.printable_string (fun s -> length s = length (rev s)) -*) - -(*$= - "abc" (rev "cba") - "" (rev "") - " " (rev " ") -*) - val pad : ?side:[`Left|`Right] -> ?c:char -> int -> string -> string (** [pad n str] ensures that [str] is at least [n] bytes long, and pads it on the [side] with [c] if it's not the case. @@ -105,15 +89,6 @@ val pad : ?side:[`Left|`Right] -> ?c:char -> int -> string -> string @param c the char used to pad (default: ' '). @since 0.17 *) -(*$= & ~printer:Q.Print.string - " 42" (pad 4 "42") - "0042" (pad ~c:'0' 4 "42") - "4200" (pad ~side:`Right ~c:'0' 4 "42") - "hello" (pad 4 "hello") - "aaa" (pad ~c:'a' 3 "") - "aaa" (pad ~side:`Right ~c:'a' 3 "") -*) - val of_char : char -> string (** [of_char 'a'] is ["a"]. @since 0.19 *) @@ -132,31 +107,13 @@ val of_list : char list -> string val of_array : char array -> string (** Convert an array of characters to a string. *) - -(*$T - of_list ['a'; 'b'; 'c'] = "abc" - of_list [] = "" -*) - + val to_array : string -> char array (** Return the array of characters contained in the string. *) val find : ?start:int -> sub:string -> string -> int (** Find [sub] in string, returns its first index or [-1]. *) - -(*$= & ~printer:string_of_int - 1 (find ~sub:"bc" "abcd") - ~-1 (find ~sub:"bc" "abd") - 1 (find ~sub:"a" "_a_a_a_") - 6 (find ~sub:"a" ~start:5 "a1a234a") -*) - -(*$Q & ~count:10_000 - Q.(pair printable_string printable_string) (fun (s1,s2) -> \ - let i = find ~sub:s2 s1 in \ - i < 0 || String.sub s1 i (length s2) = s2) -*) - + val find_all : ?start:int -> sub:string -> string -> int gen (** [find_all ~sub s] finds all occurrences of [sub] in [s], even overlapping instances. @@ -168,42 +125,16 @@ val find_all_l : ?start:int -> sub:string -> string -> int list them in a list. @param start starting position in [s]. @since 0.17 *) - -(*$= & ~printer:Q.Print.(list int) - [1; 6] (find_all_l ~sub:"bc" "abc aabc aab") - [] (find_all_l ~sub:"bc" "abd") - [76] (find_all_l ~sub:"aaaaaa" \ - "aabbaabbaaaaabbbbabababababbbbabbbabbaaababbbaaabaabbaabbaaaabbababaaaabbaabaaaaaabbbaaaabababaabaaabbaabaaaabbababbaabbaaabaabbabababbbaabababaaabaaababbbaaaabbbaabaaababbabaababbaabbaaaaabababbabaababbbaaabbabbabababaaaabaaababaaaaabbabbaabbabbbbbbbbbbbbbbaabbabbbbbabbaaabbabbbbabaaaaabbababbbaaaa") -*) - + val mem : ?start:int -> sub:string -> string -> bool (** [mem ~sub s] is true iff [sub] is a substring of [s]. @since 0.12 *) - -(*$T - mem ~sub:"bc" "abcd" - not (mem ~sub:"a b" "abcd") -*) - + val rfind : sub:string -> string -> int (** Find [sub] in string from the right, returns its first index or [-1]. Should only be used with very small [sub]. @since 0.12 *) -(*$= & ~printer:string_of_int - 1 (rfind ~sub:"bc" "abcd") - ~-1 (rfind ~sub:"bc" "abd") - 5 (rfind ~sub:"a" "_a_a_a_") - 4 (rfind ~sub:"bc" "abcdbcd") - 6 (rfind ~sub:"a" "a1a234a") -*) - -(*$Q & ~count:10_000 - Q.(pair printable_string printable_string) (fun (s1,s2) -> \ - let i = rfind ~sub:s2 s1 in \ - i < 0 || String.sub s1 i (length s2) = s2) -*) - val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> string (** [replace ~sub ~by s] replaces some occurrences of [sub] by [by] in [s]. @param which decides whether the occurrences to replace are: @@ -215,16 +146,6 @@ val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> @raise Invalid_argument if [sub = ""]. @since 0.14 *) -(*$= & ~printer:CCFun.id - (replace ~which:`All ~sub:"a" ~by:"b" "abcdabcd") "bbcdbbcd" - (replace ~which:`Left ~sub:"a" ~by:"b" "abcdabcd") "bbcdabcd" - (replace ~which:`Right ~sub:"a" ~by:"b" "abcdabcd") "abcdbbcd" - (replace ~which:`All ~sub:"ab" ~by:"hello" " abab cdabb a") \ - " hellohello cdhellob a" - (replace ~which:`Left ~sub:"ab" ~by:"nope" " a b c d ") " a b c d " - (replace ~sub:"a" ~by:"b" "1aa234a") "1bb234b" -*) - val is_sub : sub:string -> int -> string -> int -> len:int -> bool (** [is_sub ~sub i s j ~len] returns [true] iff the substring of [sub] starting at position [i] and of length [len] is a substring @@ -236,50 +157,20 @@ val repeat : string -> int -> string val prefix : pre:string -> string -> bool (** [prefix ~pre s] returns [true] iff [pre] is a prefix of [s]. *) -(*$T - prefix ~pre:"aab" "aabcd" - not (prefix ~pre:"ab" "aabcd") - not (prefix ~pre:"abcd" "abc") - prefix ~pre:"abc" "abcde" - prefix ~pre:"" "" - prefix ~pre:"" "abc" - prefix ~pre:"abc" "abc" -*) - val suffix : suf:string -> string -> bool (** [suffix ~suf s] returns [true] iff [suf] is a suffix of [s]. @since 0.7 *) -(*$T - suffix ~suf:"cd" "abcd" - suffix ~suf:"" "" - suffix ~suf:"" "abc" - not (suffix ~suf:"cd" "abcde") - not (suffix ~suf:"abcd" "cd") -*) - val chop_prefix : pre:string -> string -> string option (** [chop_prefix ~pre s] removes [pre] from [s] if [pre] really is a prefix of [s], returns [None] otherwise. @since 0.17 *) -(*$= & ~printer:Q.Print.(option string) - (Some "cd") (chop_prefix ~pre:"aab" "aabcd") - None (chop_prefix ~pre:"ab" "aabcd") - None (chop_prefix ~pre:"abcd" "abc") -*) - val chop_suffix : suf:string -> string -> string option (** [chop_suffix ~suf s] removes [suf] from [s] if [suf] really is a suffix of [s], returns [None] otherwise. @since 0.17 *) -(*$= & ~printer:Q.Print.(option string) - (Some "ab") (chop_suffix ~suf:"cd" "abcd") - None (chop_suffix ~suf:"cd" "abcde") - None (chop_suffix ~suf:"abcd" "cd") -*) - val take : int -> string -> string (** [take n s] keeps only the [n] first chars of [s]. @since 0.17 *) @@ -292,12 +183,6 @@ val take_drop : int -> string -> string * string (** [take_drop n s = take n s, drop n s]. @since 0.17 *) -(*$= - ("ab", "cd") (take_drop 2 "abcd") - ("abc", "") (take_drop 3 "abc") - ("abc", "") (take_drop 5 "abc") -*) - val lines : string -> string list (** [lines s] returns a list of the lines of [s] (splits along '\n'). @since 0.10 *) @@ -306,14 +191,6 @@ val lines_gen : string -> string gen (** [lines_gen s] returns a generator of the lines of [s] (splits along '\n'). @since 0.10 *) -(*$= & ~printer:Q.Print.(list @@ Printf.sprintf "%S") - ["ab"; "c"] (lines "ab\nc") - ["ab"; "c"] (lines "ab\nc\n") - [] (lines "") - [""] (lines "\n") - [""; "a"] (lines "\na") -*) - val concat_gen : sep:string -> string gen -> string (** [concat_gen ~sep g] concatenates all strings of [g], separated with [sep]. @since 0.10 *) @@ -326,34 +203,12 @@ val unlines_gen : string gen -> string (** [unlines_gen g] concatenates all strings of [g], separated with '\n'. @since 0.10 *) -(*$= & ~printer:CCFun.id - "" (unlines []) - "ab\nc\n" (unlines ["ab"; "c"]) -*) - -(*$Q - Q.printable_string (fun s -> trim (unlines (lines s)) = trim s) - Q.printable_string (fun s -> trim (unlines_gen (lines_gen s)) = trim s) -*) - -(*$Q - Q.(list string) (fun l -> \ - let l = unlines l |> lines in \ - l = (unlines l |> lines)) -*) - val set : string -> int -> char -> string (** [set s i c] creates a new string which is a copy of [s], except for index [i], which becomes [c]. @raise Invalid_argument if [i] is an invalid index. @since 0.12 *) -(*$T - set "abcd" 1 '_' = "a_cd" - set "abcd" 0 '-' = "-bcd" - (try ignore (set "abc" 5 '_'); false with Invalid_argument _ -> true) -*) - val iter : (char -> unit) -> string -> unit (** Alias to {!String.iter}. @since 0.12 *) @@ -376,23 +231,10 @@ val filter_map : (char -> char option) -> string -> string the corresponding element of [s] is discarded). @since 0.17 *) -(*$= & ~printer:Q.Print.string - "bcef" (filter_map \ - (function 'c' -> None | c -> Some (Char.chr (Char.code c + 1))) "abcde") -*) - val filter : (char -> bool) -> string -> string (** [filter f s] discards characters not satisfying [f]. @since 0.17 *) -(*$= & ~printer:Q.Print.string - "abde" (filter (function 'c' -> false | _ -> true) "abcdec") -*) - -(*$Q - Q.printable_string (fun s -> filter (fun _ -> true) s = s) -*) - val flat_map : ?sep:string -> (char -> string) -> string -> string (** Map each chars to a string, then concatenates them all. @param sep optional separator between each generated string. @@ -416,24 +258,6 @@ val rtrim : t -> t (** Trim space on the right (see {!String.trim} for more details). @since 1.2 *) -(*$= & ~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 @@ -487,18 +311,6 @@ val equal_caseless : string -> string -> bool (** Comparison without respect to {b ascii} lowercase. @since 1.2 *) -(*$T - equal_caseless "foo" "FoO" - equal_caseless "helLo" "HEllO" -*) - -(*$Q - Q.(pair printable_string printable_string) (fun (s1,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) -*) - (** {2 Finding} A relatively efficient algorithm for finding sub-strings. @@ -566,12 +378,6 @@ module Split : sig val list_cpy : ?drop:drop_if_empty -> by:string -> string -> string list - (*$T - Split.list_cpy ~by:"," "aa,bb,cc" = ["aa"; "bb"; "cc"] - Split.list_cpy ~by:"--" "a--b----c--" = ["a"; "b"; ""; "c"; ""] - Split.list_cpy ~by:" " "hello world aie" = ["hello"; ""; "world"; "aie"] - *) - val gen_cpy : ?drop:drop_if_empty -> by:string -> string -> string gen val seq_cpy : ?drop:drop_if_empty -> by:string -> string -> string sequence @@ -588,14 +394,6 @@ module Split : sig @raise Not_found if [by] is not part of the string. @since 0.16 *) - (*$T - Split.left ~by:" " "ab cde f g " = Some ("ab", "cde f g ") - Split.left ~by:"__" "a__c__e_f" = Some ("a", "c__e_f") - Split.left ~by:"_" "abcde" = None - Split.left ~by:"bb" "abbc" = Some ("a", "c") - Split.left ~by:"a_" "abcde" = None - *) - val right : by:string -> string -> (string * string) option (** Split on the first occurrence of [by] from the rightmost part of the string. @@ -606,29 +404,12 @@ module Split : sig @raise Not_found if [by] is not part of the string. @since 0.16 *) - (*$T - Split.right ~by:" " "ab cde f g" = Some ("ab cde f", "g") - Split.right ~by:"__" "a__c__e_f" = Some ("a__c", "e_f") - Split.right ~by:"_" "abcde" = None - Split.right ~by:"a_" "abcde" = None - *) end val split_on_char : char -> string -> string list (** Split the string along the given char. @since 1.2 *) -(*$= & ~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 1.2 *) @@ -640,78 +421,16 @@ val compare_versions : string -> string -> int considering that numbers are above text. @since 0.13 *) -(*$T - compare_versions "0.1.3" "0.1" > 0 - compare_versions "10.1" "2.0" > 0 - compare_versions "0.1.alpha" "0.1" > 0 - compare_versions "0.3.dev" "0.4" < 0 - compare_versions "0.foo" "0.0" < 0 - compare_versions "1.2.3.4" "01.2.4.3" < 0 -*) - -(*$Q - Q.(pair printable_string printable_string) (fun (a,b) -> \ - CCOrd.equiv (compare_versions a b) (CCOrd.opp compare_versions b a)) -*) - val compare_natural : string -> string -> int (** Natural Sort Order, comparing chunks of digits as natural numbers. https://en.wikipedia.org/wiki/Natural_sort_order @since 1.3 *) -(*$T - compare_natural "foo1" "foo2" < 0 - compare_natural "foo11" "foo2" > 0 - compare_natural "foo11" "foo11" = 0 - compare_natural "foo011" "foo11" = 0 - compare_natural "foo1a" "foo1b" < 0 - compare_natural "foo1a1" "foo1a2" < 0 - compare_natural "foo1a17" "foo1a2" > 0 -*) - -(*Q - (Q.pair printable_string printable_string) (fun (a,b) -> \ - CCOrd.opp (compare_natural a b) = compare_natural b a) - (Q.printable_string) (fun a -> compare_natural a a = 0) - (Q.triple printable_string printable_string printable_string) (fun (a,b,c) -> \ - if compare_natural a b < 0 && compare_natural b c < 0 \ - then compare_natural a c < 0 else Q.assume_fail()) -*) - val edit_distance : string -> string -> int (** Edition distance between two strings. This satisfies the classical distance axioms: it is always positive, symmetric, and satisfies the formula [distance a b + distance b c >= distance a c]. *) -(*$Q - Q.(string_of_size Gen.(0 -- 30)) (fun s -> \ - edit_distance s s = 0) -*) - -(* test that building a from s, and mutating one char of s, yields - a string s' that is accepted by a. - - --> generate triples (s, i, c) where c is a char, s a non empty string - and i a valid index in s. -*) - -(*$QR - ( - let gen = Q.Gen.( - 3 -- 10 >>= fun len -> - 0 -- (len-1) >>= fun i -> - string_size (return len) >>= fun s -> - char >|= fun c -> (s,i,c) - ) in - let small (s,_,_) = String.length s in - Q.make ~small gen - ) - (fun (s,i,c) -> - let s' = Bytes.of_string s in - Bytes.set s' i c; - edit_distance s (Bytes.to_string s') <= 1) -*) - (** {2 Slices} A contiguous part of a string *) module Sub : sig @@ -738,33 +457,4 @@ module Sub : sig include S with type t := t - (*$T - let s = Sub.make "abcde" 1 3 in \ - Sub.fold (fun acc x -> x::acc) [] s = ['d'; 'c'; 'b'] - Sub.make "abcde" 1 3 |> Sub.copy = "bcd" - Sub.full "abcde" |> Sub.copy = "abcde" - *) - - (*$T - let sub = Sub.make " abc " 1 ~len:3 in \ - "\"abc\"" = (CCFormat.to_string Sub.pp 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 diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index e6ab05070..3b1f4f172 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -239,7 +239,7 @@ val (--^) : int -> int -> (int, 'mut) t @since 0.17 *) val of_array : 'a array -> ('a, 'mut) t -(** [of_array a] returns a vector corresponding to the array [a]. *) +(** [of_array a] returns a vector corresponding to the array [a]. Operates in [O(n)] time. *) val of_list : 'a list -> ('a, 'mut) t diff --git a/src/data/CCZipper.ml b/src/data/CCZipper.ml index 30d227d1c..ec7eb143e 100644 --- a/src/data/CCZipper.ml +++ b/src/data/CCZipper.ml @@ -11,6 +11,11 @@ let is_empty = function | [], [] -> true | _ -> false +(*$T + (is_empty empty) + not ([42] |> make |> right |> is_empty) +*) + let to_list (l,r) = List.rev_append l r let to_rev_list (l,r) = List.rev_append r l @@ -89,3 +94,9 @@ let drop_after (l, r) = match r with | x :: _ -> l, [x] let drop_after_and_focused (l, _) = l, [] + +(*$= + ([1], [2]) (drop_after ([1], [2;3])) + ([1], []) (drop_after ([1], [])) + ([1], []) (drop_after_and_focused ([1], [2;3])) +*) diff --git a/src/data/CCZipper.mli b/src/data/CCZipper.mli index 763074ecb..9d3ea4aeb 100644 --- a/src/data/CCZipper.mli +++ b/src/data/CCZipper.mli @@ -15,11 +15,6 @@ val empty : 'a t val is_empty : _ t -> bool (** Empty zipper? Returns true iff the two lists are empty. *) -(*$T - (is_empty empty) - not ([42] |> make |> right |> is_empty) -*) - val to_list : 'a t -> 'a list (** Convert the zipper back to a list. [to_list (l,r)] is [List.rev_append l r]. *) @@ -79,9 +74,4 @@ val drop_after_and_focused : 'a t -> 'a t (** Drop every element on the "right" (calling {!right} then will do nothing), {i including} the focused element if it is present. *) -(*$= - ([1], [2]) (drop_after ([1], [2;3])) - ([1], []) (drop_after ([1], [])) - ([1], []) (drop_after_and_focused ([1], [2;3])) -*) diff --git a/src/unix/CCUnix.ml b/src/unix/CCUnix.ml index 4d2b4d55a..905cd359f 100644 --- a/src/unix/CCUnix.ml +++ b/src/unix/CCUnix.ml @@ -50,6 +50,12 @@ let escape_str s = Buffer.contents buf ) else s +(*$T + escape_str "foo" = "foo" + escape_str "foo bar" = "'foo bar'" + escape_str "fo'o b'ar" = "'fo'\\''o b'\\''ar'" +*) + let read_all ?(size=1024) ic = let buf = ref (Bytes.create size) in let len = ref 0 in @@ -107,6 +113,12 @@ let call_full ?bufsize ?stdin ?env cmd = method errcode = int_of_process_status status end) +(*$T + call_full ~stdin:(`Str "abc") "cat" |> stdout = "abc" + call_full "echo %s" (escape_str "a'b'c") |> stdout = "a'b'c\n" + call_full "echo %s" "a'b'c" |> stdout = "abc\n" +*) + let call ?bufsize ?stdin ?env cmd = call_full_inner ?bufsize ?stdin ?env cmd ~f:(fun (out,err,status) -> out, err, int_of_process_status status) @@ -115,6 +127,12 @@ let call_stdout ?bufsize ?stdin ?env cmd = call_full_inner ?bufsize ?stdin ?env cmd ~f:(fun (out,_err,_status) -> out) +(*$T + call_stdout ~stdin:(`Str "abc") "cat" = "abc" + call_stdout "echo %s" (escape_str "a'b'c") = "a'b'c\n" + call_stdout "echo %s" "a'b'c" = "abc\n" +*) + type line = string type async_call_result = diff --git a/src/unix/CCUnix.mli b/src/unix/CCUnix.mli index 938363397..77657dd44 100644 --- a/src/unix/CCUnix.mli +++ b/src/unix/CCUnix.mli @@ -16,12 +16,6 @@ type 'a gen = unit -> 'a option val escape_str : string -> string (** Escape a string so it can be a shell argument. *) -(*$T - escape_str "foo" = "foo" - escape_str "foo bar" = "'foo bar'" - escape_str "fo'o b'ar" = "'fo'\\''o b'\\''ar'" -*) - type call_result = < stdout:string; stderr:string; @@ -44,12 +38,6 @@ val call_full : @param env environment to run the command in. *) -(*$T - call_full ~stdin:(`Str "abc") "cat" |> stdout = "abc" - call_full "echo %s" (escape_str "a'b'c") |> stdout = "a'b'c\n" - call_full "echo %s" "a'b'c" |> stdout = "abc\n" -*) - val call : ?bufsize:int -> ?stdin:[`Gen of string gen | `Str of string] -> @@ -66,12 +54,6 @@ val call_stdout : ('a, Buffer.t, unit, string) format4 -> 'a -(*$T - call_stdout ~stdin:(`Str "abc") "cat" = "abc" - call_stdout "echo %s" (escape_str "a'b'c") = "a'b'c\n" - call_stdout "echo %s" "a'b'c" = "abc\n" -*) - type line = string type async_call_result = From b3c796176d63ed15ef88b473c94bd61443335e68 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 7 Feb 2018 08:22:41 -0600 Subject: [PATCH 16/20] reindent --- src/core/CCFormat.ml | 2 +- src/core/CCList.ml | 2 +- src/core/CCList.mli | 2 +- src/core/CCString.ml | 14 +++++++------- src/core/CCString.mli | 8 ++++---- src/data/CCRAL.ml | 6 +++--- 6 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index b03250dc2..c99aae738 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -390,7 +390,7 @@ let ksprintf ~f fmt = (Some "hello world") \ (ksprintf "hello %a" CCFormat.string "world" ~f:(fun s -> Some s)) *) - + module Dump = struct type 'a t = 'a printer let unit = unit diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 2f1655997..82291ba32 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -1265,7 +1265,7 @@ let replicate i x = Q.(pair small_int (small_list int)) (fun (n,l) -> \ if n>0 then repeat n l = flat_map (fun _ -> l) (1--n) \ else Q.assume_fail()) - *) +*) let repeat i l = let rec aux acc i = diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 92d19d98b..b80bf76ad 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -339,7 +339,7 @@ val sorted_insert : cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a l @param uniq if true and [x] is already in sorted position in [l], then [x] is not duplicated. Default [false] ([x] will be inserted in any case). @since 0.17 *) - + val uniq_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list (** [uniq_succ l] removes duplicate elements that occur one next to the other. Examples: diff --git a/src/core/CCString.ml b/src/core/CCString.ml index 829954e44..aadd9d9c6 100644 --- a/src/core/CCString.ml +++ b/src/core/CCString.ml @@ -287,7 +287,7 @@ let find ?(start=0) ~sub = let i = find ~sub:s2 s1 in \ i < 0 || String.sub s1 i (length s2) = s2) *) - + let find_all ?(start=0) ~sub = let pattern = Find.compile sub in fun s -> @@ -313,14 +313,14 @@ let find_all_l ?start ~sub s = [76] (find_all_l ~sub:"aaaaaa" \ "aabbaabbaaaaabbbbabababababbbbabbbabbaaababbbaaabaabbaabbaaaabbababaaaabbaabaaaaaabbbaaaabababaabaaabbaabaaaabbababbaabbaaabaabbabababbbaabababaaabaaababbbaaaabbbaabaaababbabaababbaabbaaaaabababbabaababbbaaabbabbabababaaaabaaababaaaaabbabbaabbabbbbbbbbbbbbbbaabbabbbbbabbaaabbabbbbabaaaaabbababbbaaaa") *) - + let mem ?start ~sub s = find ?start ~sub s >= 0 (*$T mem ~sub:"bc" "abcd" not (mem ~sub:"a b" "abcd") *) - + let rfind ~sub = let pattern = Find.rcompile sub in fun s -> Find.rfind ~start:(String.length s-1) ~pattern s @@ -508,7 +508,7 @@ module Split = struct Split.right ~by:"_" "abcde" = None Split.right ~by:"a_" "abcde" = None *) - + end let split_on_char c s: _ list = @@ -848,10 +848,10 @@ let of_list l = of_list ['a'; 'b'; 'c'] = "abc" of_list [] = "" *) - + let of_array a = init (Array.length a) (fun i -> a.(i)) - + let to_array s = Array.init (String.length s) (fun i -> s.[i]) @@ -1136,7 +1136,7 @@ module Sub = struct |> Sequence.for_all (fun (i,j,sub) -> Sub.get sub j = s.[i+j])) *) - + let to_gen (s,i,len) = _to_gen s i len let to_seq (s,i,len) k = for i=i to i+len-1 do k s.[i] done diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 611b15ea5..60de94938 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -107,13 +107,13 @@ val of_list : char list -> string val of_array : char array -> string (** Convert an array of characters to a string. *) - + val to_array : string -> char array (** Return the array of characters contained in the string. *) val find : ?start:int -> sub:string -> string -> int (** Find [sub] in string, returns its first index or [-1]. *) - + val find_all : ?start:int -> sub:string -> string -> int gen (** [find_all ~sub s] finds all occurrences of [sub] in [s], even overlapping instances. @@ -125,11 +125,11 @@ val find_all_l : ?start:int -> sub:string -> string -> int list them in a list. @param start starting position in [s]. @since 0.17 *) - + val mem : ?start:int -> sub:string -> string -> bool (** [mem ~sub s] is true iff [sub] is a substring of [s]. @since 0.12 *) - + val rfind : sub:string -> string -> int (** Find [sub] in string from the right, returns its first index or [-1]. Should only be used with very small [sub]. diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index 6a2147692..2799f0811 100644 --- a/src/data/CCRAL.ml +++ b/src/data/CCRAL.ml @@ -262,7 +262,7 @@ let flat_map f l = let f x = Q.Fn.apply f x in \ let f' x = f x |> of_list in \ of_list l |> flat_map f' |> to_list = CCList.(flat_map f l)) - *) +*) let flatten l = fold_rev ~f:(fun acc l -> append l acc) ~x:empty l @@ -274,7 +274,7 @@ let flatten l = fold_rev ~f:(fun acc l -> append l acc) ~x:empty l (*$Q Q.(small_list (small_list int)) (fun l -> \ of_list l |> map ~f:of_list |> flatten |> to_list = CCList.flatten l) - *) +*) let app funs l = fold_rev ~x:empty funs @@ -452,7 +452,7 @@ let repeat n l = (*$Q Q.(pair small_int (list int)) (fun (n,l) -> \ of_list l |> repeat n |> to_list = CCList.(repeat n l)) - *) +*) let range i j = let rec aux i j acc = From d4fafab9b77d21540b8205489bcdfa9222f9523a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 7 Feb 2018 20:38:01 -0600 Subject: [PATCH 17/20] more tests --- src/core/CCString.ml | 6 ++++++ src/data/CCRingBuffer.ml | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/src/core/CCString.ml b/src/core/CCString.ml index aadd9d9c6..11291efed 100644 --- a/src/core/CCString.ml +++ b/src/core/CCString.ml @@ -81,6 +81,12 @@ let rev s = Q.printable_string (fun s -> length s = length (rev s)) *) +(*$Q + Q.printable_string (fun s -> \ + rev s = (to_list s |> List.rev |> of_list)) + *) + + (*$= "abc" (rev "cba") "" (rev "") diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml index af64a188a..7c2e88b7e 100644 --- a/src/data/CCRingBuffer.ml +++ b/src/data/CCRingBuffer.ml @@ -200,7 +200,7 @@ end open Q.Gen let g_char = map Char.chr (Char.code 'A' -- Char.code 'z') let g_str = string_size ~gen:g_char (0--10) - let a_str = {Q.string with Q.gen=g_str} + let a_str = Q.set_gen g_str Q.string *) module MakeFromArray(A:Array.S) : S with module Array = A = struct From 35f9b32a5b56501c8774d67b7149eea07b32a454 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 9 Feb 2018 14:20:46 -0600 Subject: [PATCH 18/20] add `CCFormat.lazy_{or,force}` for printing thunks --- src/core/CCFormat.ml | 5 +++++ src/core/CCFormat.mli | 9 +++++++++ 2 files changed, 14 insertions(+) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index c99aae738..d01f3ad9e 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -133,6 +133,11 @@ let some pp out = function | None -> () | Some x -> pp out x +let lazy_force pp out (lazy x) = pp out x + +let lazy_or ?(default=return "") pp out x = + if Lazy.is_val x then pp out (Lazy.force x) else default out () + (** {2 IO} *) let output fmt pp x = pp fmt x diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index c750e9e32..1fa0cdfec 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -129,6 +129,15 @@ val some : 'a printer -> 'a option printer @since 1.0 *) +val lazy_force : 'a printer -> 'a lazy_t printer +(** [lazy_force pp out x] forces [x] and prints the result with [pp] + @since NEXT_RELEASE *) + +val lazy_or : ?default:unit printer -> 'a printer -> 'a lazy_t printer +(** [lazy_or ?default pp out x] prints [default] if [x] is not + evaluated yet, or uses [pp] otherwise + @since NEXT_RELEASE *) + (** {2 ANSI codes} Use ANSI escape codes https://en.wikipedia.org/wiki/ANSI_escape_code From 44f6c748aa5a00a99c4ee1f7128286ad94aebb5e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 11 Feb 2018 09:52:27 -0600 Subject: [PATCH 19/20] improve test speed and update some doc --- README.adoc | 5 ++--- src/data/CCRAL.ml | 4 ++-- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/README.adoc b/README.adoc index a1468a936..6df889c97 100644 --- a/README.adoc +++ b/README.adoc @@ -484,7 +484,7 @@ Beforehand, check `grep deprecated -r src` to see whether some functions can be removed. . `make test` -. update version in `_oasis` +. update version in `containers.opam` . `make update_next_tag` (to update `@since` comments; be careful not to change symlinks) . check status of modules (`{b status: foo}`) and update if required; removed deprecated functions, etc. @@ -492,8 +492,7 @@ can be removed. . commit the changes . `git checkout stable` . `git merge master` -. `oasis setup; make test doc` -. update `opam` (the version field; remove `oasis` in deps) +. `make test doc` . tag, and push both to github . `opam pin add containers https://github.com/c-cube/ocaml-containers.git#` . new opam package: `opam publish prepare; opam publish submit` diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index 2799f0811..f72cb7c34 100644 --- a/src/data/CCRAL.ml +++ b/src/data/CCRAL.ml @@ -258,7 +258,7 @@ let flat_map f l = ) (*$Q - Q.(pair (fun1 Observable.int (list int)) (list int)) (fun (f,l) -> \ + Q.(pair (fun1 Observable.int (small_list int)) (small_list int)) (fun (f,l) -> \ let f x = Q.Fn.apply f x in \ let f' x = f x |> of_list in \ of_list l |> flat_map f' |> to_list = CCList.(flat_map f l)) @@ -450,7 +450,7 @@ let repeat n l = (*$Q - Q.(pair small_int (list int)) (fun (n,l) -> \ + Q.(pair small_int (small_list int)) (fun (n,l) -> \ of_list l |> repeat n |> to_list = CCList.(repeat n l)) *) From 6b9f39d2240b22a82a2167dee7d27c169ba530a6 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 11 Feb 2018 09:57:06 -0600 Subject: [PATCH 20/20] prepare for 2.0 --- CHANGELOG.adoc | 13 ++++++++++++- src/core/CCFormat.mli | 4 ++-- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index aa9a6e2ef..7e766c849 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -10,7 +10,7 @@ by `include CCMonomorphic` in `Containers` module * Shadow the physical equality operator * Shadow polymorphic functions in `CCList` -- rename `print` to `pp` for Format printers (closes #153) +- rename `print` to `pp` for Format printers (closes #153, #181) - remove `CCFlatHashtbl` === others @@ -22,6 +22,17 @@ - Avoid uses of the polymorphic operators - Add a `CCMonomorphic` module shipped into a `containers.monomorphic` library - make complexity of `Array.lookup` explicit (closes #174) +- add `CCFormat.lazy_{or,force}` for printing thunks +- now that ocaml >= 4.02 is required, use `Format.pp_print_text` directly +- add `CCHeap.delete_{one,all}` +- add `CCList.tail_opt` + + +- remove qtest makefile and use a script instead +- add many tests +- fix bug in `CCRAL.drop` (see #184) +- `CCFormat`: fix support of unrecognized styles +- fix bug: don't reverse twice in `CCList.repeat` == 1.5.1, 1.5.2 diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 1fa0cdfec..8b2e5ffdd 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -131,12 +131,12 @@ val some : 'a printer -> 'a option printer val lazy_force : 'a printer -> 'a lazy_t printer (** [lazy_force pp out x] forces [x] and prints the result with [pp] - @since NEXT_RELEASE *) + @since 2.0 *) val lazy_or : ?default:unit printer -> 'a printer -> 'a lazy_t printer (** [lazy_or ?default pp out x] prints [default] if [x] is not evaluated yet, or uses [pp] otherwise - @since NEXT_RELEASE *) + @since 2.0 *) (** {2 ANSI codes}