diff --git a/.merlin b/.merlin index 0110f580..998a48f5 100644 --- a/.merlin +++ b/.merlin @@ -18,4 +18,4 @@ PKG threads PKG threads.posix PKG lwt PKG qcheck -FLG -w +a-4-44-48-60 +FLG -w +a-4-44-48-60@8 diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 00000000..8a93f975 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,37 @@ +language: c +env: + - OCAML_VERSION=4.01.0 + - OCAML_VERSION=4.02.3 + - OCAML_VERSION=4.04.2 + - OCAML_VERSION=4.05.0 + - OCAML_VERSION=4.05.0+flambda + - OCAML_VERSION=4.06.0 +addons: + apt: + sources: + - avsm + packages: + - opam +# Caching may take a lot of space with so many ocaml versions +#cache: +# directories: +# - $HOME/.opam +before_install: + # Some opam boilerplate + - export OPAMYES=1 + - export OPAMVERBOSE=1 + - opam init + - opam switch ${OCAML_VERSION} + - eval `opam config env` +install: + # Install dependencies + - opam pin add --no-action containers . + - opam install oasis + - opam install --deps-only containers +script: + - ./configure --enable-unix --enable-thread --disable-tests --disable-bench + - make build + - opam install sequence qcheck qtest gen + - ./configure --enable-unix --enable-thread --enable-tests --enable-docs --disable-bench + - make test + - make doc diff --git a/AUTHORS.adoc b/AUTHORS.adoc index b31a8f64..79736e19 100644 --- a/AUTHORS.adoc +++ b/AUTHORS.adoc @@ -23,3 +23,4 @@ - Leonid Rozenberg (@rleonid) - Bikal Gurung (@bikalgurung) - Fabian Hemmer (copy) +- Maciej Woś (@lostman) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index badb978e..ee38ca6d 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -1,5 +1,27 @@ = Changelog +== 1.5 + +- have `CCList.{get,insert,set}_at_idx` work with negative indices +- Add CCCache.add +- missing function in `CCListLabels` +- Allow negative indexes in CCList.remove_at_idx +- add an optional `drop` parameter to string-splitting functions +- add `Hash.const0` for trivial hash function that ignores its input +- improve compatibility with the stdlib +- Add List.count +- Add String.is_empty +- add missing compatibility functions: `{assoc_opt,assq_opt}` +- backport some functions added in 4.05 in `CCList` +- add functions from 4.05 into `CC{Map,Set}` +- Implement `CCImmutArray.sub` +- bugfix in `CCTrie.Make`: Remove polymorphic comparison + +- remove dependency on cppo +- add travis support +- update doc of `CCList.cartesian_product`, which returns results in unspecified order (close #154) +- fix containers.top (closes #155) + == 1.4 - add `CCMap.union` diff --git a/README.adoc b/README.adoc index 35751dd0..8bddf08e 100644 --- a/README.adoc +++ b/README.adoc @@ -14,7 +14,7 @@ map/fold_right/append, and additional functions on lists). Alternatively, `open Containers` will bring enhanced versions of the standard modules into scope. -image::https://ci.cedeela.fr/buildStatus/icon?job=containers[alt="Build Status", link="http://ci.cedeela.fr/job/containers/"] +image::https://travis-ci.org/c-cube/ocaml-containers.svg?branch=master[alt="Build Status", link="https://travis-ci.org/c-cube/ocaml-containers"] toc::[] diff --git a/_oasis b/_oasis index 2871eb57..87c1568f 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: containers -Version: 1.4 +Version: 1.5 Homepage: https://github.com/c-cube/ocaml-containers Authors: Simon Cruanes License: BSD-2-clause diff --git a/_tags b/_tags index f07a2496..393fa12e 100644 --- a/_tags +++ b/_tags @@ -117,6 +117,7 @@ true: annot, bin_annot : thread or : inline(25) or or : inline(15) - and not : warn_A, warn(-4), warn(-44) -true: no_alias_deps, safe_string, short_paths + or or : warn(-32) + and not : warn(+a-4-44-58-60@8) +true: no_alias_deps, safe_string, short_paths, color(always) : nolabels diff --git a/doc/intro.txt b/doc/intro.txt index 43c894e2..8800a6ab 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -16,8 +16,7 @@ CC-SA3 {{:http://en.wikipedia.org/wiki/File:Hypercube.svg} wikimedia} The design is mostly centered around polymorphism rather than functors. Such structures comprise (some modules in misc/, some other in core/): -the core library, containers, now depends on -{{:https://github.com/mjambon/cppo}cppo} and base-bytes (provided +the core library, containers, now depends on base-bytes (provided by ocamlfind). {4 Core Modules (extension of the standard library)} diff --git a/myocamlbuild.ml b/myocamlbuild.ml index f4ecaaf0..8e708b99 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -925,40 +925,6 @@ dispatch (MyOCamlbuildBase.dispatch_combine [ begin function | After_rules -> - (* replace with Ocamlbuild_cppo.dispatch when 4.00 is not supported - anymore *) - let dep_cppo = "%(name).cppo.ml" in - let prod1 = "%(name: <*> and not <*.cppo>).ml" in - let prod2 = "%(name: <**/*> and not <**/*.cppo>).ml" in - let f prod env _build = - let dep = env dep_cppo in - let prod = env prod in - let tags = tags_of_pathname prod ++ "cppo" in - Cmd (S[A "cppo"; T tags; S [A "-o"; P prod]; P dep ]) - in - rule "cppo1" ~dep:dep_cppo ~prod:prod1 (f prod1) ; - rule "cppo2" ~dep:dep_cppo ~prod:prod2 (f prod2) ; - pflag ["cppo"] "cppo_D" (fun s -> S [A "-D"; A s]) ; - pflag ["cppo"] "cppo_U" (fun s -> S [A "-U"; A s]) ; - pflag ["cppo"] "cppo_I" (fun s -> - if Pathname.is_directory s then S [A "-I"; P s] - else S [A "-I"; P (Pathname.dirname s)] - ) ; - pdep ["cppo"] "cppo_I" (fun s -> - if Pathname.is_directory s then [] else [s]) ; - flag ["cppo"; "cppo_q"] (A "-q") ; - flag ["cppo"; "cppo_s"] (A "-s") ; - flag ["cppo"; "cppo_n"] (A "-n") ; - pflag ["cppo"] "cppo_x" (fun s -> S [A "-x"; A s]); - (* end replace *) - - let major, minor = Scanf.sscanf Sys.ocaml_version "%d.%d.%d" - (fun major minor patchlevel -> major, minor) - in - let ocaml_major = "OCAML_MAJOR " ^ string_of_int major in - let ocaml_minor = "OCAML_MINOR " ^ string_of_int minor in - - flag ["cppo"] & S[A"-D"; A ocaml_major; A"-D"; A ocaml_minor] ; (* Documentation index *) dep ["ocaml"; "doc"; "extension:html"] & [doc_intro] ; diff --git a/opam b/opam index a6c1b05c..8dcd80a1 100644 --- a/opam +++ b/opam @@ -25,7 +25,6 @@ depends: [ "ocamlfind" {build} "base-bytes" "result" - "cppo" {build} "ocamlbuild" {build} ] depopts: [ diff --git a/src/core/CCArrayLabels.ml b/src/core/CCArrayLabels.ml index f6573cb8..fdf51544 100644 --- a/src/core/CCArrayLabels.ml +++ b/src/core/CCArrayLabels.ml @@ -1,619 +1,4 @@ (* This file is free software, part of containers. See file "license" for more details. *) -(** {1 Array utils} *) - -type 'a sequence = ('a -> unit) -> unit -type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] -type 'a gen = unit -> 'a option -type 'a equal = 'a -> 'a -> bool -type 'a ord = 'a -> 'a -> int -type 'a random_gen = Random.State.t -> 'a -type 'a printer = Format.formatter -> 'a -> unit - -(*$T - let st = Random.State.make [||] in let a = 0--10000 in \ - let b = Array.copy a in shuffle_with st a; a <> b -*) - -(** {2 Arrays} *) - -include ArrayLabels - -type 'a t = 'a array - -let empty = [| |] - -let map = Array.map - -let map2 f a b = - if Array.length a <> Array.length b then invalid_arg "map2"; - Array.init (Array.length a) (fun i -> f (Array.unsafe_get a i) (Array.unsafe_get b i)) - -let length = Array.length - -let get = Array.get - -let get_safe a i = - if i>=0 && i acc - | `Continue -> fold_while_i f acc (i+1) - else acc - in fold_while_i f acc 0 - -(*$T - fold_while (fun acc b -> if b then acc+1, `Continue else acc, `Stop) 0 (Array.of_list [true;true;false;true]) = 2 -*) - -let iter = Array.iter - -let iteri = Array.iteri - -let blit = Array.blit - -let reverse_in_place a = - let len = Array.length a in - if len>0 then ( - for k = 0 to (len-1)/2 do - let t = a.(k) in - a.(k) <- a.(len-1-k); - a.(len-1-k) <- t; - done - ) - -(*$T - reverse_in_place [| |]; true - reverse_in_place [| 1 |]; true - let a = [| 1; 2; 3; 4; 5 |] in \ - reverse_in_place a; \ - a = [| 5;4;3;2;1 |] - let a = [| 1; 2; 3; 4; 5; 6 |] in \ - reverse_in_place a; \ - a = [| 6;5;4;3;2;1 |] -*) - -let sorted cmp a = - let b = Array.copy a in - Array.sort cmp b; - b - -(*$= & ~cmp:(=) ~printer:Q.Print.(array int) - [||] (sorted Pervasives.compare [||]) - [|0;1;2;3;4|] (sorted Pervasives.compare [|3;2;1;4;0|]) -*) - -(*$Q - Q.(array int) (fun a -> \ - let b = Array.copy a in \ - Array.sort Pervasives.compare b; b = sorted Pervasives.compare a) -*) - -let sort_indices cmp a = - let len = Array.length a in - let b = Array.init len (fun k->k) in - Array.sort (fun k1 k2 -> cmp a.(k1) a.(k2)) b; - b - -(*$= & ~cmp:(=) ~printer:Q.Print.(array int) - [||] (sort_indices Pervasives.compare [||]) - [|4;2;1;0;3|] (sort_indices Pervasives.compare [|"d";"c";"b";"e";"a"|]) -*) - -(*$Q - Q.(array printable_string) (fun a -> \ - let b = sort_indices String.compare a in \ - sorted String.compare a = Array.map (Array.get a) b) -*) - -let sort_ranking cmp a = - let cmp_int : int -> int -> int = Pervasives.compare in - sort_indices cmp_int (sort_indices cmp a) - -(*$= & ~cmp:(=) ~printer:Q.Print.(array int) - [||] (sort_ranking Pervasives.compare [||]) - [|3;2;1;4;0|] (sort_ranking Pervasives.compare [|"d";"c";"b";"e";"a"|]) -*) - -(*$Q - Q.(array printable_string) (fun a -> \ - let b = sort_ranking String.compare a in \ - let a_sorted = sorted String.compare a in \ - a = Array.map (Array.get a_sorted) b) -*) - -let rev a = - let b = Array.copy a in - reverse_in_place b; - b - -(*$Q - Q.(array small_int) (fun a -> rev (rev a) = a) -*) - -(*$T - rev [| 1; 2; 3 |] = [| 3; 2; 1 |] - rev [| 1; 2; |] = [| 2; 1 |] - rev [| |] = [| |] -*) - -let rec find_aux f a i = - if i = Array.length a then None - else match f i a.(i) with - | Some _ as res -> res - | None -> find_aux f a (i+1) - -let find f a = - find_aux (fun _ -> f ) a 0 - -let findi f a = - find_aux f a 0 - -let find_idx p a = - find_aux (fun i x -> if p x then Some (i,x) else None) a 0 - -let filter_map f a = - let rec aux acc i = - if i = Array.length a - then ( - let a' = Array.of_list acc in - reverse_in_place a'; - a' - ) else match f a.(i) with - | None -> aux acc (i+1) - | Some x -> aux (x::acc) (i+1) - in aux [] 0 - -(*$T - filter_map (fun x -> if x mod 2 = 0 then Some (string_of_int x) else None) \ - [| 1; 2; 3; 4 |] = [| "2"; "4" |] - filter_map (fun x -> if x mod 2 = 0 then Some (string_of_int x) else None) \ - [| 1; 2; 3; 4; 5; 6 |] \ - = [| "2"; "4"; "6" |] -*) - -let filter p a = - filter_map (fun x -> if p x then Some x else None) a - -(* append [rev a] in front of [acc] *) -let rec __rev_append_list a acc i = - if i = Array.length a - then acc - else - __rev_append_list a (a.(i) :: acc) (i+1) - -let flat_map f a = - let rec aux acc i = - if i = Array.length a - then ( - let a' = Array.of_list acc in - reverse_in_place a'; - a' - ) - else - let a' = f a.(i) in - aux (__rev_append_list a' acc 0) (i+1) - in aux [] 0 - -(*$T - let a = [| 1; 3; 5 |] in \ - let a' = flat_map (fun x -> [| x; x+1 |]) a in \ - a' = [| 1; 2; 3; 4; 5; 6 |] -*) - -let rec _lookup_rec ~cmp k a i j = - if i>j then raise Not_found - else if i=j - then if cmp k a.(i) = 0 - then i - else raise Not_found - else - let middle = (j+i)/2 in - match cmp k a.(middle) with - | 0 -> middle - | n when n<0 -> _lookup_rec ~cmp k a i (middle-1) - | _ -> _lookup_rec ~cmp k a (middle+1) j - -let _lookup_exn ~cmp k a i j = - if i>j then raise Not_found; - match cmp k a.(i) with - | 0 -> i - | n when n<0 -> raise Not_found (* too low *) - | _ when i=j -> raise Not_found (* too high *) - | _ -> - match cmp k a.(j) with - | 0 -> j - | n when n<0 -> _lookup_rec ~cmp k a (i+1) (j-1) - | _ -> raise Not_found (* too high *) - -let lookup_exn ?(cmp=Pervasives.compare) k a = - _lookup_exn ~cmp k a 0 (Array.length a-1) - -let lookup ?(cmp=Pervasives.compare) k a = - try Some (_lookup_exn ~cmp k a 0 (Array.length a-1)) - with Not_found -> None - -(*$T - lookup 2 [|0;1;2;3;4;5|] = Some 2 - lookup 4 [|0;1;2;3;4;5|] = Some 4 - lookup 0 [|1;2;3;4;5|] = None - lookup 6 [|1;2;3;4;5|] = None - lookup 3 [| |] = None - lookup 1 [| 1 |] = Some 0 - lookup 2 [| 1 |] = None -*) - -let bsearch ?(cmp=Pervasives.compare) k a = - let rec aux i j = - if i > j - then `Just_after j - else - let middle = i + (j - i) / 2 in (* avoid overflow *) - match cmp k a.(middle) with - | 0 -> `At middle - | n when n<0 -> aux i (middle - 1) - | _ -> aux (middle + 1) j - in - let n = Array.length a in - if n=0 then `Empty - else match cmp a.(0) k, cmp a.(n-1) k with - | c, _ when c>0 -> `All_bigger - | _, c when c<0 -> `All_lower - | _ -> aux 0 (n-1) - -(*$T bsearch - bsearch 3 [|1; 2; 2; 3; 4; 10|] = `At 3 - bsearch 5 [|1; 2; 2; 3; 4; 10|] = `Just_after 4 - bsearch 1 [|1; 2; 5; 5; 11; 12|] = `At 0 - bsearch 12 [|1; 2; 5; 5; 11; 12|] = `At 5 - bsearch 10 [|1; 2; 2; 3; 4; 9|] = `All_lower - bsearch 0 [|1; 2; 2; 3; 4; 9|] = `All_bigger - bsearch 3 [| |] = `Empty -*) - -let (>>=) a f = flat_map f a - -let (>>|) a f = map f a - -let (>|=) a f = map f a - -let for_all p a = - let rec aux i = - i = Array.length a || (p a.(i) && aux (i+1)) - in - aux 0 - -let exists p a = - let rec aux i = - i <> Array.length a && (p a.(i) || aux (i+1)) - in - aux 0 - -let rec _for_all2 p a1 a2 i1 i2 ~len = - len=0 || (p a1.(i1) a2.(i2) && _for_all2 p a1 a2 (i1+1) (i2+1) ~len:(len-1)) - -let for_all2 p a b = - Array.length a = Array.length b - && - _for_all2 p a b 0 0 ~len:(Array.length a) - -let rec _exists2 p a1 a2 i1 i2 ~len = - len>0 && (p a1.(i1) a2.(i2) || _exists2 p a1 a2 (i1+1) (i2+1) ~len:(len-1)) - -let exists2 p a b = - _exists2 p a b 0 0 ~len:(min (Array.length a) (Array.length b)) - -let _iter2 f a b i j ~len = - for o = 0 to len-1 do - f (Array.get a (i+o)) (Array.get b (j+o)) - done - -let _fold2 f acc a b i j ~len = - let rec aux acc o = - if o=len then acc - else - let acc = f acc (Array.get a (i+o)) (Array.get b (j+o)) in - aux acc (o+1) - in - aux acc 0 - -let iter2 f a b = - if length a <> length b then invalid_arg "iter2"; - _iter2 f a b 0 0 ~len:(Array.length a) - -let fold2 f acc a b = - if length a <> length b then invalid_arg "fold2"; - _fold2 f acc a b 0 0 ~len:(Array.length a) - -let (--) i j = - if i<=j - then - Array.init (j-i+1) (fun k -> i+k) - else - Array.init (i-j+1) (fun k -> i-k) - -(*$T - (1 -- 4) |> Array.to_list = [1;2;3;4] - (4 -- 1) |> Array.to_list = [4;3;2;1] - (0 -- 0) |> Array.to_list = [0] -*) - -(*$Q - Q.(pair small_int small_int) (fun (a,b) -> \ - (a -- b) |> Array.to_list = CCList.(a -- b)) -*) - -let (--^) i j = - if i=j then [| |] - else if i>j - then Array.init (i-j) (fun k -> i-k) - else Array.init (j-i) (fun k -> i+k) - -(*$Q - Q.(pair small_int small_int) (fun (a,b) -> \ - (a --^ b) |> Array.to_list = CCList.(a --^ b)) -*) - -(** all the elements of a, but the i-th, into a list *) -let except_idx a i = - foldi - (fun acc j elt -> if i = j then acc else elt::acc) - [] a - -let equal eq a b = - let rec aux i = - if i = Array.length a then true - else eq a.(i) b.(i) && aux (i+1) - in - Array.length a = Array.length b - && - aux 0 - -(*$Q - Q.(pair (array small_int)(array small_int)) (fun (a,b) -> \ - equal (=) a b = equal (=) b a) -*) - -(*$T - equal (=) [|1|] [|1|] -*) - -let compare cmp a b = - let rec aux i = - if i = Array.length a - then if i = Array.length b then 0 else -1 - else if i = Array.length b - then 1 - else - let c = cmp a.(i) b.(i) in - if c = 0 then aux (i+1) else c - in - aux 0 - -(*$T - compare CCOrd.compare [| 1; 2; 3 |] [| 1; 2; 3 |] = 0 - compare CCOrd.compare [| 1; 2; 3 |] [| 2; 2; 3 |] < 0 - compare CCOrd.compare [| 1; 2; |] [| 1; 2; 3 |] < 0 - compare CCOrd.compare [| 1; 2; 3 |] [| 1; 2; |] > 0 -*) - -(* shuffle a[i...j[ using the given int random generator - See http://en.wikipedia.org/wiki/Fisher-Yates_shuffle *) -let _shuffle _rand_int a i j = - for k = j-1 downto i+1 do - let l = _rand_int (k+1) in - let tmp = a.(l) in - a.(l) <- a.(k); - a.(k) <- tmp; - done - -let shuffle a = - _shuffle Random.int a 0 (Array.length a) - -let shuffle_with st a = - _shuffle (Random.State.int st) a 0 (Array.length a) - -let rec _to_klist a i j () = - if i=j then `Nil else `Cons (a.(i), _to_klist a (i+1) j) - -let random_choose a st = - let n = Array.length a in - if n = 0 then raise Not_found; - a.(Random.State.int st n) - -let random_len n g st = - Array.init n (fun _ -> g st) - -let random g st = - let n = Random.State.int st 1_000 in - random_len n g st - -let random_non_empty g st = - let n = 1 + Random.State.int st 1_000 in - random_len n g st - -let pp ?(sep=", ") pp_item out a = - for k = 0 to Array.length a-1 do - if k > 0 then (Format.pp_print_string out sep; Format.pp_print_cut out ()); - pp_item out a.(k) - done - -let pp_i ?(sep=", ") pp_item out a = - for k = 0 to Array.length a - 1 do - if k > 0 then (Format.pp_print_string out sep; Format.pp_print_cut out ()); - pp_item k out a.(k) - done - -let to_seq a k = iter k a - -let to_gen a = - let k = ref 0 in - fun () -> - if !k < Array.length a - then ( - let x = a.(!k) in - incr k; - Some x - ) else None - -let to_klist a = _to_klist a 0 (Array.length a) - -(** {2 Generic Functions} *) - -module type MONO_ARRAY = sig - type elt - type t - - val length : t -> int - - val get : t -> int -> elt - - val set : t -> int -> elt -> unit -end - -(* Dual Pivot Quicksort (Yaroslavskiy) - from "average case analysis of Java 7's Dual Pivot Quicksort" *) -module SortGeneric(A : MONO_ARRAY) = struct - module Rand = Random.State - - let seed_ = [|123456|] - - type state = { - mutable l: int; (* left pointer *) - mutable g: int; (* right pointer *) - mutable k: int; - } - - let rand_idx_ rand i j = i + Rand.int rand (j-i) - - let swap_ a i j = - if i=j then () - else ( - let tmp = A.get a i in - A.set a i (A.get a j); - A.set a j tmp - ) - - let sort ~cmp a = - let rec insert_ a i k = - if k 0 then ( - swap_ a k (k+1); - insert_ a i (k-1) - ) - in - (* recursive part of insertion sort *) - let rec sort_insertion_rec a i j k = - if k 1 then sort_insertion_rec a i j (i+1) - in - let rand = Rand.make seed_ in - (* sort slice. - There is a chance that the two pivots are equal, but it's unlikely. *) - let rec sort_slice_ ~st a i j = - if j-i>10 then ( - st.l <- i; - st.g <- j-1; - st.k <- i; - (* choose pivots *) - let p = A.get a (rand_idx_ rand i j) in - let q = A.get a (rand_idx_ rand i j) in - (* invariant: st.p <= st.q, swap them otherwise *) - let p, q = if cmp p q > 0 then q, p else p, q in - while st.k <= st.g do - let cur = A.get a st.k in - if cmp cur p < 0 then ( - (* insert in leftmost band *) - if st.k <> st.l then swap_ a st.k st.l; - st.l <- st.l + 1 - ) else if cmp cur q > 0 then ( - (* insert in rightmost band *) - while st.k < st.g && cmp (A.get a st.g) q > 0 do - st.g <- st.g - 1 - done; - swap_ a st.k st.g; - st.g <- st.g - 1; - (* the element swapped from the right might be in the first situation. - that is, < p (we know it's <= q already) *) - if cmp (A.get a st.k) p < 0 then ( - if st.k <> st.l then swap_ a st.k st.l; - st.l <- st.l + 1 - ) - ); - st.k <- st.k + 1 - done; - (* save values before recursing *) - let l = st.l and g = st.g and sort_middle = cmp p q < 0 in - sort_slice_ ~st a i l; - if sort_middle then sort_slice_ ~st a l (g+1); - sort_slice_ ~st a (g+1) j; - ) else sort_insertion a i j - in - if A.length a > 0 then ( - let st = { l=0; g=A.length a; k=0; } in - sort_slice_ ~st a 0 (A.length a) - ) -end - - -let sort_generic (type arr)(type elt) - (module A : MONO_ARRAY with type t = arr and type elt = elt) - ?(cmp=Pervasives.compare) a - = - let module S = SortGeneric(A) in - S.sort ~cmp a - -(*$inject - module IA = struct - type elt = int - type t = int array - include Array - end - - let gen_arr = Q.Gen.(array_size (1--100) small_int) - let arr_arbitrary = Q.make - ~print:Q.Print.(array int) - ~small:Array.length - ~shrink:Q.Shrink.(array ?shrink:None) - gen_arr -*) - -(*$Q & ~count:300 - arr_arbitrary (fun a -> \ - let a1 = Array.copy a and a2 = Array.copy a in \ - Array.sort CCInt.compare a1; sort_generic ~cmp:CCInt.compare (module IA) a2; \ - a1 = a2 ) -*) +include CCArray diff --git a/src/core/CCBool.mli b/src/core/CCBool.mli index ad512f11..d8a98e1a 100644 --- a/src/core/CCBool.mli +++ b/src/core/CCBool.mli @@ -12,7 +12,7 @@ val equal : t -> t -> bool val negate : t -> t (** Negation on booleans (functional version of [not]) - @deprecate since 1.3, simply use {!not} instead *) + @deprecated since 1.3, simply use {!not} instead *) type 'a printer = Format.formatter -> 'a -> unit diff --git a/src/core/CCFun.cppo.ml b/src/core/CCFun.ml similarity index 75% rename from src/core/CCFun.cppo.ml rename to src/core/CCFun.ml index de8fcca2..60bd7c73 100644 --- a/src/core/CCFun.cppo.ml +++ b/src/core/CCFun.ml @@ -3,27 +3,17 @@ (** {1 Basic Functions} *) -#if OCAML_MAJOR >= 4 && OCAML_MINOR >= 2 +(* default implem for some operators *) -external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply" -external (@@) : ('a -> 'b) -> 'a -> 'b = "%apply" - - #else - - let (|>) x f = f x +let (|>) x f = f x let (@@) f x = f x - #endif +let opaque_identity x = x - #if OCAML_MAJOR >= 4 && OCAML_MINOR >= 3 +(* import standard implementations, if any *) -let opaque_identity = Sys.opaque_identity - - #else - - let opaque_identity x = x - - #endif +include Sys +include Pervasives let compose f g x = g (f x) diff --git a/src/core/CCHash.ml b/src/core/CCHash.ml index c4741cf4..8b0b9ac7 100644 --- a/src/core/CCHash.ml +++ b/src/core/CCHash.ml @@ -24,6 +24,7 @@ let combine4 a b c d = (** {2 Combinators} *) let const h _ = h +let const0 _ = 0 let int i = i land max_int let bool b = if b then 1 else 2 diff --git a/src/core/CCHash.mli b/src/core/CCHash.mli index 28c5fc54..ca7b4956 100644 --- a/src/core/CCHash.mli +++ b/src/core/CCHash.mli @@ -14,6 +14,12 @@ type 'a t = 'a -> hash val const : hash -> _ t (** [return h] hashes any value into [h]. Use with caution!. *) +val const0 : _ t +(** Always return 0. Useful for ignoring elements. + Example: [Hash.(pair string const0)] will map pairs [("a", 1)] + and [("a", 2)] to the same hash, but not the same as [("b", 1)] + @since 1.5 *) + val int : int t val bool : bool t val char : char t diff --git a/src/core/CCHeap.ml b/src/core/CCHeap.ml index 1b939a86..db0409db 100644 --- a/src/core/CCHeap.ml +++ b/src/core/CCHeap.ml @@ -148,8 +148,9 @@ module type S = sig val of_list : elt list -> t (** [of_list l = add_list empty l] *) - val add_seq : t -> elt sequence -> t (** @since 0.16 *) - (** Similar to {!add_list} *) + val add_seq : t -> elt sequence -> t + (** Similar to {!add_list} + @since 0.16 *) val of_seq : elt sequence -> t diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 89dd6a80..601fb06d 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -9,6 +9,63 @@ type 'a t = 'a list +(* backport new functions from stdlib here *) + +let nth_opt l n = + if n<0 then invalid_arg "nth_opt"; + let rec aux l n = match l, n with + | [], _ -> None + | x::_, 0 -> Some x + | _::l, _ -> aux l (n-1) + in + aux l n + +(*$Q + Q.(pair small_nat (list int)) (fun (i,l) -> \ + nth_opt l i = get_at_idx i l) +*) + +let rec find_opt p l = match l with + | [] -> None + | x :: _ when p x -> Some x + | _ :: tl -> find_opt p tl + +let rec compare_lengths l1 l2 = match l1, l2 with + | [], [] -> 0 + | [], _::_ -> -1 + | _::_, [] -> 1 + | _::tail1, _::tail2 -> compare_lengths tail1 tail2 + +(*$Q + Q.(pair (list int) (list int)) (fun (l1,l2) -> \ + CCOrd.equiv (CCList.compare_lengths l1 l2) \ + (CCInt.compare (length l1)(length l2))) +*) + +let rec compare_length_with l n = match l, n with + | _ when n<0 -> 1 + | [], 0 -> 0 + | [], _ -> -1 + | _::tail, _ -> compare_length_with tail (n-1) + +(*$Q + Q.(pair (list int) small_int) (fun (l,n) -> \ + CCOrd.equiv (CCList.compare_length_with l n) \ + (CCInt.compare (length l) n)) +*) + +let rec assoc_opt x = function + | [] -> None + | (y,v) :: _ when Pervasives.(=) x y -> Some v + | _ :: tail -> assoc_opt x tail + +let rec assq_opt x = function + | [] -> None + | (y,v) :: _ when Pervasives.(==) x y -> Some v + | _ :: tail -> assq_opt x tail + +(* end of backport *) + include List let empty = [] @@ -315,6 +372,16 @@ let flatten l = fold_right append l [] flatten (init 300_001 (fun x->[x])) = 0--300_000 *) +let count f l = + fold_left (fun n x -> if f x then succ n else n) 0 l + +(*$T + count (fun x -> x mod 2 = 0) [] = 0 + count (fun x -> x mod 2 = 0) [0; 0; 2; 4] = 4 + count (fun x -> x mod 2 = 0) [1; 3; 5; 7] = 0 + count (fun x -> x mod 2 = 0) [2; 6; 9; 4] = 3 +*) + let product f l1 l2 = flat_map (fun x -> map (fun y -> f x y) l2) l1 @@ -802,10 +869,7 @@ let rec last_opt = function None (last_opt []) *) -let rec find_pred p l = match l with - | [] -> None - | x :: _ when p x -> Some x - | _ :: tl -> find_pred p tl +let find_pred = find_opt let find_pred_exn p l = match find_pred p l with | None -> raise Not_found @@ -890,7 +954,7 @@ let all_ok l = try Result.Ok (map - (function Result.Ok x -> x | Error e -> err := Some e; raise Exit) + (function Result.Ok x -> x | Result.Error e -> err := Some e; raise Exit) l) with Exit -> begin match !err with @@ -1004,10 +1068,14 @@ let foldi f acc l = in foldi f acc 0 l -let rec get_at_idx_exn i l = match l with +let rec get_at_idx_rec i l = match l with | [] -> raise Not_found | x::_ when i=0 -> x - | _::l' -> get_at_idx_exn (i-1) l' + | _::l' -> get_at_idx_rec (i-1) l' + +let get_at_idx_exn i l = + let i = if i<0 then length l + i else i in + get_at_idx_rec i l let get_at_idx i l = try Some (get_at_idx_exn i l) @@ -1017,7 +1085,9 @@ let get_at_idx i l = get_at_idx 0 (range 0 10) = Some 0 get_at_idx 5 (range 0 10) = Some 5 get_at_idx 11 (range 0 10) = None + get_at_idx (-1) (range 0 10) = Some 10 get_at_idx 0 [] = None + get_at_idx (-1) [] = None *) let set_at_idx i x l0 = @@ -1027,12 +1097,14 @@ let set_at_idx i x l0 = | y::l' -> aux l' (y::acc) (i-1) in + let i = if i<0 then length l0 + i else i in aux l0 [] i (*$T set_at_idx 0 10 [1;2;3] = [10;2;3] set_at_idx 4 10 [1;2;3] = [1;2;3] set_at_idx 1 10 [1;2;3] = [1;10;3] + set_at_idx (-2) 10 [1;2;3] = [1;10;3] *) let insert_at_idx i x l = @@ -1042,12 +1114,14 @@ let insert_at_idx i x l = | y::l' -> aux l' (y::acc) (i-1) x in + let i = if i<0 then length l + i else i in aux l [] i x (*$T insert_at_idx 0 10 [1;2;3] = [10;1;2;3] insert_at_idx 4 10 [1;2;3] = [1;2;3;10] insert_at_idx 1 10 [1;2;3] = [1;10;2;3] + insert_at_idx (-2) 10 [1;2;3] = [1;10;2;3] *) let remove_at_idx i l0 = @@ -1057,12 +1131,17 @@ let remove_at_idx i l0 = | y::l' -> aux l' (y::acc) (i-1) in + let i = if i<0 then length l0 + i else i in aux l0 [] i (*$T remove_at_idx 0 [1;2;3;4] = [2;3;4] remove_at_idx 3 [1;2;3;4] = [1;2;3] remove_at_idx 5 [1;2;3;4] = [1;2;3;4] + remove_at_idx (-1) [1;2;3;4] = [1;2;3] + remove_at_idx (-2) [1;2;3;4] = [1;2;4] + remove_at_idx (-3) [1;2;3;4] = [1;3;4] + remove_at_idx (-4) [1;2;3;4] = [2;3;4] *) let range_by ~step i j = diff --git a/src/core/CCList.mli b/src/core/CCList.mli index f143de16..c6fe1af1 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -76,6 +76,10 @@ val fold_flat_map : ('acc -> 'a -> 'acc * 'b list) -> 'acc -> 'a list -> 'acc * list to a list of lists that is then [flatten]'d.. @since 0.14 *) +val count : ('a -> bool) -> 'a list -> int +(** [count f l] counts how much element of [l] comply with the function [f]. + @since 1.5 *) + val init : int -> (int -> 'a) -> 'a t (** Similar to {!Array.init} @since 0.6 *) @@ -97,6 +101,14 @@ val split : ('a * 'b) t -> 'a t * 'b t val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int +val compare_lengths : 'a t -> 'b t -> int +(** equivalent to [compare (length l1) (length l2)] but more efficient. + @since 1.5 *) + +val compare_length_with : 'a t -> int -> int +(** equivalent to [compare (length l) x] but more efficient. + @since 1.5 *) + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool val flat_map : ('a -> 'b t) -> 'a t -> 'b t @@ -112,13 +124,15 @@ val fold_product : ('c -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c (** Fold on the cartesian product *) val cartesian_product : 'a t t -> 'a t t -(** +(** Produce the cartesian product of this list of lists, + by returning all the ways of picking one element per sublist. + {b NOTE} the order of the returned list is unspecified. For example: {[ - # cartesian_product [[1;2];[3];[4;5;6]] = + # cartesian_product [[1;2];[3];[4;5;6]] |> sort = [[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]];; # cartesian_product [[1;2];[];[4;5;6]] = [];; - # cartesian_product [[1;2];[3];[4];[5];[6]] = + # cartesian_product [[1;2];[3];[4];[5];[6]] |> sort = [[1;3;4;5;6];[2;3;4;5;6]];; ]} invariant: [cartesian_product l = map_product id l]. @@ -223,6 +237,10 @@ val find_pred : ('a -> bool) -> 'a t -> 'a option or returns [None] if no element satisfies [p] @since 0.11 *) +val find_opt : ('a -> bool) -> 'a t -> 'a option +(** Safe version of {!find} + @since 1.5 *) + val find_pred_exn : ('a -> bool) -> 'a t -> 'a (** Unsafe version of {!find_pred} @raise Not_found if no such element is found @@ -321,22 +339,38 @@ val foldi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b (** Fold on list, with index *) val get_at_idx : int -> 'a t -> 'a option +(** Get by index in the list. + If the index is negative, it will get element starting from the end + of the list. *) + +val nth_opt : 'a t -> int -> 'a option +(** Safe version of {!nth}. + @raise Invalid_argument if the int is negative. + @since 1.5 *) val get_at_idx_exn : int -> 'a t -> 'a (** Get the i-th element, or - @raise Not_found if the index is invalid *) + @raise Not_found if the index is invalid + If the index is negative, it will get element starting from the end + of the list. *) val set_at_idx : int -> 'a -> 'a t -> 'a t (** Set i-th element (removes the old one), or does nothing if - index is too high *) + index is too high. + If the index is negative, it will set element starting from the end + of the list. *) val insert_at_idx : int -> 'a -> 'a t -> 'a t (** Insert at i-th position, between the two existing elements. If the - index is too high, append at the end of the list *) + index is too high, append at the end of the list. + If the index is negative, it will insert element starting from the end + of the list. *) val remove_at_idx : int -> 'a t -> 'a t (** Remove element at given index. Does nothing if the index is - too high. *) + too high. + If the index is negative, it will remove element starting from the end + of the list. *) (** {2 Set Operators} @@ -430,6 +464,14 @@ module Assoc : sig @since 0.17 *) end +val assoc_opt : 'a -> ('a * 'b) t -> 'b option +(** Safe version of {!assoc} + @since 1.5 *) + +val assq_opt : 'a -> ('a * 'b) t -> 'b option +(** Safe version of {!assq} + @since 1.5 *) + (** {2 References on Lists} @since 0.3.3 *) diff --git a/src/core/CCListLabels.ml b/src/core/CCListLabels.ml index 61df2913..e2f676b6 100644 --- a/src/core/CCListLabels.ml +++ b/src/core/CCListLabels.ml @@ -1,1186 +1,4 @@ (* This file is free software, part of containers. See file "license" for more details. *) -(** {1 complements to list} *) - -(*$inject - let lsort l = List.sort Pervasives.compare l -*) - -include ListLabels - -type 'a t = 'a list - -let empty = [] - -let is_empty = function - | [] -> true - | _::_ -> false - -(* max depth for direct recursion *) -let direct_depth_default_ = 1000 - -let map f l = - let rec direct f i l = match l with - | [] -> [] - | [x] -> [f x] - | [x1;x2] -> let y1 = f x1 in [y1; f x2] - | [x1;x2;x3] -> let y1 = f x1 in let y2 = f x2 in [y1; y2; f x3] - | _ when i=0 -> List.rev (List.rev_map f l) - | x1::x2::x3::x4::l' -> - let y1 = f x1 in - let y2 = f x2 in - let y3 = f x3 in - let y4 = f x4 in - y1 :: y2 :: y3 :: y4 :: direct f (i-1) l' - in - direct f direct_depth_default_ l - -(*$Q - (Q.list Q.small_int) (fun l -> \ - let f x = x+1 in \ - List.rev (List.rev_map f l) = map f l) -*) - -let (>|=) l f = map f l - -let direct_depth_append_ = 10_000 - -let cons x l = x::l - -let append l1 l2 = - let rec direct i l1 l2 = match l1 with - | [] -> l2 - | _ when i=0 -> safe l1 l2 - | x::l1' -> x :: direct (i-1) l1' l2 - and safe l1 l2 = - List.rev_append (List.rev l1) l2 - in - match l1 with - | [] -> l2 - | [x] -> x::l2 - | [x;y] -> x::y::l2 - | _ -> direct direct_depth_append_ l1 l2 - -let (@) = append - -(*$T - [1;2;3] @ [4;5;6] = [1;2;3;4;5;6] - (1-- 10_000) @ (10_001 -- 20_000) = 1 -- 20_000 -*) - -let cons_maybe o l = match o with - | Some x -> x :: l - | None -> l - -(*$T - cons_maybe (Some 1) [2;3] = [1;2;3] - cons_maybe None [2;3] = [2;3] -*) - -let direct_depth_filter_ = 10_000 - -let filter p l = - let rec direct i p l = match l with - | [] -> [] - | _ when i=0 -> safe p l [] - | x::l' when not (p x) -> direct i p l' - | x::l' -> x :: direct (i-1) p l' - and safe p l acc = match l with - | [] -> List.rev acc - | x::l' when not (p x) -> safe p l' acc - | x::l' -> safe p l' (x::acc) - in - direct direct_depth_filter_ p l - -(*$= & ~printer:CCInt.to_string - 500 (filter (fun x->x mod 2 = 0) (1 -- 1000) |> List.length) - 50_000 (filter (fun x->x mod 2 = 0) (1 -- 100_000) |> List.length) - 500_000 (filter (fun x->x mod 2 = 0) (1 -- 1_000_000) |> List.length) -*) - -let fold_right f l acc = - let rec direct i f l acc = match l with - | [] -> acc - | _ when i=0 -> safe f (List.rev l) acc - | x::l' -> - let acc = direct (i-1) f l' acc in - f x acc - and safe f l acc = match l with - | [] -> acc - | x::l' -> - let acc = f x acc in - safe f l' acc - in - direct direct_depth_default_ f l acc - -(*$T - fold_right (+) (1 -- 1_000_000) 0 = \ - List.fold_left (+) 0 (1 -- 1_000_000) -*) - -(*$Q - (Q.list Q.small_int) (fun l -> \ - l = fold_right (fun x y->x::y) l []) -*) - -let rec fold_while f acc = function - | [] -> acc - | e::l -> let acc, cont = f acc e in - match cont with - | `Stop -> acc - | `Continue -> fold_while f acc l - -(*$T - fold_while (fun acc b -> if b then acc+1, `Continue else acc, `Stop) 0 [true;true;false;true] = 2 -*) - -let fold_map f acc l = - let rec aux f acc map_acc l = match l with - | [] -> acc, List.rev map_acc - | x :: l' -> - let acc, y = f acc x in - aux f acc (y :: map_acc) l' - in - aux f acc [] l - -(*$= - (6, ["1"; "2"; "3"]) \ - (fold_map (fun acc x->acc+x, string_of_int x) 0 [1;2;3]) -*) - -(*$Q - Q.(list int) (fun l -> \ - fold_map (fun acc x -> x::acc, x) [] l = (List.rev l, l)) -*) - -let fold_map2 f acc l1 l2 = - let rec aux f acc map_acc l1 l2 = match l1, l2 with - | [], [] -> acc, List.rev map_acc - | [], _ - | _, [] -> invalid_arg "fold_map2" - | x1 :: l1', x2 :: l2' -> - let acc, y = f acc x1 x2 in - aux f acc (y :: map_acc) l1' l2' - in - aux f acc [] l1 l2 - -(*$= - (310, ["1 10"; "2 0"; "3 100"]) \ - (fold_map2 (fun acc x y->acc+x*y, string_of_int x ^ " " ^ string_of_int y) \ - 0 [1;2;3] [10;0;100]) -*) - -(*$T - (try ignore (fold_map2 (fun _ _ _ -> assert false) 42 [] [1]); false \ - with Invalid_argument _ -> true) -*) - -let fold_filter_map f acc l = - let rec aux f acc map_acc l = match l with - | [] -> acc, List.rev map_acc - | x :: l' -> - let acc, y = f acc x in - aux f acc (cons_maybe y map_acc) l' - in - aux f acc [] l - -(*$= & ~printer:Q.Print.(pair int (list int)) - (List.fold_left (+) 0 (1--10), [2;4;6;8;10]) \ - (fold_filter_map (fun acc x -> acc+x, if x mod 2 = 0 then Some x else None) \ - 0 (1--10)) -*) - -let fold_flat_map f acc l = - let rec aux f acc map_acc l = match l with - | [] -> acc, List.rev map_acc - | x :: l' -> - let acc, y = f acc x in - aux f acc (List.rev_append y map_acc) l' - in - aux f acc [] l - -(*$= - (6, ["1"; "a1"; "2"; "a2"; "3"; "a3"]) \ - (let pf = Printf.sprintf in \ - fold_flat_map (fun acc x->acc+x, [pf "%d" x; pf "a%d" x]) 0 [1;2;3]) -*) - -(*$Q - Q.(list int) (fun l -> \ - fold_flat_map (fun acc x -> x::acc, [x;x+10]) [] l = \ - (List.rev l, flat_map (fun x->[x;x+10]) l) ) -*) - -let init len f = - let rec init_rec acc i f = - if i=0 then f i :: acc - else init_rec (f i :: acc) (i-1) f - in - if len<0 then invalid_arg "init" - else if len=0 then [] - else init_rec [] (len-1) f - -(*$T - init 0 (fun _ -> 0) = [] - init 1 (fun x->x) = [0] - init 1000 (fun x->x) = 0--999 -*) - -let rec compare f l1 l2 = match l1, l2 with - | [], [] -> 0 - | _, [] -> 1 - | [], _ -> -1 - | x1::l1', x2::l2' -> - let c = f x1 x2 in - if c <> 0 then c else compare f l1' l2' - -let rec equal f l1 l2 = match l1, l2 with - | [], [] -> true - | [], _ | _, [] -> false - | x1::l1', x2::l2' -> f x1 x2 && equal f l1' l2' - -(*$T - equal CCInt.equal (1--1_000_000) (1--1_000_000) -*) - -let flat_map f l = - let rec aux f l kont = match l with - | [] -> kont [] - | x::l' -> - let y = f x in - let kont' tail = match y with - | [] -> kont tail - | [x] -> kont (x :: tail) - | [x;y] -> kont (x::y::tail) - | l -> kont (append l tail) - in - aux f l' kont' - in - aux f l (fun l->l) - -(*$T - flat_map (fun x -> [x+1; x*2]) [10;100] = [11;20;101;200] - List.length (flat_map (fun x->[x]) (1--300_000)) = 300_000 -*) - -let flatten l = fold_right append l [] - -(*$T - flatten [[1]; [2;3;4]; []; []; [5;6]] = 1--6 - flatten (init 300_001 (fun x->[x])) = 0--300_000 -*) - -let product f l1 l2 = - flat_map (fun x -> map (fun y -> f x y) l2) l1 - -let fold_product f acc l1 l2 = - List.fold_left - (fun acc x1 -> - List.fold_left - (fun acc x2 -> f acc x1 x2) - acc l2 - ) acc l1 - -let diagonal l = - let rec gen acc l = match l with - | [] -> acc - | x::l' -> - let acc = List.fold_left (fun acc y -> (x,y) :: acc) acc l' in - gen acc l' - in - gen [] l - -(*$T - diagonal [] = [] - diagonal [1] = [] - diagonal [1;2] = [1,2] - diagonal [1;2;3] |> List.sort Pervasives.compare = [1, 2; 1, 3; 2, 3] -*) - -let partition_map f l = - let rec iter f l1 l2 l = match l with - | [] -> List.rev l1, List.rev l2 - | x :: tl -> - match f x with - | `Left y -> iter f (y :: l1) l2 tl - | `Right y -> iter f l1 (y :: l2) tl - | `Drop -> iter f l1 l2 tl - in - iter f [] [] l - -(*$R - let l1, l2 = - partition_map (function - | n when n = 0 -> `Drop - | n when n mod 2 = 0 -> `Left n - | n -> `Right n - ) [0;1;2;3;4] - in - assert_equal [2;4] l1; - assert_equal [1;3] l2 -*) - -let return x = [x] - -let (>>=) l f = flat_map f l - -let (<$>) = map - -let pure = return - -let (<*>) funs l = product (fun f x -> f x) funs l - -let sorted_merge ?(cmp=Pervasives.compare) l1 l2 = - let rec recurse cmp acc l1 l2 = match l1,l2 with - | [], _ -> List.rev_append acc l2 - | _, [] -> List.rev_append acc l1 - | x1::l1', x2::l2' -> - let c = cmp x1 x2 in - if c < 0 then recurse cmp (x1::acc) l1' l2 - else if c > 0 then recurse cmp (x2::acc) l1 l2' - else recurse cmp (x1::x2::acc) l1' l2' - in - recurse cmp [] l1 l2 - -(*$T - List.sort Pervasives.compare ([(( * )2); ((+)1)] <*> [10;100]) \ - = [11; 20; 101; 200] - sorted_merge [1;1;2] [1;2;3] = [1;1;1;2;2;3] -*) - -(*$Q - Q.(pair (list int) (list int)) (fun (l1,l2) -> \ - List.length (sorted_merge l1 l2) = List.length l1 + List.length l2) -*) - -let sort_uniq (type elt) ?(cmp=Pervasives.compare) l = - let module S = Set.Make(struct - type t = elt - let compare = cmp - end) in - let set = fold_right S.add l S.empty in - S.elements set - -(*$T - sort_uniq [1;2;5;3;6;1;4;2;3] = [1;2;3;4;5;6] - sort_uniq [] = [] - sort_uniq [10;10;10;10;1;10] = [1;10] -*) - -let is_sorted ?(cmp=Pervasives.compare) l = - let rec aux cmp = function - | [] | [_] -> true - | x :: ((y :: _) as tail) -> cmp x y <= 0 && aux cmp tail - in - aux cmp l - -(*$Q - Q.(list small_int) (fun l -> \ - is_sorted (List.sort Pervasives.compare l)) -*) - -let sorted_insert ?(cmp=Pervasives.compare) ?(uniq=false) x l = - let rec aux cmp uniq x left l = match l with - | [] -> List.rev_append left [x] - | y :: tail -> - match cmp x y with - | 0 -> - let l' = if uniq then l else x :: l in - List.rev_append left l' - | n when n<0 -> List.rev_append left (x :: l) - | _ -> aux cmp uniq x (y::left) tail - in - 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 (sorted_insert ~uniq:true x l)) - Q.(pair small_int (list small_int)) (fun (x,l) -> \ - let l = List.sort Pervasives.compare l in \ - is_sorted (sorted_insert ~uniq:false x l)) - Q.(pair small_int (list small_int)) (fun (x,l) -> \ - let l = List.sort Pervasives.compare l in \ - let l' = sorted_insert ~uniq:false x l in \ - List.length l' = List.length l + 1) - Q.(pair small_int (list small_int)) (fun (x,l) -> \ - let l = List.sort Pervasives.compare l in \ - List.mem x (sorted_insert x l)) -*) - -let uniq_succ ?(eq=(=)) l = - let rec f acc l = match l with - | [] -> List.rev acc - | [x] -> List.rev (x::acc) - | x :: ((y :: _) as tail) when eq x y -> f acc tail - | x :: tail -> f (x::acc) tail - in - f [] l - -(*$T - uniq_succ [1;1;2;3;1;6;6;4;6;1] = [1;2;3;1;6;4;6;1] -*) - -let group_succ ?(eq=(=)) l = - let rec f ~eq acc cur l = match cur, l with - | [], [] -> List.rev acc - | _::_, [] -> List.rev (List.rev cur :: acc) - | [], x::tl -> f ~eq acc [x] tl - | (y :: _), x :: tl when eq x y -> f ~eq acc (x::cur) tl - | _, x :: tl -> f ~eq (List.rev cur :: acc) [x] tl - in - f ~eq [] [] l - -(*$T - group_succ [1;2;3;1;1;2;4] = [[1]; [2]; [3]; [1;1]; [2]; [4]] - group_succ [] = [] - group_succ [1;1;1] = [[1;1;1]] - group_succ [1;2;2;2] = [[1]; [2;2;2]] - group_succ ~eq:(fun (x,_)(y,_)-> x=y) [1, 1; 1, 2; 1, 3; 2, 0] \ - = [[1, 1; 1, 2; 1, 3]; [2, 0]] -*) - -let sorted_merge_uniq ?(cmp=Pervasives.compare) l1 l2 = - let push ~cmp acc x = match acc with - | [] -> [x] - | y :: _ when cmp x y > 0 -> x :: acc - | _ -> acc (* duplicate, do not yield *) - in - let rec recurse ~cmp acc l1 l2 = match l1,l2 with - | [], l - | l, [] -> - let acc = List.fold_left (push ~cmp) acc l in - List.rev acc - | x1::l1', x2::l2' -> - let c = cmp x1 x2 in - if c < 0 then recurse ~cmp (push ~cmp acc x1) l1' l2 - else if c > 0 then recurse ~cmp (push ~cmp acc x2) l1 l2' - else recurse ~cmp acc l1 l2' (* drop one of the [x] *) - in - recurse ~cmp [] l1 l2 - -(*$T - sorted_merge_uniq [1; 1; 2; 3; 5; 8] [1; 2; 3; 4; 6; 8; 9; 9] = [1;2;3;4;5;6;8;9] -*) - -(*$Q - Q.(list int) (fun l -> \ - let l = List.sort Pervasives.compare l in \ - sorted_merge_uniq l [] = uniq_succ l) - Q.(list int) (fun l -> \ - let l = List.sort Pervasives.compare l in \ - sorted_merge_uniq [] l = uniq_succ l) - Q.(pair (list int) (list int)) (fun (l1, l2) -> \ - let l1 = List.sort Pervasives.compare l1 \ - and l2 = List.sort Pervasives.compare l2 in \ - let l3 = sorted_merge_uniq l1 l2 in \ - uniq_succ l3 = l3) -*) - -let take n l = - let rec direct i n l = match l with - | [] -> [] - | _ when i=0 -> safe n [] l - | x::l' -> - if n > 0 - then x :: direct (i-1) (n-1) l' - else [] - and safe n acc l = match l with - | [] -> List.rev acc - | _ when n=0 -> List.rev acc - | x::l' -> safe (n-1) (x::acc) l' - in - direct direct_depth_default_ n l - -(*$T - take 2 [1;2;3;4;5] = [1;2] - take 10_000 (range 0 100_000) |> List.length = 10_000 - take 10_000 (range 0 2_000) = range 0 2_000 - take 300_000 (1 -- 400_000) = 1 -- 300_000 -*) - -(*$Q - (Q.pair (Q.list Q.small_int) Q.int) (fun (l,i) -> \ - let i = abs i in \ - let l1 = take i l in \ - List.length l1 <= i && ((List.length l1 = i) = (List.length l >= i))) -*) - -let rec drop n l = match l with - | [] -> [] - | _ when n=0 -> l - | _::l' -> drop (n-1) l' - -let hd_tl = function - | [] -> failwith "hd_tl" - | x :: l -> x, l - -(*$T - try ignore (hd_tl []); false with Failure _ -> true - hd_tl [1;2;3] = (1, [2;3]) -*) - -let take_drop n l = take n l, drop n l - -(*$Q - (Q.pair (Q.list Q.small_int) Q.int) (fun (l,i) -> \ - let i = abs i in \ - let l1, l2 = take_drop i l in \ - l1 @ l2 = l ) -*) - -let sublists_of_len ?(last=fun _ -> None) ?offset n l = - if n < 1 then invalid_arg "sublists_of_len: n must be > 0"; - let offset = match offset with - | None -> n - | Some o when o < 1 -> invalid_arg "sublists_of_len: offset must be > 0" - | Some o -> o - in - (* add sub-lists of [l] to [acc] *) - let rec aux acc l = - let group = take n l in - if group=[] then acc (* this was the last group, we are done *) - else if List.length group < n (* last group, with missing elements *) - then match last group with - | None -> acc - | Some group' -> group' :: acc - else ( - let l' = drop offset l in - aux (group :: acc) l' (* continue *) - ) - in - List.rev (aux [] l) - -(*$= sublists_of_len as subs & ~printer:Q.Print.(list (list int)) - [[1;2;3]] (subs 3 [1;2;3;4]) - [[1;2]; [3;4]; [5;6]] (subs 2 [1;2;3;4;5;6]) - [] (subs 3 [1;2]) - [[1;2];[3;4]] (subs 2 ~offset:2 [1;2;3;4]) - [[1;2];[2;3]] (subs 2 ~offset:1 [1;2;3]) - [[1;2];[4;5]] (subs 2 ~offset:3 [1;2;3;4;5;6]) - [[1;2;3];[4]] (subs 3 ~last:CCOpt.return [1;2;3;4]) - [[1;2]; [3;4]] (subs 2 [1;2;3;4;5]) -*) - -let take_while p l = - let rec direct i p l = match l with - | [] -> [] - | _ when i=0 -> safe p [] l - | x :: l' -> - if p x then x :: direct (i-1) p l' else [] - and safe p acc l = match l with - | [] -> List.rev acc - | x :: l' -> - if p x then safe p (x::acc) l' else List.rev acc - in - direct direct_depth_default_ p l - -(*$T - take_while (fun x->x<10) (1 -- 20) = (1--9) - take_while (fun x->x <> 0) [0;1;2;3] = [] - take_while (fun _ -> true) [] = [] - take_while (fun _ -> true) (1--10) = (1--10) -*) - -(*$Q - Q.(pair (fun1 small_int bool) (list small_int)) (fun (f,l) -> \ - let l1 = take_while f l in \ - List.for_all f l1) -*) - -let rec drop_while p l = match l with - | [] -> [] - | x :: l' -> if p x then drop_while p l' else l - -(*$Q - Q.(pair (fun1 small_int bool) (list small_int)) (fun (f,l) -> \ - take_while f l @ drop_while f l = l) -*) - -let last n l = - let len = List.length l in - if len < n then l else drop (len-n) l - -let head_opt = function - | [] -> None - | x::_ -> Some x - -let rec last_opt = function - | [] -> None - | [x] -> Some x - | _ :: tail -> last_opt tail - -(*$= & ~printer:Q.Print.(option int) - (Some 1) (head_opt [1;2;3]) - (Some 1) (head_opt [1]) - None (head_opt []) - (Some 3) (last_opt [1;2;3]) - (Some 1) (last_opt [1]) - None (last_opt []) -*) - -let rec find_pred p l = match l with - | [] -> None - | x :: _ when p x -> Some x - | _ :: tl -> find_pred p tl - -let find_pred_exn p l = match find_pred p l with - | None -> raise Not_found - | Some x -> x - -(*$T - find_pred ((=) 4) [1;2;5;4;3;0] = Some 4 - find_pred (fun _ -> true) [] = None - find_pred (fun _ -> false) (1 -- 10) = None - find_pred (fun x -> x < 10) (1 -- 9) = Some 1 -*) - -let find_mapi f l = - let rec aux f i = function - | [] -> None - | x::l' -> - match f i x with - | Some _ as res -> res - | None -> aux f (i+1) l' - in aux f 0 l - -let find_map f l = find_mapi (fun _ -> f) l - -let find_idx p l = find_mapi (fun i x -> if p x then Some (i, x) else None) l - -(*$T - find_map (fun x -> if x=3 then Some "a" else None) [1;2;3;4] = Some "a" - find_map (fun x -> if x=3 then Some "a" else None) [1;2;4;5] = None -*) - -let remove ?(eq=(=)) ~x l = - let rec remove' eq x acc l = match l with - | [] -> List.rev acc - | y :: tail when eq x y -> remove' eq x acc tail - | y :: tail -> remove' eq x (y::acc) tail - in - remove' eq x [] l - -(*$T - remove ~x:1 [2;1;3;3;2;1] = [2;3;3;2] - remove ~x:10 [1;2;3] = [1;2;3] -*) - -let filter_map f l = - let rec recurse acc l = match l with - | [] -> List.rev acc - | x::l' -> - let acc' = match f x with | None -> acc | Some y -> y::acc in - recurse acc' l' - in recurse [] l - -(*$= - ["2"; "4"] \ - (filter_map (fun x -> if x mod 2 = 0 then Some (string_of_int x) else None) \ - [1;2;3;4;5]) - [ "2"; "4"; "6" ] \ - (filter_map (fun x -> if x mod 2 = 0 then Some (string_of_int x) else None) \ - [ 1; 2; 3; 4; 5; 6 ]) -*) - -let mem ?(eq=(=)) x l = - let rec search eq x l = match l with - | [] -> false - | y::l' -> eq x y || search eq x l' - in search eq x l - -let add_nodup ?(eq=(=)) x l = - if mem ~eq x l then l else x::l - -let remove_one ?(eq=(=)) x l = - let rec remove_one ~eq x acc l = match l with - | [] -> assert false - | y :: tl when eq x y -> List.rev_append acc tl - | y :: tl -> remove_one ~eq x (y::acc) tl - in - if mem ~eq x l then remove_one ~eq x [] l else l - -(*$Q - Q.(pair int (list int)) (fun (x,l) -> \ - remove_one x (add_nodup x l) = l) - Q.(pair int (list int)) (fun (x,l) -> \ - mem x l || List.length (add_nodup x l) = List.length l + 1) - Q.(pair int (list int)) (fun (x,l) -> \ - not (mem x l) || List.length (remove_one x l) = List.length l - 1) -*) - -let subset ?(eq=(=)) l1 l2 = - List.for_all - (fun t -> mem ~eq t l2) - l1 - -let uniq ?(eq=(=)) l = - let rec uniq eq acc l = match l with - | [] -> List.rev acc - | x::xs when List.exists (eq x) xs -> uniq eq acc xs - | x::xs -> uniq eq (x::acc) xs - in uniq eq [] l - -(*$T - uniq [1;1;2;2;3;4;4;2;4;1;5] |> List.sort Pervasives.compare = [1;2;3;4;5] -*) - -let union ?(eq=(=)) l1 l2 = - let rec union eq acc l1 l2 = match l1 with - | [] -> List.rev_append acc l2 - | x::xs when mem ~eq x l2 -> union eq acc xs l2 - | x::xs -> union eq (x::acc) xs l2 - in union eq [] l1 l2 - -(*$T - union [1;2;4] [2;3;4;5] = [1;2;3;4;5] -*) - -let inter ?(eq=(=)) l1 l2 = - let rec inter eq acc l1 l2 = match l1 with - | [] -> List.rev acc - | x::xs when mem ~eq x l2 -> inter eq (x::acc) xs l2 - | _::xs -> inter eq acc xs l2 - in inter eq [] l1 l2 - -(*$T - inter [1;2;4] [2;3;4;5] = [2;4] -*) - -let mapi f l = - let r = ref 0 in - map - (fun x -> - let y = f !r x in - incr r; y - ) l - -(*$T - mapi (fun i x -> i*x) [10;10;10] = [0;10;20] -*) - -let iteri f l = - let rec aux f i l = match l with - | [] -> () - | x::l' -> f i x; aux f (i+1) l' - in aux f 0 l - -let foldi f acc l = - let rec foldi f acc i l = match l with - | [] -> acc - | x::l' -> - let acc = f acc i x in - foldi f acc (i+1) l' - in - foldi f acc 0 l - -let rec get_at_idx_exn i l = match l with - | [] -> raise Not_found - | x::_ when i=0 -> x - | _::l' -> get_at_idx_exn (i-1) l' - -let get_at_idx i l = - try Some (get_at_idx_exn i l) - with Not_found -> None - -(*$T - get_at_idx 0 (range 0 10) = Some 0 - get_at_idx 5 (range 0 10) = Some 5 - get_at_idx 11 (range 0 10) = None - get_at_idx 0 [] = None -*) - -let set_at_idx i x l0 = - let rec aux l acc i = match l with - | [] -> l0 - | _::l' when i=0 -> List.rev_append acc (x::l') - | y::l' -> - aux l' (y::acc) (i-1) - in - aux l0 [] i - -(*$T - set_at_idx 0 10 [1;2;3] = [10;2;3] - set_at_idx 4 10 [1;2;3] = [1;2;3] - set_at_idx 1 10 [1;2;3] = [1;10;3] -*) - -let insert_at_idx i x l = - let rec aux l acc i x = match l with - | [] -> List.rev_append acc [x] - | y::l' when i=0 -> List.rev_append acc (x::y::l') - | y::l' -> - aux l' (y::acc) (i-1) x - in - aux l [] i x - -(*$T - insert_at_idx 0 10 [1;2;3] = [10;1;2;3] - insert_at_idx 4 10 [1;2;3] = [1;2;3;10] - insert_at_idx 1 10 [1;2;3] = [1;10;2;3] -*) - -let remove_at_idx i l0 = - let rec aux l acc i = match l with - | [] -> l0 - | _::l' when i=0 -> List.rev_append acc l' - | y::l' -> - aux l' (y::acc) (i-1) - in - aux l0 [] i - -(*$T - remove_at_idx 0 [1;2;3;4] = [2;3;4] - remove_at_idx 3 [1;2;3;4] = [1;2;3] - remove_at_idx 5 [1;2;3;4] = [1;2;3;4] -*) - -let range_by ~step i j = - let rec range i j acc = - if i=j then i::acc else range i (j-step) (j::acc) - in - if step = 0 then - raise (Invalid_argument "CCList.range_by") - else if (if step > 0 then i>j else i \ - let i = min i j and j = max i j in \ - range_by ~step:1 i j = range i j) -*) - -let range i j = - let rec up i j acc = - if i=j then i::acc else up i (j-1) (j::acc) - and down i j acc = - if i=j then i::acc else down i (j+1) (j::acc) - in - if i<=j then up i j [] else down i j [] - -(*$T - range 0 5 = [0;1;2;3;4;5] - range 0 0 = [0] - range 5 2 = [5;4;3;2] -*) - -let range' i j = - if i \ - let l = (a--^b) in not (List.mem b l)) -*) - -let replicate i x = - let rec aux acc i = - if i = 0 then acc - else aux (x::acc) (i-1) - in aux [] i - -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) - in aux [] i - -module Assoc = struct - type ('a, 'b) t = ('a*'b) list - - let rec search_exn eq l x = match l with - | [] -> raise Not_found - | (y,z)::l' -> - if eq x y then z else search_exn eq l' x - - let get_exn ?(eq=(=)) x l = search_exn eq l x - - let get ?(eq=(=)) x l = - try Some (search_exn eq l x) - with Not_found -> None - - (*$T - Assoc.get 1 [1, "1"; 2, "2"] = Some "1" - Assoc.get 2 [1, "1"; 2, "2"] = Some "2" - Assoc.get 3 [1, "1"; 2, "2"] = None - Assoc.get 42 [] = None - *) - - (* search for a binding for [x] in [l], and calls [f x (Some v) rest] - or [f x None rest] depending on whether it finds the binding. - [rest] is the list of the other bindings *) - let rec search_set eq acc l x ~f = match l with - | [] -> f x None acc - | (x',y')::l' -> - if eq x x' - then f x (Some y') (List.rev_append acc l') - else search_set eq ((x',y')::acc) l' x ~f - - let set ?(eq=(=)) x y l = - search_set eq [] l x - ~f:(fun x _ l -> (x,y)::l) - - (*$T - Assoc.set 2 "two" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \ - = [1, "1"; 2, "two"] - Assoc.set 3 "3" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \ - = [1, "1"; 2, "2"; 3, "3"] - *) - - let mem ?(eq=(=)) x l = - try ignore (search_exn eq l x); true - with Not_found -> false - - (*$T - Assoc.mem 1 [1,"1"; 2,"2"; 3, "3"] - not (Assoc.mem 4 [1,"1"; 2,"2"; 3, "3"]) - *) - - let update ?(eq=(=)) ~f x l = - search_set eq [] l x - ~f:(fun x opt_y rest -> - match f opt_y with - | None -> rest (* drop *) - | Some y' -> (x,y') :: rest) - (*$= - [1,"1"; 2,"22"] \ - (Assoc.update 2 [1,"1"; 2,"2"] \ - ~f:(function Some "2" -> Some "22" | _ -> assert false) |> lsort) - [1,"1"; 3,"3"] \ - (Assoc.update 2 [1,"1"; 2,"2"; 3,"3"] \ - ~f:(function Some "2" -> None | _ -> assert false) |> lsort) - [1,"1"; 2,"2"; 3,"3"] \ - (Assoc.update 3 [1,"1"; 2,"2"] \ - ~f:(function None -> Some "3" | _ -> assert false) |> lsort) - *) - - let remove ?(eq=(=)) x l = - search_set eq [] l x - ~f:(fun _ opt_y rest -> match opt_y with - | None -> l (* keep as is *) - | Some _ -> rest) - - (*$= - [1,"1"] \ - (Assoc.remove 2 [1,"1"; 2,"2"] |> lsort) - [1,"1"; 3,"3"] \ - (Assoc.remove 2 [1,"1"; 2,"2"; 3,"3"] |> lsort) - [1,"1"; 2,"2"] \ - (Assoc.remove 3 [1,"1"; 2,"2"] |> lsort) - *) -end - -(** {2 References on Lists} *) - -module Ref = struct - type 'a t = 'a list ref - - let push l x = l := x :: !l - - let pop l = match !l with - | [] -> None - | x::tail -> - l := tail; - Some x - - let pop_exn l = match !l with - | [] -> failwith "CCList.Ref.pop_exn" - | x::tail -> - l := tail; - x - - let create() = ref [] - - let clear l = l := [] - - let lift f l = f !l - - let push_list r l = - r := List.rev_append l !r - - (*$T - let l = Ref.create() in Ref.push l 1; Ref.push_list l [2;3]; !l = [3;2;1] - *) -end - -(** {2 Monadic Operations} *) -module type MONAD = sig - type 'a t - val return : 'a -> 'a t - val (>>=) : 'a t -> ('a -> 'b t) -> 'b t -end - -module Traverse(M : MONAD) = struct - open M - - let map_m f l = - let rec aux f acc l = match l with - | [] -> return (List.rev acc) - | x::tail -> - f x >>= fun x' -> - aux f (x' :: acc) tail - in aux f [] l - - let rec map_m_par f l = match l with - | [] -> M.return [] - | x::tl -> - let x' = f x in - let tl' = map_m_par f tl in - x' >>= fun x' -> - tl' >>= fun tl' -> - M.return (x'::tl') - - let sequence_m l = map_m (fun x->x) l - - let rec fold_m f acc l = match l with - | [] -> return acc - | x :: l' -> - f acc x - >>= fun acc' -> - fold_m f acc' l' -end - -(** {2 Conversions} *) - -type 'a sequence = ('a -> unit) -> unit -type 'a gen = unit -> 'a option -type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] -type 'a printer = Format.formatter -> 'a -> unit -type 'a random_gen = Random.State.t -> 'a - -let random_len len g st = - init len (fun _ -> g st) - -(*$T - random_len 10 CCInt.random_small (Random.State.make [||]) |> List.length = 10 -*) - -let random g st = - let len = Random.State.int st 1_000 in - random_len len g st - -let random_non_empty g st = - let len = 1 + Random.State.int st 1_000 in - random_len len g st - -let random_choose l = match l with - | [] -> raise Not_found - | _::_ -> - let len = List.length l in - fun st -> - let i = Random.State.int st len in - List.nth l i - -let random_sequence l st = map (fun g -> g st) l - -let to_seq l k = List.iter k l -let of_seq seq = - let l = ref [] in - seq (fun x -> l := x :: !l); - List.rev !l - -let to_gen l = - let l = ref l in - fun () -> - match !l with - | [] -> None - | x::l' -> - l := l'; Some x - -let of_gen g = - let rec direct i g = - if i = 0 then safe [] g - else match g () with - | None -> [] - | Some x -> x :: direct (i-1) g - and safe acc g = match g () with - | None -> List.rev acc - | Some x -> safe (x::acc) g - in - direct direct_depth_default_ g - -let to_klist l = - let rec make l () = match l with - | [] -> `Nil - | x::l' -> `Cons (x, make l') - in make l - -let of_klist l = - let rec direct i g = - if i = 0 then safe [] g - else match l () with - | `Nil -> [] - | `Cons (x,l') -> x :: direct (i-1) l' - and safe acc l = match l () with - | `Nil -> List.rev acc - | `Cons (x,l') -> safe (x::acc) l' - in - direct direct_depth_default_ l - -module Infix = struct - let (>|=) = (>|=) - let (@) = (@) - let (<*>) = (<*>) - let (<$>) = (<$>) - let (>>=) = (>>=) - let (--) = (--) - let (--^) = (--^) -end - -(** {2 IO} *) - -let pp ?(start="") ?(stop="") ?(sep=", ") pp_item fmt l = - let rec print fmt l = match l with - | x::((_::_) as l) -> - pp_item fmt x; - Format.pp_print_string fmt sep; - Format.pp_print_cut fmt (); - print fmt l - | x::[] -> pp_item fmt x - | [] -> () - in - Format.pp_print_string fmt start; - print fmt l; - Format.pp_print_string fmt stop - -(*$= & ~printer:(fun s->s) - "[1, 2, 3]" \ - (CCFormat.to_string \ - (CCFormat.hbox(CCList.pp ~start:"[" ~stop:"]" CCFormat.int)) \ - [1;2;3]) -*) +include CCList diff --git a/src/core/CCListLabels.mli b/src/core/CCListLabels.mli index 09125956..4bc67737 100644 --- a/src/core/CCListLabels.mli +++ b/src/core/CCListLabels.mli @@ -97,6 +97,20 @@ val partition_map : f:('a -> [<`Left of 'b | `Right of 'c | `Drop]) -> - if [f x = `Drop], ignores [x] @since 0.11 *) +val sublists_of_len : + ?last:('a list -> 'a list option) -> + ?offset:int -> + len:int -> + 'a list -> + 'a list list +(** [sublists_of_len n l] returns sub-lists of [l] that have length [n]. + By default, these sub-lists are non overlapping: + [sublists_of_len 2 [1;2;3;4;5;6]] returns [[1;2]; [3;4]; [5;6]]. + + See {!CCList.sublists_of_len} for more details. + + @since 1.5 *) + val pure : 'a -> 'a t val (<*>) : ('a -> 'b) t -> 'a t -> 'b t diff --git a/src/core/CCMap.ml b/src/core/CCMap.ml index 8caa6a11..d1342ed1 100644 --- a/src/core/CCMap.ml +++ b/src/core/CCMap.ml @@ -6,6 +6,8 @@ type 'a sequence = ('a -> unit) -> unit type 'a printer = Format.formatter -> 'a -> unit +module type OrderedType = Map.OrderedType + module type S = sig include Map.S @@ -23,6 +25,31 @@ module type S = sig [k] is removed from [m], and if the result is [Some v'] then [add k v' m] is returned. *) + val choose_opt : 'a t -> (key * 'a) option + (** Safe version of {!choose} + @since 1.5 *) + + val min_binding_opt : 'a t -> (key * 'a) option + (** Safe version of {!min_binding} + @since 1.5 *) + + val max_binding_opt : 'a t -> (key * 'a) option + (** Safe version of {!max_binding} + @since 1.5 *) + + val find_opt : key -> 'a t -> 'a option + (** Safe version of {!find} + @since 1.5 *) + + val find_first : (key -> bool) -> 'a t -> key * 'a + (** Find smallest binding satisfying the monotonic predicate. + See {!Map.S.find_first}. + @since 1.5 *) + + val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option + (** Safe version of {!find_first} + @since 1.5 *) + val merge_safe : f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) -> 'a t -> 'b t -> 'c t @@ -35,6 +62,7 @@ module type S = sig @since 1.4 *) val of_seq : (key * 'a) sequence -> 'a t + (** Same as {!of_list} *) val add_seq : 'a t -> (key * 'a) sequence -> 'a t (** @since 0.14 *) @@ -42,6 +70,10 @@ module type S = sig val to_seq : 'a t -> (key * 'a) sequence val of_list : (key * 'a) list -> 'a t + (** Build a map from the given list of bindings [k_i -> v_i], + added in order using {!add}. + If a key occurs several times, only its last binding + will be present in the result. *) val add_list : 'a t -> (key * 'a) list -> 'a t (** @since 0.14 *) @@ -62,12 +94,72 @@ module type S = sig end module Make(O : Map.OrderedType) = struct - include Map.Make(O) + module M = Map.Make(O) - let get k m = - try Some (find k m) + (* backport functions from recent stdlib. + they will be shadowed by inclusion of [S] if present. *) + + let union f a b = + M.merge + (fun k v1 v2 -> match v1, v2 with + | None, None -> assert false + | None, (Some _ as r) -> r + | Some _ as r, None -> r + | Some v1, Some v2 -> f k v1 v2) + a b + + let choose_opt m = + try Some (M.choose m) with Not_found -> None + let find_opt k m = + try Some (M.find k m) + with Not_found -> None + + let max_binding_opt m = + try Some (M.max_binding m) + with Not_found -> None + + let min_binding_opt m = + try Some (M.min_binding m) + with Not_found -> None + + exception Find_binding_exit + + let find_first_opt f m = + let res = ref None in + try + M.iter + (fun k v -> + if f k then ( + res := Some (k,v); + raise Find_binding_exit + )) + m; + None + with Find_binding_exit -> + !res + + let find_first f m = match find_first_opt f m with + | None -> raise Not_found + | Some (k,v) -> k, v + + (* linear time, must traverse the whole map… *) + let find_last_opt f m = + let res = ref None in + M.iter + (fun k v -> if f k then res := Some (k,v)) + m; + !res + + let find_last f m = match find_last_opt f m with + | None -> raise Not_found + | Some (k,v) -> k, v + + include M + + let get = find_opt + let get_or k m ~default = try find k m with Not_found -> default @@ -90,15 +182,6 @@ module Make(O : Map.OrderedType) = struct | Some v1, Some v2 -> f k (`Both (v1,v2))) a b - let union f a b = - merge - (fun k v1 v2 -> match v1, v2 with - | None, None -> assert false - | None, (Some _ as r) -> r - | Some _ as r, None -> r - | Some v1, Some v2 -> f k v1 v2) - a b - let add_seq m s = let m = ref m in s (fun (k,v) -> m := add k v !m); diff --git a/src/core/CCMap.mli b/src/core/CCMap.mli index 5804b5a6..14b689e7 100644 --- a/src/core/CCMap.mli +++ b/src/core/CCMap.mli @@ -9,6 +9,9 @@ type 'a sequence = ('a -> unit) -> unit type 'a printer = Format.formatter -> 'a -> unit +module type OrderedType = Map.OrderedType +(** @since 1.5 *) + module type S = sig include Map.S @@ -26,6 +29,31 @@ module type S = sig [k] is removed from [m], and if the result is [Some v'] then [add k v' m] is returned. *) + val choose_opt : 'a t -> (key * 'a) option + (** Safe version of {!choose} + @since 1.5 *) + + val min_binding_opt : 'a t -> (key * 'a) option + (** Safe version of {!min_binding} + @since 1.5 *) + + val max_binding_opt : 'a t -> (key * 'a) option + (** Safe version of {!max_binding} + @since 1.5 *) + + val find_opt : key -> 'a t -> 'a option + (** Safe version of {!find} + @since 1.5 *) + + val find_first : (key -> bool) -> 'a t -> key * 'a + (** Find smallest binding satisfying the monotonic predicate. + See {!Map.S.find_first}. + @since 1.5 *) + + val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option + (** Safe version of {!find_first} + @since 1.5 *) + val merge_safe : f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) -> 'a t -> 'b t -> 'c t diff --git a/src/core/CCOrd.ml b/src/core/CCOrd.ml index 23c96d83..0b38fcfb 100644 --- a/src/core/CCOrd.ml +++ b/src/core/CCOrd.ml @@ -25,6 +25,13 @@ let equiv i j = not (equiv 1 0) *) +(*$Q + Q.(pair int int) (fun (x,y) -> \ + (equiv x y) = (equiv y x)) + Q.(triple int int int) (fun (x,y,z) -> \ + if (equiv x y && equiv y z) then (equiv x z) else true) +*) + let int (x:int) y = Pervasives.compare x y let string (x:string) y = Pervasives.compare x y let bool (x:bool) y = Pervasives.compare x y diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index 6c0385e9..271c4823 100644 --- a/src/core/CCResult.ml +++ b/src/core/CCResult.ml @@ -10,6 +10,8 @@ type 'a printer = Format.formatter -> 'a -> unit (** {2 Basics} *) +include Result + type (+'good, +'bad) t = ('good, 'bad) Result.result = | Ok of 'good | Error of 'bad diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index c0e7b63e..a494081a 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -14,6 +14,9 @@ type 'a printer = Format.formatter -> 'a -> unit (** {2 Basics} *) +include module type of Result +(** @since 1.5 *) + type (+'good, +'bad) t = ('good, 'bad) Result.result = | Ok of 'good | Error of 'bad diff --git a/src/core/CCSet.ml b/src/core/CCSet.ml index cff89e3e..32ae1a31 100644 --- a/src/core/CCSet.ml +++ b/src/core/CCSet.ml @@ -6,9 +6,43 @@ type 'a sequence = ('a -> unit) -> unit type 'a printer = Format.formatter -> 'a -> unit +module type OrderedType = Set.OrderedType + module type S = sig include Set.S + val min_elt_opt : t -> elt option + (** Safe version of {!min_elt} + @since 1.5 *) + + val max_elt_opt : t -> elt option + (** Safe version of {!max_elt} + @since 1.5 *) + + val choose_opt : t -> elt option + (** Safe version of {!choose} + @since 1.5 *) + + val find_opt : elt -> t -> elt option + (** Safe version of {!find} + @since 1.5 *) + + val find_first : (elt -> bool) -> t -> elt + (** Find minimum element satisfying predicate + @since 1.5 *) + + val find_first_opt : (elt -> bool) -> t -> elt option + (** Safe version of {!find_first} + @since 1.5 *) + + val find_last : (elt -> bool) -> t -> elt + (** Find maximum element satisfying predicate + @since 1.5 *) + + val find_last_opt : (elt -> bool) -> t -> elt option + (** Safe version of {!find_last} + @since 1.5 *) + val of_seq : elt sequence -> t val add_seq : t -> elt sequence -> t @@ -17,6 +51,8 @@ module type S = sig val to_seq : t -> elt sequence val of_list : elt list -> t + (** Build a set from the given list of elements, + added in order using {!add}. *) val add_list : t -> elt list -> t (** @since 0.14 *) @@ -29,7 +65,60 @@ module type S = sig end module Make(O : Map.OrderedType) = struct - include Set.Make(O) + module S = Set.Make(O) + + (* backport functions from recent stdlib. + they will be shadowed by inclusion of [S] if present. *) + + let find_opt x s = + try Some (S.find x s) + with Not_found -> None + + let choose_opt s = + try Some (S.choose s) + with Not_found -> None + + let min_elt_opt s = + try Some (S.min_elt s) + with Not_found -> None + + let max_elt_opt s = + try Some (S.max_elt s) + with Not_found -> None + + exception Find_binding_exit + + let find_first_opt f m = + let res = ref None in + try + S.iter + (fun x -> + if f x then ( + res := Some x; + raise Find_binding_exit + )) + m; + None + with Find_binding_exit -> + !res + + let find_first f m = match find_first_opt f m with + | None -> raise Not_found + | Some x -> x + + (* linear time, must traverse the whole set… *) + let find_last_opt f m = + let res = ref None in + S.iter + (fun x -> if f x then res := Some x) + m; + !res + + let find_last f m = match find_last_opt f m with + | None -> raise Not_found + | Some x -> x + + include S let add_seq set seq = let set = ref set in diff --git a/src/core/CCSet.mli b/src/core/CCSet.mli index 4f36ccb7..6eebbb93 100644 --- a/src/core/CCSet.mli +++ b/src/core/CCSet.mli @@ -8,9 +8,44 @@ type 'a sequence = ('a -> unit) -> unit type 'a printer = Format.formatter -> 'a -> unit +module type OrderedType = Set.OrderedType +(** @since 1.5 *) + module type S = sig include Set.S + val min_elt_opt : t -> elt option + (** Safe version of {!min_elt} + @since 1.5 *) + + val max_elt_opt : t -> elt option + (** Safe version of {!max_elt} + @since 1.5 *) + + val choose_opt : t -> elt option + (** Safe version of {!choose} + @since 1.5 *) + + val find_opt : elt -> t -> elt option + (** Safe version of {!find} + @since 1.5 *) + + val find_first : (elt -> bool) -> t -> elt + (** Find minimum element satisfying predicate + @since 1.5 *) + + val find_first_opt : (elt -> bool) -> t -> elt option + (** Safe version of {!find_first} + @since 1.5 *) + + val find_last : (elt -> bool) -> t -> elt + (** Find maximum element satisfying predicate + @since 1.5 *) + + val find_last_opt : (elt -> bool) -> t -> elt option + (** Safe version of {!find_last} + @since 1.5 *) + val of_seq : elt sequence -> t val add_seq : t -> elt sequence -> t diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.ml similarity index 88% rename from src/core/CCString.cppo.ml rename to src/core/CCString.ml index 9e588999..9654760d 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.ml @@ -7,6 +7,30 @@ type 'a gen = unit -> 'a option type 'a sequence = ('a -> unit) -> unit type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] +(* compatibility implementations *) + +let init n f = + let buf = Bytes.init n f in + Bytes.unsafe_to_string buf + +let uppercase_ascii = String.map CCChar.uppercase_ascii + +let lowercase_ascii = String.map CCChar.lowercase_ascii + +let mapi f s = init (String.length s) (fun i -> f i s.[i]) + +let capitalize_ascii s = + mapi + (fun i c -> if i=0 then CCChar.uppercase_ascii c else c) + s + +let uncapitalize_ascii s = + mapi + (fun i c -> if i=0 then CCChar.lowercase_ascii c else c) + s + +(* standard implementations *) + include String module type S = sig @@ -38,20 +62,10 @@ let compare = String.compare let hash s = Hashtbl.hash s - #if OCAML_MAJOR >= 4 && OCAML_MINOR >= 2 - -let init = String.init - - #else - - let init n f = - let buf = Bytes.init n f in - Bytes.unsafe_to_string buf - - #endif - let length = String.length +let is_empty s = equal s "" + let rev s = let n = length s in init n (fun i -> s.[n-i-1]) @@ -307,6 +321,14 @@ let replace ?(which=`All) ~sub ~by s = Buffer.contents b module Split = struct + type drop_if_empty = { + first: bool; + last: bool; + } + + let no_drop = {first=false; last=false} + let default_drop = no_drop + type split_state = | SplitStop | SplitAt of int (* previous *) @@ -314,6 +336,7 @@ module Split = struct let rec _split ~by s state = match state with | SplitStop -> None | SplitAt prev -> _split_search ~by s prev + and _split_search ~by s prev = let j = Find.find ~pattern:by s ~start:prev in if j < 0 @@ -322,54 +345,64 @@ module Split = struct let _tuple3 x y z = x,y,z - let _mkgen ~by s k = + let _mkgen ~drop ~by s k = let state = ref (SplitAt 0) in let by = Find.compile by in - fun () -> + let rec next() = match _split ~by s !state with | None -> None + | Some (state', 0, 0) when drop.first -> state := state'; next() + | Some (_, i, 0) when drop.last && i = length s -> None | Some (state', i, len) -> state := state'; Some (k s i len) + in + next - let gen ~by s = _mkgen ~by s _tuple3 + let gen ?(drop=default_drop) ~by s = _mkgen ~drop ~by s _tuple3 - let gen_cpy ~by s = _mkgen ~by s String.sub + let gen_cpy ?(drop=default_drop) ~by s = _mkgen ~drop ~by s String.sub - let _mklist ~by s k = + let _mklist ~drop ~by s k = let by = Find.compile by in let rec build acc state = match _split ~by s state with | None -> List.rev acc + | Some (state',0,0) when drop.first -> build acc state' + | Some (_, i, 0) when drop.last && i=length s -> List.rev acc | Some (state', i, len) -> build (k s i len ::acc) state' in build [] (SplitAt 0) - let list_ ~by s = _mklist ~by s _tuple3 + let list_ ?(drop=default_drop) ~by s = _mklist ~drop ~by s _tuple3 - let list_cpy ~by s = _mklist ~by s String.sub + let list_cpy ?(drop=default_drop) ~by s = _mklist ~drop ~by s String.sub - let _mkklist ~by s k = + let _mkklist ~drop ~by s k = let by = Find.compile by in let rec make state () = match _split ~by s state with | None -> `Nil + | Some (state', 0, 0) when drop.first -> make state' () + | Some (_, i, 0) when drop.last && i=length s -> `Nil | Some (state', i, len) -> `Cons (k s i len , make state') in make (SplitAt 0) - let klist ~by s = _mkklist ~by s _tuple3 + let klist ?(drop=default_drop) ~by s = _mkklist ~drop ~by s _tuple3 - let klist_cpy ~by s = _mkklist ~by s String.sub + let klist_cpy ?(drop=default_drop) ~by s = _mkklist ~drop ~by s String.sub - let _mkseq ~by s f k = + let _mkseq ~drop ~by s f k = let by = Find.compile by in let rec aux state = match _split ~by s state with | None -> () + | Some (state', 0, 0) when drop.first -> aux state' + | Some (_, i, 0) when drop.last && i=length s -> () | Some (state', i, len) -> k (f s i len); aux state' in aux (SplitAt 0) - let seq ~by s = _mkseq ~by s _tuple3 - let seq_cpy ~by s = _mkseq ~by s String.sub + let seq ?(drop=default_drop) ~by s = _mkseq ~drop ~by s _tuple3 + let seq_cpy ?(drop=default_drop) ~by s = _mkseq ~drop ~by s String.sub let left_exn ~by s = let i = find ~sub:by s in @@ -391,9 +424,9 @@ module Split = struct end let split_on_char c s: _ list = - Split.list_cpy ~by:(String.make 1 c) s + Split.list_cpy ~drop:Split.no_drop ~by:(String.make 1 c) s -let split = Split.list_cpy +let split ~by s = Split.list_cpy ~by s let compare_versions a b = let of_int s = try Some (int_of_string s) with _ -> None in @@ -611,23 +644,43 @@ let of_array a = let to_array s = Array.init (String.length s) (fun i -> s.[i]) -let lines_gen s = Split.gen_cpy ~by:"\n" s +let lines_gen s = Split.gen_cpy ~drop:{Split.first=false; last=true} ~by:"\n" s -let lines s = Split.list_cpy ~by:"\n" s +let lines s = Split.list_cpy ~drop:{Split.first=false; last=true} ~by:"\n" s -let concat_gen ~sep g = +let concat_gen_buf ~sep g : Buffer.t = let b = Buffer.create 256 in let rec aux ~first () = match g () with - | None -> Buffer.contents b + | None -> b | Some s -> if not first then Buffer.add_string b sep; Buffer.add_string b s; aux ~first:false () in aux ~first:true () -let unlines l = String.concat "\n" l +let concat_gen ~sep g = + let buf = concat_gen_buf ~sep g in + Buffer.contents buf -let unlines_gen g = concat_gen ~sep:"\n" g +let unlines l = + let len = List.fold_left (fun n s -> n + 1 + String.length s) 0 l in + let buf = Bytes.create len in + let rec aux_blit i l = match l with + | [] -> + assert (i=len); + Bytes.to_string buf + | s :: tail -> + let len_s = String.length s in + Bytes.blit_string s 0 buf i len_s; + Bytes.set buf (i+len_s) '\n'; + aux_blit (i+len_s+1) tail + in + aux_blit 0 l + +let unlines_gen g = + let buf = concat_gen_buf ~sep:"\n" g in + Buffer.add_char buf '\n'; + Buffer.contents buf let set s i c = if i<0 || i>= String.length s then invalid_arg "CCString.set"; @@ -635,32 +688,6 @@ let set s i c = let iter = String.iter - #if OCAML_MAJOR >= 4 - -let map = String.map -let iteri = String.iteri - - #else - - let map f s = init (length s) (fun i -> f s.[i]) - -let iteri f s = - for i = 0 to String.length s - 1 do - f i s.[i] - done - - #endif - - #if OCAML_MAJOR >= 4 && OCAML_MINOR >= 2 - -let mapi = String.mapi - - #else - - let mapi f s = init (length s) (fun i -> f i s.[i]) - - #endif - let filter_map f s = let buf = Buffer.create (String.length s) in iter @@ -749,32 +776,6 @@ let exists2 p s1 s2 = (** {2 Ascii functions} *) - #if OCAML_MAJOR >= 4 && OCAML_MINOR >= 3 - -let capitalize_ascii = String.capitalize_ascii -let uncapitalize_ascii = String.uncapitalize_ascii -let uppercase_ascii = String.uppercase_ascii -let lowercase_ascii = String.lowercase_ascii - - #else - - let capitalize_ascii s = - mapi - (fun i c -> if i=0 then CCChar.uppercase_ascii c else c) - s - - -let uncapitalize_ascii s = - mapi - (fun i c -> if i=0 then CCChar.lowercase_ascii c else c) - s - -let uppercase_ascii = map CCChar.uppercase_ascii - -let lowercase_ascii = map CCChar.lowercase_ascii - - #endif - let equal_caseless s1 s2: bool = let char_lower c = if c >= 'A' && c <= 'Z' diff --git a/src/core/CCString.mli b/src/core/CCString.mli index cb9bbb4f..5852b3ae 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -54,6 +54,9 @@ val equal : string -> string -> bool val compare : string -> string -> int +val is_empty : string -> bool +(** @since 1.5 *) + val hash : string -> int val init : int -> (int -> char) -> string @@ -278,6 +281,14 @@ 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 *) @@ -290,9 +301,20 @@ 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 -> unlines (lines s) = s) - Q.printable_string (fun s -> unlines_gen (lines_gen s) = s) + 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 @@ -474,7 +496,26 @@ end (** {2 Splitting} *) module Split : sig - val list_ : by:string -> string -> (string*int*int) list + (** Specification of what to do with empty blocks, as in [split ~by:"-" "-a-b-"]. + + - [{first=false; last=false}] will return [""; "a"; "b"; ""] + - [{first=true; last=false}] will return ["a"; "b" ""] + - [{first=false; last=true}] will return [""; "a"; "b"] + - [{first=true; last=true}] will return ["a"; "b"] + + The default value of all remaining functions is [Drop_none]. + @since 1.5 + *) + type drop_if_empty = { + first: bool; + last: bool; + } + + val no_drop : drop_if_empty + (** Do not drop any group, even empty and on borders + @since 1.5 *) + + val list_ : ?drop:drop_if_empty -> by:string -> string -> (string*int*int) list (** Eplit the given string along the given separator [by]. Should only be used with very small separators, otherwise use {!Containers_string.KMP}. @@ -483,18 +524,18 @@ module Split : sig a string from the slice. @raise Failure if [by = ""] *) - val gen : by:string -> string -> (string*int*int) gen + val gen : ?drop:drop_if_empty -> by:string -> string -> (string*int*int) gen - val seq : by:string -> string -> (string*int*int) sequence + val seq : ?drop:drop_if_empty -> by:string -> string -> (string*int*int) sequence - val klist : by:string -> string -> (string*int*int) klist + val klist : ?drop:drop_if_empty -> by:string -> string -> (string*int*int) klist (** {6 Copying functions} Those split functions actually copy the substrings, which can be more convenient but less efficient in general *) - val list_cpy : by:string -> string -> string list + val list_cpy : ?drop:drop_if_empty -> by:string -> string -> string list (*$T Split.list_cpy ~by:"," "aa,bb,cc" = ["aa"; "bb"; "cc"] @@ -502,11 +543,11 @@ module Split : sig Split.list_cpy ~by:" " "hello world aie" = ["hello"; ""; "world"; "aie"] *) - val gen_cpy : by:string -> string -> string gen + val gen_cpy : ?drop:drop_if_empty -> by:string -> string -> string gen - val seq_cpy : by:string -> string -> string sequence + val seq_cpy : ?drop:drop_if_empty -> by:string -> string -> string sequence - val klist_cpy : by:string -> string -> string klist + val klist_cpy : ?drop:drop_if_empty -> by:string -> string -> string klist val left : by:string -> string -> (string * string) option (** Split on the first occurrence of [by] from the leftmost part of diff --git a/src/core/containers.ml b/src/core/containers.ml index 6c3234b5..cb3f4814 100644 --- a/src/core/containers.ml +++ b/src/core/containers.ml @@ -7,21 +7,12 @@ module Array = CCArray module ArrayLabels = CCArrayLabels module Array_slice = CCArray_slice module Bool = CCBool -module Char = struct - include Char - include (CCChar : module type of CCChar with type t := t) -end +module Char = Char module Equal = CCEqual module Float = CCFloat -module Format = struct - include Format - include CCFormat -end +module Format = CCFormat module Fun = CCFun module Hash = CCHash -module Int = CCInt -module Int64 = CCInt64 -module IO = CCIO (** @since 0.14 *) module Hashtbl = struct @@ -35,25 +26,19 @@ module Hashtbl = struct module Make' = CCHashtbl.Make end module Heap = CCHeap +module Int = CCInt +module Int64 = CCInt64 +module IO = CCIO module List = CCList module ListLabels = CCListLabels -module Map = struct - module type OrderedType = Map.OrderedType - include CCMap -end +module Map = CCMap module Option = CCOpt module Ord = CCOrd module Pair = CCPair module Parse = CCParse module Random = CCRandom module Ref = CCRef -module Result = struct - include Result - include CCResult -end -module Set = struct - module type OrderedType = Set.OrderedType - include CCSet -end +module Result = CCResult +module Set = CCSet module String = CCString module Vector = CCVector diff --git a/src/data/CCCache.ml b/src/data/CCCache.ml index 3437d493..ec956458 100644 --- a/src/data/CCCache.ml +++ b/src/data/CCCache.ml @@ -30,6 +30,15 @@ type ('a, 'b) callback = in_cache:bool -> 'a -> 'b -> unit let clear c = c.clear () +let add c x y = + try + (* check that x is not bound (see invariants) *) + let _ = c.get x in + false + with Not_found -> + c.set x y; + true + let default_callback_ ~in_cache:_ _ _ = () let with_cache ?(cb=default_callback_) c f x = diff --git a/src/data/CCCache.mli b/src/data/CCCache.mli index 1caac2ed..28c287b2 100644 --- a/src/data/CCCache.mli +++ b/src/data/CCCache.mli @@ -71,6 +71,11 @@ val size : (_,_) t -> int val iter : ('a,'b) t -> ('a -> 'b -> unit) -> unit (** Iterate on cached values. Should yield [size cache] pairs. *) +val add : ('a, 'b) t -> 'a -> 'b -> bool +(** Manually add a cached value. Returns [true] if the value has succesfully + been added, and [false] if the value was already bound. + @since 1.5 *) + val dummy : ('a,'b) t (** Dummy cache, never stores any value *) diff --git a/src/data/CCImmutArray.ml b/src/data/CCImmutArray.ml index d85b9909..1165b6af 100644 --- a/src/data/CCImmutArray.ml +++ b/src/data/CCImmutArray.ml @@ -27,6 +27,8 @@ let set a n x = a'.(n) <- x; a' +let sub = Array.sub (* Would this not be better implemented with CCArray_slice *) + let map = Array.map let mapi = Array.mapi diff --git a/src/data/CCImmutArray.mli b/src/data/CCImmutArray.mli index 77e0666d..a58dc35c 100644 --- a/src/data/CCImmutArray.mli +++ b/src/data/CCImmutArray.mli @@ -36,6 +36,15 @@ val get : 'a t -> int -> 'a val set : 'a t -> int -> 'a -> 'a t (** Copy the array and modify its copy *) +val sub : 'a t -> int -> int -> 'a t +(** [sub a start len] returns a fresh array of length len, containing the elements + from [start] to [pstart + len - 1] of array a. + + Raises [Invalid_argument "Array.sub"] if [start] and [len] do not designate a + valid subarray of a; that is, if start < 0, or len < 0, or start + len > Array.length a. + + @since 1.5 *) + val map : ('a -> 'b) -> 'a t -> 'b t val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index 4b4b60e5..d7f8b9f7 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -593,6 +593,13 @@ module Make(W : WORD) in List.iter (explore ~dir k) l' + let _list_eq l1 l2 = + try List.for_all2 (fun x y -> W.compare x y = 0) l1 l2 + with Invalid_argument _ -> false + + let _key_to_list key = + List.rev (_seq_append_list_rev [] (W.to_seq key)) + (* range above (if [above = true]) or below a threshold . [p c c'] must return [true] if [c'], in the tree, meets some criterion w.r.t [c] which is a part of the key. *) @@ -646,7 +653,7 @@ module Make(W : WORD) _iter_prefix ~prefix (fun key' v -> k (key', v)) t | Some (Node (Some v, _), prefix), Below -> (* yield the value for key *) - assert (W.of_list (prefix []) = key); + assert (_list_eq (prefix []) (_key_to_list key)); k (key, v) | Some _, _ | None, _ -> () @@ -673,6 +680,21 @@ module Make(W : WORD) (T.below [1;1] t1 |> Sequence.to_list) *) + (* NOTE: Regression test. See #158 *) + (*$T + let module TPoly = Make (struct \ + type t = (unit -> char) list \ + type char_ = char \ + let compare = compare \ + let to_seq a k = List.iter (fun c -> k (c ())) a \ + let of_list l = List.map (fun c -> (fun () -> c)) l \ + end) \ + in \ + let trie = TPoly.of_list [[fun () -> 'a'], 1; [fun () -> 'b'], 2] in \ + ignore (TPoly.below [fun () -> 'a'] trie |> Sequence.to_list); \ + true + *) + (*$Q & ~count:30 Q.(list_of_size Gen.(0--100) (pair printable_string small_int)) (fun l -> \ let t = S.of_list l in \ diff --git a/src/top/containers_top.ml b/src/top/containers_top.ml index 4f6854c0..4eeca3ab 100644 --- a/src/top/containers_top.ml +++ b/src/top/containers_top.ml @@ -17,13 +17,11 @@ let install_printers = List.iter install_printer let () = install_printers - [ "CCHashtbl.pp" - ; "CCBV.pp" - ; "CCDeque.pp" - ; "CCFQueue.pp" - ; "CCIntMap.pp" - ; "CCPersistentArray.pp" - ; "CCBigstring.pp" - ; "CCKTree.pp" - ; "CCSexpM.pp" + [ "CCHashtbl.print" + ; "CCBV.print" + ; "CCDeque.print" + ; "CCFQueue.print" + ; "CCIntMap.print" + ; "CCPersistentArray.print" + ; "CCSexp.pp" ]