simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2026-01-24 10:06:40 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch 'master' into stable for 1.5

Browse source
This commit is contained in:
Simon Cruanes 2018-01-02 18:14:49 +01:00
commit 46e41f7f84
36 changed files with 695 additions and 2015 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.merlin
View file

@ -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

37
.travis.yml Normal file
View file

@ -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

1
AUTHORS.adoc
View file

@ -23,3 +23,4 @@
- Leonid Rozenberg (@rleonid)
- Bikal Gurung (@bikalgurung)
- Fabian Hemmer (copy)
- Maciej Woś (@lostman)

22
CHANGELOG.adoc
View file

@ -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`

2
README.adoc
View file

@ -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::[]

2
_oasis
View file

@ -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

5
_tags
View file

@ -117,6 +117,7 @@ true: annot, bin_annot
<src/threads/*.ml{,i}>: thread
<src/core/CCVector.cmx> or <src/core/CCString.cmx>: inline(25)
<src/data/CCFlatHashtbl.cm*> or <src/data/CCHashTrie.cm*> or <src/data/CCPersistent*>: inline(15)
<src/**/*.ml> and not <src/misc/*.ml>: warn_A, warn(-4), warn(-44)
true: no_alias_deps, safe_string, short_paths
<src/core/CCMap.*> or <src/core/CCSet.*> or <src/core/CCList.*>: warn(-32)
<src/**/*.ml> and not <src/misc/*.ml>: warn(+a-4-44-58-60@8)
true: no_alias_deps, safe_string, short_paths, color(always)
<src/**/*Labels.cm*>: nolabels

3
doc/intro.txt
View file

@ -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)}

34
myocamlbuild.ml
View file

@ -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] ;

1
opam
View file

@ -25,7 +25,6 @@ depends: [
"ocamlfind" {build}
"base-bytes"
"result"
"cppo" {build}
"ocamlbuild" {build}
]
depopts: [

617
src/core/CCArrayLabels.ml
View file

@ -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<Array.length a
then Some (Array.unsafe_get a i)
else None
(*$=
(Some 1) (get_safe [|1;2;3|] 0)
(Some 2) (get_safe [|1;2;3|] 1)
(Some 3) (get_safe [|1;2;3|] 2)
None (get_safe [|1;2;3|] 4)
None (get_safe [|1;2;3|] max_int)
None (get_safe [|1;2;3|] ~-1)
None (get_safe [|1;2;3|] ~-42)
*)
let set = Array.set
let fold = Array.fold_left
let foldi f acc a =
let rec aux acc i =
if i = Array.length a then acc else aux (f acc i a.(i)) (i+1)
in
aux acc 0
let fold_while f acc a =
let rec fold_while_i f acc i =
if i < Array.length a then
let acc, cont = f acc a.(i) in
match cont with
| `Stop -> 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<i then ()
else if cmp (A.get a k) (A.get a (k+1)) > 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<j then (
insert_ a i (k-1);
sort_insertion_rec a i j (k+1)
)
in
(* insertion sort, for small slices *)
let sort_insertion a i j =
if j-i > 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

2
src/core/CCBool.mli
View file

@ -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

22
src/core/CCFun.cppo.ml → src/core/CCFun.ml
View file

@ -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)

1
src/core/CCHash.ml
View file

@ -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

6
src/core/CCHash.mli
View file

@ -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

5
src/core/CCHeap.ml
View file

@ -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

93
src/core/CCList.ml
View file

@ -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 =

56
src/core/CCList.mli
View file

@ -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 *)

1184
src/core/CCListLabels.ml
View file

File diff suppressed because it is too large Load diff

14
src/core/CCListLabels.mli
View file

@ -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

107
src/core/CCMap.ml
View file

@ -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);

28
src/core/CCMap.mli
View file

@ -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

7
src/core/CCOrd.ml
View file

@ -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

2
src/core/CCResult.ml
View file

@ -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

3
src/core/CCResult.mli
View file

@ -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

91
src/core/CCSet.ml
View file

@ -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

35
src/core/CCSet.mli
View file

@ -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

171
src/core/CCString.cppo.ml → src/core/CCString.ml
View file

@ -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'

61
src/core/CCString.mli
View file

@ -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

31
src/core/containers.ml
View file

@ -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

9
src/data/CCCache.ml
View file

@ -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 =

5
src/data/CCCache.mli
View file

@ -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 *)

2
src/data/CCImmutArray.ml
View file

@ -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

9
src/data/CCImmutArray.mli
View file

@ -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

24
src/data/CCTrie.ml
View file

@ -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 \

16
src/top/containers_top.ml
View file

@ -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"
]