mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-07 11:45:31 -05:00
Merge branch 'master' into stable
This commit is contained in:
Simon Cruanes
commit
ff2c9a0e11
26 changed files with 601 additions and 607 deletions
|
|
@ -25,3 +25,5 @@
|
|||
- Fabian Hemmer (copy)
|
||||
- Maciej Woś (@lostman)
|
||||
- Orbifx (Stavros Polymenis)
|
||||
- Rand (@rand00)
|
||||
- Dave Aitken (@actionshrimp)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
8
Makefile
8
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` ==========" ; \
|
||||
|
|
|
|||
|
|
@ -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#<release>`
|
||||
. new opam package: `opam publish prepare; opam publish submit`
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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 ${@}))
|
||||
|
|
|
|||
|
|
@ -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. *)
|
||||
|
|
|
|||
|
|
@ -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 j1<j2 then on_newline j1 else on_space j2
|
||||
end
|
||||
done
|
||||
let text = Format.pp_print_text
|
||||
|
||||
(*$= & ~printer:(fun s->CCFormat.sprintf "%S" s)
|
||||
"a\nb\nc" (sprintf_no_color "@[<v>%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 "<lazy>") 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
|
||||
|
|
|
|||
|
|
@ -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. *)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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. *)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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} *)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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]))
|
||||
*)
|
||||
|
|
|
|||
|
|
@ -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]))
|
||||
*)
|
||||
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue