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

Merge branch 'master' into stable

Browse source
This commit is contained in:
Simon Cruanes 2016-04-22 23:03:07 +02:00
commit e69ad8a6de
78 changed files with 2536 additions and 807 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.merlin
View file

@ -26,4 +26,5 @@ PKG bigarray
PKG sequence
PKG hamt
PKG gen
PKG qcheck
FLG -w +a -w -4 -w -44

1
AUTHORS.adoc
View file

@ -13,3 +13,4 @@
- Guillaume Bury (guigui)
- JP Rodi
- octachron (Florian Angeletti)
- Johannes Kloos

53
CHANGELOG.adoc
View file

@ -1,5 +1,58 @@
= Changelog
== 0.17
=== potentially breaking
- change the semantics of `CCString.find_all` (allow overlaps)
=== Additions
- add `CCString.pad` for more webscale
- add `(--^)` to CCRAl, CCFQueue, CCKlist (closes #56); add `CCKList.Infix`
- add monomorphic signatures in `CCInt` and `CCFloat`
- add `CCList.{sorted_insert,is_sorted}`
- add `CCLazy_list` in containers.iter (with a few functions)
- add `CCTrie.longest_prefix`
- provide additional ordering properties in `CCTrie.{above,below}`
- add `CCOpt.if_`
- have
* `CCRandom.split_list` fail on `len=0`
* `CCRandom.sample_without_replacement` fail if `n<=0`
- add `CCOpt.{for_all, exists}`
- add `CCRef.{get_then_incr,incr_then_get}`
- add `Result.{to,of}_err`
- add `CCFormat.within`
- add `map/mapi` to some of the map types.
- add `CCString.{drop,take,chop_prefix,chop_suffix,filter,filter_map}`
- add `CCList.fold_filter_map`
- add `CCIO.File.with_temp` for creating temporary files
- add `{CCArray,CCVector,CCList}.(--^)` for right-open ranges
- add `Containers.{Char,Result}`
- modify `CCPersistentHashtbl.merge` and add `CCMap.merge_safe`
- add `CCHet`, heterogeneous containers (table/map) indexed by keys
- add `CCString.rev`
- add `CCImmutArray` into containers.data
- add `CCList.Assoc.remove`
=== Fixes, misc
- Make `CCPersistentHashtbl.S.merge` more general.
- optimize KMP search in `CCString.Find` (hand-specialize code)
- bugfix in `CCFormat.to_file` (fd was closed too early)
- add a special case for pattern of length 1 in `CCString.find`
- more tests, bugfixes, and benchs for KMP in CCString
- in CCString, use KMP for faster sub-string search; add `find_all{,_l}`
others:
- `watch` target should build all
- add version constraint on sequence
- migrate to new qtest
- add an `IO` section to the tutorial
- enable `-j 0` for ocamlbuild
== 0.16
=== breaking

2
Makefile
View file

@ -126,7 +126,7 @@ devel:
watch:
while find src/ benchs/ -print0 | xargs -0 inotifywait -e delete_self -e modify ; do \
echo "============ at `date` ==========" ; \
make ; \
make all; \
done
.PHONY: examples push_doc tags qtest-gen qtest-clean devel update_next_tag

9
README.adoc
View file

@ -4,7 +4,8 @@
image::media/logo.png[logo]
What is _containers_? (take a look at the link:TUTORIAL.adoc[tutorial]!)
What is _containers_? (take a look at the link:TUTORIAL.adoc[tutorial]!
or the http://cedeela.fr/~simon/software/containers[documentation])
- A usable, reasonably well-designed library that extends OCaml's standard
library (in 'src/core/', packaged under `containers` in ocamlfind. Modules
@ -165,6 +166,7 @@ Documentation http://cedeela.fr/~simon/software/containers[here].
- `CCWBTree`, a weight-balanced tree, implementing a map interface
- `CCRAL`, a random-access list structure, with `O(1)` cons/hd/tl and `O(ln(n))`
access to elements by their index.
- `CCImmutArray`, immutable interface to arrays
=== Containers.io
@ -190,15 +192,16 @@ Iterators:
=== String
See http://cedeela.fr/~simon/software/containers/string[doc].
See http://cedeela.fr/~simon/software/containers/Containers_string[doc].
In the module `Containers_string`:
- `Levenshtein`: edition distance between two strings
- `KMP`: Knuth-Morris-Pratt substring algorithm
- `Parse`: simple parser combinators
=== Advanced
See http://cedeela.fr/~simon/software/containers/advanced[doc].
See http://cedeela.fr/~simon/software/containers/Containers_advanced[doc].
In the module `Containers_advanced`:
- `CCLinq`, high-level query language over collections

100
TUTORIAL.adoc
View file

@ -166,6 +166,76 @@ val x : int = 2
----
== IO helpers
The core library contains a module called `CCIO` that provides useful
functions for reading and writing files. It provides functions that
make resource handling easy, following
the pattern `with_resource : resource -> (access -> 'a) -> 'a` where
the type `access` is a temporary handle to the resource (e.g.,
imagine `resource` is a file name and `access` a file descriptor).
Calling `with_resource r f` will access `r`, give the result to `f`,
compute the result of `f` and, whether `f` succeeds or raises an
error, it will free the resource.
Consider for instance:
[source,OCaml]
----
# CCIO.with_out "/tmp/foobar"
(fun out_channel ->
CCIO.write_lines_l out_channel ["hello"; "world"]);;
- : unit = ()
----
This just opened the file '/tmp/foobar', creating it if it didn't exist,
and wrote two lines in it. We did not have to close the file descriptor
because `with_out` took care of it. By the way, the type signatures are:
[source,OCaml]
----
val with_out :
?mode:int -> ?flags:open_flag list ->
string -> (out_channel -> 'a) -> 'a
val write_lines_l : out_channel -> string list -> unit
----
So we see the pattern for `with_out` (which opens a function in write
mode and gives its functional argument the corresponding file descriptor).
NOTE: you should never let the resource escape the
scope of the `with_resource` call, because it will not be valid outside.
OCaml's type system doesn't make it easy to forbid that so we rely
on convention here (it would be possible, but cumbersome, using
a record with an explicitely quantified function type).
Now we can read the file again:
[source,OCaml]
----
# let lines = CCIO.with_in "/tmp/foobar" CCIO.read_lines_l ;;
val lines : string list = ["hello"; "world"]
----
There are some other functions in `CCIO` that return _generators_
instead of lists. The type of generators in containers
is `type 'a gen = unit -> 'a option` (combinators can be
found in the opam library called "gen"). A generator is to be called
to obtain successive values, until it returns `None` (which means it
has been exhausted). In particular, python users might recognize
the function
[source,OCaml]
----
# CCIO.File.walk ;;
- : string -> walk_item gen = <fun>;;
----
where `type walk_item = [ `Dir | `File ] * string` is a path
paired with a flag distinguishing files from directories.
== To go further: containers.data
There is also a sub-library called `containers.data`, with lots of
@ -173,5 +243,33 @@ more specialized data-structures.
The documentation contains the API for all the modules
(see link:README.adoc[the readme]); they also provide
interface to `sequence` and, as the rest of containers, minimize
dependencies over other modules.
dependencies over other modules. To use `containers.data` you need to link it,
either in your build system or by `#require containers.data;;`
A quick example based on purely functional double-ended queues:
[source,OCaml]
----
# #require "containers.data";;
# #install_printer CCFQueue.print;; (* better printing of queues! *)
# let q = CCFQueue.of_list [2;3;4] ;;
val q : int CCFQueue.t = queue {2; 3; 4}
# let q2 = q |> CCFQueue.cons 1 |> CCFQueue.cons 0 ;;
val q2 : int CCFQueue.t = queue {0; 1; 2; 3; 4}
(* remove first element *)
# CCFQueue.take_front q2;;
- : (int * int CCFQueue.t) option = Some (0, queue {1; 2; 3; 4})
(* q was not changed *)
# CCFQueue.take_front q;;
- : (int * int CCFQueue.t) option = Some (2, queue {3; 4})
(* take works on both ends of the queue *)
# CCFQueue.take_back_l 2 q2;;
- : int CCFQueue.t * int list = (queue {0; 1; 2}, [3; 4])
----

13
_oasis
View file

@ -1,6 +1,6 @@
OASISFormat: 0.4
Name: containers
Version: 0.16
Version: 0.17
Homepage: https://github.com/c-cube/ocaml-containers
Authors: Simon Cruanes
License: BSD-2-clause
@ -10,6 +10,8 @@ OCamlVersion: >= 4.00.1
BuildTools: ocamlbuild
AlphaFeatures: ocamlbuild_more_args
XOCamlbuildExtraArgs: "-j 0"
Synopsis: A modular standard library focused on data structures.
Description:
Containers is a standard library (BSD license) focused on data structures,
@ -77,7 +79,8 @@ Library "containers_data"
CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl,
CCMixmap, CCRingBuffer, CCIntMap, CCPersistentArray,
CCMixset, CCHashconsedSet, CCGraph, CCHashSet, CCBitField,
CCHashTrie, CCBloom, CCWBTree, CCRAL, CCAllocCache
CCHashTrie, CCBloom, CCWBTree, CCRAL, CCAllocCache,
CCImmutArray, CCHet
BuildDepends: bytes
# BuildDepends: bytes, bisect_ppx
FindlibParent: containers
@ -85,7 +88,7 @@ Library "containers_data"
Library "containers_iter"
Path: src/iter
Modules: CCKTree, CCKList
Modules: CCKTree, CCKList, CCLazy_list
FindlibParent: containers
FindlibName: iter
@ -152,7 +155,7 @@ Executable run_benchs
CompiledObject: best
Build$: flag(bench)
MainIs: run_benchs.ml
BuildDepends: containers, containers.advanced,
BuildDepends: containers, containers.advanced, qcheck,
containers.data, containers.string, containers.iter,
containers.thread, sequence, gen, benchmark, hamt
@ -176,7 +179,7 @@ Executable run_qtest
containers.io, containers.advanced, containers.sexp,
containers.bigarray, containers.unix, containers.thread,
containers.data,
sequence, gen, unix, oUnit, QTest2Lib
sequence, gen, unix, oUnit, qcheck
Test all
Command: ./run_qtest.native

10
_tags
View file

@ -1,5 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: 1dc452faf114e2c3c507c622ca14c960)
# DO NOT EDIT (digest: b6feb825fcf5f052598fa7164e7f8398)
# Ignore VCS directories, you can use the same kind of rule outside
# OASIS_START/STOP if you want to exclude directories that contains
# useless stuff for the build process
@ -73,6 +73,7 @@ true: annot, bin_annot
<benchs/run_benchs.{native,byte}>: package(bytes)
<benchs/run_benchs.{native,byte}>: package(gen)
<benchs/run_benchs.{native,byte}>: package(hamt)
<benchs/run_benchs.{native,byte}>: package(qcheck)
<benchs/run_benchs.{native,byte}>: package(result)
<benchs/run_benchs.{native,byte}>: package(sequence)
<benchs/run_benchs.{native,byte}>: package(threads)
@ -84,6 +85,7 @@ true: annot, bin_annot
<benchs/run_benchs.{native,byte}>: use_containers_thread
<benchs/*.ml{,i,y}>: package(benchmark)
<benchs/*.ml{,i,y}>: package(gen)
<benchs/*.ml{,i,y}>: package(qcheck)
<benchs/*.ml{,i,y}>: package(threads)
<benchs/*.ml{,i,y}>: use_containers_advanced
<benchs/*.ml{,i,y}>: use_containers_iter
@ -94,11 +96,11 @@ true: annot, bin_annot
<benchs/run_bench_hash.{native,byte}>: package(result)
<benchs/run_bench_hash.{native,byte}>: use_containers
# Executable run_qtest
<qtest/run_qtest.{native,byte}>: package(QTest2Lib)
<qtest/run_qtest.{native,byte}>: package(bigarray)
<qtest/run_qtest.{native,byte}>: package(bytes)
<qtest/run_qtest.{native,byte}>: package(gen)
<qtest/run_qtest.{native,byte}>: package(oUnit)
<qtest/run_qtest.{native,byte}>: package(qcheck)
<qtest/run_qtest.{native,byte}>: package(result)
<qtest/run_qtest.{native,byte}>: package(sequence)
<qtest/run_qtest.{native,byte}>: package(threads)
@ -113,11 +115,11 @@ true: annot, bin_annot
<qtest/run_qtest.{native,byte}>: use_containers_string
<qtest/run_qtest.{native,byte}>: use_containers_thread
<qtest/run_qtest.{native,byte}>: use_containers_unix
<qtest/*.ml{,i,y}>: package(QTest2Lib)
<qtest/*.ml{,i,y}>: package(bigarray)
<qtest/*.ml{,i,y}>: package(bytes)
<qtest/*.ml{,i,y}>: package(gen)
<qtest/*.ml{,i,y}>: package(oUnit)
<qtest/*.ml{,i,y}>: package(qcheck)
<qtest/*.ml{,i,y}>: package(result)
<qtest/*.ml{,i,y}>: package(sequence)
<qtest/*.ml{,i,y}>: package(threads)
@ -155,7 +157,7 @@ true: annot, bin_annot
# OASIS_STOP
<tests/*.ml{,i}>: thread
<src/threads/*.ml{,i}>: thread
<src/core/CCVector.cmx>: inline(25)
<src/core/CCVector.cmx> or <src/core/CCString.cmx>: inline(25)
<src/data/CCFlatHashtbl.cm*> or <src/data/CCHashTrie.cm*> or <src/data/CCPersistent*>: inline(15)
<src/**/*.ml> and not <src/misc/*.ml>: warn_A, warn(-4), warn(-44)
true: no_alias_deps, safe_string, short_paths

175
benchs/run_benchs.ml
View file

@ -42,14 +42,24 @@ module L = struct
else if x mod 5 = 1 then [x;x+1]
else [x;x+1;x+2;x+3]
let f_ral_ x =
if x mod 10 = 0 then CCRAL.empty
else if x mod 5 = 1 then CCRAL.of_list [x;x+1]
else CCRAL.of_list [x;x+1;x+2;x+3]
let bench_flat_map ?(time=2) n =
let l = CCList.(1 -- n) in
let flatten_map_ l = List.flatten (CCList.map f_ l)
and flatten_ccmap_ l = List.flatten (List.map f_ l) in
let ral = CCRAL.of_list l in
let flatten_map_ l () = ignore @@ List.flatten (CCList.map f_ l)
and flatmap l () = ignore @@ CCList.flat_map f_ l
and flatten_ccmap_ l () = ignore @@ List.flatten (List.map f_ l)
and flatmap_ral_ l () = ignore @@ CCRAL.flat_map f_ral_ l
in
B.throughputN time ~repeat
[ "flat_map", CCList.flat_map f_, l
; "flatten o CCList.map", flatten_ccmap_, l
; "flatten o map", flatten_map_, l
[ "flat_map", flatmap l, ()
; "flatten o CCList.map", flatten_ccmap_ l, ()
; "flatten o map", flatten_map_ l, ()
; "ral_flatmap", flatmap_ral_ ral, ()
]
(* APPEND *)
@ -87,6 +97,21 @@ module L = struct
; "CCList.(fold_right append)", cc_fold_right_append_, l
]
(* RANDOM ACCESS *)
let bench_nth ?(time=2) n =
let l = CCList.(1 -- n) in
let ral = CCRAL.of_list l in
let bench_list l () =
for i = 0 to n-1 do ignore (List.nth l i) done
and bench_ral l () =
for i = 0 to n-1 do ignore (CCRAL.get_exn l i) done
in
B.throughputN time ~repeat
[ "List.nth", bench_list l, ()
; "RAL.get", bench_ral ral, ()
]
(* MAIN *)
let () = B.Tree.register (
@ -112,6 +137,11 @@ module L = struct
[ app_int (bench_append ~time:2) 100
; app_int (bench_append ~time:2) 10_000
; app_int (bench_append ~time:4) 100_000]
; "nth" @>>
B.Tree.concat
[ app_int (bench_nth ~time:2) 100
; app_int (bench_nth ~time:2) 10_000
; app_int (bench_nth ~time:4) 100_000]
]
)
end
@ -1081,7 +1111,6 @@ module Thread = struct
end
module Graph = struct
(* divisors graph *)
let div_children_ i =
(* divisors of [i] that are [>= j] *)
@ -1155,6 +1184,140 @@ module Graph = struct
)
end
module Str = struct
(* random string, but always returns the same for a given size *)
let rand_str_ ?(among="abcdefgh") n =
let module Q = QCheck in
let st = Random.State.make [| n + 17 |] in
let gen_c = QCheck.Gen.oneofl (CCString.to_list among) in
QCheck.Gen.string_size ~gen:gen_c (QCheck.Gen.return n) st
let find ?(start=0) ~sub s =
let n = String.length sub in
let i = ref start in
try
while !i + n <= String.length s do
if CCString.is_sub ~sub 0 s !i ~len:n then raise Exit;
incr i
done;
-1
with Exit ->
!i
let rfind ~sub s =
let n = String.length sub in
let i = ref (String.length s - n) in
try
while !i >= 0 do
if CCString.is_sub ~sub 0 s !i ~len:n then raise Exit;
decr i
done;
~-1
with Exit ->
!i
let find_all ?(start=0) ~sub s =
let i = ref start in
fun () ->
let res = find ~sub s ~start:!i in
if res = ~-1 then None
else (
i := res + 1;
Some res
)
let find_all_l ?start ~sub s = find_all ?start ~sub s |> Gen.to_list
let pp_pb needle haystack =
Format.printf "search needle `%s` in `%s`...@."
needle (String.sub haystack 0 (min 300 (String.length haystack)))
(* benchmark String.{,r}find *)
let bench_find_ ~dir ~size n =
let needle = rand_str_ size in
let haystack = rand_str_ n in
pp_pb needle haystack;
let mk_naive = match dir with
| `Direct -> fun () -> find ~sub:needle haystack
| `Reverse -> fun () -> rfind ~sub:needle haystack
and mk_current = match dir with
| `Direct -> fun () -> CCString.find ~sub:needle haystack
| `Reverse -> fun () -> CCString.rfind ~sub:needle haystack
and mk_current_compiled = match dir with
| `Direct -> let f = CCString.find ~start:0 ~sub:needle in fun () -> f haystack
| `Reverse -> let f = CCString.rfind ~sub:needle in fun () -> f haystack
in
assert (mk_naive () = mk_current ());
B.throughputN 3 ~repeat
[ "naive", mk_naive, ()
; "current", mk_current, ()
; "current_compiled", mk_current_compiled, ()
]
(* benchmark String.find_all *)
let bench_find_all ~size n =
let needle = rand_str_ size in
let haystack = rand_str_ n in
pp_pb needle haystack;
let mk_naive () = find_all_l ~sub:needle haystack
and mk_current () = CCString.find_all_l ~sub:needle haystack
and mk_current_compiled =
let f = CCString.find_all_l ~start:0 ~sub:needle in fun () -> f haystack in
assert (mk_naive () = mk_current ());
B.throughputN 3 ~repeat
[ "naive", mk_naive, ()
; "current", mk_current, ()
; "current_compiled", mk_current_compiled, ()
]
(* benchmark String.find_all on constant strings *)
let bench_find_all_special ~size n =
let needle = CCString.repeat "a" (size-1) ^ "b" in
let haystack = CCString.repeat "a" n in
pp_pb needle haystack;
let mk_naive () = find_all_l ~sub:needle haystack
and mk_current () = CCString.find_all_l ~sub:needle haystack in
assert (mk_naive () = mk_current ());
B.throughputN 3 ~repeat
[ "naive", mk_naive, ()
; "current", mk_current, ()
]
let bench_find = bench_find_ ~dir:`Direct
let bench_rfind = bench_find_ ~dir:`Reverse
let () = B.Tree.register (
"string" @>>>
[ "find" @>>>
[ "3" @>> app_ints (bench_find ~size:3) [100; 100_000; 500_000]
; "5" @>> app_ints (bench_find ~size:5) [100; 100_000; 500_000]
; "15" @>> app_ints (bench_find ~size:15) [100; 100_000; 500_000]
; "50" @>> app_ints (bench_find ~size:50) [100; 100_000; 500_000]
; "500" @>> app_ints (bench_find ~size:500) [100_000; 500_000]
];
"find_all" @>>>
[ "1" @>> app_ints (bench_find_all ~size:1) [100; 100_000; 500_000]
; "3" @>> app_ints (bench_find_all ~size:3) [100; 100_000; 500_000]
; "5" @>> app_ints (bench_find_all ~size:5) [100; 100_000; 500_000]
; "15" @>> app_ints (bench_find_all ~size:15) [100; 100_000; 500_000]
; "50" @>> app_ints (bench_find_all ~size:50) [100; 100_000; 500_000]
; "500" @>> app_ints (bench_find_all ~size:500) [100_000; 500_000]
; "special" @>>>
[ "6" @>> app_ints (bench_find_all_special ~size:6) [100_000; 500_000]
; "30" @>> app_ints (bench_find_all_special ~size:30) [100_000; 500_000]
; "100" @>> app_ints (bench_find_all_special ~size:100) [100_000; 500_000]
]
];
"rfind" @>>>
[ "3" @>> app_ints (bench_rfind ~size:3) [100; 100_000; 500_000]
; "15" @>> app_ints (bench_rfind ~size:15) [100; 100_000; 500_000]
; "50" @>> app_ints (bench_rfind ~size:50) [100; 100_000; 500_000]
; "500" @>> app_ints (bench_rfind ~size:500) [100_000; 500_000]
];
])
end
module Alloc = struct
module type ALLOC_ARR = sig
type 'a t

5
containers.odocl
View file

@ -1,5 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: 0670f1d87f40756af3f470a0fbb07a1b)
# DO NOT EDIT (digest: b2fa90a283cbf634dc8de2f37468b64b)
src/core/CCVector
src/core/CCPrint
src/core/CCError
@ -28,6 +28,7 @@ src/core/CCResult
src/core/Containers
src/iter/CCKTree
src/iter/CCKList
src/iter/CCLazy_list
src/data/CCMultiMap
src/data/CCMultiSet
src/data/CCTrie
@ -52,6 +53,8 @@ src/data/CCBloom
src/data/CCWBTree
src/data/CCRAL
src/data/CCAllocCache
src/data/CCImmutArray
src/data/CCHet
src/string/Containers_string
src/string/CCKMP
src/string/CCLevenshtein

3
doc/build_deps.ml
View file

@ -1,5 +1,8 @@
#!/usr/bin/env ocaml
(* note: this requires to generate documentation first, so that
.odoc files are generated *)
#use "topfind";;
#require "containers";;
#require "containers.io";;

8
doc/intro.txt
View file

@ -71,10 +71,13 @@ CCBitField
CCBloom
CCBV
CCCache
CCDeque
CCFQueue
CCFlatHashtbl
CCGraph
CCHashSet
CCHashTrie
CCImmutArray
CCIntMap
CCMixmap
CCMixset
@ -113,7 +116,10 @@ CCSexpM
Iterators:
{!modules: CCKList CCKTree}
{!modules:
CCKList
CCKTree
CCLazy_list}
{4 String}

22
opam
View file

@ -1,6 +1,6 @@
opam-version: "1.2"
name: "containers"
version: "0.16.1"
version: "0.17"
author: "Simon Cruanes"
maintainer: "simon.cruanes@inria.fr"
build: [
@ -31,7 +31,12 @@ depends: [
"cppo" {build}
"ocamlbuild" {build}
]
depopts: [ "sequence" "base-bigarray" "base-unix" "base-threads" ]
depopts: [ "sequence" "base-bigarray" "base-unix" "base-threads" "qtest" { test } ]
conflicts: [
"sequence" { < "0.5" }
"qtest" { < "2.2" }
"qcheck"
]
tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ]
homepage: "https://github.com/c-cube/ocaml-containers/"
doc: "http://cedeela.fr/~simon/software/containers/"
@ -39,11 +44,12 @@ available: [ocaml-version >= "4.00.0"]
dev-repo: "https://github.com/c-cube/ocaml-containers.git"
bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"
post-messages: [
"A large release, with several deprecations
(in particular, bigstring, now in its own library, and
submodules of CCHashtbl), and lots of new features, including coloring in
CCFormat!
"Another large release, with many new features:
A new tutorial can be found at https://github.com/c-cube/ocaml-containers/blob/master/TUTORIAL.adoc
change log: https://github.com/c-cube/ocaml-containers/blob/0.16/CHANGELOG.adoc"
- performance improvements, in particular for string search (using KMP)
- `CCHet`, a heterogeneous map with unique keys
- `CCImmutArray`, immutable arrays
- `CCString.pad`, for webscale string padding!
as usual, see https://github.com/c-cube/ocaml-containers/blob/0.17/CHANGELOG.adoc"
]

19
setup.ml
View file

@ -1,7 +1,7 @@
(* setup.ml generated for the first time by OASIS v0.4.4 *)
(* OASIS_START *)
(* DO NOT EDIT (digest: f539e6ebb649532fb166b0cbc6f63784) *)
(* DO NOT EDIT (digest: 93504d34b391fe80e66c77fd2e99f4e0) *)
(*
Regenerated by OASIS v0.4.5
Visit http://oasis.forge.ocamlcore.org for more information and
@ -6802,7 +6802,7 @@ open OASISTypes;;
let setup_t =
{
BaseSetup.configure = InternalConfigurePlugin.configure;
build = OCamlbuildPlugin.build ["-use-ocamlfind"];
build = OCamlbuildPlugin.build ["-use-ocamlfind"; "-j 0"];
test =
[
("all",
@ -6875,7 +6875,7 @@ let setup_t =
alpha_features = ["ocamlbuild_more_args"];
beta_features = [];
name = "containers";
version = "0.16";
version = "0.17";
license =
OASISLicense.DEP5License
(OASISLicense.DEP5Unit
@ -7194,7 +7194,9 @@ let setup_t =
"CCBloom";
"CCWBTree";
"CCRAL";
"CCAllocCache"
"CCAllocCache";
"CCImmutArray";
"CCHet"
];
lib_pack = false;
lib_internal_modules = [];
@ -7225,7 +7227,7 @@ let setup_t =
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
{
lib_modules = ["CCKTree"; "CCKList"];
lib_modules = ["CCKTree"; "CCKList"; "CCLazy_list"];
lib_pack = false;
lib_internal_modules = [];
lib_findlib_parent = Some "containers";
@ -7500,6 +7502,7 @@ let setup_t =
[
InternalLibrary "containers";
InternalLibrary "containers_advanced";
FindlibPackage ("qcheck", None);
InternalLibrary "containers_data";
InternalLibrary "containers_string";
InternalLibrary "containers_iter";
@ -7585,7 +7588,7 @@ let setup_t =
FindlibPackage ("gen", None);
FindlibPackage ("unix", None);
FindlibPackage ("oUnit", None);
FindlibPackage ("QTest2Lib", None)
FindlibPackage ("qcheck", None)
];
bs_build_tools = [ExternalTool "ocamlbuild"];
bs_c_sources = [];
@ -7719,7 +7722,7 @@ let setup_t =
};
oasis_fn = Some "_oasis";
oasis_version = "0.4.5";
oasis_digest = Some "\178\214Tv\135\017WW\030\246]e\192\157\t\199";
oasis_digest = Some "\168\138o\130\169\030i2!\170\1730n\148\174\208";
oasis_exec = None;
oasis_setup_args = [];
setup_update = false
@ -7727,6 +7730,6 @@ let setup_t =
let setup () = BaseSetup.setup setup_t;;
# 7731 "setup.ml"
# 7734 "setup.ml"
(* OASIS_STOP *)
let () = setup ();;

2
src/advanced/CCLinq.mli
View file

@ -33,6 +33,8 @@ Functions and operations are assumed to be referentially transparent, i.e.
they should not rely on external side effects, they should not rely on
the order of execution.
@deprecated use {{: https://github.com/c-cube/olinq} OLinq} (once released)
{[
CCLinq.(

1
src/bigarray/CCArray1.mli
View file

@ -25,6 +25,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Bigarrays of dimension 1}
@deprecated do not use, this was always experimental
{b NOTE this module will be removed soon and should not be depended upon}
{b status: deprecated}

22
src/core/CCArray.ml
View file

@ -443,6 +443,28 @@ let (--) i j =
else
Array.init (i-j+1) (fun k -> i-k)
(*$T
(1 -- 4) |> Array.to_list = [1;2;3;4]
(4 -- 1) |> Array.to_list = [4;3;2;1]
(0 -- 0) |> Array.to_list = [0]
*)
(*$Q
Q.(pair small_int small_int) (fun (a,b) -> \
(a -- b) |> Array.to_list = CCList.(a -- b))
*)
let (--^) i j =
if i=j then [| |]
else if i>j
then Array.init (i-j) (fun k -> i-k)
else Array.init (j-i) (fun k -> i+k)
(*$Q
Q.(pair small_int small_int) (fun (a,b) -> \
(a --^ b) |> Array.to_list = CCList.(a --^ b))
*)
(** all the elements of a, but the i-th, into a list *)
let except_idx a i =
foldi

4
src/core/CCArray.mli
View file

@ -166,6 +166,10 @@ val except_idx : 'a t -> int -> 'a list
val (--) : int -> int -> int t
(** Range array *)
val (--^) : int -> int -> int t
(** Range array, excluding right bound
@since 0.17 *)
val random : 'a random_gen -> 'a t random_gen
val random_non_empty : 'a random_gen -> 'a t random_gen
val random_len : int -> 'a random_gen -> 'a t random_gen

10
src/core/CCFloat.ml
View file

@ -74,3 +74,13 @@ let random_range i j st = i +. random (j-.i) st
let equal_precision ~epsilon a b = abs_float (a-.b) < epsilon
let classify = Pervasives.classify_float
module Infix = struct
let (=) = Pervasives.(=)
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (>) = Pervasives.(>)
let (<=) = Pervasives.(<=)
let (>=) = Pervasives.(>=)
end
include Infix

25
src/core/CCFloat.mli
View file

@ -76,3 +76,28 @@ val equal_precision : epsilon:t -> t -> t -> bool
(** Equality with allowed error up to a non negative epsilon value *)
val classify : float -> fpclass
(** {2 Infix Operators}
@since 0.17 *)
module Infix : sig
val (=) : t -> t -> bool
(** @since 0.17 *)
val (<>) : t -> t -> bool
(** @since 0.17 *)
val (<) : t -> t -> bool
(** @since 0.17 *)
val (>) : t -> t -> bool
(** @since 0.17 *)
val (<=) : t -> t -> bool
(** @since 0.17 *)
val (>=) : t -> t -> bool
(** @since 0.17 *)
end
include module type of Infix

35
src/core/CCFormat.ml
View file

@ -76,14 +76,19 @@ let opt pp fmt x = match x with
| None -> Format.pp_print_string fmt "none"
| Some x -> Format.fprintf fmt "some %a" pp x
let pair ppa ppb fmt (a, b) =
Format.fprintf fmt "(%a,@ %a)" ppa a ppb b
let pair ?(sep=", ") ppa ppb fmt (a, b) =
Format.fprintf fmt "(%a%s@,%a)" ppa a sep ppb b
let triple ppa ppb ppc fmt (a, b, c) =
Format.fprintf fmt "(%a,@ %a,@ %a)" ppa a ppb b ppc c
let triple ?(sep=", ") ppa ppb ppc fmt (a, b, c) =
Format.fprintf fmt "(%a%s@,%a%s@,%a)" ppa a sep ppb b sep ppc c
let quad ppa ppb ppc ppd fmt (a, b, c, d) =
Format.fprintf fmt "(%a,@ %a,@ %a,@ %a)" ppa a ppb b ppc c ppd d
let quad ?(sep=", ") ppa ppb ppc ppd fmt (a, b, c, d) =
Format.fprintf fmt "(%a%s@,%a%s@,%a%s@,%a)" ppa a sep ppb b sep ppc c sep ppd d
let within a b p out x =
string out a;
p out x;
string out b
let map f pp fmt x =
pp fmt (f x);
@ -125,22 +130,12 @@ let fprintf = Format.fprintf
let stdout = Format.std_formatter
let stderr = Format.err_formatter
let _with_file_out filename f =
let to_file filename format =
let oc = open_out filename in
let fmt = Format.formatter_of_out_channel oc in
begin try
let x = f fmt in
Format.pp_print_flush fmt ();
close_out oc;
x
with e ->
Format.pp_print_flush fmt ();
close_out_noerr oc;
raise e
end
let to_file filename format =
_with_file_out filename (fun fmt -> Format.fprintf fmt format)
Format.kfprintf
(fun fmt -> Format.pp_print_flush fmt (); close_out_noerr oc)
fmt format
type color =
[ `Black

15
src/core/CCFormat.mli
View file

@ -38,9 +38,18 @@ val seq : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a seque
val opt : 'a printer -> 'a option printer
val pair : 'a printer -> 'b printer -> ('a * 'b) printer
val triple : 'a printer -> 'b printer -> 'c printer -> ('a * 'b * 'c) printer
val quad : 'a printer -> 'b printer -> 'c printer -> 'd printer -> ('a * 'b * 'c * 'd) printer
(** In the tuple printers, the [sep] argument is only available
@since 0.17 *)
val pair : ?sep:string -> 'a printer -> 'b printer -> ('a * 'b) printer
val triple : ?sep:string -> 'a printer -> 'b printer -> 'c printer -> ('a * 'b * 'c) printer
val quad : ?sep:string -> 'a printer -> 'b printer ->
'c printer -> 'd printer -> ('a * 'b * 'c * 'd) printer
val within : string -> string -> 'a printer -> 'a printer
(** [within a b p] wraps [p] inside the strings [a] and [b]. Convenient,
for instances, for brackets, parenthesis, quotes, etc.
@since 0.17 *)
val map : ('a -> 'b) -> 'b printer -> 'a printer

33
src/core/CCIO.ml
View file

@ -49,15 +49,18 @@ let gen_flat_map f next_elem =
in
next
let finally_ f x ~h =
try
let res = f x in
h x;
res
with e ->
h x;
raise e
let with_in ?(mode=0o644) ?(flags=[Open_text]) filename f =
let ic = open_in_gen (Open_rdonly::flags) mode filename in
try
let x = f ic in
close_in ic;
x
with e ->
close_in ic;
raise e
finally_ f ic ~h:close_in
let read_chunks ?(size=1024) ic =
let buf = Bytes.create size in
@ -139,13 +142,7 @@ let read_all ?(size=1024) ic = read_all_ ~op:Ret_string ~size ic
let with_out ?(mode=0o644) ?(flags=[Open_creat; Open_trunc; Open_text]) filename f =
let oc = open_out_gen (Open_wronly::flags) mode filename in
try
let x = f oc in
close_out oc;
x
with e ->
close_out oc;
raise e
finally_ f oc ~h:close_out
let with_out_a ?mode ?(flags=[]) filename f =
with_out ?mode ~flags:(Open_wronly::Open_creat::Open_append::flags) filename f
@ -323,8 +320,8 @@ module File = struct
gen_filter_map
(function
| `File, f -> Some f
| `Dir, _ -> None
) (walk d)
| `Dir, _ -> None)
(walk d)
else read_dir_base d
let show_walk_item (i,f) =
@ -332,4 +329,8 @@ module File = struct
| `File -> "file:"
| `Dir -> "dir:"
) ^ f
let with_temp ?temp_dir ~prefix ~suffix f =
let name = Filename.temp_file ?temp_dir prefix suffix in
finally_ f name ~h:remove_noerr
end

10
src/core/CCIO.mli
View file

@ -195,4 +195,14 @@ module File : sig
symlinks, etc.) *)
val show_walk_item : walk_item -> string
val with_temp :
?temp_dir:string -> prefix:string -> suffix:string ->
(string -> 'a) -> 'a
(** [with_temp ~prefix ~suffix f] will call [f] with the name of a new
temporary file (located in [temp_dir]).
After [f] returns, the file is deleted. Best to be used in
combination with {!with_out}.
See {!Filename.temp_file}
@since 0.17 *)
end

12
src/core/CCInt.ml
View file

@ -53,3 +53,15 @@ let to_string = string_of_int
let of_string s =
try Some (int_of_string s)
with _ -> None
module Infix = struct
let (=) = Pervasives.(=)
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (>) = Pervasives.(>)
let (<=) = Pervasives.(<=)
let (>=) = Pervasives.(>=)
end
include Infix
let min = min
let max = max

31
src/core/CCInt.mli
View file

@ -39,3 +39,34 @@ val to_string : t -> string
val of_string : string -> t option
(** @since 0.13 *)
val min : t -> t -> t
(** @since 0.17 *)
val max : t -> t -> t
(** @since 0.17 *)
(** {2 Infix Operators}
@since 0.17 *)
module Infix : sig
val (=) : t -> t -> bool
(** @since 0.17 *)
val (<>) : t -> t -> bool
(** @since 0.17 *)
val (<) : t -> t -> bool
(** @since 0.17 *)
val (>) : t -> t -> bool
(** @since 0.17 *)
val (<=) : t -> t -> bool
(** @since 0.17 *)
val (>=) : t -> t -> bool
(** @since 0.17 *)
end
include module type of Infix

79
src/core/CCList.ml
View file

@ -174,6 +174,21 @@ let fold_map2 f acc l1 l2 =
with Invalid_argument _ -> true)
*)
let fold_filter_map f acc l =
let rec aux f acc map_acc l = match l with
| [] -> acc, List.rev map_acc
| x :: l' ->
let acc, y = f acc x in
aux f acc (cons_maybe y map_acc) l'
in
aux f acc [] l
(*$= & ~printer:Q.Print.(pair int (list int))
(List.fold_left (+) 0 (1--10), [2;4;6;8;10]) \
(fold_filter_map (fun acc x -> acc+x, if x mod 2 = 0 then Some x else None) \
0 (1--10))
*)
let fold_flat_map f acc l =
let rec aux f acc map_acc l = match l with
| [] -> acc, List.rev map_acc
@ -351,6 +366,47 @@ let sort_uniq (type elt) ?(cmp=Pervasives.compare) l =
sort_uniq [10;10;10;10;1;10] = [1;10]
*)
let is_sorted ?(cmp=Pervasives.compare) l =
let rec aux cmp = function
| [] | [_] -> true
| x :: ((y :: _) as tail) -> cmp x y <= 0 && aux cmp tail
in
aux cmp l
(*$Q
Q.(list small_int) (fun l -> \
is_sorted (List.sort Pervasives.compare l))
*)
let sorted_insert ?(cmp=Pervasives.compare) ?(uniq=false) x l =
let rec aux cmp uniq x left l = match l with
| [] -> List.rev_append left [x]
| y :: tail ->
match cmp x y with
| 0 ->
let l' = if uniq then l else x :: l in
List.rev_append left l'
| n when n<0 -> List.rev_append left (x :: l)
| _ -> aux cmp uniq x (y::left) tail
in
aux cmp uniq x [] l
(*$Q
Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \
is_sorted (sorted_insert ~uniq:true x l))
Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \
is_sorted (sorted_insert ~uniq:false x l))
Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \
let l' = sorted_insert ~uniq:false x l in \
List.length l' = List.length l + 1)
Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \
List.mem x (sorted_insert x l))
*)
let uniq_succ ?(eq=(=)) l =
let rec f acc l = match l with
| [] -> List.rev acc
@ -763,11 +819,18 @@ let range' i j =
let (--) = range
let (--^) = range'
(*$T
append (range 0 100) (range 101 1000) = range 0 1000
append (range 1000 501) (range 500 0) = range 1000 0
*)
(*$Q
Q.(pair small_int small_int) (fun (a,b) -> \
let l = (a--^b) in not (List.mem b l))
*)
let replicate i x =
let rec aux acc i =
if i = 0 then acc
@ -849,6 +912,21 @@ module Assoc = struct
(Assoc.update [1,"1"; 2,"2"] 3 \
~f:(function None -> Some "3" | _ -> assert false) |> lsort)
*)
let remove ?(eq=(=)) l x =
search_set eq [] l x
~f:(fun _ opt_y rest -> match opt_y with
| None -> l (* keep as is *)
| Some _ -> rest)
(*$=
[1,"1"] \
(Assoc.remove [1,"1"; 2,"2"] 2 |> lsort)
[1,"1"; 3,"3"] \
(Assoc.remove [1,"1"; 2,"2"; 3,"3"] 2 |> lsort)
[1,"1"; 2,"2"] \
(Assoc.remove [1,"1"; 2,"2"] 3 |> lsort)
*)
end
(** {2 Zipper} *)
@ -1088,6 +1166,7 @@ module Infix = struct
let (<$>) = (<$>)
let (>>=) = (>>=)
let (--) = (--)
let (--^) = (--^)
end
(** {2 IO} *)

34
src/core/CCList.mli
View file

@ -53,6 +53,11 @@ val fold_map2 : ('acc -> 'a -> 'b -> 'acc * 'c) -> 'acc -> 'a list -> 'b list ->
@raise Invalid_argument if the lists do not have the same length
@since 0.16 *)
val fold_filter_map : ('acc -> 'a -> 'acc * 'b option) -> 'acc -> 'a list -> 'acc * 'b list
(** [fold_filter_map f acc l] is a [fold_left]-like function, but also
generates a list of output in a way similar to {!filter_map}
@since 0.17 *)
val fold_flat_map : ('acc -> 'a -> 'acc * 'b list) -> 'acc -> 'a list -> 'acc * 'b list
(** [fold_flat_map f acc l] is a [fold_left]-like function, but it also maps the
list to a list of lists that is then [flatten]'d..
@ -179,6 +184,24 @@ val sorted_merge_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
removes duplicates
@since 0.10 *)
val is_sorted : ?cmp:('a -> 'a -> int) -> 'a list -> bool
(** [is_sorted l] returns [true] iff [l] is sorted (according to given order)
@param cmp the comparison function (default [Pervasives.compare])
@since 0.17 *)
val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list
(** [sorted_insert x l] inserts [x] into [l] such that, if [l] was sorted,
then [sorted_insert x l] is sorted too.
@param uniq if true and [x] is already in sorted position in [l], then
[x] is not duplicated. Default [false] ([x] will be inserted in any case).
@since 0.17 *)
(*$Q
Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \
is_sorted (sorted_insert x l))
*)
val uniq_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list
(** [uniq_succ l] removes duplicate elements that occur one next to the other.
Examples:
@ -263,6 +286,10 @@ val range' : int -> int -> int t
val (--) : int -> int -> int t
(** Infix alias for [range] *)
val (--^) : int -> int -> int t
(** Infix alias for [range']
@since 0.17 *)
val replicate : int -> 'a -> 'a t
(** Replicate the given element [n] times *)
@ -294,6 +321,10 @@ module Assoc : sig
and removing [k] if it returns [None], mapping [k] to [v'] if it
returns [Some v']
@since 0.16 *)
val remove : ?eq:('a->'a->bool) -> ('a,'b) t -> 'a -> ('a,'b) t
(** [remove l k] removes the first occurrence of [k] from [l].
@since 0.17 *)
end
(** {2 Zipper} *)
@ -478,6 +509,9 @@ module Infix : sig
val (<$>) : ('a -> 'b) -> 'a t -> 'b t
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
val (--) : int -> int -> int t
val (--^) : int -> int -> int t
(** @since 0.17 *)
end
(** {2 IO} *)

15
src/core/CCMap.ml
View file

@ -24,6 +24,12 @@ module type S = sig
[k] is removed from [m], and if the result is [Some v'] then
[add k v' m] is returned. *)
val merge_safe :
f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) ->
'a t -> 'b t -> 'c t
(** [merge_safe ~f a b] merges the maps [a] and [b] together.
@since 0.17 *)
val of_seq : (key * 'a) sequence -> 'a t
val add_seq : 'a t -> (key * 'a) sequence -> 'a t
@ -75,6 +81,15 @@ module Make(O : Map.OrderedType) = struct
| None -> remove k m
| Some v' -> add k v' m
let merge_safe ~f a b =
merge
(fun k v1 v2 -> match v1, v2 with
| None, None -> assert false
| Some v1, None -> f k (`Left v1)
| None, Some v2 -> f k (`Right v2)
| Some v1, Some v2 -> f k (`Both (v1,v2)))
a b
let add_seq m s =
let m = ref m in
s (fun (k,v) -> m := add k v !m);

6
src/core/CCMap.mli
View file

@ -27,6 +27,12 @@ module type S = sig
[k] is removed from [m], and if the result is [Some v'] then
[add k v' m] is returned. *)
val merge_safe :
f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) ->
'a t -> 'b t -> 'c t
(** [merge_safe ~f a b] merges the maps [a] and [b] together.
@since 0.17 *)
val of_seq : (key * 'a) sequence -> 'a t
val add_seq : 'a t -> (key * 'a) sequence -> 'a t

10
src/core/CCOpt.ml
View file

@ -71,6 +71,16 @@ let filter p = function
| Some x as o when p x -> o
| o -> o
let if_ p x = if p x then Some x else None
let exists p = function
| None -> false
| Some x -> p x
let for_all p = function
| None -> true
| Some x -> p x
let iter f o = match o with
| None -> ()
| Some x -> f x

10
src/core/CCOpt.mli
View file

@ -50,6 +50,16 @@ val filter : ('a -> bool) -> 'a t -> 'a t
(** Filter on 0 or 1 element
@since 0.5 *)
val if_ : ('a -> bool) -> 'a -> 'a option
(** [if_ f x] is [Some x] if [f x], [None] otherwise
@since 0.17 *)
val exists : ('a -> bool) -> 'a t -> bool
(** @since 0.17 *)
val for_all : ('a -> bool) -> 'a t -> bool
(** @since 0.17 *)
val get : 'a -> 'a t -> 'a
(** [get default x] unwraps [x], but if [x = None] it returns [default] instead.
@since 0.4.1 *)

14
src/core/CCRandom.ml
View file

@ -85,7 +85,9 @@ let sample_without_replacement (type elt) ?(compare=compare) k (rng:elt t) st=
if S.mem x s then
aux s k
else
aux (S.add x s) (k-1) in
aux (S.add x s) (k-1)
in
if k<=0 then invalid_arg "sample_without_replacement";
aux S.empty k
let list_seq l st = List.map (fun f -> f st) l
@ -112,12 +114,20 @@ let _diff_list ~last l =
If we define, y_k = x_{k+1} - x_{k} for k in 0..(len-1), then by construction
∑_k y_k = ∑_k (x_{k+1} - x_k ) = x_{len} - x_0 = i. *)
let split_list i ~len st =
if len <= 1 then invalid_arg "Random.split_list";
if i >= len then
let xs = sample_without_replacement (len-1) (int_range 1 (i-1)) st in
_diff_list ( 0::xs ) ~last:i
else
None
(*$Q
Q.(pair small_int small_int) (fun (i,j) -> \
let len, n = 2+min i j, max i j in \
let l = QCheck.Gen.generate1 (split_list n ~len) in \
match l with None -> true | Some l -> l<> [] && List.for_all (fun x->x>0) l)
*)
let retry ?(max=10) g st =
let rec aux n =
match g st with
@ -213,5 +223,5 @@ let uniformity_test ?(size_hint=10) k rng st =
Hashtbl.fold predicate histogram true
(*$T split_list
run ~st:(Runner.random_state()) ( uniformity_test 50_000 (split_list 10 ~len:3) )
run ~st:(QCheck_runner.random_state()) ( uniformity_test 50_000 (split_list 10 ~len:3) )
*)

5
src/core/CCRandom.mli
View file

@ -58,6 +58,7 @@ val sample_without_replacement:
(** [sample_without_replacement n g] makes a list of [n] elements which are all
generated randomly using [g] with the added constraint that none of the generated
random values are equal
@raise Invalid_argument if [n <= 0]
@since 0.15 *)
val list_seq : 'a t list -> 'a list t
@ -102,7 +103,9 @@ val split : int -> (int * int) option t
val split_list : int -> len:int -> int list option t
(** Split a value [n] into a list of values whose sum is [n]
and whose length is [length].
and whose length is [length]. The list is never empty and does not
contain [0].
@raise Invalid_argument if [len <= 1]
@return [None] if the value is too small *)
val retry : ?max:int -> 'a option t -> 'a option t

8
src/core/CCRef.ml
View file

@ -21,6 +21,14 @@ let iter f r = f !r
let update f r = r := (f !r)
let incr_then_get r =
incr r; !r
let get_then_incr r =
let x = !r in
incr r;
x
let compare f r1 r2 = f !r1 !r2
let equal f r1 r2 = f !r1 !r2

8
src/core/CCRef.mli
View file

@ -24,6 +24,14 @@ val iter : ('a -> unit) -> 'a t -> unit
val update : ('a -> 'a) -> 'a t -> unit
(** Update the reference's content with the given function *)
val incr_then_get : int t -> int
(** [incr_then_get r] increments [r] and returns its new value, think [++ r]
@since 0.17 *)
val get_then_incr : int t -> int
(** [get_then_incr r] increments [r] and returns its old value, think [r++]
@since 0.17 *)
val compare : 'a ord -> 'a t ord
val equal : 'a eq -> 'a t eq

10
src/core/CCResult.ml
View file

@ -245,6 +245,16 @@ let to_seq e k = match e with
| Ok x -> k x
| Error _ -> ()
type ('a, 'b) error = [`Ok of 'a | `Error of 'b]
let of_err = function
| `Ok x -> Ok x
| `Error y -> Error y
let to_err = function
| Ok x -> `Ok x
| Error y -> `Error y
(** {2 IO} *)
let pp pp_x buf e = match e with

8
src/core/CCResult.mli
View file

@ -181,6 +181,14 @@ val of_opt : 'a option -> ('a, string) t
val to_seq : ('a, _) t -> 'a sequence
type ('a, 'b) error = [`Ok of 'a | `Error of 'b]
val of_err : ('a, 'b) error -> ('a, 'b) t
(** @since 0.17 *)
val to_err : ('a, 'b) t -> ('a, 'b) error
(** @since 0.17 *)
(** {2 IO} *)
val pp : 'a printer -> ('a, string) t printer

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

@ -50,6 +50,10 @@ let init n f =
let length = String.length
let rev s =
let n = length s in
init n (fun i -> s.[n-i-1])
let rec _to_list s acc i len =
if len=0 then List.rev acc
else _to_list s (s.[i]::acc) (i+1) (len-1)
@ -66,32 +70,197 @@ let is_sub ~sub i s j ~len =
if i+len > String.length sub then invalid_arg "CCString.is_sub";
_is_sub ~sub i s j ~len
(* note: inefficient *)
let find ?(start=0) ~sub s =
let n = String.length sub in
let i = ref start in
try
while !i + n <= String.length s do
if _is_sub ~sub 0 s !i ~len:n then raise Exit;
incr i
type _ direction =
| Direct : [`Direct] direction
| Reverse : [`Reverse] direction
(* we follow https://en.wikipedia.org/wiki/Knuth–Morris–Pratt_algorithm *)
module Find = struct
type 'a kmp_pattern = {
failure : int array;
str : string;
}
(* invariant: [length failure = length str].
We use a phantom type to avoid mixing the directions. *)
let kmp_pattern_length p = String.length p.str
(* access the [i]-th element of [s] according to direction [dir] *)
let get_
: type a. dir:a direction -> string -> int -> char
= fun ~dir -> match dir with
| Direct -> String.get
| Reverse -> (fun s i -> s.[String.length s - i - 1])
let kmp_compile_
: type a. dir:a direction -> string -> a kmp_pattern
= fun ~dir str ->
let len = length str in
let get = get_ ~dir in (* how to read elements of the string *)
match len with
| 0 -> {failure=[| |]; str;}
| 1 -> {failure=[| -1 |]; str;}
| _ ->
(* at least 2 elements, the algorithm can work *)
let failure = Array.make len 0 in
failure.(0) <- -1;
(* i: current index in str *)
let i = ref 2 in
(* j: index of candidate substring *)
let j = ref 0 in
while !i < len do
match !j with
| _ when get str (!i-1) = get str !j ->
(* substring starting at !j continues matching current char *)
incr j;
failure.(!i) <- !j;
incr i;
| 0 ->
(* back to the beginning *)
failure.(!i) <- 0;
incr i;
| _ ->
(* fallback for the prefix string *)
assert (!j > 0);
j := failure.(!j)
done;
(* Format.printf "{@[failure:%a, str:%s@]}@." CCFormat.(array int) failure str; *)
{ failure; str; }
let kmp_compile s = kmp_compile_ ~dir:Direct s
let kmp_rcompile s = kmp_compile_ ~dir:Reverse s
(* proper search function.
[i] index in [s]
[j] index in [pattern]
[len] length of [s] *)
let kmp_find ~pattern s idx =
let len = length s in
let i = ref idx in
let j = ref 0 in
let pat_len = kmp_pattern_length pattern in
while !j < pat_len && !i + !j < len do
let c = String.get s (!i + !j) in
let expected = String.get pattern.str !j in
if c = expected
then (
(* char matches *)
incr j;
) else (
let fail_offset = pattern.failure.(!j) in
if fail_offset >= 0
then (
assert (fail_offset < !j);
(* follow the failure link *)
i := !i + !j - fail_offset;
j := fail_offset
) else (
(* beginning of pattern *)
j := 0;
incr i
)
)
done;
-1
with Exit ->
!i
if !j = pat_len
then !i
else -1
(* proper search function, from the right.
[i] index in [s]
[j] index in [pattern]
[len] length of [s] *)
let kmp_rfind ~pattern s idx =
let len = length s in
let i = ref (len - idx - 1) in
let j = ref 0 in
let pat_len = kmp_pattern_length pattern in
while !j < pat_len && !i + !j < len do
let c = String.get s (len - !i - !j - 1) in
let expected = String.get pattern.str (String.length pattern.str - !j - 1) in
if c = expected
then (
(* char matches *)
incr j;
) else (
let fail_offset = pattern.failure.(!j) in
if fail_offset >= 0
then (
assert (fail_offset < !j);
(* follow the failure link *)
i := !i + !j - fail_offset;
j := fail_offset
) else (
(* beginning of pattern *)
j := 0;
incr i
)
)
done;
(* adjust result: first, [res = string.length s - res -1] to convert
back to real indices; then, what we got is actually the position
of the end of the pattern, so we subtract the [length of the pattern -1]
to obtain the real result. *)
if !j = pat_len
then len - !i - kmp_pattern_length pattern
else -1
type 'a pattern =
| P_char of char
| P_KMP of 'a kmp_pattern
let pattern_length = function
| P_char _ -> 1
| P_KMP p -> kmp_pattern_length p
let compile ~sub : [`Direct] pattern =
if length sub=1
then P_char sub.[0]
else P_KMP (kmp_compile sub)
let rcompile ~sub : [`Reverse] pattern =
if length sub=1
then P_char sub.[0]
else P_KMP (kmp_rcompile sub)
let find ~pattern s start = match pattern with
| P_char c ->
(try String.index_from s start c with Not_found -> -1)
| P_KMP pattern -> kmp_find ~pattern s start
let rfind ~pattern s start = match pattern with
| P_char c ->
(try String.rindex_from s start c with Not_found -> -1)
| P_KMP pattern -> kmp_rfind ~pattern s start
end
let find ?(start=0) ~sub =
let pattern = Find.compile ~sub in
fun s -> Find.find ~pattern s start
let find_all ?(start=0) ~sub =
let pattern = Find.compile ~sub in
fun s ->
let i = ref start in
fun () ->
let res = Find.find ~pattern s !i in
if res = ~-1 then None
else (
i := res + 1; (* possible overlap *)
Some res
)
let find_all_l ?start ~sub s =
let rec aux acc g = match g () with
| None -> List.rev acc
| Some i -> aux (i::acc) g
in
aux [] (find_all ?start ~sub s)
let mem ?start ~sub s = find ?start ~sub s >= 0
let rfind ~sub s =
let n = String.length sub in
let i = ref (String.length s - n) in
try
while !i >= 0 do
if _is_sub ~sub 0 s !i ~len:n then raise Exit;
decr i
done;
~-1
with Exit ->
!i
let rfind ~sub =
let pattern = Find.rcompile ~sub in
fun s -> Find.rfind ~pattern s (String.length s-1)
(* Replace substring [s.[pos]....s.[pos+len-1]] by [by] in [s] *)
let replace_at_ ~pos ~len ~by s =
@ -105,16 +274,18 @@ let replace ?(which=`All) ~sub ~by s =
if sub="" then invalid_arg "CCString.replace";
match which with
| `Left ->
let i = find ~sub s in
let i = find ~sub s ~start:0 in
if i>=0 then replace_at_ ~pos:i ~len:(String.length sub) ~by s else s
| `Right ->
let i = rfind ~sub s in
if i>=0 then replace_at_ ~pos:i ~len:(String.length sub) ~by s else s
| `All ->
(* compile search pattern only once *)
let pattern = Find.compile ~sub in
let b = Buffer.create (String.length s) in
let start = ref 0 in
while !start < String.length s do
let i = find ~start:!start ~sub s in
let i = Find.find ~pattern s !start in
if i>=0 then (
(* between last and cur occurrences *)
Buffer.add_substring b s !start (i- !start);
@ -133,29 +304,20 @@ module Split = struct
| SplitStop
| SplitAt of int (* previous *)
(* [by_j... prefix of s_i...] ? *)
let rec _is_prefix ~by s i j =
j = String.length by
||
( i < String.length s &&
s.[i] = by.[j] &&
_is_prefix ~by s (i+1) (j+1)
)
let rec _split ~by s state = match state with
| SplitStop -> None
| SplitAt prev -> _split_search ~by s prev prev
and _split_search ~by s prev i =
if i >= String.length s
| SplitAt prev -> _split_search ~by s prev
and _split_search ~by s prev =
let j = Find.find ~pattern:by s prev in
if j < 0
then Some (SplitStop, prev, String.length s - prev)
else if _is_prefix ~by s i 0
then Some (SplitAt (i+String.length by), prev, i-prev)
else _split_search ~by s prev (i+1)
else Some (SplitAt (j+Find.pattern_length by), prev, j-prev)
let _tuple3 x y z = x,y,z
let _mkgen ~by s k =
let state = ref (SplitAt 0) in
let by = Find.compile ~sub:by in
fun () ->
match _split ~by s !state with
| None -> None
@ -168,6 +330,7 @@ module Split = struct
let gen_cpy ~by s = _mkgen ~by s String.sub
let _mklist ~by s k =
let by = Find.compile ~sub:by in
let rec build acc state = match _split ~by s state with
| None -> List.rev acc
| Some (state', i, len) ->
@ -180,6 +343,7 @@ module Split = struct
let list_cpy ~by s = _mklist ~by s String.sub
let _mkklist ~by s k =
let by = Find.compile ~sub:by in
let rec make state () = match _split ~by s state with
| None -> `Nil
| Some (state', i, len) ->
@ -191,6 +355,7 @@ module Split = struct
let klist_cpy ~by s = _mkklist ~by s String.sub
let _mkseq ~by s f k =
let by = Find.compile ~sub:by in
let rec aux state = match _split ~by s state with
| None -> ()
| Some (state', i, len) -> k (f s i len); aux state'
@ -259,6 +424,27 @@ let suffix ~suf s =
!i = String.length suf
)
let take n s =
if n < String.length s
then String.sub s 0 n
else s
let drop n s =
if n < String.length s
then String.sub s n (String.length s - n)
else ""
let take_drop n s = take n s, drop n s
let chop_suffix ~suf s =
if suffix ~suf s
then Some (String.sub s 0 (String.length s-String.length suf))
else None
let chop_prefix ~pre s =
if prefix ~pre s
then Some (String.sub s (String.length pre) (String.length s-String.length pre))
else None
let blit = String.blit
@ -268,6 +454,15 @@ let fold f acc s =
else fold_rec f (f acc s.[i]) s (i+1)
in fold_rec f acc s 0
let pad ?(side=`Left) ?(c=' ') n s =
let len_s = String.length s in
if len_s >= n then s
else
let pad_len = n - len_s in
match side with
| `Left -> init n (fun i -> if i < pad_len then c else s.[i-pad_len])
| `Right -> init n (fun i -> if i < len_s then s.[i] else c)
let _to_gen s i0 len =
let i = ref i0 in
fun () ->
@ -373,6 +568,22 @@ let mapi f s = init (length s) (fun i -> f i s.[i])
#endif
let filter_map f s =
let buf = Buffer.create (String.length s) in
iter
(fun c -> match f c with
| None -> ()
| Some c' -> Buffer.add_char buf c')
s;
Buffer.contents buf
let filter f s =
let buf = Buffer.create (String.length s) in
iter
(fun c -> if f c then Buffer.add_char buf c)
s;
Buffer.contents buf
let flat_map ?sep f s =
let buf = Buffer.create (String.length s) in
iteri

139
src/core/CCString.mli
View file

@ -63,6 +63,37 @@ val init : int -> (int -> char) -> string
init 0 (fun _ -> assert false) = ""
*)
val rev : string -> string
(** [rev s] returns the reverse of [s]
@since 0.17 *)
(*$Q
Q.printable_string (fun s -> s = rev (rev s))
Q.printable_string (fun s -> length s = length (rev s))
*)
(*$=
"abc" (rev "cba")
"" (rev "")
" " (rev " ")
*)
val pad : ?side:[`Left|`Right] -> ?c:char -> int -> string -> string
(** [pad n str] ensures that [str] is at least [n] bytes long,
and pads it on the [side] with [c] if it's not the case.
@param side determines where padding occurs (default: [`Left])
@param c the char used to pad (default: ' ')
@since 0.17 *)
(*$= & ~printer:Q.Print.string
" 42" (pad 4 "42")
"0042" (pad ~c:'0' 4 "42")
"4200" (pad ~side:`Right ~c:'0' 4 "42")
"hello" (pad 4 "hello")
"aaa" (pad ~c:'a' 3 "")
"aaa" (pad ~side:`Right ~c:'a' 3 "")
*)
val of_gen : char gen -> string
val of_seq : char sequence -> string
val of_klist : char klist -> string
@ -81,10 +112,35 @@ val find : ?start:int -> sub:string -> string -> int
Should only be used with very small [sub] *)
(*$= & ~printer:string_of_int
(find ~sub:"bc" "abcd") 1
(find ~sub:"bc" "abd") ~-1
(find ~sub:"a" "_a_a_a_") 1
(find ~sub:"a" ~start:5 "a1a234a") 6
1 (find ~sub:"bc" "abcd")
~-1 (find ~sub:"bc" "abd")
1 (find ~sub:"a" "_a_a_a_")
6 (find ~sub:"a" ~start:5 "a1a234a")
*)
(*$Q & ~count:10_000
Q.(pair printable_string printable_string) (fun (s1,s2) -> \
let i = find ~sub:s2 s1 in \
i < 0 || String.sub s1 i (length s2) = s2)
*)
val find_all : ?start:int -> sub:string -> string -> int gen
(** [find_all ~sub s] finds all occurrences of [sub] in [s], even overlapping
instances.
@param start starting position in [s]
@since 0.17 *)
val find_all_l : ?start:int -> sub:string -> string -> int list
(** [find_all ~sub s] finds all occurrences of [sub] in [s] and returns
them in a list
@param start starting position in [s]
@since 0.17 *)
(*$= & ~printer:Q.Print.(list int)
[1; 6] (find_all_l ~sub:"bc" "abc aabc aab")
[] (find_all_l ~sub:"bc" "abd")
[76] (find_all_l ~sub:"aaaaaa" \
"aabbaabbaaaaabbbbabababababbbbabbbabbaaababbbaaabaabbaabbaaaabbababaaaabbaabaaaaaabbbaaaabababaabaaabbaabaaaabbababbaabbaaabaabbabababbbaabababaaabaaababbbaaaabbbaabaaababbabaababbaabbaaaaabababbabaababbbaaabbabbabababaaaabaaababaaaaabbabbaabbabbbbbbbbbbbbbbaabbabbbbbabbaaabbabbbbabaaaaabbababbbaaaa")
*)
val mem : ?start:int -> sub:string -> string -> bool
@ -102,11 +158,17 @@ val rfind : sub:string -> string -> int
@since 0.12 *)
(*$= & ~printer:string_of_int
(rfind ~sub:"bc" "abcd") 1
(rfind ~sub:"bc" "abd") ~-1
(rfind ~sub:"a" "_a_a_a_") 5
(rfind ~sub:"bc" "abcdbcd") 4
(rfind ~sub:"a" "a1a234a") 6
1 (rfind ~sub:"bc" "abcd")
~-1 (rfind ~sub:"bc" "abd")
5 (rfind ~sub:"a" "_a_a_a_")
4 (rfind ~sub:"bc" "abcdbcd")
6 (rfind ~sub:"a" "a1a234a")
*)
(*$Q & ~count:10_000
Q.(pair printable_string printable_string) (fun (s1,s2) -> \
let i = rfind ~sub:s2 s1 in \
i < 0 || String.sub s1 i (length s2) = s2)
*)
val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> string
@ -157,6 +219,46 @@ val suffix : suf:string -> string -> bool
not (suffix ~suf:"abcd" "cd")
*)
val chop_prefix : pre:string -> string -> string option
(** [chop_pref ~pre s] removes [pre] from [s] if [pre] really is a prefix
of [s], returns [None] otherwise
@since 0.17 *)
(*$= & ~printer:Q.Print.(option string)
(Some "cd") (chop_prefix ~pre:"aab" "aabcd")
None (chop_prefix ~pre:"ab" "aabcd")
None (chop_prefix ~pre:"abcd" "abc")
*)
val chop_suffix : suf:string -> string -> string option
(** [chop_suffix ~suf s] removes [suf] from [s] if [suf] really is a suffix
of [s], returns [None] otherwise
@since 0.17 *)
(*$= & ~printer:Q.Print.(option string)
(Some "ab") (chop_suffix ~suf:"cd" "abcd")
None (chop_suffix ~suf:"cd" "abcde")
None (chop_suffix ~suf:"abcd" "cd")
*)
val take : int -> string -> string
(** [take n s] keeps only the [n] first chars of [s]
@since 0.17 *)
val drop : int -> string -> string
(** [drop n s] removes the [n] first chars of [s]
@since 0.17 *)
val take_drop : int -> string -> string * string
(** [take_drop n s = take n s, drop n s]
@since 0.17 *)
(*$=
("ab", "cd") (take_drop 2 "abcd")
("abc", "") (take_drop 3 "abc")
("abc", "") (take_drop 5 "abc")
*)
val lines : string -> string list
(** [lines s] returns a list of the lines of [s] (splits along '\n')
@since 0.10 *)
@ -210,6 +312,25 @@ val mapi : (int -> char -> char) -> string -> string
(** Map chars with their index
@since 0.12 *)
val filter_map : (char -> char option) -> string -> string
(** @since 0.17 *)
(*$= & ~printer:Q.Print.string
"bcef" (filter_map \
(function 'c' -> None | c -> Some (Char.chr (Char.code c + 1))) "abcde")
*)
val filter : (char -> bool) -> string -> string
(** @since 0.17 *)
(*$= & ~printer:Q.Print.string
"abde" (filter (function 'c' -> false | _ -> true) "abcdec")
*)
(*$Q
Q.printable_string (fun s -> filter (fun _ -> true) s = s)
*)
val flat_map : ?sep:string -> (char -> string) -> string -> string
(** Map each chars to a string, then concatenates them all
@param sep optional separator between each generated string

16
src/core/CCVector.ml
View file

@ -637,6 +637,22 @@ let (--) i j =
(0 -- 0) |> to_list = [0]
*)
(*$Q
Q.(pair small_int small_int) (fun (a,b) -> \
(a -- b) |> to_list = CCList.(a -- b))
*)
let (--^) i j =
if i=j then create()
else if i>j
then init (i-j) (fun k -> i-k)
else init (j-i) (fun k -> i+k)
(*$Q
Q.(pair small_int small_int) (fun (a,b) -> \
(a --^ b) |> to_list = CCList.(a --^ b))
*)
let of_array a =
if Array.length a = 0
then create ()

5
src/core/CCVector.mli
View file

@ -237,6 +237,11 @@ val (--) : int -> int -> (int, 'mut) t
therefore the result is never empty).
Example: [1 -- 10] returns the vector [[1;2;3;4;5;6;7;8;9;10]] *)
val (--^) : int -> int -> (int, 'mut) t
(** Range of integers, either ascending or descending, but excluding right.,
Example: [1 --^ 10] returns the vector [[1;2;3;4;5;6;7;8;9]]
@since 0.17 *)
val of_array : 'a array -> ('a, 'mut) t
val of_list : 'a list -> ('a, 'mut) t
val to_array : ('a,_) t -> 'a array

24
src/core/META
View file

@ -1,6 +1,6 @@
# OASIS_START
# DO NOT EDIT (digest: 6791ff3a69a4e02811e4c0d33830d0e7)
version = "0.16"
# DO NOT EDIT (digest: 775c1a5da08322de06b23069a43379ed)
version = "0.17"
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 = "0.16"
version = "0.17"
description = "A modular standard library focused on data structures."
requires = "bytes unix"
archive(byte) = "containers_unix.cma"
@ -20,7 +20,7 @@ package "unix" (
)
package "top" (
version = "0.16"
version = "0.17"
description = "A modular standard library focused on data structures."
requires =
"compiler-libs.common containers containers.data containers.bigarray containers.string containers.unix containers.sexp containers.iter"
@ -32,7 +32,7 @@ package "top" (
)
package "thread" (
version = "0.16"
version = "0.17"
description = "A modular standard library focused on data structures."
requires = "containers threads"
archive(byte) = "containers_thread.cma"
@ -43,7 +43,7 @@ package "thread" (
)
package "string" (
version = "0.16"
version = "0.17"
description = "A modular standard library focused on data structures."
requires = "bytes"
archive(byte) = "containers_string.cma"
@ -54,7 +54,7 @@ package "string" (
)
package "sexp" (
version = "0.16"
version = "0.17"
description = "A modular standard library focused on data structures."
requires = "bytes"
archive(byte) = "containers_sexp.cma"
@ -65,7 +65,7 @@ package "sexp" (
)
package "iter" (
version = "0.16"
version = "0.17"
description = "A modular standard library focused on data structures."
archive(byte) = "containers_iter.cma"
archive(byte, plugin) = "containers_iter.cma"
@ -75,7 +75,7 @@ package "iter" (
)
package "io" (
version = "0.16"
version = "0.17"
description = "A modular standard library focused on data structures."
requires = "bytes"
archive(byte) = "containers_io.cma"
@ -86,7 +86,7 @@ package "io" (
)
package "data" (
version = "0.16"
version = "0.17"
description = "A modular standard library focused on data structures."
requires = "bytes"
archive(byte) = "containers_data.cma"
@ -97,7 +97,7 @@ package "data" (
)
package "bigarray" (
version = "0.16"
version = "0.17"
description = "A modular standard library focused on data structures."
requires = "containers bigarray bytes"
archive(byte) = "containers_bigarray.cma"
@ -108,7 +108,7 @@ package "bigarray" (
)
package "advanced" (
version = "0.16"
version = "0.17"
description = "A modular standard library focused on data structures."
requires = "containers sequence"
archive(byte) = "containers_advanced.cma"

9
src/core/containers.ml
View file

@ -80,3 +80,12 @@ module Vector = CCVector
module Int64 = CCInt64
(** @since 0.13 *)
module Char = struct
include Char
include (CCChar : module type of CCChar with type t := t)
end
(** @since 0.17 *)
module Result = CCResult
(** @since 0.17 *)

29
src/data/CCDeque.ml
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Imperative deque} *)
@ -37,7 +15,10 @@ type 'a node = {
mutable next : 'a node;
mutable prev : 'a node;
}
(** Linked list of cells *)
(** Linked list of cells.
invariant: only the first and last cells are allowed to
be anything but [Three] (all the intermediate ones are [Three]) *)
type 'a t = {
mutable cur : 'a node;

43
src/data/CCDeque.mli
View file

@ -1,29 +1,10 @@
(*
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:
(* This file is free software, part of containers. See file "license" for more details. *)
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.
(** {1 Imperative deque}
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.
*)
(** {1 Imperative deque} *)
This structure provides fast access to its front and back elements,
with O(1) operations*)
type 'a t
(** Contains 'a elements, queue in both ways *)
@ -76,10 +57,12 @@ val take_front : 'a t -> 'a
val append_front : into:'a t -> 'a t -> unit
(** [append_front ~into q] adds all elements of [q] at the front
of [into]
O(length q) in time
@since 0.13 *)
val append_back : into:'a t -> 'a t -> unit
(** [append_back ~into q] adds all elements of [q] at the back of [into]
(** [append_back ~into q] adds all elements of [q] at the back of [into].
O(length q) in time
@since 0.13 *)
val iter : ('a -> unit) -> 'a t -> unit
@ -100,6 +83,7 @@ val of_seq : 'a sequence -> 'a t
{!add_seq_back} instead *)
val to_seq : 'a t -> 'a sequence
(** iterate on the elements *)
val of_gen : 'a gen -> 'a t
(** [of_gen g] makes a deque containing the elements of [g]
@ -111,24 +95,25 @@ val to_gen : 'a t -> 'a gen
val add_seq_front : 'a t -> 'a sequence -> unit
(** [add_seq_front q seq] adds elements of [seq] into the front of [q],
in reverse order
in reverse order.
O(n) in time, where [n] is the number of elements to add.
@since 0.13 *)
val add_seq_back : 'a t -> 'a sequence -> unit
(** [add_seq_back q seq] adds elements of [seq] into the back of [q],
in order
in order.
O(n) in time, where [n] is the number of elements to add.
@since 0.13 *)
val copy : 'a t -> 'a t
(** Fresh copy *)
(** Fresh copy, O(n) in time *)
val of_list : 'a list -> 'a t
(** Conversion from list, in order
@since 0.13 *)
val to_list : 'a t -> 'a list
(** List of elements, in order
{b warning: not tailrec}
(** List of elements, in order. Less efficient than {!to_rev_list}.
@since 0.13 *)
val to_rev_list : 'a t -> 'a list

184
src/data/CCFQueue.ml
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Functional queues (fifo)} *)
@ -73,39 +51,39 @@ let _empty = Lazy.from_val empty
let rec cons : 'a. 'a -> 'a t -> 'a t
= fun x q -> match q with
| Shallow Zero -> _single x
| Shallow (One y) -> Shallow (Two (x,y))
| Shallow (Two (y,z)) -> Shallow (Three (x,y,z))
| Shallow (Three (y,z,z')) ->
| Shallow Zero -> _single x
| Shallow (One y) -> Shallow (Two (x,y))
| Shallow (Two (y,z)) -> Shallow (Three (x,y,z))
| Shallow (Three (y,z,z')) ->
_deep 4 (Two (x,y)) _empty (Two (z,z'))
| Deep (_, Zero, _middle, _tl) -> assert false
| Deep (n,One y, middle, tl) -> _deep (n+1) (Two (x,y)) middle tl
| Deep (n,Two (y,z), middle, tl) -> _deep (n+1)(Three (x,y,z)) middle tl
| Deep (n,Three (y,z,z'), lazy q', tail) ->
| Deep (_, Zero, _middle, _tl) -> assert false
| Deep (n,One y, middle, tl) -> _deep (n+1) (Two (x,y)) middle tl
| Deep (n,Two (y,z), middle, tl) -> _deep (n+1)(Three (x,y,z)) middle tl
| Deep (n,Three (y,z,z'), lazy q', tail) ->
_deep (n+1) (Two (x,y)) (lazy (cons (z,z') q')) tail
(*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
cons x (of_list l) |> to_list = x::l)
*)
*)
let rec snoc : 'a. 'a t -> 'a -> 'a t
= fun q x -> match q with
| Shallow Zero -> _single x
| Shallow (One y) -> Shallow (Two (y,x))
| Shallow (Two (y,z)) -> Shallow (Three (y,z,x))
| Shallow (Three (y,z,z')) ->
| Shallow Zero -> _single x
| Shallow (One y) -> Shallow (Two (y,x))
| Shallow (Two (y,z)) -> Shallow (Three (y,z,x))
| Shallow (Three (y,z,z')) ->
_deep 4 (Two (y,z)) _empty (Two (z',x))
| Deep (_,_hd, _middle, Zero) -> assert false
| Deep (n,hd, middle, One y) -> _deep (n+1) hd middle (Two(y,x))
| Deep (n,hd, middle, Two (y,z)) -> _deep (n+1) hd middle (Three(y,z,x))
| Deep (n,hd, lazy q', Three (y,z,z')) ->
| Deep (_,_hd, _middle, Zero) -> assert false
| Deep (n,hd, middle, One y) -> _deep (n+1) hd middle (Two(y,x))
| Deep (n,hd, middle, Two (y,z)) -> _deep (n+1) hd middle (Three(y,z,x))
| Deep (n,hd, lazy q', Three (y,z,z')) ->
_deep (n+1) hd (lazy (snoc q' (y,z))) (Two(z',x))
(*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
snoc (of_list l) x |> to_list = l @ [x])
*)
*)
(*$R
let q = List.fold_left snoc empty [1;2;3;4;5] in
@ -117,27 +95,27 @@ let rec snoc : 'a. 'a t -> 'a -> 'a t
let rec take_front_exn : 'a. 'a t -> ('a *'a t)
= fun q -> match q with
| Shallow Zero -> raise Empty
| Shallow (One x) -> x, empty
| Shallow (Two (x,y)) -> x, Shallow (One y)
| Shallow (Three (x,y,z)) -> x, Shallow (Two (y,z))
| Deep (_,Zero, _, _) -> assert false
| Deep (n,One x, lazy q', tail) ->
| Shallow Zero -> raise Empty
| Shallow (One x) -> x, empty
| Shallow (Two (x,y)) -> x, Shallow (One y)
| Shallow (Three (x,y,z)) -> x, Shallow (Two (y,z))
| Deep (_,Zero, _, _) -> assert false
| Deep (n,One x, lazy q', tail) ->
if is_empty q'
then x, Shallow tail
else
let (y,z), q' = take_front_exn q' in
x, _deep (n-1)(Two (y,z)) (Lazy.from_val q') tail
| Deep (n,Two (x,y), middle, tail) ->
then x, Shallow tail
else
let (y,z), q' = take_front_exn q' in
x, _deep (n-1)(Two (y,z)) (Lazy.from_val q') tail
| Deep (n,Two (x,y), middle, tail) ->
x, _deep (n-1) (One y) middle tail
| Deep (n,Three (x,y,z), middle, tail) ->
| Deep (n,Three (x,y,z), middle, tail) ->
x, _deep (n-1) (Two(y,z)) middle tail
(*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
let x', q = cons x (of_list l) |> take_front_exn in \
x'=x && to_list q = l)
*)
*)
(*$R
let q = of_list [1;2;3;4] in
@ -180,25 +158,25 @@ let take_front_while p q =
let rec take_back_exn : 'a. 'a t -> 'a t * 'a
= fun q -> match q with
| Shallow Zero -> invalid_arg "FQueue.take_back_exn"
| Shallow (One x) -> empty, x
| Shallow (Two (x,y)) -> _single x, y
| Shallow (Three (x,y,z)) -> Shallow (Two(x,y)), z
| Deep (_, _hd, _middle, Zero) -> assert false
| Deep (n, hd, lazy q', One x) ->
| Shallow Zero -> invalid_arg "FQueue.take_back_exn"
| Shallow (One x) -> empty, x
| Shallow (Two (x,y)) -> _single x, y
| Shallow (Three (x,y,z)) -> Shallow (Two(x,y)), z
| Deep (_, _hd, _middle, Zero) -> assert false
| Deep (n, hd, lazy q', One x) ->
if is_empty q'
then Shallow hd, x
else
let q'', (y,z) = take_back_exn q' in
_deep (n-1) hd (Lazy.from_val q'') (Two (y,z)), x
| Deep (n, hd, middle, Two(x,y)) -> _deep (n-1) hd middle (One x), y
| Deep (n, hd, middle, Three(x,y,z)) -> _deep (n-1) hd middle (Two (x,y)), z
then Shallow hd, x
else
let q'', (y,z) = take_back_exn q' in
_deep (n-1) hd (Lazy.from_val q'') (Two (y,z)), x
| Deep (n, hd, middle, Two(x,y)) -> _deep (n-1) hd middle (One x), y
| Deep (n, hd, middle, Three(x,y,z)) -> _deep (n-1) hd middle (Two (x,y)), z
(*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
let q,x' = snoc (of_list l) x |> take_back_exn in \
x'=x && to_list q = l)
*)
*)
let take_back q =
try Some (take_back_exn q)
@ -242,8 +220,8 @@ let _size_digit = function
let size : 'a. 'a t -> int
= function
| Shallow d -> _size_digit d
| Deep (n, _, _, _) -> n
| Shallow d -> _size_digit d
| Deep (n, _, _, _) -> n
(*$Q
(Q.list Q.int) (fun l -> \
@ -262,15 +240,15 @@ let _nth_digit i d = match i, d with
let rec nth_exn : 'a. int -> 'a t -> 'a
= fun i q -> match i, q with
| _, Shallow Zero -> raise Not_found
| 0, Shallow (One x) -> x
| 0, Shallow (Two (x,_)) -> x
| 1, Shallow (Two (_,x)) -> x
| 0, Shallow (Three (x,_,_)) -> x
| 1, Shallow (Three (_,x,_)) -> x
| 2, Shallow (Three (_,_,x)) -> x
| _, Shallow _ -> raise Not_found
| _, Deep (_, l, q, r) ->
| _, Shallow Zero -> raise Not_found
| 0, Shallow (One x) -> x
| 0, Shallow (Two (x,_)) -> x
| 1, Shallow (Two (_,x)) -> x
| 0, Shallow (Three (x,_,_)) -> x
| 1, Shallow (Three (_,x,_)) -> x
| 2, Shallow (Three (_,_,x)) -> x
| _, Shallow _ -> raise Not_found
| _, Deep (_, l, q, r) ->
if i<_size_digit l
then _nth_digit i l
else
@ -326,7 +304,7 @@ let add_seq_front seq q =
(*$Q
Q.(pair (list int) (list int)) (fun (l1, l2) -> \
add_seq_front (Sequence.of_list l1) (of_list l2) |> to_list = l1 @ l2)
*)
*)
let add_seq_back q seq =
let q = ref q in
@ -341,8 +319,8 @@ let _digit_to_seq d k = match d with
let rec to_seq : 'a. 'a t -> 'a sequence
= fun q k -> match q with
| Shallow d -> _digit_to_seq d k
| Deep (_, hd, lazy q', tail) ->
| Shallow d -> _digit_to_seq d k
| Deep (_, hd, lazy q', tail) ->
_digit_to_seq hd k;
to_seq q' (fun (x,y) -> k x; k y);
_digit_to_seq tail k
@ -354,9 +332,9 @@ let rec to_seq : 'a. 'a t -> 'a sequence
let append q1 q2 =
match q1, q2 with
| Shallow Zero, _ -> q2
| _, Shallow Zero -> q1
| _ -> add_seq_back q1 (to_seq q2)
| Shallow Zero, _ -> q2
| _, Shallow Zero -> q1
| _ -> add_seq_back q1 (to_seq q2)
(*$Q
(Q.pair (Q.list Q.int)(Q.list Q.int)) (fun (l1,l2) -> \
@ -379,8 +357,8 @@ let _map_digit f d = match d with
let rec map : 'a 'b. ('a -> 'b) -> 'a t -> 'b t
= fun f q -> match q with
| Shallow d -> Shallow (_map_digit f d)
| Deep (size, hd, lazy q', tl) ->
| Shallow d -> Shallow (_map_digit f d)
| Deep (size, hd, lazy q', tl) ->
let q'' = map (fun (x,y) -> f x, f y) q' in
_deep size (_map_digit f hd) (Lazy.from_val q'') (_map_digit f tl)
@ -399,8 +377,8 @@ let _fold_digit f acc d = match d with
let rec fold : 'a 'b. ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
= fun f acc q -> match q with
| Shallow d -> _fold_digit f acc d
| Deep (_, hd, lazy q', tl) ->
| Shallow d -> _fold_digit f acc d
| Deep (_, hd, lazy q', tl) ->
let acc = _fold_digit f acc hd in
let acc = fold (fun acc (x,y) -> f (f acc x) y) acc q' in
_fold_digit f acc tl
@ -455,18 +433,18 @@ let _digit_to_klist d cont = match d with
let rec _flat_klist : 'a. ('a * 'a) klist -> 'a klist -> 'a klist
= fun l cont () -> match l () with
| `Nil -> cont ()
| `Cons ((x,y),l') -> _double x y (_flat_klist l' cont) ()
| `Nil -> cont ()
| `Cons ((x,y),l') -> _double x y (_flat_klist l' cont) ()
let to_klist q =
let rec aux : 'a. 'a t -> 'a klist -> 'a klist
= fun q cont () -> match q with
| Shallow d -> _digit_to_klist d cont ()
| Deep (_, hd, lazy q', tl) ->
| Shallow d -> _digit_to_klist d cont ()
| Deep (_, hd, lazy q', tl) ->
_digit_to_klist hd
(_flat_klist
(aux q' _nil)
(_digit_to_klist tl cont))
(aux q' _nil)
(_digit_to_klist tl cont))
()
in
aux q _nil
@ -483,7 +461,7 @@ let rec _equal_klist eq l1 l2 = match l1(), l2() with
| `Nil, _
| _, `Nil -> false
| `Cons(x1,l1'), `Cons(x2,l2') ->
eq x1 x2 && _equal_klist eq l1' l2'
eq x1 x2 && _equal_klist eq l1' l2'
let equal eq q1 q2 = _equal_klist eq (to_klist q1) (to_klist q2)
@ -507,12 +485,24 @@ let (--) a b =
0 -- 0 |> to_list = [0]
*)
let (--^) a b =
if a=b then empty
else if a<b then a -- (b-1)
else a -- (b+1)
(*$T
1 --^ 5 |> to_list = [1;2;3;4]
5 --^ 1 |> to_list = [5;4;3;2]
1 --^ 2 |> to_list = [1]
0 --^ 0 |> to_list = []
*)
let print pp_x out d =
let first = ref true in
Format.fprintf out "@[<hov2>queue {";
iter
(fun x ->
if !first then first:= false else Format.fprintf out ";@ ";
pp_x out x
if !first then first:= false else Format.fprintf out ";@ ";
pp_x out x
) d;
Format.fprintf out "}@]"

36
src/data/CCFQueue.mli
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Functional queues} *)
@ -33,7 +11,7 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Basics} *)
type +'a t
(** Queue containing elements of type 'a *)
(** Queue containing elements of type 'a *)
val empty : 'a t
@ -107,9 +85,9 @@ val init : 'a t -> 'a t
(** {2 Global Operations} *)
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. *)
(** Append two queues. Elements from the second one come
after elements of the first one.
Linear in the size of the second queue. *)
val rev : 'a t -> 'a t
(** Reverse the queue, O(n) complexity
@ -149,5 +127,9 @@ val (--) : int -> int -> int t
(** [a -- b] is the integer range from [a] to [b], both included.
@since 0.10 *)
val (--^) : int -> int -> int t
(** [a -- b] is the integer range from [a] to [b], where [b] is excluded.
@since 0.17 *)
val print : 'a printer -> 'a t printer
(** @since 0.13 *)

191
src/data/CCHet.ml Normal file
View file

@ -0,0 +1,191 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Associative containers with Heterogenerous Values} *)
(*$R
let k1 : int Key.t = Key.create() in
let k2 : int Key.t = Key.create() in
let k3 : string Key.t = Key.create() in
let k4 : float Key.t = Key.create() in
let tbl = Tbl.create () in
Tbl.add tbl k1 1;
Tbl.add tbl k2 2;
Tbl.add tbl k3 "k3";
assert_equal (Some 1) (Tbl.find tbl k1);
assert_equal (Some 2) (Tbl.find tbl k2);
assert_equal (Some "k3") (Tbl.find tbl k3);
assert_equal None (Tbl.find tbl k4);
assert_equal 3 (Tbl.length tbl);
Tbl.add tbl k1 10;
assert_equal (Some 10) (Tbl.find tbl k1);
assert_equal 3 (Tbl.length tbl);
assert_equal None (Tbl.find tbl k4);
Tbl.add tbl k4 0.0;
assert_equal (Some 0.0) (Tbl.find tbl k4);
()
*)
type 'a sequence = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
module type KEY_IMPL = sig
type t
exception Store of t
val id : int
end
module Key = struct
type 'a t = (module KEY_IMPL with type t = 'a)
let _n = ref 0
let create (type k) () =
incr _n;
let id = !_n in
let module K = struct
type t = k
let id = id
exception Store of k
end in
(module K : KEY_IMPL with type t = k)
let id (type k) (module K : KEY_IMPL with type t = k) = K.id
let equal
: type a b. a t -> b t -> bool
= fun (module K1) (module K2) -> K1.id = K2.id
end
type pair =
| Pair : 'a Key.t * 'a -> pair
type exn_pair =
| E_pair : 'a Key.t * exn -> exn_pair
let pair_of_e_pair (E_pair (k,e)) =
let module K = (val k) in
match e with
| K.Store v -> Pair (k,v)
| _ -> assert false
module Tbl = struct
module M = Hashtbl.Make(struct
type t = int
let equal (i:int) j = i=j
let hash (i:int) = Hashtbl.hash i
end)
type t = exn_pair M.t
let create ?(size=16) () = M.create size
let mem t k = M.mem t (Key.id k)
let find_exn (type a) t (k : a Key.t) : a =
let module K = (val k) in
let E_pair (_, v) = M.find t K.id in
match v with
| K.Store v -> v
| _ -> assert false
let find t k =
try Some (find_exn t k)
with Not_found -> None
let add_pair_ t p =
let Pair (k,v) = p in
let module K = (val k) in
let p = E_pair (k, K.Store v) in
M.replace t K.id p
let add t k v = add_pair_ t (Pair (k,v))
let length t = M.length t
let iter f t = M.iter (fun _ pair -> f (pair_of_e_pair pair)) t
let to_seq t yield = iter yield t
let to_list t = M.fold (fun _ p l -> pair_of_e_pair p::l) t []
let add_list t l = List.iter (add_pair_ t) l
let add_seq t seq = seq (add_pair_ t)
let of_list l =
let t = create() in
add_list t l;
t
let of_seq seq =
let t = create() in
add_seq t seq;
t
end
module Map = struct
module M = Map.Make(struct
type t = int
let compare (i:int) j = Pervasives.compare i j
end)
type t = exn_pair M.t
let empty = M.empty
let mem k t = M.mem (Key.id k) t
let find_exn (type a) (k : a Key.t) t : a =
let module K = (val k) in
let E_pair (_, e) = M.find K.id t in
match e with
| K.Store v -> v
| _ -> assert false
let find k t =
try Some (find_exn k t)
with Not_found -> None
let add_e_pair_ p t =
let E_pair ((module K),_) = p in
M.add K.id p t
let add_pair_ p t =
let Pair ((module K) as k,v) = p in
let p = E_pair (k, K.Store v) in
M.add K.id p t
let add (type a) (k : a Key.t) v t =
let module K = (val k) in
add_e_pair_ (E_pair (k, K.Store v)) t
let cardinal t = M.cardinal t
let length = cardinal
let iter f t = M.iter (fun _ p -> f (pair_of_e_pair p)) t
let to_seq t yield = iter yield t
let to_list t = M.fold (fun _ p l -> pair_of_e_pair p::l) t []
let add_list t l = List.fold_right add_pair_ l t
let add_seq t seq =
let t = ref t in
seq (fun pair -> t := add_pair_ pair !t);
!t
let of_list l = add_list empty l
let of_seq seq = add_seq empty seq
end

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

@ -0,0 +1,90 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Associative containers with Heterogenerous Values}
This is similar to {!CCMixtbl}, but the injection is directly used as
a key.
@since 0.17 *)
type 'a sequence = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
module Key : sig
type 'a t
val create : unit -> 'a t
val equal : 'a t -> 'a t -> bool
(** Compare two keys that have compatible types *)
end
type pair =
| Pair : 'a Key.t * 'a -> pair
(** {2 Imperative table indexed by {!Key}} *)
module Tbl : sig
type t
val create : ?size:int -> unit -> t
val mem : t -> _ Key.t -> bool
val add : t -> 'a Key.t -> 'a -> unit
val length : t -> int
val find : t -> 'a Key.t -> 'a option
val find_exn : t -> 'a Key.t -> 'a
(** @raise Not_found if the key is not in the table *)
val iter : (pair -> unit) -> t -> unit
val to_seq : t -> pair sequence
val of_seq : pair sequence -> t
val add_seq : t -> pair sequence -> unit
val add_list : t -> pair list -> unit
val of_list : pair list -> t
val to_list : t -> pair list
end
(** {2 Immutable map} *)
module Map : sig
type t
val empty : t
val mem : _ Key.t -> t -> bool
val add : 'a Key.t -> 'a -> t -> t
val length : t -> int
val cardinal : t -> int
val find : 'a Key.t -> t -> 'a option
val find_exn : 'a Key.t -> t -> 'a
(** @raise Not_found if the key is not in the table *)
val iter : (pair -> unit) -> t -> unit
val to_seq : t -> pair sequence
val of_seq : pair sequence -> t
val add_seq : t -> pair sequence -> t
val add_list : t -> pair list -> t
val of_list : pair list -> t
val to_list : t -> pair list
end

129
src/data/CCImmutArray.ml Normal file
View file

@ -0,0 +1,129 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Immutable Arrays} *)
(* TODO: tests *)
(* TODO: transient API? for batch modifications *)
type 'a t = 'a array
let empty = [| |]
let length = Array.length
let singleton x = [| x |]
let doubleton x y = [| x; y |]
let make n x = Array.make n x
let init n f = Array.init n f
let get = Array.get
let set a n x =
let a' = Array.copy a in
a'.(n) <- x;
a'
let map = Array.map
let mapi = Array.mapi
let append a b =
let na = length a in
Array.init (na + length b)
(fun i -> if i < na then a.(i) else b.(i-na))
let iter = Array.iter
let iteri = Array.iteri
let fold = Array.fold_left
let foldi f acc a =
let n = ref 0 in
Array.fold_left
(fun acc x ->
let acc = f acc !n x in
incr n;
acc)
acc a
exception ExitNow
let for_all p a =
try
Array.iter (fun x -> if not (p x) then raise ExitNow) a;
true
with ExitNow -> false
let exists p a =
try
Array.iter (fun x -> if p x then raise ExitNow) a;
false
with ExitNow -> true
(** {2 Conversions} *)
type 'a sequence = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
let of_list = Array.of_list
let to_list = Array.to_list
let of_array_unsafe a = a (* careful with that axe, Eugene *)
let to_seq a k = iter k a
let of_seq s =
let l = ref [] in
s (fun x -> l := x :: !l);
Array.of_list (List.rev !l)
(*$Q
Q.(list int) (fun l -> \
let g = Sequence.of_list l in \
of_seq g |> to_seq |> Sequence.to_list = l)
*)
let rec gen_to_list_ acc g = match g() with
| None -> List.rev acc
| Some x -> gen_to_list_ (x::acc) g
let of_gen g =
let l = gen_to_list_ [] g in
Array.of_list l
let to_gen a =
let i = ref 0 in
fun () ->
if !i < Array.length a then (
let x = a.(!i) in
incr i;
Some x
) else None
(*$Q
Q.(list int) (fun l -> \
let g = Gen.of_list l in \
of_gen g |> to_gen |> Gen.to_list = l)
*)
(** {2 IO} *)
type 'a printer = Format.formatter -> 'a -> unit
let print ?(start="[|") ?(stop="|]") ?(sep=";") pp_item out a =
Format.pp_print_string out start;
for k = 0 to Array.length a - 1 do
if k > 0 then (
Format.pp_print_string out sep;
Format.pp_print_cut out ()
);
pp_item out a.(k)
done;
Format.pp_print_string out stop;
()

85
src/data/CCImmutArray.mli Normal file
View file

@ -0,0 +1,85 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Immutable Arrays}
Purely functional use of arrays. Update is costly, but reads are very fast.
Sadly, it is not possible to make this type covariant without using black
magic.
@since 0.17 *)
type 'a t
(** Array of values of type 'a. The underlying type really is
an array, but it will never be modified.
It should be covariant but OCaml will not accept it. *)
val empty : 'a t
val length : _ t -> int
val singleton : 'a -> 'a t
val doubleton : 'a -> 'a -> 'a t
val make : int -> 'a -> 'a t
(** [make n x] makes an array of [n] times [x] *)
val init : int -> (int -> 'a) -> 'a t
(** [init n f] makes the array [[| f 0; f 1; ... ; f (n-1) |]].
@raise Invalid_argument if [n < 0] *)
val get : 'a t -> int -> 'a
(** Access the element *)
val set : 'a t -> int -> 'a -> 'a t
(** Copy the array and modify its copy *)
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
val append : 'a t -> 'a t -> 'a t
val iter : ('a -> unit) -> 'a t -> unit
val iteri : (int -> 'a -> unit) -> 'a t -> unit
val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
val for_all : ('a -> bool) -> 'a t -> bool
val exists : ('a -> bool) -> 'a t -> bool
(** {2 Conversions} *)
type 'a sequence = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
val of_list : 'a list -> 'a t
val to_list : 'a t -> 'a list
val of_array_unsafe : 'a array -> 'a t
(** Take ownership of the given array. Careful, the array must {b NOT}
be modified afterwards! *)
val to_seq : 'a t -> 'a sequence
val of_seq : 'a sequence -> 'a t
val of_gen : 'a gen -> 'a t
val to_gen : 'a t -> 'a gen
(** {2 IO} *)
type 'a printer = Format.formatter -> 'a -> unit
val print :
?start:string -> ?stop:string -> ?sep:string ->
'a printer -> 'a t printer

12
src/data/CCIntMap.ml
View file

@ -287,6 +287,18 @@ let rec fold f t acc = match t with
let cardinal t = fold (fun _ _ n -> n+1) t 0
let rec mapi f t = match t with
| E -> E
| L (k, v) -> L (k, f k v)
| N (p, s, l, r) ->
N (p, s, mapi f l, mapi f r)
let rec map f t = match t with
| E -> E
| L (k, v) -> L (k, f v)
| N (p, s, l, r) ->
N (p, s, map f l, map f r)
let rec choose_exn = function
| E -> raise Not_found
| L (k, v) -> k, v

6
src/data/CCIntMap.mli
View file

@ -66,6 +66,12 @@ val iter : (int -> 'a -> unit) -> 'a t -> unit
val fold : (int -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
(** @since 0.17 *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** @since 0.17 *)
val choose : 'a t -> (int * 'a) option
val choose_exn : 'a t -> int * 'a

50
src/data/CCPersistentHashtbl.ml
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Persistent hash-table on top of OCaml's hashtables} *)
@ -89,8 +67,9 @@ module type S = sig
(** Fresh copy of the table; the underlying structure is not shared
anymore, so using both tables alternatively will be efficient *)
val merge : (key -> 'a option -> 'a option -> 'a option) ->
'a t -> 'a t -> 'a t
val merge :
f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) ->
'a t -> 'b t -> 'c t
(** Merge two tables together into a new table. The function's argument
correspond to values associated with the key (if present); if the
function returns [None] the key will not appear in the result. *)
@ -561,12 +540,15 @@ module Make(H : HashedType) : S with type key = H.t = struct
false
with ExitPTbl -> true
let merge f t1 t2 =
let merge ~f t1 t2 =
let tbl = create (max (length t1) (length t2)) in
let tbl = fold
(fun tbl k v1 ->
let v2 = try Some (find t2 k) with Not_found -> None in
match f k (Some v1) v2 with
let comb =
try `Both (v1, find t2 k)
with Not_found -> `Left v1
in
match f k comb with
| None -> tbl
| Some v' -> replace tbl k v')
tbl t1
@ -574,19 +556,19 @@ module Make(H : HashedType) : S with type key = H.t = struct
fold
(fun tbl k v2 ->
if mem t1 k then tbl
else match f k None (Some v2) with
else match f k (`Right v2) with
| None -> tbl
| Some _ -> replace tbl k v2
| Some v' -> replace tbl k v'
) tbl t2
(*$R
let t1 = H.of_list [1, "a"; 2, "b1"] in
let t2 = H.of_list [2, "b2"; 3, "c"] in
let t = H.merge
(fun _ v1 v2 -> match v1, v2 with
| None, _ -> v2
| _ , None -> v1
| Some s1, Some s2 -> if s1 < s2 then Some s1 else Some s2)
~f:(fun _ -> function
| `Right v2 -> Some v2
| `Left v1 -> Some v1
| `Both (s1,s2) -> if s1 < s2 then Some s1 else Some s2)
t1 t2
in
OUnit.assert_equal ~printer:string_of_int 3 (H.length t);

29
src/data/CCPersistentHashtbl.mli
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Persistent hash-table on top of OCaml's hashtables}
@ -96,8 +74,9 @@ module type S = sig
(** Fresh copy of the table; the underlying structure is not shared
anymore, so using both tables alternatively will be efficient *)
val merge : (key -> 'a option -> 'a option -> 'a option) ->
'a t -> 'a t -> 'a t
val merge :
f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) ->
'a t -> 'b t -> 'c t
(** Merge two tables together into a new table. The function's argument
correspond to values associated with the key (if present); if the
function returns [None] the key will not appear in the result. *)

13
src/data/CCRAL.ml
View file

@ -426,6 +426,18 @@ let range i j =
range i j |> to_list = CCList.(i -- j) )
*)
let range_r_open_ i j =
if i=j then empty
else if i<j then range i (j-1)
else range i (j+1)
(*$= & ~printer:CCFormat.(to_string (hbox (list int)))
[1;2;3;4] (1 --^ 5 |> to_list)
[5;4;3;2] (5 --^ 1 |> to_list)
[1] (1 --^ 2 |> to_list)
[] (0 --^ 0 |> to_list)
*)
(** {2 Conversions} *)
type 'a sequence = ('a -> unit) -> unit
@ -554,6 +566,7 @@ module Infix = struct
let (>|=) l f = map ~f l
let (<*>) = app
let (--) = range
let (--^) = range_r_open_
end
include Infix

4
src/data/CCRAL.mli
View file

@ -175,6 +175,10 @@ module Infix : sig
val (--) : int -> int -> int t
(** Alias to {!range} *)
val (--^) : int -> int -> int t
(** [a -- b] is the integer range from [a] to [b], where [b] is excluded.
@since 0.17 *)
end
include module type of Infix

515
src/data/CCTrie.ml
View file

@ -1,27 +1,5 @@
(*
copyright (c) 2013-2014, 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 Prefix Tree} *)
@ -32,7 +10,7 @@ type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list]
(** {6 A Composite Word}
Words are made of characters, who belong to a total order *)
Words are made of characters, who belong to a total order *)
module type WORD = sig
type t
@ -66,6 +44,16 @@ module type S = sig
(** Same as {!find} but can fail.
@raise Not_found if the key is not present *)
val longest_prefix : key -> 'a t -> key
(** [longest_prefix k m] finds the longest prefix of [k] that leads to
at least one path in [m] (it does not mean that the prefix is bound to
a value.
Example: if [m] has keys "abc0" and "abcd", then [longest_prefix "abc2" m]
will return "abc"
@since 0.17 *)
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
(** Update the binding for the given key. The function is given
[None] if the key is absent, or [Some v] if [key] is bound to [v];
@ -75,6 +63,14 @@ module type S = sig
val fold : ('b -> key -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold on key/value bindings. Will use {!WORD.of_list} to rebuild keys. *)
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
(** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys.
@since 0.17 *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Map values, giving only the value.
@since 0.17 *)
val iter : (key -> 'a -> unit) -> 'a t -> unit
(** Same as {!fold}, but for effectful functions *)
@ -107,10 +103,12 @@ module type S = sig
(** {6 Ranges} *)
val above : key -> 'a t -> (key * 'a) sequence
(** All bindings whose key is bigger or equal to the given key *)
(** All bindings whose key is bigger or equal to the given key, in
ascending order *)
val below : key -> 'a t -> (key * 'a) sequence
(** All bindings whose key is smaller or equal to the given key *)
(** All bindings whose key is smaller or equal to the given key,
in decreasing order *)
(**/**)
val check_invariants: _ t -> bool
@ -125,7 +123,9 @@ end
let t1 = T.of_list l1
let small_l l = List.fold_left (fun acc (k,v) -> List.length k+acc) 0 l
*)
let s1 = String.of_list ["cat", 1; "catogan", 2; "foo", 3]
*)
(*$T
String.of_list ["a", 1; "b", 2] |> String.size = 2
@ -134,21 +134,23 @@ end
String.of_list ["a", 1; "b", 2] |> String.find_exn "b" = 2
String.of_list ["a", 1; "b", 2] |> String.find "c" = None
String.of_list ["cat", 1; "catogan", 2; "foo", 3] |> String.find_exn "cat" = 1
String.of_list ["cat", 1; "catogan", 2; "foo", 3] |> String.find_exn "catogan" = 2
String.of_list ["cat", 1; "catogan", 2; "foo", 3] |> String.find_exn "foo" = 3
String.of_list ["cat", 1; "catogan", 2; "foo", 3] |> String.find "cato" = None
s1 |> String.find_exn "cat" = 1
s1 |> String.find_exn "catogan" = 2
s1 |> String.find_exn "foo" = 3
s1 |> String.find "cato" = None
*)
module Make(W : WORD) = struct
module Make(W : WORD)
: S with type char_ = W.char_ and type key = W.t
= struct
type char_ = W.char_
type key = W.t
module M = Map.Make(struct
type t = char_
let compare = W.compare
end)
type t = char_
let compare = W.compare
end)
type 'a t =
| Empty
@ -156,9 +158,9 @@ module Make(W : WORD) = struct
| Node of 'a option * 'a t M.t
(* invariants:
- for Path(l,t) l is never empty
- for Node (None,map) map always has at least 2 elements
- for Node (Some _,map) map can be anything *)
- for Path(l,t) l is never empty
- for Node (None,map) map always has at least 2 elements
- for Node (Some _,map) map can be anything *)
let empty = Empty
@ -171,7 +173,7 @@ module Make(W : WORD) = struct
| Cons (_, t) -> check_invariants t
| Node (None, map) when M.is_empty map -> false
| Node (_, map) ->
M.for_all (fun _ v -> check_invariants v) map
M.for_all (fun _ v -> check_invariants v) map
let is_empty = function
| Empty -> true
@ -191,12 +193,17 @@ module Make(W : WORD) = struct
| None -> ()
| Some y -> k y)
let _seq_append_list l seq =
let _seq_map f seq k = seq (fun x -> k (f x))
let _seq_append_list_rev l seq =
let l = ref l in
seq (fun x -> l := x :: !l);
!l
let _seq_map map k =
let _seq_append_list l seq =
List.rev_append (_seq_append_list_rev [] seq) l
let seq_of_map map k =
M.iter (fun key v -> k (key,v)) map
(* return common prefix, and disjoint suffixes *)
@ -204,12 +211,12 @@ module Make(W : WORD) = struct
| [], _
| _, [] -> [], l1, l2
| c1::l1', c2::l2' ->
if W.compare c1 c2 = 0
then
let pre, rest1, rest2 = _merge_lists l1' l2' in
c1::pre, rest1, rest2
else
[], l1, l2
if W.compare c1 c2 = 0
then
let pre, rest1, rest2 = _merge_lists l1' l2' in
c1::pre, rest1, rest2
else
[], l1, l2
(* sub-tree t prefixed with c *)
@ -220,11 +227,11 @@ module Make(W : WORD) = struct
| None ->
if M.is_empty map then Empty
else
if M.cardinal map = 1
then
let c, sub = M.min_binding map in
_cons c sub
else Node (value,map)
if M.cardinal map = 1
then
let c, sub = M.min_binding map in
_cons c sub
else Node (value,map)
(* remove key [c] from [t] *)
let _remove c t = match t with
@ -234,35 +241,35 @@ module Make(W : WORD) = struct
then Empty
else t
| Node (value, map) ->
if M.mem c map
then
let map' = M.remove c map in
_mk_node value map'
else t
if M.mem c map
then
let map' = M.remove c map in
_mk_node value map'
else t
let update key f t =
(* first arg: current subtree and rebuild function; [c]: current char *)
let goto (t, rebuild) c =
match t with
| Empty -> empty, fun t -> rebuild (_cons c t)
| Cons (c', t') ->
if W.compare c c' = 0
then t', (fun t -> rebuild (_cons c t))
else
let rebuild' new_child =
rebuild (
if is_empty new_child then t
else
let map = M.singleton c new_child in
let map = M.add c' t' map in
_mk_node None map
) in
empty, rebuild'
| Node (value, map) ->
| Empty -> empty, fun t -> rebuild (_cons c t)
| Cons (c', t') ->
if W.compare c c' = 0
then t', (fun t -> rebuild (_cons c t))
else
let rebuild' new_child =
rebuild (
if is_empty new_child then t
else
let map = M.singleton c new_child in
let map = M.add c' t' map in
_mk_node None map
) in
empty, rebuild'
| Node (value, map) ->
try
let t' = M.find c map in
(* rebuild: we modify [t], so we put the new version in [map]
if it's not empty, and make the node again *)
if it's not empty, and make the node again *)
let rebuild' new_child =
rebuild (
if is_empty new_child
@ -286,12 +293,12 @@ module Make(W : WORD) = struct
| Cons (c, t') ->
rebuild
(match f None with
| None -> t
| Some _ as v -> _mk_node v (M.singleton c t')
| None -> t
| Some _ as v -> _mk_node v (M.singleton c t')
)
| Node (value, map) ->
let value' = f value in
rebuild (_mk_node value' map)
let value' = f value in
rebuild (_mk_node value' map)
in
let word = W.to_seq key in
_fold_seq_and_then goto ~finish (t, _id) word
@ -313,9 +320,9 @@ module Make(W : WORD) = struct
let goto t c = match t with
| Empty -> raise Not_found
| Cons (c', t') ->
if W.compare c c' = 0
then t'
else raise Not_found
if W.compare c c' = 0
then t'
else raise Not_found
| Node (_, map) -> M.find c map
and finish t = match t with
| Node (Some v, _) -> v
@ -328,7 +335,44 @@ module Make(W : WORD) = struct
try Some (find_exn k t)
with Not_found -> None
let _difflist_add f x = fun l' -> f (x :: l')
type 'a difflist = 'a list -> 'a list
let _difflist_add
: 'a difflist -> 'a -> 'a difflist
= fun f x -> fun l' -> f (x :: l')
let longest_prefix k t =
(* at subtree [t], and character [c] *)
let goto (t,prefix) c = match t with
| Empty -> Empty, prefix
| Cons (c', t') ->
if W.compare c c' = 0
then t', _difflist_add prefix c
else Empty, prefix
| Node (_, map) ->
try
let t' = M.find c map in
t', _difflist_add prefix c
with Not_found -> Empty, prefix
and finish (_,prefix) =
W.of_list (prefix [])
in
let word = W.to_seq k in
_fold_seq_and_then goto ~finish (t,_id) word
(*$= & ~printer:CCFun.id
"ca" (String.longest_prefix "carte" s1)
"" (String.longest_prefix "yolo" s1)
"cat" (String.longest_prefix "cat" s1)
"catogan" (String.longest_prefix "catogan" s1)
*)
(*$Q
Q.(pair (list (pair printable_string int)) printable_string) (fun (l,s) -> \
let m = String.of_list l in \
let s' = String.longest_prefix s m in \
CCString.prefix ~pre:s' s)
*)
(* fold that also keeps the path from the root, so as to provide the list
of chars that lead to a value. The path is a difference list, ie
@ -337,26 +381,66 @@ module Make(W : WORD) = struct
| Empty -> acc
| Cons (c, t') -> _fold f (_difflist_add path c) t' acc
| Node (v, map) ->
let acc = match v with
| None -> acc
| Some v -> f acc path v
in
M.fold
(fun c t' acc -> _fold f (_difflist_add path c) t' acc)
map acc
let acc = match v with
| None -> acc
| Some v -> f acc path v
in
M.fold
(fun c t' acc -> _fold f (_difflist_add path c) t' acc)
map acc
let fold f acc t =
_fold
(fun acc path v ->
let key = W.of_list (path []) in
f acc key v
) _id t acc
let key = W.of_list (path []) in
f acc key v)
_id t acc
(*$T
T.fold (fun acc k v -> (k,v) :: acc) [] t1 \
|> List.sort Pervasives.compare = List.sort Pervasives.compare l1
*)
let mapi f t =
let rec map_ prefix t = match t with
| Empty -> Empty
| Cons (c, t') -> Cons (c, map_ (_difflist_add prefix c) t')
| Node (v, map) ->
let v' = match v with
| None -> None
| Some v -> Some (f (W.of_list (prefix [])) v)
in let map' =
M.mapi (fun c t' ->
let prefix' = _difflist_add prefix c in
map_ prefix' t')
map
in Node (v', map')
in map_ _id t
(*$= & ~printer:Q.Print.(list (pair (list int) string))
(List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Pervasives.compare) \
(T.mapi (fun k v -> v ^ "!") t1 \
|> T.to_list |> List.sort Pervasives.compare)
*)
let map f t =
let rec map_ = function
| Empty -> Empty
| Cons (c, t') -> Cons (c, map_ t')
| Node (v, map) ->
let v' = match v with
| None -> None
| Some v -> Some (f v)
in let map' = M.map map_ map
in Node (v', map')
in map_ t
(*$= & ~printer:Q.Print.(list (pair (list int) string))
(List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Pervasives.compare) \
(T.map (fun v -> v ^ "!") t1 \
|> T.to_list |> List.sort Pervasives.compare)
*)
let iter f t =
_fold
(fun () path y -> f (W.of_list (path [])) y)
@ -365,21 +449,21 @@ module Make(W : WORD) = struct
let _iter_prefix ~prefix f t =
_fold
(fun () path y ->
let key = W.of_list (prefix (path [])) in
f key y)
let key = W.of_list (prefix (path [])) in
f key y)
_id t ()
let rec fold_values f acc t = match t with
| Empty -> acc
| Cons (_, t') -> fold_values f acc t'
| Node (v, map) ->
let acc = match v with
| None -> acc
| Some v -> f acc v
in
M.fold
(fun _c t' acc -> fold_values f acc t')
map acc
let acc = match v with
| None -> acc
| Some v -> f acc v
in
M.fold
(fun _c t' acc -> fold_values f acc t')
map acc
let iter_values f t = fold_values (fun () x -> f x) () t
@ -395,7 +479,7 @@ module Make(W : WORD) = struct
_mk_node None map
| Cons (c1, t1'), Node (value, map) ->
begin try
begin try
(* collision *)
let t2' = M.find c1 map in
let new_t = merge f t1' t2' in
@ -408,25 +492,25 @@ module Make(W : WORD) = struct
(* no collision *)
assert (not(is_empty t1'));
Node (value, M.add c1 t1' map)
end
end
| Node _, Cons _ -> merge f t2 t1 (* previous case *)
| Node(v1, map1), Node (v2, map2) ->
let v = match v1, v2 with
| None, _ -> v2
| _, None -> v1
| Some v1, Some v2 -> f v1 v2
in
let map' = M.merge
let v = match v1, v2 with
| None, _ -> v2
| _, None -> v1
| Some v1, Some v2 -> f v1 v2
in
let map' = M.merge
(fun _c t1 t2 -> match t1, t2 with
| None, None -> assert false
| Some t, None
| None, Some t -> Some t
| Some t1, Some t2 ->
let new_t = merge f t1 t2 in
if is_empty new_t then None else Some new_t
| None, None -> assert false
| Some t, None
| None, Some t -> Some t
| Some t1, Some t2 ->
let new_t = merge f t1 t2 in
if is_empty new_t then None else Some new_t
) map1 map2
in
_mk_node v map'
in
_mk_node v map'
(*$QR & ~count:30
Q.(let p = list_of_size Gen.(0--100) (pair printable_string small_int) in pair p p)
@ -443,10 +527,10 @@ module Make(W : WORD) = struct
| Empty -> 0
| Cons (_, t') -> size t'
| Node (v, map) ->
let s = if v=None then 0 else 1 in
M.fold
(fun _ t' acc -> size t' + acc)
map s
let s = if v=None then 0 else 1 in
M.fold
(fun _ t' acc -> size t' + acc)
map s
(*$T
T.size t1 = List.length l1
@ -467,9 +551,9 @@ module Make(W : WORD) = struct
let rec to_tree t () =
let _tree_node x l () = `Node (x,l) in
match t with
| Empty -> `Nil
| Cons (c, t') -> `Node (`Char c, [to_tree t'])
| Node (v, map) ->
| Empty -> `Nil
| Cons (c, t') -> `Node (`Char c, [to_tree t'])
| Node (v, map) ->
let x = match v with
| None -> `Switch
| Some v -> `Val v
@ -479,78 +563,114 @@ module Make(W : WORD) = struct
(** {6 Ranges} *)
(* stack of actions for [above] and [below] *)
type 'a alternative =
| Yield of 'a * char_ difflist
| Explore of 'a t * char_ difflist
type direction =
| Above
| Below
let rec explore ~dir k alt = match alt with
| Yield (v,prefix) -> k (W.of_list (prefix[]), v)
| Explore (Empty, _) -> ()
| Explore (Cons (c,t), prefix) ->
explore ~dir k (Explore (t, _difflist_add prefix c))
| Explore (Node (o,map), prefix) ->
(* if above, yield value now *)
begin match o, dir with
| Some v, Above -> k (W.of_list (prefix[]), v)
| _ -> ()
end;
let seq = seq_of_map map in
let seq = _seq_map (fun (c,t') -> Explore (t', _difflist_add prefix c)) seq in
let l' = match o, dir with
| _, Above -> _seq_append_list [] seq
| None, Below -> _seq_append_list_rev [] seq
| Some v, Below ->
_seq_append_list_rev [Yield (v, prefix)] seq
in
List.iter (explore ~dir k) l'
(* range above (if [above = true]) or below a threshold .
[p c c'] must return [true] if [c'], in the tree, meets some criterion
w.r.t [c] which is a part of the key. *)
let _half_range ~above ~p key t k =
[p c c'] must return [true] if [c'], in the tree, meets some criterion
w.r.t [c] which is a part of the key. *)
let _half_range ~dir ~p key t k =
(* at subtree [cur = Some (t,trail)] or [None], alternatives above
[alternatives], and char [c] in [key]. *)
let on_char (cur, alternatives) c =
match cur with
| None -> (None, alternatives)
| Some (Empty,_) -> (None, alternatives)
| Some (Cons (c', t'), trail) ->
| None -> (None, alternatives)
| Some (Empty,_) -> (None, alternatives)
| Some (Cons (c', t'), trail) ->
if W.compare c c' = 0
then Some (t', _difflist_add trail c), alternatives
else None, alternatives
| Some (Node (o, map), trail) ->
(* if [not above], [o]'s key is below [key] so add it *)
begin match o with
| Some v when not above -> k (W.of_list (trail []), v)
| _ -> ()
end;
let alternatives =
let seq = _seq_map map in
let seq = _filter_map_seq
(fun (c', t') -> if p c c'
then Some (t', _difflist_add trail c')
else None
) seq
in
_seq_append_list alternatives seq
then Some (t', _difflist_add trail c), alternatives
else None, alternatives
| Some (Node (o, map), trail) ->
(* if [dir=Below], [o]'s key is below [key] and the other
alternatives in [map] *)
let alternatives = match o, dir with
| Some v, Below -> Yield (v, trail) :: alternatives
| _ -> alternatives
in
begin try
let t' = M.find c map in
Some (t', _difflist_add trail c), alternatives
with Not_found ->
None, alternatives
let alternatives =
let seq = seq_of_map map in
let seq = _filter_map_seq
(fun (c', t') ->
if p ~cur:c ~other:c'
then Some (Explore (t', _difflist_add trail c'))
else None)
seq
in
(* ordering:
- Above: explore alternatives in increasing order
- Below: explore alternatives in decreasing order *)
match dir with
| Above -> _seq_append_list alternatives seq
| Below -> _seq_append_list_rev alternatives seq
in
begin
try
let t' = M.find c map in
Some (t', _difflist_add trail c), alternatives
with Not_found ->
None, alternatives
end
(* run through the current path (if any) and alternatives *)
and finish (cur,alternatives) =
begin match cur with
| Some (t, prefix) when above ->
begin match cur, dir with
| Some (t, prefix), Above ->
(* subtree prefixed by input key, therefore above key *)
_iter_prefix ~prefix (fun key' v -> k (key', v)) t
| Some (Node (Some v, _), prefix) when not above ->
| Some (Node (Some v, _), prefix), Below ->
(* yield the value for key *)
assert (W.of_list (prefix []) = key);
k (key, v)
| Some _
| None -> ()
| Some _, _
| None, _ -> ()
end;
List.iter
(fun (t,prefix) -> _iter_prefix ~prefix (fun key' v -> k (key', v)) t)
alternatives
List.iter (explore ~dir k) alternatives
in
let word = W.to_seq key in
_fold_seq_and_then on_char ~finish (Some(t,_id), []) word
let above key t =
_half_range ~above:true ~p:(fun c c' -> W.compare c c' < 0) key t
_half_range ~dir:Above ~p:(fun ~cur ~other -> W.compare cur other < 0) key t
let below key t =
_half_range ~above:false ~p:(fun c c' -> W.compare c c' > 0) key t
_half_range ~dir:Below ~p:(fun ~cur ~other -> W.compare cur other > 0) key t
(*$= & ~printer:CCPrint.(to_string (list (pair (list int) string)))
[ [1], "1"; [1;2], "12"; [1;2;3], "123"; [2;1], "21" ] \
(T.above [1] t1 |> Sequence.sort |> Sequence.to_list)
(T.above [1] t1 |> Sequence.to_list)
[ [1;2], "12"; [1;2;3], "123"; [2;1], "21" ] \
(T.above [1;1] t1 |> Sequence.sort |> Sequence.to_list)
[ [], "[]"; [1], "1"; [1;2], "12" ] \
(T.below [1;2] t1 |> Sequence.sort |> Sequence.to_list)
[ [], "[]"; [1], "1" ] \
(T.below [1;1] t1 |> Sequence.sort |> Sequence.to_list)
(T.above [1;1] t1 |> Sequence.to_list)
[ [1;2], "12"; [1], "1"; [], "[]" ] \
(T.below [1;2] t1 |> Sequence.to_list)
[ [1], "1"; [], "[]" ] \
(T.below [1;1] t1 |> Sequence.to_list)
*)
(*$Q & ~count:30
@ -559,7 +679,14 @@ module Make(W : WORD) = struct
S.check_invariants t)
*)
(*$Q & ~count:20
(*$inject
let rec sorted ~rev = function
| [] | [_] -> true
| x :: ((y ::_) as tl) ->
(if rev then x >= y else x <= y) && sorted ~rev tl
*)
(*$Q & ~count:200
Q.(list_of_size Gen.(1 -- 20) (pair printable_string small_int)) \
(fun l -> let t = String.of_list l in \
List.for_all (fun (k,_) -> \
@ -570,6 +697,16 @@ module Make(W : WORD) = struct
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)) \
(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)) \
(fun l -> let t = String.of_list l in \
List.for_all (fun (k,_) -> \
String.below k t |> Sequence.to_list |> sorted ~rev:true) \
l)
*)
end
@ -579,28 +716,28 @@ module type ORDERED = sig
end
module MakeArray(X : ORDERED) = Make(struct
type t = X.t array
type char_ = X.t
let compare = X.compare
let to_seq a k = Array.iter k a
let of_list = Array.of_list
end)
type t = X.t array
type char_ = X.t
let compare = X.compare
let to_seq a k = Array.iter k a
let of_list = Array.of_list
end)
module MakeList(X : ORDERED) = Make(struct
type t = X.t list
type char_ = X.t
let compare = X.compare
let to_seq a k = List.iter k a
let of_list l = l
end)
type t = X.t list
type char_ = X.t
let compare = X.compare
let to_seq a k = List.iter k a
let of_list l = l
end)
module String = Make(struct
type t = string
type char_ = char
let compare = Char.compare
let to_seq s k = String.iter k s
let of_list l =
let buf = Buffer.create (List.length l) in
List.iter (fun c -> Buffer.add_char buf c) l;
Buffer.contents buf
end)
type t = string
type char_ = char
let compare = Char.compare
let to_seq s k = String.iter k s
let of_list l =
let buf = Buffer.create (List.length l) in
List.iter (fun c -> Buffer.add_char buf c) l;
Buffer.contents buf
end)

50
src/data/CCTrie.mli
View file

@ -1,27 +1,5 @@
(*
copyright (c) 2013-2014, 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 Prefix Tree} *)
@ -32,7 +10,7 @@ type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list]
(** {6 A Composite Word}
Words are made of characters, who belong to a total order *)
Words are made of characters, who belong to a total order *)
module type WORD = sig
type t
@ -66,6 +44,16 @@ module type S = sig
(** Same as {!find} but can fail.
@raise Not_found if the key is not present *)
val longest_prefix : key -> 'a t -> key
(** [longest_prefix k m] finds the longest prefix of [k] that leads to
at least one path in [m] (it does not mean that the prefix is bound to
a value.
Example: if [m] has keys "abc0" and "abcd", then [longest_prefix "abc2" m]
will return "abc"
@since 0.17 *)
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
(** Update the binding for the given key. The function is given
[None] if the key is absent, or [Some v] if [key] is bound to [v];
@ -75,6 +63,14 @@ module type S = sig
val fold : ('b -> key -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold on key/value bindings. Will use {!WORD.of_list} to rebuild keys. *)
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
(** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys.
@since 0.17 *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Map values, giving only the value.
@since 0.17 *)
val iter : (key -> 'a -> unit) -> 'a t -> unit
(** Same as {!fold}, but for effectful functions *)
@ -107,10 +103,12 @@ module type S = sig
(** {6 Ranges} *)
val above : key -> 'a t -> (key * 'a) sequence
(** All bindings whose key is bigger or equal to the given key *)
(** All bindings whose key is bigger or equal to the given key, in
ascending order *)
val below : key -> 'a t -> (key * 'a) sequence
(** All bindings whose key is smaller or equal to the given key *)
(** All bindings whose key is smaller or equal to the given key,
in decreasing order *)
(**/**)
val check_invariants: _ t -> bool

14
src/data/CCWBTree.ml
View file

@ -97,6 +97,10 @@ module type S = sig
val fold : f:('b -> key -> 'a -> 'b) -> x:'b -> 'a t -> 'b
val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t
val map : f:('a -> 'b) -> 'a t -> 'b t
val iter : f:(key -> 'a -> unit) -> 'a t -> unit
val split : key -> 'a t -> 'a t * 'a option * 'a t
@ -368,6 +372,16 @@ module MakeFull(K : KEY) : S with type key = K.t = struct
let acc = f acc k v in
fold ~f ~x:acc r
let rec mapi ~f = function
| E -> E
| N (k, v, l, r, w) ->
N (k, f k v, mapi ~f l, mapi ~f r, w)
let rec map ~f = function
| E -> E
| N (k, v, l, r, w) ->
N (k, f v, map ~f l, map ~f r, w)
let rec iter ~f m = match m with
| E -> ()
| N (k, v, l, r, _) ->

10
src/data/CCWBTree.mli
View file

@ -62,6 +62,16 @@ module type S = sig
val fold : f:('b -> key -> 'a -> 'b) -> x:'b -> 'a t -> 'b
val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t
(** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys.
@since 0.17
*)
val map : f:('a -> 'b) -> 'a t -> 'b t
(** Map values, giving only the value.
@since 0.17
*)
val iter : f:(key -> 'a -> unit) -> 'a t -> unit
val split : key -> 'a t -> 'a t * 'a option * 'a t

4
src/data/containers_data.mldylib
View file

@ -1,5 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: f1eb737bc11930f88f05f61212c0f303)
# DO NOT EDIT (digest: dd0c9f2f982ba538c549f23a4800cb92)
CCMultiMap
CCMultiSet
CCTrie
@ -24,4 +24,6 @@ CCBloom
CCWBTree
CCRAL
CCAllocCache
CCImmutArray
CCHet
# OASIS_STOP

4
src/data/containers_data.mllib
View file

@ -1,5 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: f1eb737bc11930f88f05f61212c0f303)
# DO NOT EDIT (digest: dd0c9f2f982ba538c549f23a4800cb92)
CCMultiMap
CCMultiSet
CCTrie
@ -24,4 +24,6 @@ CCBloom
CCWBTree
CCRAL
CCAllocCache
CCImmutArray
CCHet
# OASIS_STOP

184
src/iter/CCKList.ml
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Continuation List} *)
@ -72,15 +50,15 @@ let rec equal eq l1 l2 = match l1(), l2() with
| `Nil, _
| _, `Nil -> false
| `Cons (x1,l1'), `Cons (x2,l2') ->
eq x1 x2 && equal eq l1' l2'
eq x1 x2 && equal eq l1' l2'
let rec compare cmp l1 l2 = match l1(), l2() with
| `Nil, `Nil -> 0
| `Nil, _ -> -1
| _, `Nil -> 1
| `Cons (x1,l1'), `Cons (x2,l2') ->
let c = cmp x1 x2 in
if c = 0 then compare cmp l1' l2' else c
let c = cmp x1 x2 in
if c = 0 then compare cmp l1' l2' else c
let rec fold f acc res = match res () with
| `Nil -> acc
@ -94,8 +72,8 @@ let iteri f l =
let rec aux f l i = match l() with
| `Nil -> ()
| `Cons (x, l') ->
f i x;
aux f l' (i+1)
f i x;
aux f l' (i+1)
in
aux f l 0
@ -110,7 +88,7 @@ let rec take n (l:'a t) () =
let rec take_while p l () = match l () with
| `Nil -> `Nil
| `Cons (x,l') ->
if p x then `Cons (x, take_while p l') else `Nil
if p x then `Cons (x, take_while p l') else `Nil
(*$T
of_list [1;2;3;4] |> take_while (fun x->x < 4) |> to_list = [1;2;3]
@ -144,7 +122,7 @@ let mapi f l =
let rec aux f l i () = match l() with
| `Nil -> `Nil
| `Cons (x, tl) ->
`Cons (f i x, aux f tl (i+1))
`Cons (f i x, aux f tl (i+1))
in
aux f l 0
@ -155,10 +133,10 @@ let mapi f l =
let rec fmap f (l:'a t) () = match l() with
| `Nil -> `Nil
| `Cons (x, l') ->
begin match f x with
begin match f x with
| None -> fmap f l' ()
| Some y -> `Cons (y, fmap f l')
end
end
(*$T
fmap (fun x -> if x mod 2=0 then Some (x*3) else None) (1--10) |> to_list \
@ -168,9 +146,9 @@ let rec fmap f (l:'a t) () = match l() with
let rec filter p l () = match l () with
| `Nil -> `Nil
| `Cons (x, l') ->
if p x
then `Cons (x, filter p l')
else filter p l' ()
if p x
then `Cons (x, filter p l')
else filter p l' ()
let rec append l1 l2 () = match l1 () with
| `Nil -> l2 ()
@ -195,25 +173,25 @@ let rec unfold f acc () = match f acc with
let rec flat_map f l () = match l () with
| `Nil -> `Nil
| `Cons (x, l') ->
_flat_map_app f (f x) l' ()
_flat_map_app f (f x) l' ()
and _flat_map_app f l l' () = match l () with
| `Nil -> flat_map f l' ()
| `Cons (x, tl) ->
`Cons (x, _flat_map_app f tl l')
`Cons (x, _flat_map_app f tl l')
let product_with f l1 l2 =
let rec _next_left h1 tl1 h2 tl2 () =
match tl1() with
| `Nil -> _next_right ~die:true h1 tl1 h2 tl2 ()
| `Cons (x, tl1') ->
| `Nil -> _next_right ~die:true h1 tl1 h2 tl2 ()
| `Cons (x, tl1') ->
_map_list_left x h2
(_next_right ~die:false (x::h1) tl1' h2 tl2)
()
and _next_right ~die h1 tl1 h2 tl2 () =
match tl2() with
| `Nil when die -> `Nil
| `Nil -> _next_left h1 tl1 h2 tl2 ()
| `Cons (y, tl2') ->
| `Nil when die -> `Nil
| `Nil -> _next_left h1 tl1 h2 tl2 ()
| `Cons (y, tl2') ->
_map_list_right h1 y
(_next_left h1 tl1 (y::h2) tl2')
()
@ -232,7 +210,7 @@ let product l1 l2 =
let rec group eq l () = match l() with
| `Nil -> `Nil
| `Cons (x, l') ->
`Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l'))
`Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l'))
(*$T
of_list [1;1;1;2;2;3;3;1] |> group (=) |> map to_list |> to_list = \
@ -242,21 +220,21 @@ let rec group eq l () = match l() with
let rec _uniq eq prev l () = match prev, l() with
| _, `Nil -> `Nil
| None, `Cons (x, l') ->
`Cons (x, _uniq eq (Some x) l')
`Cons (x, _uniq eq (Some x) l')
| Some y, `Cons (x, l') ->
if eq x y
then _uniq eq prev l' ()
else `Cons (x, _uniq eq (Some x) l')
if eq x y
then _uniq eq prev l' ()
else `Cons (x, _uniq eq (Some x) l')
let uniq eq l = _uniq eq None l
let rec filter_map f l () = match l() with
| `Nil -> `Nil
| `Cons (x, l') ->
begin match f x with
begin match f x with
| None -> filter_map f l' ()
| Some y -> `Cons (y, filter_map f l')
end
end
let flatten l = flat_map (fun x->x) l
@ -275,43 +253,55 @@ let range i j =
let (--) = range
let (--^) i j =
if i=j then empty
else if i<j then range i (j-1)
else range i (j+1)
(*$T
1 --^ 5 |> to_list = [1;2;3;4]
5 --^ 1 |> to_list = [5;4;3;2]
1 --^ 2 |> to_list = [1]
0 --^ 0 |> to_list = []
*)
let rec fold2 f acc l1 l2 = match l1(), l2() with
| `Nil, _
| _, `Nil -> acc
| `Cons(x1,l1'), `Cons(x2,l2') ->
fold2 f (f acc x1 x2) l1' l2'
fold2 f (f acc x1 x2) l1' l2'
let rec map2 f l1 l2 () = match l1(), l2() with
| `Nil, _
| _, `Nil -> `Nil
| `Cons(x1,l1'), `Cons(x2,l2') ->
`Cons (f x1 x2, map2 f l1' l2')
`Cons (f x1 x2, map2 f l1' l2')
let rec iter2 f l1 l2 = match l1(), l2() with
| `Nil, _
| _, `Nil -> ()
| `Cons(x1,l1'), `Cons(x2,l2') ->
f x1 x2; iter2 f l1' l2'
f x1 x2; iter2 f l1' l2'
let rec for_all2 f l1 l2 = match l1(), l2() with
| `Nil, _
| _, `Nil -> true
| `Cons(x1,l1'), `Cons(x2,l2') ->
f x1 x2 && for_all2 f l1' l2'
f x1 x2 && for_all2 f l1' l2'
let rec exists2 f l1 l2 = match l1(), l2() with
| `Nil, _
| _, `Nil -> false
| `Cons(x1,l1'), `Cons(x2,l2') ->
f x1 x2 || exists2 f l1' l2'
f x1 x2 || exists2 f l1' l2'
let rec merge cmp l1 l2 () = match l1(), l2() with
| `Nil, tl2 -> tl2
| tl1, `Nil -> tl1
| `Cons(x1,l1'), `Cons(x2,l2') ->
if cmp x1 x2 < 0
then `Cons (x1, merge cmp l1' l2)
else `Cons (x2, merge cmp l1 l2')
if cmp x1 x2 < 0
then `Cons (x1, merge cmp l1' l2)
else `Cons (x2, merge cmp l1 l2')
let rec zip a b () = match a(), b() with
| `Nil, _
@ -373,14 +363,14 @@ let of_array a =
let to_array l =
match l() with
| `Nil -> [| |]
| `Cons (x, _) ->
let n = length l in
let a = Array.make n x in (* need first elem to create [a] *)
iteri
(fun i x -> a.(i) <- x)
l;
a
| `Nil -> [| |]
| `Cons (x, _) ->
let n = length l in
let a = Array.make n x in (* need first elem to create [a] *)
iteri
(fun i x -> a.(i) <- x)
l;
a
(*$Q
Q.(array int) (fun a -> of_array a |> to_array = a)
@ -399,8 +389,8 @@ let to_gen l =
let l = ref l in
fun () ->
match !l () with
| `Nil -> None
| `Cons (x,l') ->
| `Nil -> None
| `Cons (x,l') ->
l := l';
Some x
@ -412,16 +402,16 @@ let of_gen g =
let rec consume r () = match !r with
| Of_gen_saved cons -> cons
| Of_gen_thunk g ->
begin match g() with
begin match g() with
| None ->
r := Of_gen_saved `Nil;
`Nil
r := Of_gen_saved `Nil;
`Nil
| Some x ->
let tl = consume (ref (Of_gen_thunk g)) in
let l = `Cons (x, tl) in
r := Of_gen_saved l;
l
end
let tl = consume (ref (Of_gen_thunk g)) in
let l = `Cons (x, tl) in
r := Of_gen_saved l;
l
end
in
consume (ref (Of_gen_thunk g))
@ -450,12 +440,12 @@ let rec memoize f =
fun () -> match !r with
| MemoSave l -> l
| MemoThunk ->
let l = match f() with
| `Nil -> `Nil
| `Cons (x, tail) -> `Cons (x, memoize tail)
in
r := MemoSave l;
l
let l = match f() with
| `Nil -> `Nil
| `Cons (x, tail) -> `Cons (x, memoize tail)
in
r := MemoSave l;
l
(*$R
let printer = Q.Print.(list int) in
@ -480,13 +470,13 @@ let rec interleave a b () = match a() with
let rec fair_flat_map f a () = match a() with
| `Nil -> `Nil
| `Cons (x, tail) ->
let y = f x in
interleave y (fair_flat_map f tail) ()
let y = f x in
interleave y (fair_flat_map f tail) ()
let rec fair_app f a () = match f() with
| `Nil -> `Nil
| `Cons (f1, fs) ->
interleave (map f1 a) (fair_app fs a) ()
interleave (map f1 a) (fair_app fs a) ()
let (>>-) a f = fair_flat_map f a
let (<.>) f a = fair_app f a
@ -497,6 +487,18 @@ let (<.>) f a = fair_app f a
|> to_list |> List.sort Pervasives.compare = [2; 3; 11; 30]
*)
(** {2 Infix} *)
module Infix = struct
let (>>=) = (>>=)
let (>|=) = (>|=)
let (<*>) = (<*>)
let (>>-) = (>>-)
let (<.>) = (<.>)
let (--) = (--)
let (--^) = (--^)
end
(** {2 Monadic Operations} *)
module type MONAD = sig
type 'a t
@ -511,8 +513,8 @@ module Traverse(M : MONAD) = struct
let rec aux acc l = match l () with
| `Nil -> return (of_list (List.rev acc))
| `Cons (x,l') ->
f x >>= fun x' ->
aux (x' :: acc) l'
f x >>= fun x' ->
aux (x' :: acc) l'
in
aux [] l
@ -521,7 +523,7 @@ module Traverse(M : MONAD) = struct
let rec fold_m f acc l = match l() with
| `Nil -> return acc
| `Cons (x,l') ->
f acc x >>= fun acc' -> fold_m f acc' l'
f acc x >>= fun acc' -> fold_m f acc' l'
end
(** {2 IO} *)
@ -539,10 +541,10 @@ let print ?(sep=",") pp_item fmt l =
let rec pp fmt l = match l() with
| `Nil -> ()
| `Cons (x,l') ->
Format.pp_print_string fmt sep;
Format.pp_print_cut fmt ();
pp_item fmt x;
pp fmt l'
Format.pp_print_string fmt sep;
Format.pp_print_cut fmt ();
pp_item fmt x;
pp fmt l'
in
match l() with
| `Nil -> ()

44
src/iter/CCKList.mli
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Continuation List} *)
@ -152,6 +130,12 @@ val flatten : 'a t t -> 'a t
val range : int -> int -> int t
val (--) : int -> int -> int t
(** [a -- b] is the range of integers containing
[a] and [b] (therefore, never empty) *)
val (--^) : int -> int -> int t
(** [a -- b] is the integer range from [a] to [b], where [b] is excluded.
@since 0.17 *)
(** {2 Operations on two Collections} *)
@ -226,6 +210,20 @@ val (<.>) : ('a -> 'b) t -> 'a t -> 'b t
(** Infix version of {!fair_app}
@since 0.13 *)
(** {2 Infix operators}
@since 0.17 *)
module Infix : sig
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
val (>>-) : 'a t -> ('a -> 'b t) -> 'b t
val (<.>) : ('a -> 'b) t -> 'a t -> 'b t
val (--) : int -> int -> int t
val (--^) : int -> int -> int t
end
(** {2 Monadic Operations} *)
module type MONAD = sig
type 'a t

109
src/iter/CCLazy_list.ml Normal file
View file

@ -0,0 +1,109 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Lazy List} *)
type +'a t = 'a node lazy_t
and +'a node =
| Nil
| Cons of 'a * 'a t
let empty = Lazy.from_val Nil
let return x = Lazy.from_val (Cons (x, empty))
let is_empty = function
| lazy Nil -> true
| lazy (Cons _) -> false
let cons x tl = Lazy.from_val (Cons (x,tl))
let head = function
| lazy Nil -> None
| lazy (Cons (x, tl)) -> Some (x,tl)
let length l =
let rec aux acc l = match l with
| lazy Nil -> acc
| lazy (Cons (_, tl)) -> aux (acc+1) tl
in
aux 0 l
(*$Q
Q.(list int) (fun l -> length (of_list l) = List.length l)
*)
let rec map ~f l =
lazy (
match l with
| lazy Nil -> Nil
| lazy (Cons (x,tl)) -> Cons (f x, map ~f tl)
)
let rec append a b =
lazy (
match a with
| lazy Nil -> Lazy.force b
| lazy (Cons (x,tl)) -> Cons (x, append tl b)
)
(*$Q
Q.(pair (list int) (list int)) (fun (l1,l2) ->\
length (append (of_list l1) (of_list l2)) = List.length l1 + List.length l2)
*)
let rec flat_map ~f l =
lazy (
match l with
| lazy Nil -> Nil
| lazy (Cons (x,tl)) ->
let res = append (f x) (flat_map ~f tl) in
Lazy.force res
)
module Infix = struct
let (>|=) x f = map ~f x
let (>>=) x f = flat_map ~f x
end
include Infix
type 'a gen = unit -> 'a option
let rec of_gen g =
lazy (
match g() with
| None -> Nil
| Some x -> Cons (x, of_gen g)
)
(*$Q
Q.(list int) (fun l -> l = (Gen.of_list l |> of_gen |> to_list))
*)
let rec of_list = function
| [] -> empty
| x :: tl -> cons x (of_list tl)
let to_list_rev l =
let rec aux acc = function
| lazy Nil -> acc
| lazy (Cons (x,tl)) -> aux (x::acc) tl
in
aux [] l
let to_list l = List.rev (to_list_rev l)
(*$Q
Q.(list int) (fun l -> l = to_list (of_list l))
*)
let to_gen l =
let l = ref l in
fun () -> match !l with
| lazy Nil -> None
| lazy (Cons (x,tl)) -> l := tl; Some x
(*$Q
Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list))
*)

57
src/iter/CCLazy_list.mli Normal file
View file

@ -0,0 +1,57 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Lazy List}
@since 0.17 *)
type +'a t = 'a node lazy_t
and +'a node =
| Nil
| Cons of 'a * 'a t
val empty : 'a t
(** Empty list *)
val return : 'a -> 'a t
(** Return a computed value *)
val is_empty : _ t -> bool
(** Evaluates the head *)
val length : _ t -> int
(** [length l] returns the number of elements in [l], eagerly (linear time).
Caution, will not terminate if [l] is infinite *)
val cons : 'a -> 'a t -> 'a t
val head : 'a t -> ('a * 'a t) option
(** Evaluate head, return it, or [None] if the list is empty *)
val map : f:('a -> 'b) -> 'a t -> 'b t
(** Lazy map *)
val append : 'a t -> 'a t -> 'a t
(** Lazy concatenation *)
val flat_map : f:('a -> 'b t) -> 'a t -> 'b t
(** Monadic flatten + map *)
module Infix : sig
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
end
include module type of Infix
type 'a gen = unit -> 'a option
val of_gen : 'a gen -> 'a t
val of_list : 'a list -> 'a t
val to_list : 'a t -> 'a list
val to_list_rev : 'a t -> 'a list
val to_gen : 'a t -> 'a gen

3
src/iter/containers_iter.mldylib
View file

@ -1,5 +1,6 @@
# OASIS_START
# DO NOT EDIT (digest: 2edfdbafae02fa6210e0c192d7250b1a)
# DO NOT EDIT (digest: 158a5d6029014525d6b1b1c6dc6c848a)
CCKTree
CCKList
CCLazy_list
# OASIS_STOP

3
src/iter/containers_iter.mllib
View file

@ -1,5 +1,6 @@
# OASIS_START
# DO NOT EDIT (digest: 2edfdbafae02fa6210e0c192d7250b1a)
# DO NOT EDIT (digest: 158a5d6029014525d6b1b1c6dc6c848a)
CCKTree
CCKList
CCLazy_list
# OASIS_STOP

4
src/string/CCApp_parse.mli
View file

@ -50,7 +50,9 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
]}
{b status: experimental}
@deprecated CCParse is more expressive and stable
{b status: deprecated}
@since 0.10
*)

24
src/string/CCKMP.ml
View file

@ -1,27 +1,5 @@
(*
copyright (c) 2013-2014, 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 Knuth-Morris-Pratt} *)

24
src/string/CCKMP.mli
View file

@ -1,27 +1,5 @@
(*
copyright (c) 2013-2014, 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 Knuth-Morris-Pratt} *)

25
src/string/CCParse.ml
View file

@ -121,6 +121,31 @@ exception ParseError of line_num * col_num * (unit -> string)
*)
(* test with a temporary file *)
(*$R
let test n =
let p = CCParse.(U.list ~sep:"," U.int) in
let l = CCList.(1 -- n) in
let l' =
CCIO.File.with_temp ~temp_dir:"/tmp/"
~prefix:"containers_test" ~suffix:""
(fun name ->
(* write test into file *)
CCIO.with_out name
(fun oc ->
let fmt = Format.formatter_of_out_channel oc in
Format.fprintf fmt "@[%a@]@."
(CCList.print ~sep:"," ~start:"[" ~stop:"]" CCInt.print) l);
(* parse it back *)
CCParse.parse_file_exn ~size:1024 ~file:name ~p)
in
assert_equal ~printer:Q.Print.(list int) l l'
in
test 100_000;
test 400_000;
*)
let const_ x () = x
let input_of_string s =

2
src/threads/CCPool.ml
View file

@ -264,7 +264,7 @@ module Make(P : PARAM) = struct
let l = List.rev_map (fun i ->
Fut.make
(fun () ->
Thread.delay 0.1;
Thread.delay 0.05;
1
)) l in
let l' = List.map Fut.get l in

8
src/threads/CCTimer.ml
View file

@ -184,12 +184,12 @@ let stop timer =
let timer = create () in
let n = CCLock.create 1 in
let res = CCLock.create 0 in
after timer 0.6
after timer 0.3
~f:(fun () -> CCLock.update n (fun x -> x+2));
ignore (Thread.create
(fun _ -> Thread.delay 0.8; CCLock.set res (CCLock.get n)) ());
after timer 0.4
(fun _ -> Thread.delay 0.4; CCLock.set res (CCLock.get n)) ());
after timer 0.2
~f:(fun () -> CCLock.update n (fun x -> x * 4));
Thread.delay 1. ;
Thread.delay 0.6 ;
OUnit.assert_equal 6 (CCLock.get res);
*)

24
src/unix/CCUnix.ml
View file

@ -1,27 +1,5 @@
(*
copyright (c) 2013-2015, 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 High-level Functions on top of Unix} *)

24
src/unix/CCUnix.mli
View file

@ -1,27 +1,5 @@
(*
copyright (c) 2013-2015, 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 High-level Functions on top of Unix}