From 404fede54a57ec088dad38899342663ae575af59 Mon Sep 17 00:00:00 2001 From: LemonBoy Date: Tue, 18 Apr 2017 10:45:28 +0200 Subject: [PATCH 01/12] 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 02/12] 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 03/12] 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 04/12] 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 05/12] 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 06/12] 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 07/12] 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 08/12] 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 09/12] 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 10/12] 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 11/12] 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 8460b01f2f78624a31f62af89427a0bbea0a8fc3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 19 Apr 2017 17:36:53 +0200 Subject: [PATCH 12/12] 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