mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2026-01-29 04:14:51 -05:00
Merge branch 'master' into stable for 1.3
This commit is contained in:
Simon Cruanes
commit
f24d983b04
38 changed files with 1353 additions and 578 deletions
|
|
@ -21,3 +21,4 @@
|
|||
- Glenn Slotte (glennsl)
|
||||
- @LemonBoy
|
||||
- Leonid Rozenberg (@rleonid)
|
||||
- Bikal Gurung (@bikalgurung)
|
||||
|
|
@ -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
55
README.adoc
|
|
@ -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
4
_oasis
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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, ()
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -93,6 +93,7 @@ CCPersistentArray
|
|||
CCPersistentHashtbl
|
||||
CCRAL
|
||||
CCRingBuffer
|
||||
CCSimple_queue
|
||||
CCTrie
|
||||
CCWBTree
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
10
opam
|
|
@ -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"
|
||||
]
|
||||
|
|
|
|||
58
setup.ml
58
setup.ml
|
|
@ -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
|
||||
(* Practically speaking destdir is prepended at the beginning of the
|
||||
target filename
|
||||
*)
|
||||
fun fn -> destdir^fn
|
||||
(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 *)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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].
|
||||
[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 ->
|
||||
|
|
|
|||
|
|
@ -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].
|
||||
[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 ->
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -387,6 +387,37 @@ let combine_gen l1 l2 =
|
|||
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]
|
||||
|
||||
let (>>=) l f = flat_map f l
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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} *)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -361,8 +361,8 @@ let rec inter f a 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
|
||||
then inter f a l2
|
||||
else inter f a r2
|
||||
else E
|
||||
|
||||
(*$R
|
||||
|
|
@ -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'))
|
||||
*)
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
*)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,26 +1,13 @@
|
|||
(*
|
||||
* CCRingBuffer - Polymorphic circular buffer with
|
||||
* deque semantics for accessing both the head and tail.
|
||||
*
|
||||
* 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
|
||||
*)
|
||||
|
||||
(** Polymorphic Circular Buffer for IO *)
|
||||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
(* Copyright (C) 2015 Simon Cruanes, Carmelo Piccione *)
|
||||
|
||||
(** Generic Circular Buffer for IO, with bulk operations.
|
||||
The bulk operations (e.g. based on {!Array.blit} or {!Bytes.blit})
|
||||
are more efficient than item-by-item copy.
|
||||
|
||||
See https://en.wikipedia.org/wiki/Circular_buffer for an overview. *)
|
||||
|
||||
module Array = struct
|
||||
(** The abstract type for arrays *)
|
||||
|
|
@ -31,11 +18,8 @@ module Array = struct
|
|||
(** 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] *)
|
||||
|
|
@ -68,11 +52,11 @@ module Array = struct
|
|||
include Bytes
|
||||
end
|
||||
|
||||
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 = struct
|
||||
type elt = Elt.t
|
||||
type t = Elt.t array
|
||||
let make = Array.make
|
||||
let create size = Array.make size Elt.dummy
|
||||
let length = Array.length
|
||||
let get = Array.get
|
||||
let set = Array.set
|
||||
|
|
@ -80,7 +64,6 @@ module Array = struct
|
|||
let blit = Array.blit
|
||||
let iter = Array.iter
|
||||
let sub = Array.sub
|
||||
let empty = Array.of_list []
|
||||
end
|
||||
end
|
||||
|
||||
|
|
@ -88,16 +71,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. *)
|
||||
|
|
@ -105,26 +89,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
|
||||
(** [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 *)
|
||||
|
|
@ -132,9 +119,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)? *)
|
||||
|
||||
|
|
@ -172,70 +156,74 @@ 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
|
||||
(** Create a buffer from an initial array, but doesn't take ownership
|
||||
of it (stills allocates a new internal array) *)
|
||||
of it (stills allocates a new internal array)
|
||||
@since 0.11 *)
|
||||
|
||||
val to_array : t -> Array.t
|
||||
(** Create an array from the elements, in order.
|
||||
@since 0.11 *)
|
||||
end
|
||||
|
||||
module MakeFromArray(A:Array.S) = struct
|
||||
(*$inject
|
||||
open Q.Gen
|
||||
let g_char = map Char.chr (Char.code 'A' -- Char.code 'z')
|
||||
let g_str = string_size ~gen:g_char (0--10)
|
||||
let a_str = {Q.string with Q.gen=g_str}
|
||||
*)
|
||||
|
||||
module MakeFromArray(A:Array.S) : S with module Array = A = struct
|
||||
module Array = A
|
||||
|
||||
type t = {
|
||||
mutable start : int;
|
||||
mutable stop : int; (* excluded *)
|
||||
mutable buf : Array.t;
|
||||
bounded : bool;
|
||||
size : int
|
||||
buf : Array.t;
|
||||
}
|
||||
|
||||
exception Empty
|
||||
|
||||
let create ?(bounded=false) size =
|
||||
let create size =
|
||||
if size < 1 then invalid_arg "CCRingBuffer.create";
|
||||
{ start=0;
|
||||
stop=0;
|
||||
bounded;
|
||||
size;
|
||||
buf = A.empty
|
||||
buf = A.create (size+1); (* keep room for extra slot *)
|
||||
}
|
||||
|
||||
let copy b =
|
||||
{ b with buf=A.copy b.buf; }
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
let b' = Byte.copy b in \
|
||||
try Byte.iteri b (fun i c -> if Byte.get_front b' i <> c then raise Exit); true with Exit -> false)
|
||||
*)
|
||||
|
||||
(*$T
|
||||
let b = Byte.of_array (Bytes.of_string "abc") in \
|
||||
let b' = Byte.copy b in \
|
||||
|
|
@ -248,172 +236,103 @@ module MakeFromArray(A:Array.S) = struct
|
|||
match len with 0 -> 0 | l -> l - 1
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.capacity b >= s_len)
|
||||
*)
|
||||
|
||||
(*$Q
|
||||
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> let s = Bytes.of_string s in \
|
||||
let i = abs i in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create ~bounded:true i in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.capacity b <= i)
|
||||
*)
|
||||
|
||||
let max_capacity b = if b.bounded then Some b.size else None
|
||||
|
||||
(*$Q
|
||||
Q.small_int (fun i -> \
|
||||
let i = abs i in \
|
||||
let b = Byte.create i in \
|
||||
Byte.max_capacity b = None)
|
||||
*)
|
||||
|
||||
(*$Q
|
||||
Q.small_int (fun i -> \
|
||||
let i = abs i in \
|
||||
let b = Byte.create ~bounded:true i in \
|
||||
Byte.max_capacity b = Some i)
|
||||
*)
|
||||
|
||||
let length b =
|
||||
if b.stop >= b.start
|
||||
then b.stop - b.start
|
||||
else (A.length b.buf - b.start) + b.stop
|
||||
|
||||
(*$Q
|
||||
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> let s = Bytes.of_string s in \
|
||||
let i = abs i in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create i in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.length b = s_len)
|
||||
*)
|
||||
let is_full b = length b + 1 = Array.length b.buf
|
||||
|
||||
(*$Q
|
||||
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> let s = Bytes.of_string s in \
|
||||
let i = abs i in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create ~bounded:true i in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.length b >= 0 && Byte.length b <= i)
|
||||
*)
|
||||
let next_ b i =
|
||||
let j = i+1 in
|
||||
if j = A.length b.buf then 0 else j
|
||||
|
||||
(* resize [b] so that inner capacity is [cap] *)
|
||||
let resize b cap elem =
|
||||
assert (cap >= A.length b.buf);
|
||||
let buf' = A.make cap elem in
|
||||
(* copy into buf' *)
|
||||
if b.stop >= b.start
|
||||
then
|
||||
A.blit b.buf b.start buf' 0 (b.stop - b.start)
|
||||
else begin
|
||||
let len_end = A.length b.buf - b.start in
|
||||
A.blit b.buf b.start buf' 0 len_end;
|
||||
A.blit b.buf 0 buf' len_end b.stop;
|
||||
end;
|
||||
b.buf <- buf'
|
||||
let incr_start_ b = b.start <- next_ b b.start
|
||||
let incr_stop_ b = b.stop <- next_ b b.stop
|
||||
|
||||
let blit_from_bounded b from_buf o len =
|
||||
let cap = capacity b - length b in
|
||||
(* resize if needed, with a constant to amortize *)
|
||||
if cap < len then (
|
||||
let new_size =
|
||||
let desired = A.length b.buf + len + 24 in
|
||||
min (b.size+1) desired in
|
||||
resize b new_size (A.get from_buf 0);
|
||||
let good = capacity b = b.size || capacity b - length b >= len in
|
||||
assert good;
|
||||
);
|
||||
let sub = A.sub from_buf o len in
|
||||
let iter x =
|
||||
let capacity = A.length b.buf in
|
||||
A.set b.buf b.stop x;
|
||||
if b.stop = capacity-1 then b.stop <- 0 else b.stop <- b.stop + 1;
|
||||
if b.start = b.stop then
|
||||
if b.start = capacity-1 then b.start <- 0 else b.start <- b.start + 1
|
||||
in
|
||||
A.iter iter sub
|
||||
|
||||
|
||||
let blit_from_unbounded b from_buf o len =
|
||||
let cap = capacity b - length b in
|
||||
(* resize if needed, with a constant to amortize *)
|
||||
if cap < len
|
||||
then resize b (max (b.size+1) (A.length b.buf + len + 24)) (A.get from_buf 0);
|
||||
let good = capacity b - length b >= len in
|
||||
assert good;
|
||||
if b.stop >= b.start
|
||||
then (* [_______ start xxxxxxxxx stop ______] *)
|
||||
let len_end = A.length b.buf - b.stop in
|
||||
if len_end >= len
|
||||
then (A.blit from_buf o b.buf b.stop len;
|
||||
b.stop <- b.stop + len)
|
||||
else (A.blit from_buf o b.buf b.stop len_end;
|
||||
A.blit from_buf (o+len_end) b.buf 0 (len-len_end);
|
||||
b.stop <- len-len_end)
|
||||
else begin (* [xxxxx stop ____________ start xxxxxx] *)
|
||||
let len_middle = b.start - b.stop in
|
||||
assert (len_middle >= len);
|
||||
A.blit from_buf o b.buf b.stop len;
|
||||
b.stop <- b.stop + len
|
||||
end;
|
||||
let push_back b e =
|
||||
A.set b.buf b.stop e;
|
||||
incr_stop_ b;
|
||||
if b.start = b.stop then incr_start_ b; (* overwritten one element *)
|
||||
()
|
||||
|
||||
let blit_from b from_buf o len =
|
||||
if A.length from_buf = 0 then () else
|
||||
if b.bounded then
|
||||
blit_from_bounded b from_buf o len
|
||||
else
|
||||
blit_from_unbounded b from_buf o len
|
||||
if len = 0 then ()
|
||||
else if o + len > A.length from_buf then invalid_arg "CCRingBuffer.blit_from"
|
||||
else (
|
||||
for i=o to o+len-1 do
|
||||
push_back b (A.get from_buf i)
|
||||
done
|
||||
)
|
||||
|
||||
(*$Q
|
||||
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
let b' = Byte.copy b in \
|
||||
try Byte.iteri b (fun i c -> if Byte.get_front b' i <> c then raise Exit); true with Exit -> false)
|
||||
*)
|
||||
|
||||
(*$Q
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.push_back b 'X'; \
|
||||
Byte.peek_back_exn b = 'X')
|
||||
*)
|
||||
|
||||
(*$Q
|
||||
(Q.pair a_str a_str) (fun (s,s') -> \
|
||||
let b = Byte.create (max (String.length s+String.length s') 64) in \
|
||||
let s = Bytes.of_string s in let s' = Bytes.of_string s' in \
|
||||
(let b = Byte.create 24 in \
|
||||
Byte.blit_from b s 0 (Bytes.length s); \
|
||||
Byte.blit_from b s' 0 (Bytes.length s'); \
|
||||
Byte.length b = Bytes.length s + Bytes.length s'))
|
||||
Byte.length b = Bytes.length s + Bytes.length s')
|
||||
*)
|
||||
|
||||
|
||||
(*$Q
|
||||
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
|
||||
(Q.pair a_str a_str) (fun (s,s') -> \
|
||||
let s = Bytes.of_string s in let s' = Bytes.of_string s' in \
|
||||
(let b = Byte.create ~bounded:true (Bytes.length s + Bytes.length s') in \
|
||||
let b = Byte.create (max (Bytes.length s + Bytes.length s') 64) in \
|
||||
Byte.blit_from b s 0 (Bytes.length s); \
|
||||
Byte.blit_from b s' 0 (Bytes.length s'); \
|
||||
Byte.length b = Bytes.length s + Bytes.length s'))
|
||||
Byte.length b = Bytes.length s + Bytes.length s')
|
||||
*)
|
||||
|
||||
|
||||
let blit_into b to_buf o len =
|
||||
if o+len > A.length to_buf
|
||||
then invalid_arg "CCRingBuffer.blit_into";
|
||||
if b.stop >= b.start
|
||||
then
|
||||
if o+len > A.length to_buf then (
|
||||
invalid_arg "CCRingBuffer.blit_into";
|
||||
);
|
||||
if b.stop >= b.start then (
|
||||
let n = min (b.stop - b.start) len in
|
||||
let _ = A.blit b.buf b.start to_buf o n in
|
||||
A.blit b.buf b.start to_buf o n;
|
||||
n
|
||||
else begin
|
||||
) else (
|
||||
let len_end = A.length b.buf - b.start in
|
||||
A.blit b.buf b.start to_buf o (min len_end len);
|
||||
if len_end >= len
|
||||
then len (* done *)
|
||||
else begin
|
||||
else (
|
||||
let n = min b.stop (len - len_end) in
|
||||
A.blit b.buf 0 to_buf (o+len_end) n;
|
||||
n + len_end
|
||||
end
|
||||
end
|
||||
)
|
||||
)
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
let b = Byte.create (Bytes.length s) in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let b = Byte.create (max 64 (Bytes.length s)) in \
|
||||
Byte.blit_from b s 0 (Bytes.length s); \
|
||||
let to_buf = Bytes.create (Bytes.length s) in \
|
||||
let len = Byte.blit_into b to_buf 0 (Bytes.length s) in \
|
||||
|
|
@ -426,35 +345,20 @@ module MakeFromArray(A:Array.S) = struct
|
|||
()
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.clear b; \
|
||||
Byte.length b = 0)
|
||||
*)
|
||||
|
||||
|
||||
let reset b =
|
||||
clear b;
|
||||
b.buf <- A.empty
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.reset b; \
|
||||
Byte.length b = 0 && Byte.capacity b = 0)
|
||||
*)
|
||||
|
||||
|
||||
let is_empty b = b.start = b.stop
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.skip b s_len; \
|
||||
Byte.is_empty b)
|
||||
|
|
@ -463,17 +367,15 @@ module MakeFromArray(A:Array.S) = struct
|
|||
let take_front_exn b =
|
||||
if b.start = b.stop then raise Empty;
|
||||
let c = A.get b.buf b.start in
|
||||
if b.start + 1 = A.length b.buf
|
||||
then b.start <- 0
|
||||
else b.start <- b.start + 1;
|
||||
b.start <- next_ b b.start;
|
||||
c
|
||||
|
||||
let take_front b = try Some (take_front_exn b) with Empty -> None
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let front = Byte.take_front_exn b in \
|
||||
front = Bytes.get s 0 with Byte.Empty -> s_len = 0)
|
||||
|
|
@ -481,7 +383,7 @@ module MakeFromArray(A:Array.S) = struct
|
|||
|
||||
let take_back_exn b =
|
||||
if b.start = b.stop then raise Empty;
|
||||
if b.stop - 1 = 0
|
||||
if b.stop = 0
|
||||
then b.stop <- A.length b.buf - 1
|
||||
else b.stop <- b.stop - 1;
|
||||
A.get b.buf b.stop
|
||||
|
|
@ -489,12 +391,13 @@ module MakeFromArray(A:Array.S) = struct
|
|||
let take_back b = try Some (take_back_exn b) with Empty -> None
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let back = Byte.take_back_exn b in \
|
||||
back = Bytes.get s (Bytes.length s - 1) with Byte.Empty -> s_len = 0)
|
||||
back = Bytes.get s (Bytes.length s - 1) \
|
||||
with Byte.Empty -> s_len = 0)
|
||||
*)
|
||||
|
||||
let junk_front b =
|
||||
|
|
@ -504,9 +407,9 @@ module MakeFromArray(A:Array.S) = struct
|
|||
else b.start <- b.start + 1
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let () = Byte.junk_front b in \
|
||||
s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0)
|
||||
|
|
@ -519,35 +422,38 @@ module MakeFromArray(A:Array.S) = struct
|
|||
else b.stop <- b.stop - 1
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let () = Byte.junk_back b in \
|
||||
s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0)
|
||||
*)
|
||||
|
||||
let skip b len =
|
||||
if len > length b then
|
||||
invalid_arg ("CCRingBuffer.skip: " ^ string_of_int len);
|
||||
if b.stop >= b.start
|
||||
then b.start <- b.start + len
|
||||
else
|
||||
if len > length b then (
|
||||
invalid_arg "CCRingBuffer.skip";
|
||||
);
|
||||
if b.stop >= b.start then (
|
||||
b.start <- b.start + len;
|
||||
assert (b.stop >= b.start);
|
||||
) else (
|
||||
let len_end = A.length b.buf - b.start in
|
||||
if len > len_end
|
||||
if len >= len_end
|
||||
then b.start <- len-len_end (* wrap to the beginning *)
|
||||
else b.start <- b.start + len
|
||||
)
|
||||
|
||||
(*$Q
|
||||
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
|
||||
(Q.pair a_str a_str) (fun (s,s') -> \
|
||||
let s = Bytes.of_string s in let s' = Bytes.of_string s' in \
|
||||
(let b = Byte.create 24 in \
|
||||
let b = Byte.create (max (Bytes.length s+Bytes.length s') 64) in \
|
||||
Byte.blit_from b s 0 (Bytes.length s); \
|
||||
Byte.blit_from b s' 0 (Bytes.length s'); \
|
||||
let h = Bytes.of_string "hello world" in \
|
||||
Byte.blit_from b h 0 (Bytes.length h); (* big enough *) \
|
||||
let l = Byte.length b in let l' = l/2 in Byte.skip b l'; \
|
||||
Byte.length b + l' = l))
|
||||
Byte.length b + l' = l)
|
||||
*)
|
||||
|
||||
let iter b ~f =
|
||||
|
|
@ -567,9 +473,9 @@ module MakeFromArray(A:Array.S) = struct
|
|||
)
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try Byte.iteri b (fun i c -> if Byte.get_front b i <> c then raise Exit); \
|
||||
true with Exit -> false)
|
||||
|
|
@ -577,29 +483,28 @@ module MakeFromArray(A:Array.S) = struct
|
|||
|
||||
let get b i =
|
||||
if b.stop >= b.start
|
||||
then
|
||||
if i >= b.stop - b.start
|
||||
then invalid_arg ("CCRingBuffer.get:" ^ string_of_int i)
|
||||
else A.get b.buf (b.start + i)
|
||||
else
|
||||
then (
|
||||
if i >= b.stop - b.start then (
|
||||
invalid_arg "CCRingBuffer.get"
|
||||
) else A.get b.buf (b.start + i)
|
||||
) else (
|
||||
let len_end = A.length b.buf - b.start in
|
||||
if i < len_end
|
||||
then A.get b.buf (b.start + i)
|
||||
else if i - len_end > b.stop
|
||||
then invalid_arg ("CCRingBuffer.get: " ^ string_of_int i)
|
||||
else A.get b.buf (i - len_end)
|
||||
if i < len_end then A.get b.buf (b.start + i)
|
||||
else if i - len_end > b.stop then (
|
||||
invalid_arg "CCRingBuffer.get"
|
||||
) else A.get b.buf (i - len_end)
|
||||
)
|
||||
|
||||
let get_front b i =
|
||||
if is_empty b then
|
||||
invalid_arg ("CCRingBuffer.get_front: " ^ string_of_int i)
|
||||
else
|
||||
get b i
|
||||
if is_empty b then (
|
||||
invalid_arg "CCRingBuffer.get_front"
|
||||
) else get b i
|
||||
|
||||
(*$Q
|
||||
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
|
||||
(Q.pair Q.small_int a_str) (fun (i, s) -> \
|
||||
let s = Bytes.of_string (s ^ " ") in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
let index = abs (i mod Byte.length b) in \
|
||||
let front = Byte.get_front b index in \
|
||||
|
|
@ -608,15 +513,15 @@ module MakeFromArray(A:Array.S) = struct
|
|||
|
||||
let get_back b i =
|
||||
let offset = ((length b) - i - 1) in
|
||||
if offset < 0 then
|
||||
raise (Invalid_argument ("CCRingBuffer.get_back:" ^ string_of_int i))
|
||||
else get b offset
|
||||
if offset < 0 then (
|
||||
invalid_arg "CCRingBuffer.get_back"
|
||||
) else get b offset
|
||||
|
||||
(*$Q
|
||||
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
|
||||
(Q.pair Q.small_int a_str) (fun (i, s) -> \
|
||||
let s = Bytes.of_string (s ^ " ") in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
let index = abs (i mod Byte.length b) in \
|
||||
let back = Byte.get_back b index in \
|
||||
|
|
@ -627,14 +532,14 @@ module MakeFromArray(A:Array.S) = struct
|
|||
let to_list b =
|
||||
let len = length b in
|
||||
let rec build l i =
|
||||
if i < 0 then l else
|
||||
build ((get_front b i)::l) (i-1) in
|
||||
if i < 0 then l else build ((get_front b i)::l) (i-1)
|
||||
in
|
||||
build [] (len-1)
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
let l = Byte.to_list b in \
|
||||
let explode s = let rec exp i l = \
|
||||
|
|
@ -643,45 +548,40 @@ module MakeFromArray(A:Array.S) = struct
|
|||
explode s = l)
|
||||
*)
|
||||
|
||||
let push_back b e = blit_from b (A.make 1 e) 0 1
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.push_back b 'X'; \
|
||||
Byte.peek_back b = 'X')
|
||||
*)
|
||||
|
||||
(* TODO: more efficient version *)
|
||||
(* TODO: more efficient version, with one or two blit *)
|
||||
let append b ~into =
|
||||
iter b ~f:(push_back into)
|
||||
|
||||
let peek_front b =
|
||||
let peek_front_exn b =
|
||||
if is_empty b then raise Empty
|
||||
else A.get b.buf b.start
|
||||
|
||||
let peek_front b = try Some (peek_front_exn b) with Empty -> None
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let back = Byte.peek_front b in \
|
||||
try let back = Byte.peek_front_exn b in \
|
||||
back = Bytes.get s 0 with Byte.Empty -> s_len = 0)
|
||||
*)
|
||||
|
||||
let peek_back b = if is_empty b
|
||||
let peek_back_exn b = if is_empty b
|
||||
then raise Empty
|
||||
else A.get b.buf
|
||||
(if b.stop = 0 then capacity b - 1 else b.stop-1)
|
||||
else (
|
||||
let i = if b.stop = 0 then A.length b.buf - 1 else b.stop-1 in
|
||||
A.get b.buf i
|
||||
)
|
||||
|
||||
let peek_back b = try Some (peek_back_exn b) with Empty -> None
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = Byte.create s_len in \
|
||||
let b = Byte.create (max s_len 64) in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let back = Byte.peek_back b in \
|
||||
try let back = Byte.peek_back_exn b in \
|
||||
back = Bytes.get s (s_len - 1) with Byte.Empty -> s_len = 0)
|
||||
*)
|
||||
|
||||
|
|
@ -691,16 +591,13 @@ module MakeFromArray(A:Array.S) = struct
|
|||
b
|
||||
|
||||
let to_array b =
|
||||
if is_empty b then A.empty
|
||||
else (
|
||||
let a = A.make (length b) (peek_front b) in
|
||||
let a = A.create (length b) in
|
||||
let n = blit_into b a 0 (length b) in
|
||||
assert (n = length b);
|
||||
a
|
||||
)
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> let s = Bytes.of_string s in \
|
||||
a_str (fun s -> let s = Bytes.of_string s in \
|
||||
let b = Byte.of_array s in let s' = Byte.to_array b in \
|
||||
s = s')
|
||||
*)
|
||||
|
|
@ -708,4 +605,218 @@ end
|
|||
|
||||
module Byte = MakeFromArray(Array.Byte)
|
||||
|
||||
module Make(Elt:sig type t end) = MakeFromArray(Array.Make(Elt))
|
||||
module Make(Elt:sig
|
||||
type t
|
||||
val dummy : t
|
||||
end) = MakeFromArray(Array.Make(Elt))
|
||||
|
||||
|
||||
(*$inject
|
||||
module BI = CCRingBuffer.Make(struct type t = int let dummy=0 end)
|
||||
*)
|
||||
|
||||
(* try to trigger an error on resize
|
||||
see issue #126 *)
|
||||
(*$R
|
||||
let b = BI.create 50 in
|
||||
let st = Random.State.make [| 0 |] in
|
||||
for _i = 1 to 100_000 do
|
||||
if Random.State.float st 1.0 < 0.5 then
|
||||
BI.push_back b 0
|
||||
else
|
||||
let _ = BI.take_front b in ()
|
||||
done
|
||||
*)
|
||||
|
||||
(* Test against reference implementation (lists) on a succession of
|
||||
operations.
|
||||
|
||||
Remarks on semantics:
|
||||
|
||||
JUNK_FRONT/JUNK_BACK: try to remove if not empty
|
||||
SKIP: if at least n elements, skip; else nop
|
||||
*)
|
||||
|
||||
(*$inject
|
||||
module BS = CCRingBuffer.Byte
|
||||
|
||||
type op =
|
||||
| Push_back of char
|
||||
| Take_front
|
||||
| Take_back
|
||||
| Peek_front
|
||||
| Peek_back
|
||||
| Junk_front
|
||||
| Junk_back
|
||||
| Skip of int
|
||||
| Blit of string * int * int
|
||||
| Z_if_full
|
||||
|
||||
let str_of_op = function
|
||||
| Push_back c -> Printf.sprintf "push_back(%C)" c
|
||||
| Take_front -> Printf.sprintf "take_front"
|
||||
| Take_back -> Printf.sprintf "take_back"
|
||||
| Peek_front -> Printf.sprintf "peek_front"
|
||||
| Peek_back -> Printf.sprintf "peek_back"
|
||||
| Junk_front -> Printf.sprintf "junk_front"
|
||||
| Junk_back -> Printf.sprintf "junk_back"
|
||||
| Skip n -> Printf.sprintf "skip(%d)" n
|
||||
| Blit (s,i,len) -> Printf.sprintf "blit(%S,%d,%d)" s i len
|
||||
| Z_if_full -> "zero_if_full"
|
||||
|
||||
let push_back c = Push_back c
|
||||
let skip n = assert (n>=0); Skip n
|
||||
let blit s i len =
|
||||
if i<0 || len<0 || i+len > String.length s then (
|
||||
failwith ("wrong blit: " ^ str_of_op (Blit (s,i,len)));
|
||||
);
|
||||
Blit (s,i,len)
|
||||
|
||||
let shrink_op =
|
||||
let open Q.Iter in
|
||||
function
|
||||
| Push_back c -> Q.Shrink.char c >|= push_back
|
||||
| Take_front | Take_back | Junk_back | Junk_front
|
||||
| Z_if_full | Peek_front | Peek_back
|
||||
-> empty
|
||||
| Skip n -> Q.Shrink.int n >|= skip
|
||||
| Blit (s,i,len) ->
|
||||
let s_i =
|
||||
Q.Shrink.int i >>= fun i' ->
|
||||
assert (i' <= i && i' + len <= String.length s);
|
||||
if i' <= 0 then empty else return (blit s i' len)
|
||||
and s_len =
|
||||
Q.Shrink.int len >>= fun len'->
|
||||
assert (len' <= len && i + len' <= String.length s);
|
||||
if len' <= 0 then empty else return (blit s i len')
|
||||
and s_s =
|
||||
Q.Shrink.string s >>= fun s' ->
|
||||
if i+len > String.length s' then empty else return (blit s' i len)
|
||||
in
|
||||
append s_i (append s_len s_s)
|
||||
|
||||
let rec len_op size acc = function
|
||||
| Push_back _ -> min size (acc + 1)
|
||||
| Take_front | Take_back | Junk_front | Junk_back -> max (acc-1) 0
|
||||
| Skip n -> if acc >= n then acc-n else acc
|
||||
| Z_if_full | Peek_front | Peek_back -> acc
|
||||
| Blit (_,_,len) -> min size (acc + len)
|
||||
|
||||
let apply_op b = function
|
||||
| Push_back c -> BS.push_back b c; None
|
||||
| Take_front -> BS.take_front b
|
||||
| Take_back -> BS.take_back b
|
||||
| Junk_front -> (try BS.junk_front b with BS.Empty -> ()); None
|
||||
| Junk_back -> (try BS.junk_back b with BS.Empty -> ()); None
|
||||
| Peek_front -> BS.peek_front b
|
||||
| Peek_back -> BS.peek_back b
|
||||
| Skip n -> if n <= BS.length b then BS.skip b n; None
|
||||
| Blit (s,i,len) ->
|
||||
assert(i+len <= String.length s);
|
||||
BS.blit_from b (Bytes.unsafe_of_string s) i len; None
|
||||
| Z_if_full -> if BS.is_full b then Some '0' else None
|
||||
|
||||
let gen_op =
|
||||
let open Q.Gen in
|
||||
let g_blit =
|
||||
string_size ~gen:g_char (5--20) >>= fun s ->
|
||||
(0 -- String.length s) >>= fun len ->
|
||||
assert (len >= 0 && len <= String.length s);
|
||||
(0--(String.length s-len)) >|= fun i ->
|
||||
blit s i len
|
||||
in
|
||||
frequency
|
||||
[ 3, return Take_back;
|
||||
3, return Take_front;
|
||||
1, return Junk_back;
|
||||
1, return Junk_front;
|
||||
1, return Peek_front;
|
||||
1, return Peek_back;
|
||||
2, g_blit;
|
||||
1, (0--5 >|= skip);
|
||||
2, map push_back g_char;
|
||||
1, return Z_if_full;
|
||||
]
|
||||
|
||||
let arb_op =
|
||||
Q.make
|
||||
~shrink:shrink_op
|
||||
~print:str_of_op
|
||||
gen_op
|
||||
|
||||
let arb_ops = Q.list arb_op
|
||||
|
||||
module L_impl = struct
|
||||
type t = {
|
||||
size: int;
|
||||
mutable l: char list;
|
||||
}
|
||||
|
||||
let create size = {size; l=[]}
|
||||
|
||||
let normalize_ b =
|
||||
let n = List.length b.l in
|
||||
if n>b.size then b.l <- CCList.drop (n-b.size) b.l
|
||||
|
||||
let push_back b c = b.l <- b.l @ [c]; normalize_ b
|
||||
let take_front b = match b.l with
|
||||
| [] -> None
|
||||
| c :: l -> b.l <- l; Some c
|
||||
let peek_front b = match b.l with [] -> None | x::_ -> Some x
|
||||
let take_back b =
|
||||
let n = List.length b.l in
|
||||
if n=0 then None
|
||||
else (
|
||||
let init, last = CCList.take_drop (n-1) b.l in
|
||||
let x = List.hd last in
|
||||
b.l <- init;
|
||||
Some x
|
||||
)
|
||||
let peek_back b = match b.l with [] -> None | l -> Some (List.hd (List.rev l))
|
||||
let junk_front b = ignore (take_front b)
|
||||
let junk_back b = ignore (take_back b)
|
||||
let skip b n =
|
||||
if n <= List.length b.l then (
|
||||
CCInt.range' 0 n (fun _ -> junk_front b)
|
||||
)
|
||||
|
||||
let blit b s i len =
|
||||
for j=i to i+len-1 do push_back b (String.get s j) done
|
||||
|
||||
let apply_op b = function
|
||||
| Push_back c -> push_back b c; None
|
||||
| Take_front -> take_front b
|
||||
| Take_back -> take_back b
|
||||
| Peek_front -> peek_front b
|
||||
| Peek_back -> peek_back b
|
||||
| Junk_back -> junk_back b; None
|
||||
| Junk_front -> junk_front b; None
|
||||
| Skip n -> skip b n; None
|
||||
| Blit (s,i,len) -> blit b s i len; None
|
||||
| Z_if_full -> if b.size = List.length b.l then Some '0' else None
|
||||
|
||||
let to_list b = b.l
|
||||
end
|
||||
|
||||
*)
|
||||
|
||||
(* check that a lot of operations can be applied without failure,
|
||||
and that the result has correct length *)
|
||||
(*$QR & ~count:3_000
|
||||
arb_ops (fun ops ->
|
||||
let size = 64 in
|
||||
let b = BS.create size in
|
||||
List.iter (fun o-> ignore (apply_op b o)) ops;
|
||||
BS.length b = List.fold_left (len_op size) 0 ops)
|
||||
*)
|
||||
|
||||
(* check identical behavior with list implem *)
|
||||
(*$QR & ~count:3_000
|
||||
arb_ops (fun ops ->
|
||||
let size = 64 in
|
||||
let b = BS.create size in
|
||||
let l = L_impl.create size in
|
||||
let l1 = CCList.filter_map (apply_op b) ops in
|
||||
let l2 = CCList.filter_map (L_impl.apply_op l) ops in
|
||||
l1=l2 && BS.to_list b = L_impl.to_list l)
|
||||
*)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
(** [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
201
src/data/CCSimple_queue.ml
Normal 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
90
src/data/CCSimple_queue.mli
Normal 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
|
||||
|
|
@ -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) \
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue