diff --git a/AUTHORS.adoc b/AUTHORS.adoc index 5d6d131c6..56dba7428 100644 --- a/AUTHORS.adoc +++ b/AUTHORS.adoc @@ -25,3 +25,5 @@ - Fabian Hemmer (copy) - Maciej Woś (@lostman) - Orbifx (Stavros Polymenis) +- Rand (@rand00) +- Dave Aitken (@actionshrimp) 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/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` ==========" ; \ 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/containers.opam b/containers.opam index ace182e29..21bfedc7d 100644 --- a/containers.opam +++ b/containers.opam @@ -1,13 +1,13 @@ opam-version: "1.2" name: "containers" -version: "2.0+alpha2" +version: "2.0" author: "Simon Cruanes" maintainer: "simon.cruanes.2007@m4x.org" 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" @@ -18,6 +18,8 @@ depopts: [ "qtest" { test } "qcheck" { test } "oUnit" { test } + "sequence" { test } + "gen" { test } "odoc" { doc } ] conflicts: [ @@ -37,5 +39,5 @@ These changes belong to 3 categories: - make most optional arguments relying on polymorphic operators mandatory - improve consistency of printers -changelog: https://github.com/c-cube/ocaml-containers/blob/2.0+alpha1/CHANGELOG.adoc" +changelog: https://github.com/c-cube/ocaml-containers/blob/2.0/CHANGELOG.adoc" ] 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 ${@})) 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 965ff9edf..d01f3ad9e 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") @@ -161,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 @@ -266,6 +243,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] @@ -286,7 +265,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 @@ -296,20 +275,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 = @@ -411,6 +391,10 @@ 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 diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 6430bc939..8b2e5ffdd 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 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 2.0 *) + (** {2 ANSI codes} Use ANSI escape codes https://en.wikipedia.org/wiki/ANSI_escape_code @@ -271,11 +280,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 3da6407f0..82291ba32 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)) @@ -1253,11 +1256,21 @@ 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] +*) + +(*$Q + 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 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 diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 58041c2fe..b80bf76ad 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -340,12 +340,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 ~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..11291efed 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,23 @@ 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)) +*) + +(*$Q + Q.printable_string (fun s -> \ + rev s = (to_list s |> List.rev |> of_list)) + *) + + +(*$= + "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 +281,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 +313,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 +382,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 +450,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 +491,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 +507,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 +552,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 +604,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 +655,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 +702,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 +725,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 +745,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 +790,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,6 +850,11 @@ 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)) @@ -649,6 +865,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 +907,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 +944,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 +956,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 +1002,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 +1060,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 +1113,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..60de94938 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 *) @@ -133,30 +108,12 @@ 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. @@ -169,41 +126,15 @@ val find_all_l : ?start:int -> sub:string -> string -> int 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/core/META b/src/core/META deleted file mode 100644 index d5c489691..000000000 --- a/src/core/META +++ /dev/null @@ -1,77 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 6fc8b50f808e0788951f153fb45868c5) -version = "1.5.2" -description = "A modular standard library focused on data structures." -requires = "bytes result" -archive(byte) = "containers.cma" -archive(byte, plugin) = "containers.cma" -archive(native) = "containers.cmxa" -archive(native, plugin) = "containers.cmxs" -exists_if = "containers.cma" -package "unix" ( - version = "1.5.2" - description = "A modular standard library focused on data structures." - requires = "bytes result unix" - archive(byte) = "containers_unix.cma" - archive(byte, plugin) = "containers_unix.cma" - archive(native) = "containers_unix.cmxa" - archive(native, plugin) = "containers_unix.cmxs" - exists_if = "containers_unix.cma" -) - -package "top" ( - version = "1.5.2" - description = "A modular standard library focused on data structures." - requires = - "compiler-libs.common containers containers.data containers.unix containers.sexp containers.iter" - archive(byte) = "containers_top.cma" - archive(byte, plugin) = "containers_top.cma" - archive(native) = "containers_top.cmxa" - archive(native, plugin) = "containers_top.cmxs" - exists_if = "containers_top.cma" -) - -package "thread" ( - version = "1.5.2" - description = "A modular standard library focused on data structures." - requires = "containers threads" - archive(byte) = "containers_thread.cma" - archive(byte, plugin) = "containers_thread.cma" - archive(native) = "containers_thread.cmxa" - archive(native, plugin) = "containers_thread.cmxs" - exists_if = "containers_thread.cma" -) - -package "sexp" ( - version = "1.5.2" - description = "A modular standard library focused on data structures." - requires = "bytes result" - archive(byte) = "containers_sexp.cma" - archive(byte, plugin) = "containers_sexp.cma" - archive(native) = "containers_sexp.cmxa" - archive(native, plugin) = "containers_sexp.cmxs" - exists_if = "containers_sexp.cma" -) - -package "iter" ( - version = "1.5.2" - description = "A modular standard library focused on data structures." - archive(byte) = "containers_iter.cma" - archive(byte, plugin) = "containers_iter.cma" - archive(native) = "containers_iter.cmxa" - archive(native, plugin) = "containers_iter.cmxs" - exists_if = "containers_iter.cma" -) - -package "data" ( - version = "1.5.2" - description = "A modular standard library focused on data structures." - requires = "bytes" - archive(byte) = "containers_data.cma" - archive(byte, plugin) = "containers_data.cma" - archive(native) = "containers_data.cmxa" - archive(native, plugin) = "containers_data.cmxs" - exists_if = "containers_data.cma" -) -# OASIS_STOP - diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index f025bf53a..f72cb7c34 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 (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)) +*) + 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,24 +340,49 @@ 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) *) +(* 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' = 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 +*) + +(*$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 @@ -406,6 +448,12 @@ let repeat n l = in aux n l empty + +(*$Q + Q.(pair small_int (small_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 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 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 =