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

Merge branch 'master' into stable for 1.3

Browse source
This commit is contained in:
Simon Cruanes 2017-07-29 18:09:09 +02:00
commit f24d983b04
38 changed files with 1353 additions and 578 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
AUTHORS.adoc
View file

@ -20,4 +20,5 @@
- David Sheets (@dsheets)
- Glenn Slotte (glennsl)
- @LemonBoy
- Leonid Rozenberg (@rleonid)
- Leonid Rozenberg (@rleonid)
- Bikal Gurung (@bikalgurung)

18
CHANGELOG.adoc
View file

@ -1,5 +1,23 @@
= Changelog
== 1.3
- deprecate `CCBool.negate`
- add `CCString.compare_natural` (closes #146)
- add callbacks in `CCCache.with_cache{,_rec}` (closes #140)
- tail-rec `CCList.split` (by @bikalgurung, see #138)
- change `CCRingBuffer.peek_{front,back}` to return options (closes #127)
- add `CCRingBuffer.is_full`
- add `CCArray.find_map{,_i}`, deprecated older names (closes #129)
- add `CCList.{keep,all}_{some,ok}` (closes #124)
- large refactor of `CCSimple_queue` (close #125)
- add `CCSimple_queue` to containers.data
- small change for consistency in `CCIntMap`
- bugfix in `CCRingBuffer.skip`, and corresponding tests
- cleanup and refactor of `CCRingBuffer` (see #126). Add strong tests.
- add rich testsuite to `CCIntMap`, based on @jmid's work
== 1.2
- make many modules extensions of stdlib (close #109)

55
README.adoc
View file

@ -4,6 +4,8 @@
A modular, clean and powerful extension of the OCaml standard library.
https://c-cube.github.io/ocaml-containers/last/[(Jump to the current API documentation)].
Containers is an extension of OCaml's standard library (under BSD license)
focused on data structures, combinators and iterators, without dependencies on
unix, str or num. Every module is independent and is prefixed with 'CC' in the
@ -91,7 +93,7 @@ and <<tutorial,the tutorial below>> for a gentle introduction.
== Documentation
In general, see http://c-cube.github.io/ocaml-containers/ or
In general, see http://c-cube.github.io/ocaml-containers/last/ or
http://cedeela.fr/~simon/software/containers for the **API documentation**.
Some examples can be found link:doc/containers.adoc[there].
@ -135,18 +137,54 @@ To build the small benchmarking suite (requires https://github.com/chris00/ocaml
== Contributing
PRs on github are welcome (patches by email too, if you prefer so).
PRs on github are very welcome (patches by email too, if you prefer so).
A few guidelines:
[[first-time-contribute]]
=== First-Time Contributors
Assuming your are in a clone of the repository:
. Some dependencies are required, you'll need
`opam install benchmark qcheck qtest sequence`.
. run `make devel` to enable everything (including tests).
. make your changes, commit, push, and open a PR.
. use `make test` without moderation! It must pass before a PR
is merged. There are around 900 tests right now, and new
features should come with their own tests.
If you feel like writing new tests, that is totally worth a PR
(and my gratefulness).
=== General Guidelines
A few guidelines to follow the philosophy of containers:
- no dependencies between basic modules (even just for signatures);
- add `@since` tags for new functions;
- add tests if possible (using `qtest`).
- add tests if possible (using https://github.com/vincent-hugot/iTeML/[qtest]). There are numerous inline tests already,
to see what it looks like search for comments starting with `(*$`
in source files.
It is helpful to run `make devel` to enable everything. Some dependencies
are required, you'll need `opam install benchmark qcheck qtest sequence`.
=== For Total Beginners
Powered by image:http://oasis.forge.ocamlcore.org/oasis-badge.png[alt="OASIS", style="border: none;", link="http://oasis.forge.ocamlcore.org/"]
Thanks for wanting to contribute!
To contribute a change, here are the steps (roughly):
. click "fork" on https://github.com/c-cube/ocaml-containers on the top right of the page. This will create a copy of the repository on your own github account.
. click the big green "clone or download" button, with "SSH". Copy the URL (which should look like `git@github.com:<your username>/ocaml-containers.git`) into a terminal to enter the command:
+
[source,sh]
----
$ git clone git@github.com:<your username>/ocaml-containers.git
----
+
. then, `cd` into the newly created directory.
. make the changes you want. See <<first-time-contribute>> for
more details about what to do in particular.
. use `git add` and `git commit` to commit these changes.
. `git push origin master` to push the new change(s) onto your
copy of the repository
. on github, open a "pull request" (PR). Et voilà !
[[tutorial]]
== Tutorial
@ -441,3 +479,6 @@ printer:: `'a printer = Format.formatter -> 'a -> unit` is a pretty-printer
=== Extended Documentation
See link:doc/containers.adoc[the extended documentation] for more examples.
Powered by image:http://oasis.forge.ocamlcore.org/oasis-badge.png[alt="OASIS", style="border: none;", link="http://oasis.forge.ocamlcore.org/"]

4
_oasis
View file

@ -1,6 +1,6 @@
OASISFormat: 0.4
Name: containers
Version: 1.2
Version: 1.3
Homepage: https://github.com/c-cube/ocaml-containers
Authors: Simon Cruanes
License: BSD-2-clause
@ -67,7 +67,7 @@ Library "containers_data"
CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl,
CCMixmap, CCRingBuffer, CCIntMap, CCPersistentArray,
CCMixset, CCGraph, CCHashSet, CCBitField,
CCHashTrie, CCWBTree, CCRAL,
CCHashTrie, CCWBTree, CCRAL, CCSimple_queue,
CCImmutArray, CCHet, CCZipper
BuildDepends: bytes
# BuildDepends: bytes, bisect_ppx

8
benchs/run_benchs.ml
View file

@ -20,16 +20,24 @@ module L = struct
let f_ x = x+1
let rec map_naive f l = match l with
| [] -> []
| x :: tail ->
let y = f x in
y :: map_naive f tail
let bench_map ?(time=2) n =
let l = CCList.(1 -- n) in
let ral = CCRAL.of_list l in
let map_naive () = ignore (try List.map f_ l with Stack_overflow -> [])
and map_naive2 () = ignore (try map_naive f_ l with Stack_overflow -> [])
and map_tailrec () = ignore (List.rev (List.rev_map f_ l))
and ccmap () = ignore (CCList.map f_ l)
and ralmap () = ignore (CCRAL.map ~f:f_ ral)
in
B.throughputN time ~repeat
[ "List.map", map_naive, ()
; "List.map(inline)", map_naive2, ()
; "List.rev_map o rev", map_tailrec, ()
; "CCList.map", ccmap, ()
; "CCRAL.map", ralmap, ()

3
containers.odocl
View file

@ -1,5 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: 97e963a89adef885748c84195b76d95c)
# DO NOT EDIT (digest: fe2373b07664be05f7322781403afad6)
src/core/CCVector
src/core/CCHeap
src/core/CCList
@ -53,6 +53,7 @@ src/data/CCBitField
src/data/CCHashTrie
src/data/CCWBTree
src/data/CCRAL
src/data/CCSimple_queue
src/data/CCImmutArray
src/data/CCHet
src/data/CCZipper

1
doc/intro.txt
View file

@ -93,6 +93,7 @@ CCPersistentArray
CCPersistentHashtbl
CCRAL
CCRingBuffer
CCSimple_queue
CCTrie
CCWBTree
}

20
myocamlbuild.ml
View file

@ -1,5 +1,5 @@
(* OASIS_START *)
(* DO NOT EDIT (digest: d0913c9409d93aeda14a31d6f9ebb3b2) *)
(* DO NOT EDIT (digest: 9ebeddeee0d56b1f8c98544fabcbbd9b) *)
module OASISGettext = struct
(* # 22 "src/oasis/OASISGettext.ml" *)
@ -105,10 +105,7 @@ module OASISString = struct
ok := false;
incr str_idx
done;
if !what_idx = String.length what then
true
else
false
!what_idx = String.length what
let strip_starts_with ~what str =
@ -131,10 +128,7 @@ module OASISString = struct
ok := false;
decr str_idx
done;
if !what_idx = -1 then
true
else
false
!what_idx = -1
let strip_ends_with ~what str =
@ -440,7 +434,7 @@ module OASISExpr = struct
end
# 443 "myocamlbuild.ml"
# 437 "myocamlbuild.ml"
module BaseEnvLight = struct
(* # 22 "src/base/BaseEnvLight.ml" *)
@ -520,7 +514,7 @@ module BaseEnvLight = struct
end
# 523 "myocamlbuild.ml"
# 517 "myocamlbuild.ml"
module MyOCamlbuildFindlib = struct
(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
@ -881,7 +875,7 @@ module MyOCamlbuildBase = struct
end
# 884 "myocamlbuild.ml"
# 878 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
{
@ -921,7 +915,7 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
# 925 "myocamlbuild.ml"
# 919 "myocamlbuild.ml"
(* OASIS_STOP *)
let doc_intro = "doc/intro.txt" ;;

10
opam
View file

@ -43,12 +43,8 @@ available: [ocaml-version >= "4.01.0"]
dev-repo: "https://github.com/c-cube/ocaml-containers.git"
bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"
post-messages: [
"Major release, with breaking changes. The APIs are more focused,
more consistent, and some sub-libraries were removed or merged into the core
ones.
"Small release with many bugfixes and a few new functions.
A summary of the changes can be found at
https://github.com/c-cube/ocaml-containers/issues/84
and in the changelog
https://github.com/c-cube/ocaml-containers/blob/1.0/CHANGELOG.adoc"
A summary hub.com/c-cube/ocaml-containers/issues/84
changelog: https://github.com/c-cube/ocaml-containers/blob/1.3/CHANGELOG.adoc"
]

60
setup.ml
View file

@ -1,9 +1,9 @@
(* setup.ml generated for the first time by OASIS v0.4.4 *)
(* OASIS_START *)
(* DO NOT EDIT (digest: fdb4a0fff7e0145854a42105c9c8afcf) *)
(* DO NOT EDIT (digest: a62cfaee59320a25dee6d9bbad9cd339) *)
(*
Regenerated by OASIS v0.4.8
Regenerated by OASIS v0.4.10
Visit http://oasis.forge.ocamlcore.org for more information and
documentation about functions used in this file.
*)
@ -112,10 +112,7 @@ module OASISString = struct
ok := false;
incr str_idx
done;
if !what_idx = String.length what then
true
else
false
!what_idx = String.length what
let strip_starts_with ~what str =
@ -138,10 +135,7 @@ module OASISString = struct
ok := false;
decr str_idx
done;
if !what_idx = -1 then
true
else
false
!what_idx = -1
let strip_ends_with ~what str =
@ -3162,7 +3156,7 @@ module OASISFileUtil = struct
end
# 3165 "setup.ml"
# 3159 "setup.ml"
module BaseEnvLight = struct
(* # 22 "src/base/BaseEnvLight.ml" *)
@ -3242,7 +3236,7 @@ module BaseEnvLight = struct
end
# 3245 "setup.ml"
# 3239 "setup.ml"
module BaseContext = struct
(* # 22 "src/base/BaseContext.ml" *)
@ -5665,7 +5659,7 @@ module BaseCompat = struct
end
# 5668 "setup.ml"
# 5662 "setup.ml"
module InternalConfigurePlugin = struct
(* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *)
@ -6016,17 +6010,14 @@ module InternalInstallPlugin = struct
let install =
let in_destdir =
let in_destdir fn =
try
let destdir =
destdir ()
in
(* Practically speaking destdir is prepended
* at the beginning of the target filename
*)
fun fn -> destdir^fn
(* Practically speaking destdir is prepended at the beginning of the
target filename
*)
(destdir ())^fn
with PropList.Not_set _ ->
fun fn -> fn
fn
in
let install_file ~ctxt ?(prepend_destdir=true) ?tgt_fn src_file envdir =
@ -6471,7 +6462,7 @@ module InternalInstallPlugin = struct
end
# 6474 "setup.ml"
# 6465 "setup.ml"
module OCamlbuildCommon = struct
(* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
@ -6828,11 +6819,10 @@ module OCamlbuildDocPlugin = struct
run_ocamlbuild ~ctxt (index_html :: run.extra_args) argv;
List.iter
(fun glb ->
BaseBuilt.register
~ctxt
BaseBuilt.BDoc
cs.cs_name
[OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb)])
match OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb) with
| (_ :: _) as filenames ->
BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name [filenames]
| [] -> ())
["*.html"; "*.css"]
@ -6844,7 +6834,7 @@ module OCamlbuildDocPlugin = struct
end
# 6847 "setup.ml"
# 6837 "setup.ml"
module CustomPlugin = struct
(* # 22 "src/plugins/custom/CustomPlugin.ml" *)
@ -6976,7 +6966,7 @@ module CustomPlugin = struct
end
# 6979 "setup.ml"
# 6969 "setup.ml"
open OASISTypes;;
let setup_t =
@ -7051,7 +7041,7 @@ let setup_t =
{
oasis_version = "0.4";
ocaml_version = Some (OASISVersion.VGreaterEqual "4.00.1");
version = "1.2";
version = "1.3";
license =
OASISLicense.DEP5License
(OASISLicense.DEP5Unit
@ -7742,6 +7732,7 @@ let setup_t =
"CCHashTrie";
"CCWBTree";
"CCRAL";
"CCSimple_queue";
"CCImmutArray";
"CCHet";
"CCZipper"
@ -8908,8 +8899,9 @@ let setup_t =
plugin_data = []
};
oasis_fn = Some "_oasis";
oasis_version = "0.4.8";
oasis_digest = Some "\214\023V\1858'\142!X\\k\202\255w\167\213";
oasis_version = "0.4.10";
oasis_digest =
Some "\164\233\1428\169\160\007\155\182\180\021s\193\n\134-";
oasis_exec = None;
oasis_setup_args = [];
setup_update = false
@ -8917,7 +8909,7 @@ let setup_t =
let setup () = BaseSetup.setup setup_t;;
# 8921 "setup.ml"
# 8913 "setup.ml"
let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t
open BaseCompat.Compat_0_4
(* OASIS_STOP *)

10
src/core/CCArray.ml
View file

@ -212,11 +212,13 @@ let rec find_aux f a i =
| Some _ as res -> res
| None -> find_aux f a (i+1)
let find f a =
find_aux (fun _ -> f ) a 0
let find_map f a = find_aux (fun _ -> f ) a 0
let findi f a =
find_aux f a 0
let find = find_map
let find_map_i f a = find_aux f a 0
let findi = find_map_i
let find_idx p a =
find_aux (fun i x -> if p x then Some (i,x) else None) a 0

40
src/core/CCArray.mli
View file

@ -71,30 +71,44 @@ val sorted : ('a -> 'a -> int) -> 'a t -> 'a array
val sort_indices : ('a -> 'a -> int) -> 'a t -> int array
(** [sort_indices cmp a] returns a new array [b], with the same length as [a],
such that [b.(i)] is the index of the [i]-th element of [a] in [sort cmp a].
In other words, [map (fun i -> a.(i)) (sort_indices a) = sorted cmp a].
[a] is not modified.
such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a]
appears in [a]. [a] is not modified.
In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a].
[sort_indices] yields the inverse permutation of {!sort_ranking}.
@since 1.0 *)
val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array
(** [sort_ranking cmp a] returns a new array [b], with the same length as [a],
such that [b.(i)] is the position in [sorted cmp a] of the [i]-th
element of [a].
[a] is not modified.
such that [b.(i)] is the index at which the [i]-the element of [a] appears
in [sorted cmp a]. [a] is not modified.
In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a].
In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a].
[sort_ranking] yields the inverse permutation of {!sort_indices}.
Without duplicates, we also have
In the absence of duplicate elements in [a], we also have
[lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)]
@since 1.0 *)
val find_map : ('a -> 'b option) -> 'a t -> 'b option
(** [find_map f a] returns [Some y] if there is an element [x] such
that [f x = Some y], else it returns [None]
@since 1.3
*)
val find : ('a -> 'b option) -> 'a t -> 'b option
(** [find f a] returns [Some y] if there is an element [x] such
that [f x = Some y], else it returns [None] *)
(** Alias to {!find_map}
@deprecated since 1.3 *)
val find_map_i : (int -> 'a -> 'b option) -> 'a t -> 'b option
(** Like {!find_map}, but also pass the index to the predicate function.
@since 1.3 *)
val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option
(** Like {!find}, but also pass the index to the predicate function.
@since 0.3.4 *)
(** Alias to {!find_map_i}
@since 0.3.4
@deprecated since 1.3 *)
val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
@ -107,7 +121,7 @@ val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option
[Some i] ([i] the index of the key) otherwise *)
val lookup_exn : ?cmp:'a ord -> 'a -> 'a t -> int
(** Same as {!lookup_exn}, but
(** Same as {!lookup}, but
@raise Not_found if the key is not present *)
val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t ->

21
src/core/CCArray_slice.mli
View file

@ -86,20 +86,23 @@ val sorted : ('a -> 'a -> int) -> 'a t -> 'a array
val sort_indices : ('a -> 'a -> int) -> 'a t -> int array
(** [sort_indices cmp a] returns a new array [b], with the same length as [a],
such that [b.(i)] is the index of the [i]-th element of [a] in [sort cmp a].
In other words, [map (fun i -> a.(i)) (sort_indices a) = sorted cmp a].
[a] is not modified.
such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a]
appears in [a]. [a] is not modified.
In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a].
[sort_indices] yields the inverse permutation of {!sort_ranking}.
@since 1.0 *)
val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array
(** [sort_ranking cmp a] returns a new array [b], with the same length as [a],
such that [b.(i)] is the position in [sorted cmp a] of the [i]-th
element of [a].
[a] is not modified.
such that [b.(i)] is the index at which the [i]-the element of [a] appears
in [sorted cmp a]. [a] is not modified.
In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a].
In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a].
[sort_ranking] yields the inverse permutation of {!sort_indices}.
Without duplicates, we also have
In the absence of duplicate elements in [a], we also have
[lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)]
@since 1.0 *)
@ -122,7 +125,7 @@ val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option
[Some i] ([i] the index of the key) otherwise *)
val lookup_exn : ?cmp:'a ord -> 'a -> 'a t -> int
(** Same as {!lookup_exn}, but
(** Same as {!lookup}, but
@raise Not_found if the key is not present *)
val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t ->

2
src/core/CCBool.ml
View file

@ -7,7 +7,7 @@ let equal (a:bool) b = a=b
let compare (a:bool) b = Pervasives.compare a b
let negate x = not x
let negate = not
type 'a printer = Format.formatter -> 'a -> unit

3
src/core/CCBool.mli
View file

@ -11,7 +11,8 @@ val compare : t -> t -> int
val equal : t -> t -> bool
val negate : t -> t
(** Negation on booleans (functional version of [not]) *)
(** Negation on booleans (functional version of [not])
@deprecate since 1.3, simply use {!not} instead *)
type 'a printer = Format.formatter -> 'a -> unit

2
src/core/CCFormat.ml
View file

@ -77,7 +77,7 @@ let text out (s:string): unit =
(*$= & ~printer:(fun s->CCFormat.sprintf "%S" s)
"a\nb\nc" (sprintf_no_color "@[<v>%a@]%!" text "a b c")
"a b\nc" (sprintf_no_color "@[<h>%a@]%!" text "a b\nc")
*)
*)
let list ?(sep=return ",@ ") pp fmt l =
let rec pp_list l = match l with

2
src/core/CCFormat.mli
View file

@ -311,5 +311,5 @@ module Dump : sig
val result : 'a t -> ('a, string) Result.result t
val result' : 'a t -> 'e t -> ('a, 'e) Result.result t
val to_string : 'a t -> 'a -> string
(** Alias to {!to_string} *)
(** Alias to {!CCFormat.to_string} *)
end

93
src/core/CCList.ml
View file

@ -366,7 +366,7 @@ let combine l1 l2 =
if List.length l1=List.length l2 \
then CCList.combine l1 l2 = List.combine l1 l2 \
else Q.assume_fail() )
*)
*)
let combine_gen l1 l2 =
let l1 = ref l1 in
@ -385,7 +385,38 @@ let combine_gen l1 l2 =
let res1 = combine (take n l1) (take n l2) in \
let res2 = combine_gen l1 l2 |> of_gen in \
res1 = res2)
*)
*)
let split l =
let rec direct i l = match l with
| [] -> [], []
| [x1, y1] -> [x1], [y1]
| [x1, y1; x2, y2] -> [x1;x2], [y1;y2]
| [x1, y1; x2, y2; x3, y3] -> [x1;x2;x3], [y1;y2;y3]
| [x1, y1; x2, y2; x3, y3; x4, y4] -> [x1;x2;x3;x4], [y1;y2;y3;y4]
| _ when i=0 -> split_slow [] [] l
| (x1, y1) :: (x2, y2) :: (x3, y3) :: (x4, y4) :: (x5, y5) :: l' ->
let rx, ry = direct (i-1) l' in
x1 :: x2 :: x3 :: x4 :: x5 :: rx,
y1 :: y2 :: y3 :: y4 :: y5 :: ry
and split_slow acc1 acc2 l = match l with
| [] -> List.rev acc1, List.rev acc2
| (x1, x2) :: tail ->
let acc1 = x1 :: acc1
and acc2 = x2 :: acc2 in
split_slow acc1 acc2 tail
in
direct direct_depth_default_ l
(*$Q
(Q.(list_of_size Gen.(0--10_000) (pair small_int small_string))) (fun l -> \
let (l1, l2) = split l in \
List.length l1 = List.length l \
&& List.length l2 = List.length l)
Q.(list_of_size Gen.(0--10_000) (pair small_int small_int)) (fun l -> \
split l = List.split l)
*)
let return x = [x]
@ -688,9 +719,9 @@ let take_while p l =
*)
(*$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)
Q.(pair (fun1 Observable.int bool) (list small_int)) (fun (f,l) -> \
let l1 = take_while (Q.Fn.apply f) l in \
List.for_all (Q.Fn.apply f) l1)
*)
let rec drop_while p l = match l with
@ -698,8 +729,8 @@ 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)
Q.(pair (fun1 Observable.int bool) (list small_int)) (fun (f,l) -> \
take_while (Q.Fn.apply f) l @ drop_while (Q.Fn.apply f) l = l)
*)
let take_drop_while p l =
@ -720,9 +751,9 @@ let take_drop_while p l =
direct direct_depth_default_ p l
(*$Q
Q.(pair (fun1 small_int bool) (list small_int)) (fun (f,l) -> \
let l1,l2 = take_drop_while f l in \
(l1 = take_while f l) && (l2 = drop_while f l))
Q.(pair (fun1 Observable.int bool) (list small_int)) (fun (f,l) -> \
let l1,l2 = take_drop_while (Q.Fn.apply f) l in \
(l1 = take_while (Q.Fn.apply f) l) && (l2 = drop_while (Q.Fn.apply f) l))
*)
let last n l =
@ -811,6 +842,48 @@ let filter_map f l =
[ 1; 2; 3; 4; 5; 6 ])
*)
let keep_some l = filter_map (fun x->x) l
let keep_ok l =
filter_map
(function
| Result.Ok x -> Some x
| Result.Error _ -> None)
l
let all_some l =
try Some (map (function Some x -> x | None -> raise Exit) l)
with Exit -> None
(*$=
(Some []) (all_some [])
(Some [1;2;3]) (all_some [Some 1; Some 2; Some 3])
None (all_some [Some 1; None; None; Some 4])
*)
let all_ok l =
let err = ref None in
try
Result.Ok
(map
(function Result.Ok x -> x | Error e -> err := Some e; raise Exit)
l)
with Exit ->
begin match !err with
| None -> assert false
| Some e -> Result.Error e
end
(*$inject
open Result
*)
(*$=
(Ok []) (all_ok [])
(Ok [1;2;3]) (all_ok [Ok 1; Ok 2; Ok 3])
(Error "e2") (all_ok [Ok 1; Error "e2"; Error "e3"; Ok 4])
*)
let mem ?(eq=(=)) x l =
let rec search eq x l = match l with
| [] -> false

39
src/core/CCList.mli
View file

@ -92,6 +92,9 @@ val combine_gen : 'a list -> 'b list -> ('a * 'b) gen
instead, the output has as many pairs as the smallest input list.
@since 1.2 *)
val split : ('a * 'b) t -> 'a t * 'b t
(** A tail-recursive version of {!List.split}. *)
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
@ -111,13 +114,13 @@ val fold_product : ('c -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c
val cartesian_product : 'a t t -> 'a t t
(**
For example:
{[
# cartesian_product [[1;2];[3];[4;5;6]] =
[[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]] =
[[1;3;4;5;6];[2;3;4;5;6]];;
]}
{[
# cartesian_product [[1;2];[3];[4;5;6]] =
[[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]] =
[[1;3;4;5;6];[2;3;4;5;6]];;
]}
invariant: [cartesian_product l = map_product id l].
@since 1.2 *)
@ -247,6 +250,26 @@ val remove : ?eq:('a -> 'a -> bool) -> x:'a -> 'a t -> 'a t
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
(** Map and remove elements at the same time *)
val keep_some : 'a option t -> 'a t
(** [filter_some l] retains only elements of the form [Some x].
Same as [filter_map CCFun.id]
@since 1.3 *)
val keep_ok : ('a, _) Result.result t -> 'a t
(** [filter_some l] retains only elements of the form [Some x].
Same as [filter_map CCFun.id]
@since 1.3 *)
val all_some : 'a option t -> 'a t option
(** [all_some l] returns [Some l'] if all elements of [l] are of the form [Some x],
or [None] otherwise.
@since 1.3 *)
val all_ok : ('a, 'err) Result.result t -> ('a t, 'err) Result.result
(** [all_ok l] returns [Ok l'] if all elements of [l] are of the form [Ok x],
or [Error e] otherwise (with the first error met).
@since 1.3 *)
val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** Merges elements from both sorted list *)
@ -498,3 +521,5 @@ end
val pp : ?start:string -> ?stop:string -> ?sep:string ->
'a printer -> 'a t printer
(** {2 Lists of pairs} *)

2
src/core/CCResult.ml
View file

@ -129,7 +129,7 @@ let fold_ok f acc r = match r with
(*$=
42 (fold_ok (+) 2 (Ok 40))
40 (fold_ok (+) 40 (Error "foo"))
*)
*)
let is_ok = function
| Ok _ -> true

38
src/core/CCString.cppo.ml
View file

@ -414,6 +414,44 @@ let compare_versions a b =
in
cmp_rec (Split.gen_cpy ~by:"." a) (Split.gen_cpy ~by:"." b)
type nat_chunk =
| NC_char of char
| NC_int of int
let compare_natural a b =
(* stream of chunks *)
let chunks s : unit -> nat_chunk option =
let i = ref 0 in
let rec next () =
if !i = length s then None
else match String.get s !i with
| '0'..'9' as c -> incr i; read_int (Char.code c - Char.code '0')
| c -> incr i; Some (NC_char c)
and read_int n =
if !i = length s then Some (NC_int n)
else match String.get s !i with
| '0'..'9' as c -> incr i; read_int (10 * n + Char.code c - Char.code '0')
| _ -> Some (NC_int n)
in
next
in
let rec cmp_rec a b = match a(), b() with
| None, None -> 0
| Some _, None -> 1
| None, Some _ -> -1
| Some x, Some y ->
match x, y with
| NC_char x, NC_char y ->
let c = Char.compare x y in
if c<>0 then c else cmp_rec a b
| NC_int _, NC_char _ -> 1
| NC_char _, NC_int _ -> -1
| NC_int x, NC_int y ->
let c = Pervasives.compare x y in
if c<>0 then c else cmp_rec a b
in
cmp_rec (chunks a) (chunks b)
let edit_distance s1 s2 =
if length s1 = 0
then length s2

27
src/core/CCString.mli
View file

@ -375,7 +375,7 @@ val rtrim : t -> t
Q.(printable_string) (fun s -> \
let s' = rtrim s in \
if s'="" then Q.assume_fail() else s'.[String.length s'-1] <> ' ')
*)
*)
(** {2 Operations on 2 strings} *)
@ -578,6 +578,29 @@ val compare_versions : string -> string -> int
CCOrd.equiv (compare_versions a b) (CCOrd.opp compare_versions b a))
*)
val compare_natural : string -> string -> int
(** Natural Sort Order, comparing chunks of digits as natural numbers.
https://en.wikipedia.org/wiki/Natural_sort_order
@since 1.3 *)
(*$T
compare_natural "foo1" "foo2" < 0
compare_natural "foo11" "foo2" > 0
compare_natural "foo11" "foo11" = 0
compare_natural "foo011" "foo11" = 0
compare_natural "foo1a" "foo1b" < 0
compare_natural "foo1a1" "foo1a2" < 0
compare_natural "foo1a17" "foo1a2" > 0
*)
(*Q
(Q.pair printable_string printable_string) (fun (a,b) -> \
CCOrd.opp (compare_natural a b) = compare_natural b a)
(Q.printable_string) (fun a -> compare_natural a a = 0)
(Q.triple printable_string printable_string printable_string) (fun (a,b,c) -> \
if compare_natural a b < 0 && compare_natural b c < 0 \
then compare_natural a c < 0 else Q.assume_fail())
*)
val edit_distance : string -> string -> int
(** Edition distance between two strings. This satisfies the classical
@ -654,7 +677,7 @@ module Sub : sig
(*$= & ~printer:(String.make 1)
'b' Sub.(get (make "abc" 1 ~len:2) 0)
'c' Sub.(get (make "abc" 1 ~len:2) 1)
*)
*)
(*$QR
Q.(printable_string_of_size Gen.(3--10)) (fun s ->

16
src/core/META
View file

@ -1,6 +1,6 @@
# OASIS_START
# DO NOT EDIT (digest: 1e93f21c6208d4f0718882bfffe34612)
version = "1.2"
# DO NOT EDIT (digest: 2c23f3e7c83e14a0b87e7d6bb7df91bd)
version = "1.3"
description = "A modular standard library focused on data structures."
requires = "bytes result"
archive(byte) = "containers.cma"
@ -9,7 +9,7 @@ archive(native) = "containers.cmxa"
archive(native, plugin) = "containers.cmxs"
exists_if = "containers.cma"
package "unix" (
version = "1.2"
version = "1.3"
description = "A modular standard library focused on data structures."
requires = "bytes result unix"
archive(byte) = "containers_unix.cma"
@ -20,7 +20,7 @@ package "unix" (
)
package "top" (
version = "1.2"
version = "1.3"
description = "A modular standard library focused on data structures."
requires =
"compiler-libs.common containers containers.data containers.unix containers.sexp containers.iter"
@ -32,7 +32,7 @@ package "top" (
)
package "thread" (
version = "1.2"
version = "1.3"
description = "A modular standard library focused on data structures."
requires = "containers threads"
archive(byte) = "containers_thread.cma"
@ -43,7 +43,7 @@ package "thread" (
)
package "sexp" (
version = "1.2"
version = "1.3"
description = "A modular standard library focused on data structures."
requires = "bytes result"
archive(byte) = "containers_sexp.cma"
@ -54,7 +54,7 @@ package "sexp" (
)
package "iter" (
version = "1.2"
version = "1.3"
description = "A modular standard library focused on data structures."
archive(byte) = "containers_iter.cma"
archive(byte, plugin) = "containers_iter.cma"
@ -64,7 +64,7 @@ package "iter" (
)
package "data" (
version = "1.2"
version = "1.3"
description = "A modular standard library focused on data structures."
requires = "bytes"
archive(byte) = "containers_data.cma"

2
src/data/CCBV.ml
View file

@ -269,7 +269,7 @@ let iter bv f =
let bv = create ~size:n true in \
let l = iter bv |> Sequence.zip |> Sequence.to_list in \
List.length l = n && List.for_all (fun (_,b) -> b) l)
*)
*)
let iter_true bv f =
iter bv (fun i b -> if b then f i else ())

6
src/data/CCBV.mli
View file

@ -86,9 +86,9 @@ val first : t -> int option
changed type at 1.2 *)
val first_exn : t -> int
(** First set bit, or
@raise Not_found if all bits are 0
@since 1.2 *)
(** First set bit, or
@raise Not_found if all bits are 0
@since 1.2 *)
val filter : t -> (int -> bool) -> unit
(** [filter bv p] only keeps the true bits of [bv] whose [index]

39
src/data/CCCache.ml
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Caches} *)
@ -48,18 +26,25 @@ type ('a,'b) t = {
clear : unit -> unit;
}
type ('a, 'b) callback = in_cache:bool -> 'a -> 'b -> unit
let clear c = c.clear ()
let with_cache c f x =
let default_callback_ ~in_cache:_ _ _ = ()
let with_cache ?(cb=default_callback_) c f x =
try
c.get x
let y = c.get x in
cb ~in_cache:true x y;
y
with Not_found ->
let y = f x in
c.set x y;
cb ~in_cache:false x y;
y
let with_cache_rec c f =
let rec f' x = with_cache c (f f') x in
let with_cache_rec ?(cb=default_callback_) c f =
let rec f' x = with_cache ~cb c (f f') x in
f'
(*$R

40
src/data/CCCache.mli
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Caches}
@ -53,13 +31,22 @@ type ('a, 'b) t
val clear : (_,_) t -> unit
(** Clear the content of the cache *)
val with_cache : ('a, 'b) t -> ('a -> 'b) -> 'a -> 'b
type ('a, 'b) callback = in_cache:bool -> 'a -> 'b -> unit
(** Type of the callback that is called once a cached value is found
or not.
Should never raise.
@param in_cache is [true] if the value was in cache, [false]
if the value was just produced.
@since 1.3 *)
val with_cache : ?cb:('a, 'b) callback -> ('a, 'b) t -> ('a -> 'b) -> 'a -> 'b
(** [with_cache c f] behaves like [f], but caches calls to [f] in the
cache [c]. It always returns the same value as
[f x], if [f x] returns, or raise the same exception.
However, [f] may not be called if [x] is in the cache. *)
However, [f] may not be called if [x] is in the cache.
@param cb called after the value is generated or retrieved *)
val with_cache_rec : ('a,'b) t -> (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
val with_cache_rec : ?cb:('a, 'b) callback -> ('a,'b) t -> (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
(** [with_cache_rec c f] is a function that first, applies [f] to
some [f' = fix f], such that recursive calls to [f'] are cached in [c].
It is similar to {!with_cache} but with a function that takes as
@ -74,6 +61,7 @@ val with_cache_rec : ('a,'b) t -> (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
fib 70;;
]}
@param cb called after the value is generated or retrieved
*)
val size : (_,_) t -> int

2
src/data/CCGraph.ml
View file

@ -300,7 +300,7 @@ module Traverse = struct
`Exit 345614]
in
assert_equal expected l
*)
*)
end
(** {2 Cycles} *)

255
src/data/CCIntMap.ml
View file

@ -238,13 +238,13 @@ let update k f t =
let doubleton k1 v1 k2 v2 = add k1 v1 (singleton k2 v2)
let rec equal ~eq a b = a==b || match a, b with
| E, E -> true
| L (ka, va), L (kb, vb) -> ka = kb && eq va vb
| N (pa, sa, la, ra), N (pb, sb, lb, rb) ->
pa=pb && sa=sb && equal ~eq la lb && equal ~eq ra rb
| E, _
| N _, _
| L _, _ -> false
| E, E -> true
| L (ka, va), L (kb, vb) -> ka = kb && eq va vb
| N (pa, sa, la, ra), N (pb, sb, lb, rb) ->
pa=pb && sa=sb && equal ~eq la lb && equal ~eq ra rb
| E, _
| N _, _
| L _, _ -> false
(*$Q
Q.(list (pair int bool)) ( fun l -> \
@ -289,23 +289,23 @@ let choose t =
let rec union f t1 t2 =
if t1==t2 then t1
else match t1, t2 with
| E, o | o, E -> o
| L (k, v), o
| o, L (k, v) ->
(* insert k, v into o *)
insert_ (fun ~old v -> f k old v) k v o
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
if p1 = p2 && m1 = m2
then mk_node_ p1 m1 (union f l1 l2) (union f r1 r2)
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
then if Bit.is_0 p2 ~bit:m1
then N (p1, m1, union f l1 t2, r1)
else N (p1, m1, l1, union f r1 t2)
else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2
then if Bit.is_0 p1 ~bit:m2
then N (p2, m2, union f t1 l2, r2)
else N (p2, m2, l2, union f t1 r2)
else join_ t1 p1 t2 p2
| E, o | o, E -> o
| L (k, v), o
| o, L (k, v) ->
(* insert k, v into o *)
insert_ (fun ~old v -> f k old v) k v o
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
if p1 = p2 && m1 = m2
then mk_node_ p1 m1 (union f l1 l2) (union f r1 r2)
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
then if Bit.is_0 p2 ~bit:m1
then N (p1, m1, union f l1 t2, r1)
else N (p1, m1, l1, union f r1 t2)
else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2
then if Bit.is_0 p1 ~bit:m2
then N (p2, m2, union f t1 l2, r2)
else N (p2, m2, l2, union f t1 r2)
else join_ t1 p1 t2 p2
(*$Q & ~small:(fun (a,b) -> List.length a + List.length b)
Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1,l2) -> \
@ -344,26 +344,26 @@ let rec union f t1 t2 =
let rec inter f a b =
if a==b then a
else match a, b with
| E, _ | _, E -> E
| L (k, v), o
| o, L (k, v) ->
begin try
let v' = find_exn k o in
L (k, f k v v')
with Not_found -> E
end
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
if p1 = p2 && m1 = m2
then mk_node_ p1 m1 (inter f l1 l2) (inter f r1 r2)
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
then if Bit.is_0 p2 ~bit:m1
then inter f l1 b
else inter f r1 b
else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2
then if Bit.is_0 p1 ~bit:m2
then inter f l2 a
else inter f r2 a
else E
| E, _ | _, E -> E
| L (k, v), o
| o, L (k, v) ->
begin try
let v' = find_exn k o in
L (k, f k v v')
with Not_found -> E
end
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
if p1 = p2 && m1 = m2
then mk_node_ p1 m1 (inter f l1 l2) (inter f r1 r2)
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
then if Bit.is_0 p2 ~bit:m1
then inter f l1 b
else inter f r1 b
else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2
then if Bit.is_0 p1 ~bit:m2
then inter f a l2
else inter f a r2
else E
(*$R
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (print CCString.print))
@ -541,3 +541,170 @@ let print pp_x out m =
Format.pp_print_cut out ()
) m;
Format.fprintf out "}@]"
(* Some thorough tests from Jan Midtgaar
https://github.com/jmid/qc-ptrees
*)
(*$inject
let test_count = 2_500
open QCheck
type instr_tree =
| Empty
| Singleton of int * int
| Add of int * int * instr_tree
| Remove of int * instr_tree
| Union of instr_tree * instr_tree
| Inter of instr_tree * instr_tree
let rec to_string (a:instr_tree): string =
let int_to_string = string_of_int in
match a with
| Empty -> "Empty"
| Singleton (k,v) -> Printf.sprintf "Singleton(%d,%d)" k v
| Add (k,v,t) -> Printf.sprintf "Add(%d,%d," k v ^ (to_string t) ^ ")"
| Remove (n,t) -> "Remove (" ^ (int_to_string n) ^ ", " ^ (to_string t) ^ ")"
| Union (t,t') -> "Union (" ^ (to_string t) ^ ", " ^ (to_string t') ^ ")"
| Inter (t,t') -> "Inter (" ^ (to_string t) ^ ", " ^ (to_string t') ^ ")"
let merge_f _ x y = min x y
let rec interpret t : _ t = match t with
| Empty -> empty
| Singleton (k,v) -> singleton k v
| Add (k,v,t) -> add k v (interpret t)
| Remove (n,t) -> remove n (interpret t)
| Union (t,t') ->
let s = interpret t in
let s' = interpret t' in
union merge_f s s'
| Inter (t,t') ->
let s = interpret t in
let s' = interpret t' in
inter merge_f s s'
let tree_gen int_gen : instr_tree Q.Gen.t =
let open Gen in
sized
(fix (fun recgen n -> match n with
| 0 -> oneof [return Empty;
Gen.map2 (fun i j -> Singleton (i,j)) int_gen int_gen]
| _ ->
frequency
[ (1, return Empty);
(1, map2 (fun k v -> Singleton (k,v)) int_gen int_gen);
(2, map3 (fun i j t -> Add (i,j,t)) int_gen int_gen (recgen (n-1)));
(2, map2 (fun i t -> Remove (i,t)) int_gen (recgen (n-1)));
(2, map2 (fun l r -> Union (l,r)) (recgen (n/2)) (recgen (n/2)));
(2, map2 (fun l r -> Inter (l,r)) (recgen (n/2)) (recgen (n/2)));
]))
let (<+>) = Q.Iter.(<+>)
let rec tshrink t : instr_tree Q.Iter.t = match t with
| Empty -> Iter.empty
| Singleton (k,v) ->
(Iter.return Empty)
<+> (Iter.map (fun k' -> Singleton (k',v)) (Shrink.int k))
<+> (Iter.map (fun v' -> Singleton (k,v')) (Shrink.int v))
| Add (k,v,t) ->
(Iter.of_list [Empty; t; Singleton (k,v)])
<+> (Iter.map (fun t' -> Add (k,v,t')) (tshrink t))
<+> (Iter.map (fun k' -> Add (k',v,t)) (Shrink.int k))
<+> (Iter.map (fun v' -> Add (k,v',t)) (Shrink.int v))
| Remove (i,t) ->
(Iter.of_list [Empty; t])
<+> (Iter.map (fun t' -> Remove (i,t')) (tshrink t))
<+> (Iter.map (fun i' -> Remove (i',t)) (Shrink.int i))
| Union (t0,t1) ->
(Iter.of_list [Empty;t0;t1])
<+> (Iter.map (fun t0' -> Union (t0',t1)) (tshrink t0))
<+> (Iter.map (fun t1' -> Union (t0,t1')) (tshrink t1))
| Inter (t0,t1) ->
(Iter.of_list [Empty;t0;t1])
<+> (Iter.map (fun t0' -> Inter (t0',t1)) (tshrink t0))
<+> (Iter.map (fun t1' -> Inter (t0,t1')) (tshrink t1))
let arb_int =
frequency
[(5,small_signed_int);
(3,int);
(1, oneofl [min_int;max_int])]
let arb_tree =
make ~print:to_string ~shrink:tshrink
(tree_gen arb_int.gen)
let empty_m = []
let singleton_m k v = [k,v]
let mem_m i s = List.mem_assoc i s
let rec remove_m i s = match s with
| [] -> []
| (j,v)::s' -> if i=j then s' else (j,v)::(remove_m i s')
let add_m k v s = List.sort Pervasives.compare ((k,v)::remove_m k s)
let rec union_m s s' = match s,s' with
| [], _ -> s'
| _, [] -> s
| (k1,v1)::is,(k2,v2)::js ->
if k1<k2 then (k1,v1)::(union_m is s') else
if k1>k2 then (k2,v2)::(union_m s js) else
(k1,min v1 v2)::(union_m is js)
let rec inter_m s s' = match s with
| [] -> []
| (k,v)::s ->
if List.mem_assoc k s'
then (k,min v (List.assoc k s'))::(inter_m s s')
else inter_m s s'
let abstract s = List.sort Pervasives.compare (fold (fun k v acc -> (k,v)::acc) s [])
*)
(* A bunch of agreement properties *)
(*$=
empty_m (let s = empty in abstract s)
*)
(*$QR & ~count:test_count
(Q.pair arb_int arb_int) (fun (k,v) ->
abstract (singleton k v) = singleton_m k v)
*)
(*$QR & ~count:test_count
Q.(pair arb_tree arb_int)
(fun (t,n) ->
let s = interpret t in
mem n s = mem_m n (abstract s))
*)
(*$QR & ~count:test_count
(triple arb_tree arb_int arb_int)
(fun (t,k,v) ->
let s = interpret t in
abstract (add k v s) = add_m k v (abstract s))
*)
(*$QR & ~count:test_count
(pair arb_tree arb_int)
(fun (t,n) ->
let s = interpret t in
abstract (remove n s) = remove_m n (abstract s))
*)
(*$QR & ~count:test_count
(pair arb_tree arb_tree)
(fun (t,t') ->
let s = interpret t in
let s' = interpret t' in
abstract (union merge_f s s') = union_m (abstract s) (abstract s'))
*)
(*$QR & ~count:test_count
Q.(pair arb_tree arb_tree)
(fun (t,t') ->
let s = interpret t in
let s' = interpret t' in
abstract (inter merge_f s s') = inter_m (abstract s) (abstract s'))
*)

3
src/data/CCRAL.ml
View file

@ -151,7 +151,8 @@ let mapi ~f l =
*)
(*$Q
Q.(pair (list small_int)(fun2 int int bool)) (fun (l,f) -> \
Q.(pair (list small_int)(fun2 Observable.int Observable.int bool)) (fun (l,f) -> \
let f = Q.Fn.apply f in \
mapi ~f (of_list l) |> to_list = List.mapi f l )
*)

699
src/data/CCRingBuffer.ml
View file

File diff suppressed because it is too large Load diff

99
src/data/CCRingBuffer.mli
View file

@ -1,31 +1,19 @@
(*
* CCRingBuffer - Polymorphic Circular Buffer
* Copyright (C) 2015 Simon Cruanes, Carmelo Piccione
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version,
* with the special exception on linking described in file LICENSE.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(* Copyright (C) 2015 Simon Cruanes, Carmelo Piccione *)
(** {1 Circular Buffer (Deque)}
Useful for IO, or as a general-purpose alternative to {!Queue} when
Useful for IO, or as a bounded-size alternative to {!Queue} when
batch operations are needed.
{b status: experimental}
@since 0.9
Change in the API to provide only a bounded buffer
@since 1.3
*)
(** {2 Underlying Array} *)
@ -39,11 +27,8 @@ module Array : sig
(** The type of an array instance *)
type t
val empty : t
(** The empty array *)
val make: int -> elt -> t
(** [make s e] makes an array of size [s] with [e] elements *)
val create : int -> t
(** Make an array of the given size, filled with dummy elements *)
val length: t -> int
(** [length t] gets the total number of elements currently in [t] *)
@ -75,7 +60,7 @@ module Array : sig
S with type elt = char and type t = Bytes.t
(** Makes an array given an arbitrary element type *)
module Make(Elt:sig type t end) :
module Make(Elt:sig type t val dummy : t end) :
S with type elt = Elt.t and type t = Elt.t array
end
@ -87,16 +72,17 @@ module type S = sig
(** The module type of Array for this ring buffer *)
module Array : Array.S
(** Defines the ring buffer type, with both bounded and
unbounded flavors *)
(** Defines the bounded ring buffer type *)
type t
(** Raised in querying functions when the buffer is empty *)
exception Empty
val create : ?bounded:bool -> int -> t
(** [create ?bounded size] creates a new buffer with given size.
Defaults to [bounded=false]. *)
val create : int -> t
(** [create size] creates a new bounded buffer with given size.
The underlying array is allocated immediately and no further (large)
allocation will happen from now on.
@raise Invalid_argument if the arguments is [< 1] *)
val copy : t -> t
(** Make a fresh copy of the buffer. *)
@ -104,26 +90,29 @@ module type S = sig
val capacity : t -> int
(** Length of the inner buffer. *)
val max_capacity : t -> int option
(** Maximum length of the inner buffer, or [None] if unbounded. *)
val length : t -> int
(** Number of elements currently stored in the buffer. *)
val is_full : t -> bool
(** true if pushing an element would erase another element.
@since 1.3 *)
val blit_from : t -> Array.t -> int -> int -> unit
(** [blit_from buf from_buf o len] copies the slice [o, ... o + len - 1] from
a input buffer [from_buf] to the end of the buffer.
If the slice is too large for the buffer, only the last part of the array
will be copied.
@raise Invalid_argument if [o,len] is not a valid slice of [s] *)
val blit_into : t -> Array.t -> int -> int -> int
val blit_into : t -> Array.t -> int -> int -> int
(** [blit_into buf to_buf o len] copies at most [len] elements from [buf]
into [to_buf] starting at offset [o] in [s].
@return the number of elements actually copied ([min len (length buf)]).
@raise Invalid_argument if [o,len] is not a valid slice of [s] *)
@raise Invalid_argument if [o,len] is not a valid slice of [s]. *)
val append : t -> into:t -> unit
(** [append b ~into] copies all data from [b] and adds it at the
end of [into] *)
end of [into]. Erases data of [into] if there is not enough room. *)
val to_list : t -> Array.elt list
(** Extract the current content into a list *)
@ -131,9 +120,6 @@ module type S = sig
val clear : t -> unit
(** Clear the content of the buffer. Doesn't actually destroy the content. *)
val reset : t -> unit
(** Clear the content of the buffer, and also resize it to a default size *)
val is_empty :t -> bool
(** Is the buffer empty (i.e. contains no elements)? *)
@ -171,26 +157,34 @@ module type S = sig
If [t.bounded=false], the buffer will grow as needed,
otherwise the oldest elements are replaced first. *)
val peek_front : t -> Array.elt
(** First value from front of [t].
@raise Empty if buffer is empty. *)
val peek_front : t -> Array.elt option
(** First value from front of [t], without modification. *)
val peek_back : t -> Array.elt
(** Get the last value from back of [t].
@raise Empty if buffer is empty. *)
val peek_front_exn : t -> Array.elt
(** First value from front of [t], without modification.
@raise Empty if buffer is empty.
@since 1.3 *)
val peek_back : t -> Array.elt option
(** Get the last value from back of [t], without modification. *)
val peek_back_exn : t -> Array.elt
(** Get the last value from back of [t], without modification.
@raise Empty if buffer is empty.
@since 1.3 *)
val take_back : t -> Array.elt option
(** Take the last value from back of [t], if any *)
(** Take and remove the last value from back of [t], if any *)
val take_back_exn : t -> Array.elt
(** Take the last value from back of [t].
(** Take and remove the last value from back of [t].
@raise Empty if buffer is already empty. *)
val take_front : t -> Array.elt option
(** Take the first value from front of [t], if any *)
(** Take and remove the first value from front of [t], if any *)
val take_front_exn : t -> Array.elt
(** Take the first value from front of [t].
(** Take and remove the first value from front of [t].
@raise Empty if buffer is already empty. *)
val of_array : Array.t -> t
@ -210,4 +204,7 @@ module Byte : S with module Array = Array.Byte
module MakeFromArray(A : Array.S) : S with module Array = A
(** Buffer using regular arrays *)
module Make(X : sig type t end) : S with type Array.elt = X.t and type Array.t = X.t array
module Make(X : sig
type t
val dummy : t
end) : S with type Array.elt = X.t and type Array.t = X.t array

201
src/data/CCSimple_queue.ml Normal file
View file

@ -0,0 +1,201 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Functional queues (fifo)} *)
type 'a sequence = ('a -> unit) -> unit
type 'a printer = Format.formatter -> 'a -> unit
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
type 'a gen = unit -> 'a option
type 'a t = {
hd : 'a list;
tl : 'a list;
} (** Queue containing elements of type 'a *)
let empty = {
hd = [];
tl = [];
}
(* invariant: if hd=[], then tl=[] *)
let make_ hd tl = match hd with
| [] -> {hd=List.rev tl; tl=[] }
| _::_ -> {hd; tl; }
let is_empty q = q.hd = []
let push x q = make_ q.hd (x :: q.tl)
let snoc q x = push x q
let peek_exn q =
match q.hd with
| [] -> assert (q.tl = []); invalid_arg "Queue.peek"
| x::_ -> x
let peek q = match q.hd with
| [] -> None
| x::_ -> Some x
let pop_exn q =
match q.hd with
| [] -> assert (q.tl = []); invalid_arg "Queue.peek"
| x::hd' ->
let q' = make_ hd' q.tl in
x, q'
let pop q =
try Some (pop_exn q)
with Invalid_argument _ -> None
(*$Q
Q.(list small_int) (fun l -> \
let q = of_list l in \
equal CCInt.equal (Gen.unfold pop q |> of_gen) q)
*)
let junk q =
try
let _, q' = pop_exn q in
q'
with Invalid_argument _ -> q
let map f q = { hd=List.map f q.hd; tl=List.map f q.tl; }
let rev q = make_ q.tl q.hd
(*$Q
Q.(list small_int) (fun l -> \
equal CCInt.equal (of_list l |> rev) (of_list (List.rev l)))
Q.(list small_int) (fun l -> \
let q = of_list l in \
equal CCInt.equal q (q |> rev |> rev))
*)
let length q = List.length q.hd + List.length q.tl
(*$Q
Q.(list small_int)(fun l -> \
length (of_list l) = List.length l)
*)
(*$Q
Q.(list small_int)(fun l -> \
equal CCInt.equal (of_list l) (List.fold_left snoc empty l))
*)
let fold f acc q =
let acc' = List.fold_left f acc q.hd in
List.fold_right (fun x acc -> f acc x) q.tl acc'
(* iterate on a list in reverse order *)
let rec rev_iter_ f l = match l with
| [] -> ()
| x :: tl -> rev_iter_ f tl; f x
let iter f q =
List.iter f q.hd;
rev_iter_ f q.tl
let to_list q = fold (fun acc x->x::acc) [] q |> List.rev
let add_list q l = List.fold_left snoc q l
let of_list l = add_list empty l
let to_seq q = fun k -> iter k q
let add_seq q seq =
let q = ref q in
seq (fun x -> q := push x !q);
!q
let of_seq s = add_seq empty s
(*$Q
Q.(list small_int) (fun l -> \
equal CCInt.equal \
(of_seq (Sequence.of_list l)) \
(of_list l))
Q.(list small_int) (fun l -> \
l = (of_list l |> to_seq |> Sequence.to_list))
*)
let rec klist_iter_ k f = match k() with
| `Nil -> ()
| `Cons (x,tl) -> f x; klist_iter_ tl f
let add_klist q l = add_seq q (klist_iter_ l)
let of_klist l = add_klist empty l
let to_klist q =
let rec aux1 l () = match l with
| [] -> aux2 (List.rev q.tl) ()
| x :: tl -> `Cons (x, aux1 tl)
and aux2 l () = match l with
| [] -> `Nil
| x :: tl -> `Cons (x, aux2 tl)
in
aux1 q.hd
let rec gen_iter g f = match g() with
| None -> ()
| Some x -> f x; gen_iter g f
let add_gen q g = add_seq q (gen_iter g)
let of_gen g = add_gen empty g
let to_gen q =
let st = ref (`Left q.hd) in
let rec aux () = match !st with
| `Stop -> None
| `Left [] -> st := `Right q.tl; aux()
| `Left (x::tl) -> st := `Left tl; Some x
| `Right [] -> st := `Stop; None
| `Right (x::tl) -> st := `Right tl; Some x
in
aux
let rec klist_equal eq l1 l2 = match l1(), l2() with
| `Nil, `Nil -> true
| `Nil, _
| _, `Nil -> false
| `Cons (x1,l1'), `Cons (x2,l2') ->
eq x1 x2 && klist_equal eq l1' l2'
let equal eq q1 q2 = klist_equal eq (to_klist q1) (to_klist q2)
(*$Q
Q.(pair (list small_int)(list small_int)) (fun (l1,l2) -> \
equal CCInt.equal (of_list l1)(of_list l2) = (l1=l2))
*)
let append q1 q2 =
add_seq q1
(fun yield ->
to_seq q2 yield)
(*$Q
Q.(pair (list small_int)(list small_int)) (fun (l1,l2) -> \
equal CCInt.equal \
(append (of_list l1)(of_list l2)) \
(of_list (List.append l1 l2)))
*)
module Infix = struct
let (>|=) q f = map f q
let (<::) = snoc
let (@) = append
end
include Infix
(** {2 IO} *)
let pp ?(sep=fun out () -> Format.fprintf out ",@ ") pp_item out l =
let first = ref true in
iter
(fun x ->
if !first then first := false else sep out ();
pp_item out x)
l

90
src/data/CCSimple_queue.mli Normal file
View file

@ -0,0 +1,90 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Functional queues (fifo)} *)
(** Simple implementation of functional queues
@since 1.3 *)
type 'a sequence = ('a -> unit) -> unit
type 'a printer = Format.formatter -> 'a -> unit
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
type 'a gen = unit -> 'a option
type +'a t
(** Queue containing elements of type 'a *)
val empty : 'a t
val is_empty : 'a t -> bool
val push : 'a -> 'a t -> 'a t
(** Push element at the end of the queue *)
val snoc : 'a t -> 'a -> 'a t
(** Flip version of {!push} *)
val peek : 'a t -> 'a option
(** First element of the queue *)
val peek_exn : 'a t -> 'a
(** Same as {!peek} but
@raise Invalid_argument if the queue is empty *)
val pop : 'a t -> ('a * 'a t) option
(** Get and remove the first element *)
val pop_exn : 'a t -> ('a * 'a t)
(** Same as {!pop}, but fails on empty queues.
@raise Invalid_argument if the queue is empty *)
val junk : 'a t -> 'a t
(** Remove first element. If the queue is empty, do nothing. *)
val append : 'a t -> 'a t -> 'a t
(** Append two queues. Elements from the second one come
after elements of the first one.
Linear in the size of the second queue. *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Map values *)
val rev : 'a t -> 'a t
(** Reverse the queue. Constant time. *)
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
module Infix : sig
val (>|=) : 'a t -> ('a -> 'b) -> 'b t (** Alias to {!map} *)
val (@) : 'a t -> 'a t -> 'a t (** Alias to {!append} *)
val (<::) : 'a t -> 'a -> 'a t (** Alias to {!snoc} *)
end
include module type of Infix
val length : 'a t -> int
(** Number of elements in the queue (linear in time) *)
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
val iter : ('a -> unit) -> 'a t -> unit
val to_list : 'a t -> 'a list
val add_list : 'a t -> 'a list -> 'a t
val of_list : 'a list -> 'a t
val to_seq : 'a t -> 'a sequence
val add_seq : 'a t -> 'a sequence -> 'a t
val of_seq : 'a sequence -> 'a t
val to_klist : 'a t -> 'a klist
val add_klist : 'a t -> 'a klist -> 'a t
val of_klist : 'a klist -> 'a t
val of_gen : 'a gen -> 'a t
val add_gen : 'a t -> 'a gen -> 'a t
val to_gen : 'a t -> 'a gen
(** {2 IO} *)
val pp : ?sep:unit printer -> 'a printer -> 'a t printer

10
src/data/CCTrie.ml
View file

@ -684,25 +684,27 @@ module Make(W : WORD)
| [] | [_] -> true
| x :: ((y ::_) as tl) ->
(if rev then x >= y else x <= y) && sorted ~rev tl
let gen_str = Q.small_printable_string
*)
(*$Q & ~count:200
Q.(list_of_size Gen.(1 -- 20) (pair printable_string small_int)) \
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \
(fun l -> let t = String.of_list l in \
List.for_all (fun (k,_) -> \
String.above k t |> Sequence.for_all (fun (k',v) -> k' >= k)) \
l)
Q.(list_of_size Gen.(1 -- 20) (pair printable_string small_int)) \
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \
(fun l -> let t = String.of_list l in \
List.for_all (fun (k,_) -> \
String.below k t |> Sequence.for_all (fun (k',v) -> k' <= k)) \
l)
Q.(list_of_size Gen.(1 -- 20) (pair printable_string small_int)) \
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \
(fun l -> let t = String.of_list l in \
List.for_all (fun (k,_) -> \
String.above k t |> Sequence.to_list |> sorted ~rev:false) \
l)
Q.(list_of_size Gen.(1 -- 20) (pair printable_string small_int)) \
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \
(fun l -> let t = String.of_list l in \
List.for_all (fun (k,_) -> \
String.below k t |> Sequence.to_list |> sorted ~rev:true) \

2
src/data/CCZipper.ml
View file

@ -17,7 +17,7 @@ let to_rev_list (l,r) = List.rev_append r l
(*$inject
let zip_gen = Q.(pair (small_list int)(small_list int))
*)
*)
(*$Q
zip_gen (fun z -> \

3
src/data/containers_data.mldylib
View file

@ -1,5 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: faa1bae1054c39ac202fac31d38a084e)
# DO NOT EDIT (digest: d1bab4c4f6793f682baaf28f0865fa42)
CCMultiMap
CCMultiSet
CCTrie
@ -21,6 +21,7 @@ CCBitField
CCHashTrie
CCWBTree
CCRAL
CCSimple_queue
CCImmutArray
CCHet
CCZipper

3
src/data/containers_data.mllib
View file

@ -1,5 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: faa1bae1054c39ac202fac31d38a084e)
# DO NOT EDIT (digest: d1bab4c4f6793f682baaf28f0865fa42)
CCMultiMap
CCMultiSet
CCTrie
@ -21,6 +21,7 @@ CCBitField
CCHashTrie
CCWBTree
CCRAL
CCSimple_queue
CCImmutArray
CCHet
CCZipper