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

Merge branch 'master' into stable for 2.1

Browse source
This commit is contained in:
Simon Cruanes 2018-03-28 20:27:11 -05:00
commit 6d02b2b540
79 changed files with 2196 additions and 285 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
.travis.yml
View file

@ -1,33 +1,15 @@
language: c
install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-docker.sh
script: bash -ex .travis-docker.sh
services:
- docker
env:
- OCAML_VERSION=4.02.3
- OCAML_VERSION=4.04.2
- OCAML_VERSION=4.05.0
- OCAML_VERSION=4.05.0+flambda
- OCAML_VERSION=4.06.0
addons:
apt:
sources:
- avsm
packages:
- opam
# Caching may take a lot of space with so many ocaml versions
#cache:
# directories:
# - $HOME/.opam
before_install:
# Some opam boilerplate
- export OPAMYES=1
- export OPAMVERBOSE=1
- opam init
- opam switch ${OCAML_VERSION}
- eval `opam config env`
install:
# Install dependencies
- opam pin add --no-action containers .
- opam install jbuilder base-bytes result
- opam install --deps-only containers
script:
- make build
- opam install sequence qcheck qtest gen
- make test
global:
- PINS="containers:."
- DISTRO="ubuntu-16.04"
matrix:
- PACKAGE="containers" OCAML_VERSION="4.02.3" DEPOPTS="base-threads base-unix"
- PACKAGE="containers" OCAML_VERSION="4.03.0" DEPOPTS="base-threads base-unix"
- PACKAGE="containers" OCAML_VERSION="4.04.2" DEPOPTS="base-threads base-unix"
- PACKAGE="containers" OCAML_VERSION="4.05.0" DEPOPTS="base-threads base-unix"
- PACKAGE="containers" OCAML_VERSION="4.06.0" DEPOPTS="base-threads base-unix"

2
AUTHORS.adoc
View file

@ -27,3 +27,5 @@
- Orbifx (Stavros Polymenis)
- Rand (@rand00)
- Dave Aitken (@actionshrimp)
- Etienne Millon (@emillon)
- Christopher Zimmermann (@madroach)

28
CHANGELOG.adoc
View file

@ -1,5 +1,33 @@
= Changelog
== 2.1
- make `CCInt64` compatible with `Int64` (breaking!) (closes #192)
- Add `CCBijection` in containers.data
- feat(mono): add dotted comparison operators for floats
- add `?margin` parameter to `CCFormat.ksprintf`
- add `CCUtf8_string` with basic encoding and decoding functionalities
- Add `CCLazy_list.<|>`
- Adding `CCNativeint`
- enrich `CCInt.Infix` to get a uniform interface with `CCInt{32,64}`
- add `CCInt{32,64}.Infix`
- Adding CCInt32 module
- add `CCHash.combine{5,6}`
- Add infix operators to CCFloat
- feat(list): add `{interleave,intersperse}` (closes #191)
- add missing signatures of `CCArrayLabels` (closes #193)
- Add CCFun.iterate
- add experimental `CCFun_vec` data structure for fast functional vectors
- fix: strong type aliases in Random (closes #210)
- use standard `List.sort_uniq`
- remove explicit dep on `bytes` in jbuild files
- update printers names in containers.top (closes #201)
- Enable support for Travis CI and Appveyor
- test deps are required when we run tests
- point to JST's blog post on poly compare
== 2.0
=== breaking

82
README.adoc
View file

@ -14,7 +14,8 @@ map/fold_right/append, and additional functions on lists).
Alternatively, `open Containers` will bring enhanced versions of the standard
modules into scope.
image::https://travis-ci.org/c-cube/ocaml-containers.svg?branch=master[alt="Build Status", link="https://travis-ci.org/c-cube/ocaml-containers"]
image::https://travis-ci.org/c-cube/ocaml-containers.svg?branch=master[alt="Build Status on Travis", link="https://travis-ci.org/c-cube/ocaml-containers"]
image::https://ci.appveyor.com/api/projects/status/tftx9q8auil4cv4c?svg=true[alt="Build Status on AppVeyor", link="https://ci.appveyor.com/project/c-cube/ocaml-containers"]
toc::[]
@ -45,6 +46,78 @@ Containers is:
Some of the modules have been moved to their own repository (e.g. `sequence`,
`gen`, `qcheck`) and are on opam for great fun and profit.
== Migration Guide
=== To 2.0
- The type system should detect issues related to `print` renamed into `pp` easily.
If you are lucky, a call to `sed -i 's/print/pp/g'` on the concerned files
might help rename all the calls
properly.
- many optional arguments have become mandatory, because their default value
would be a polymorphic "magic" operator such as `(=)` or `(>=)`.
Now these have to be specified explicitly, but during the transition
you can use `Pervasives.(=)` and `Pervasives.(>=)` as explicit arguments.
- if your code contains `open Containers`, the biggest hurdle you face
might be that operators have become monomorphic by default.
We believe this is a useful change that prevents many subtle bugs.
However, during migration and until you use proper combinators for
equality (`CCEqual`), comparison (`CCOrd`), and hashing (`CCHash`),
you might want to add `open Pervasives` just after the `open Containers`.
See <<mono-ops,the section on monomorphic operators>> for more details.
[[mono-ops]]
== Monomorphic operators: why, and how?
=== Why shadow polymorphic operators by default?
To quote @bluddy in https://github.com/c-cube/ocaml-containers/issues/196[#196]:
The main problem with polymorphic comparison is that many data structures will
give one result for structural comparison, and a different result for semantic
comparison. The classic example is comparing maps. If you have a list of maps
and try to use comparison to sort them, you'll get the wrong result: multiple
map structures can represent the same semantic mapping from key to value, and
comparing them in terms of structure is simply wrong. A far more pernicious bug
occurs with hashtables. Identical hashtables will seem to be identical for a
while, as before they've had a key clash, the outer array is likely to be the
same. Once you get a key clash though, you start getting lists inside the
arrays (or maps inside the arrays if you try to make a smarter hashtable) and
that will cause comparison errors ie. identical hashtables will be seen as
different or vice versa.
Every time you use a polymorphic comparison where you're using a data type
where structural comparison != semantic comparison, it's a bug. And ever time
you use polymorphic comparison where the type of data being compared may vary
(e.g. it's an int now, but it may be a map later), you're planting a bug for
the future.
See also:
- https://blog.janestreet.com/the-perils-of-polymorphic-compare/
- https://blog.janestreet.com/building-a-better-compare/
=== Sometimes polymorphic operators still make sense!
If you just want to use polymorphic operators, it's fine! You can access them
easily by using `Pervasives.(=)`, `Pervasives.max`, etc.
When migrating a module, you can add `open Pervasives` on top of it to restore
the default behavior. It is, however, recommended to export an `equal` function
(and `compare`, and `hash`) for all the public types, even if their internal
definition is just the corresponding polymorphic operator.
This way, other modules can refer to `Foo.equal` and will not have to be
updated the day `Foo.equal` is no longer just polymorphic equality.
Another bonus is that `Hashtbl.Make(Foo)` or `Map.Make(Foo)` will just work™.
=== Further discussions
See issues
https://github.com/c-cube/ocaml-containers/issues/196[#196],
https://github.com/c-cube/ocaml-containers/issues/197[#197]
== Change Log
See link:CHANGELOG.adoc[this file].
@ -102,7 +175,7 @@ per-version doc http://c-cube.github.io/ocaml-containers/[there].
[[build]]
== Build
You will need OCaml `>=` 4.01.0.
You will need OCaml `>=` 4.02.0.
=== Via opam
@ -112,8 +185,7 @@ The prefered way to install is through http://opam.ocaml.org/[opam].
=== From Sources
On the branch `master` you will need `oasis` to build the library. On the
branch `stable` it is not necessary.
You need dune (formerly jbuilder).
$ make
@ -474,8 +546,6 @@ printer:: `'a printer = Format.formatter -> 'a -> unit` is a pretty-printer
See link:doc/containers.adoc[the extended documentation] for more examples.
Powered by image:http://oasis.forge.ocamlcore.org/oasis-badge.png[alt="OASIS", style="border: none;", link="http://oasis.forge.ocamlcore.org/"]
== HOWTO (for contributors)
=== Make a release

26
appveyor.yml Normal file
View file

@ -0,0 +1,26 @@
platform:
- x86
environment:
global:
FORK_USER: ocaml
FORK_BRANCH: master
CYG_ROOT: C:\cygwin64
PINS: containers:.
matrix:
- OPAM_SWITCH: 4.02.3+mingw64c
PACKAGE: containers
- OPAM_SWITCH: 4.03.0+mingw64c
PACKAGE: containers
- OPAM_SWITCH: 4.04.2+mingw64c
PACKAGE: containers
- OPAM_SWITCH: 4.05.0+mingw64c
PACKAGE: containers
- OPAM_SWITCH: 4.06.0+mingw64c
PACKAGE: containers
- CYG_ROOT: C:\cygwin
OPAM_SWITCH: 4.06.0+mingw32c
PACKAGE: containers
install:
- ps: iex ((new-object net.webclient).DownloadString("https://raw.githubusercontent.com/$env:FORK_USER/ocaml-ci-scripts/$env:FORK_BRANCH/appveyor-install.ps1"))
build_script:
- call %CYG_ROOT%\bin\bash.exe -l %APPVEYOR_BUILD_FOLDER%\appveyor-opam.sh

3
benchs/jbuild
View file

@ -2,7 +2,8 @@
(executables
((names (run_benchs run_bench_hash))
(libraries (containers containers.data containers.iter
containers.thread benchmark gen sequence qcheck))
containers.thread benchmark gen sequence qcheck
batteries))
(flags (:standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always))
(ocamlopt_flags (:standard -O3 -color always
-unbox-closures -unbox-closures-factor 20))

12
benchs/run_benchs.ml
View file

@ -110,14 +110,22 @@ module L = struct
let bench_nth ?(time=2) n =
let l = CCList.(1 -- n) in
let ral = CCRAL.of_list l in
let v = CCFun_vec.of_list l in
let bv = BatVect.of_list l in
let bench_list l () =
for i = 0 to n-1 do ignore (List.nth l i) done
for i = 0 to n-1 do Sys.opaque_identity (ignore (List.nth l i)) done
and bench_ral l () =
for i = 0 to n-1 do ignore (CCRAL.get_exn l i) done
for i = 0 to n-1 do Sys.opaque_identity (ignore (CCRAL.get_exn l i)) done
and bench_funvec l () =
for i = 0 to n-1 do Sys.opaque_identity (ignore (CCFun_vec.get_exn i l)) done
and bench_batvec l () =
for i = 0 to n-1 do Sys.opaque_identity (ignore (BatVect.get l i)) done
in
B.throughputN time ~repeat
[ "List.nth", bench_list l, ()
; "RAL.get", bench_ral ral, ()
; "funvec.get", bench_funvec v, ()
; "batvec.get", bench_batvec bv, ()
]
(* MAIN *)

18
containers.opam
View file

@ -1,6 +1,6 @@
opam-version: "1.2"
name: "containers"
version: "2.0"
version: "2.1"
author: "Simon Cruanes"
maintainer: "simon.cruanes.2007@m4x.org"
build: [
@ -9,18 +9,20 @@ build: [
build-doc: [ "jbuilder" "build" "@doc" ]
build-test: [ "jbuilder" "runtest" "-p" name "-j" jobs]
depends: [
"jbuilder" {build}
"jbuilder" {build & >= "1.0+beta12"}
"result"
"uchar"
"qtest" { test }
"qcheck" { test }
"ounit" { test }
"sequence" { test }
"gen" { test }
"uutf" { test }
"odoc" { doc }
]
depopts: [
"base-unix"
"base-threads"
"qtest" { test }
"qcheck" { test }
"oUnit" { test }
"sequence" { test }
"gen" { test }
"odoc" { doc }
]
conflicts: [
"sequence" { < "0.5" }

2
qtest/jbuild
View file

@ -18,7 +18,7 @@
(modules (run_qtest))
(libraries (sequence gen qcheck containers containers.unix
containers.data containers.thread containers.iter
containers.sexp))
containers.sexp uutf))
))
(alias

2
src/core/CCArray.mli
View file

@ -13,7 +13,7 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Arrays} *)
include module type of Array
include module type of struct include Array end
type 'a t = 'a array

33
src/core/CCArrayLabels.mli
View file

@ -13,7 +13,7 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Arrays} *)
include module type of ArrayLabels
include module type of struct include ArrayLabels end
type 'a t = 'a array
@ -27,6 +27,10 @@ val equal : 'a equal -> 'a t equal
val compare : 'a ord -> 'a t ord
val swap : 'a t -> int -> int -> unit
(** [swap arr i j] swaps elements at indices [i] and [j].
@since 1.4 *)
val get : 'a t -> int -> 'a
(** [get a n] returns the element number [n] of array [a].
The first element has number 0.
@ -63,6 +67,18 @@ val fold_while : f:('a -> 'b -> 'a * [`Stop | `Continue]) -> init:'a -> 'b t ->
indicated by the accumulator.
@since 0.8 *)
val fold_map : f:('acc -> 'a -> 'acc * 'b) -> init:'acc -> 'a t -> 'acc * 'b t
(** [fold_map f acc a] is a [fold_left]-like function, but it also maps the
array to another array.
@since 2.1 *)
val scan_left : f:('acc -> 'a -> 'acc) -> init:'acc -> 'a t -> 'acc t
(** [scan_left f acc a] returns the array
[ [|acc; f acc x0; f (f acc a.(0)) a.(1); …|] ].
@since 2.1 *)
val iter : f:('a -> unit) -> 'a t -> unit
(** [iter f a] applies function [f] in turn to all
the elements of [a]. It is equivalent to
@ -111,13 +127,24 @@ val sort_ranking : f:('a -> 'a -> int) -> 'a t -> int array
[lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)].
@since 1.0 *)
val find_map : f:('a -> 'b option) -> 'a t -> 'b option
(** [find_map f a] returns [Some y] if there is an element [x] such
that [f x = Some y], else it returns [None].
@since 2.1 *)
val find : f:('a -> 'b option) -> 'a t -> 'b option
(** [find f a] returns [Some y] if there is an element [x] such
that [f x = Some y], else it returns [None]. *)
that [f x = Some y], else it returns [None].
@deprecated since 2.1 *)
val find_map_i : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
(** Like {!find_map}, but also pass the index to the predicate function.
@since 2.1 *)
val findi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
(** Like {!find}, but also pass the index to the predicate function.
@since 0.3.4 *)
@since 0.3.4
@deprecated since 2.1 *)
val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option
(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],

6
src/core/CCChar.mli
View file

@ -4,7 +4,7 @@
@since 0.14 *)
include module type of Char
include module type of struct include Char end
val equal : t -> t -> bool
(** The equal function for chars. *)
@ -41,7 +41,7 @@ val to_int : t -> int
@since 1.0 *)
val pp_buf : Buffer.t -> t -> unit
(** Used to be {!pp}, changed name @since 2.0 *)
(** Renamed from [pp] since 2.0. *)
val pp : Format.formatter -> t -> unit
(** Used to be {!print}, changed name @since 2.0 *)
(** Renamed from [print] since 2.0. *)

7
src/core/CCFloat.ml
View file

@ -16,6 +16,11 @@ module Infix = struct
let (>) = Pervasives.(>)
let (<=) = Pervasives.(<=)
let (>=) = Pervasives.(>=)
let (~-) = Pervasives.(~-.)
let (+) = Pervasives.(+.)
let (-) = Pervasives.(-.)
let ( * ) = Pervasives.( *. )
let (/) = Pervasives.(/.)
end
include Infix
@ -35,6 +40,8 @@ let is_nan x = (x : t) <> x
let add = (+.)
let sub = (-.)
let mul = ( *. )
let div = (/.)
let neg = (~-.)
let abs = Pervasives.abs_float
let scale = ( *. )

15
src/core/CCFloat.mli
View file

@ -130,6 +130,21 @@ module Infix : sig
val (>=) : t -> t -> bool
(** @since 0.17 *)
val (+) : t -> t -> t
(** Addition. @since 2.1 *)
val (-) : t -> t -> t
(** Subtraction. @since 2.1 *)
val (~-) : t -> t
(** Unary negation. @since 2.1 *)
val ( * ) : t -> t -> t
(** Multiplication. @since 2.1 *)
val (/) : t -> t -> t
(** Division. @since 2.1 *)
end
include module type of Infix

3
src/core/CCFormat.ml
View file

@ -383,10 +383,11 @@ let fprintf_dyn_color ~colors out fmt =
assert_equal "yolo" (sprintf_no_color "@{<red>yolo@}");
*)
let ksprintf ~f fmt =
let ksprintf ?margin ~f fmt =
let buf = Buffer.create 32 in
let out = Format.formatter_of_buffer buf in
if !color_enabled then set_color_tag_handling out;
begin match margin with None -> () | Some m -> pp_set_margin out m end;
Format.kfprintf
(fun _ -> Format.pp_print_flush out (); f (Buffer.contents buf))
out fmt

31
src/core/CCFormat.mli
View file

@ -17,7 +17,8 @@ type 'a printer = t -> 'a -> unit
(** {2 Combinators} *)
val silent : 'a printer (** Prints nothing *)
val silent : 'a printer
(** Prints nothing. *)
val unit : unit printer
(** Prints "()". *)
@ -65,8 +66,8 @@ val seq : ?sep:unit printer -> 'a printer -> 'a sequence printer
val opt : 'a printer -> 'a option printer
(** [opt pp] prints options as follows:
[Some x] will become "some foo" if [pp x ---> "foo"].
[None] will become "none". *)
- [Some x] will become "some foo" if [pp x ---> "foo"].
- [None] will become "none". *)
(** In the tuple printers, the [sep] argument is only available.
@since 0.17 *)
@ -124,18 +125,18 @@ val const : 'a printer -> 'a -> unit printer
val some : 'a printer -> 'a option printer
(** [some pp] will print options as follows:
- [Some x] is printed using [pp] on [x].
- [None] is not printed at all.
- [Some x] is printed using [pp] on [x]
- [None] is not printed at all
@since 1.0
*)
val lazy_force : 'a printer -> 'a lazy_t printer
(** [lazy_force pp out x] forces [x] and prints the result with [pp]
(** [lazy_force pp out x] forces [x] and prints the result with [pp].
@since 2.0 *)
val lazy_or : ?default:unit printer -> 'a printer -> 'a lazy_t printer
(** [lazy_or ?default pp out x] prints [default] if [x] is not
evaluated yet, or uses [pp] otherwise
evaluated yet, or uses [pp] otherwise.
@since 2.0 *)
(** {2 ANSI codes}
@ -191,28 +192,33 @@ val set_color_default : bool -> unit
val with_color : string -> 'a printer -> 'a printer
(** [with_color "Blue" pp] behaves like the printer [pp], but with the given
style.
{b status: unstable}
@since 0.16 *)
val with_colorf : string -> t -> ('a, t, unit, unit) format4 -> 'a
(** [with_colorf "Blue" out "%s %d" "yolo" 42] will behave like {!Format.fprintf},
but wrapping the content with the given style.
{b status: unstable}
@since 0.16 *)
val with_color_sf : string -> ('a, t, unit, string) format4 -> 'a
(** [with_color_sf "Blue" out "%s %d" "yolo" 42] will behave like
{!sprintf}, but wrapping the content with the given style.
Example:
{[
CCFormat.with_color_sf "red" "%a" CCFormat.Dump.(list int) [1;2;3] |> print_endline;;
]}
{b status: unstable}
@since 0.21 *)
val with_color_ksf : f:(string -> 'b) -> string -> ('a, t, unit, 'b) format4 -> 'a
(** [with_color_ksf "Blue" ~f "%s %d" "yolo" 42] will behave like
{!ksprintf}, but wrapping the content with the given style.
Example:
the following with raise [Failure] with a colored message
{[
@ -244,14 +250,15 @@ val tee : t -> t -> t
val sprintf : ('a, t, unit, string) format4 -> 'a
(** Print into a string any format string that would usually be compatible
with {!fprintf}. Similar to {!Format.asprintf}. *)
with {!fprintf}. Like {!Format.asprintf}. *)
val sprintf_no_color : ('a, t, unit, string) format4 -> 'a
(** Similar to {!sprintf} but never prints colors.
(** Like {!sprintf} but never prints colors.
@since 0.16 *)
val sprintf_dyn_color : colors:bool -> ('a, t, unit, string) format4 -> 'a
(** Similar to {!sprintf} but enable/disable colors depending on [colors].
(** Like {!sprintf} but enable/disable colors depending on [colors].
Example:
{[
(* with colors *)
@ -269,15 +276,17 @@ val fprintf : t -> ('a, t, unit ) format -> 'a
@since 0.14 *)
val fprintf_dyn_color : colors:bool -> t -> ('a, t, unit ) format -> 'a
(** Similar to {!fprintf} but enable/disable colors depending on [colors].
(** Like {!fprintf} but enable/disable colors depending on [colors].
@since 0.21 *)
val ksprintf :
?margin:int ->
f:(string -> 'b) ->
('a, Format.formatter, unit, 'b) format4 ->
'a
(** [ksprintf fmt ~f] formats using [fmt], in a way similar to {!sprintf},
and then calls [f] on the resulting string.
@param margin set margin (since 2.1)
@since 0.14 *)
val to_file : string -> ('a, t, unit, unit) format4 -> 'a

20
src/core/CCFun.ml
View file

@ -66,6 +66,26 @@ let finally2 ~h f x y =
ignore (h ());
raise e
let rec iterate n f x =
if n < 0 then
invalid_arg "CCFun.iterate"
else if n = 0 then
x
else
iterate (n - 1) f (f x)
(*$= iterate & ~printer:Q.Print.int
10 (iterate 0 succ 10)
11 (iterate 1 succ 10)
12 (iterate 2 succ 10)
15 (iterate 5 succ 10)
*)
(*$R
assert_raises
(Invalid_argument "CCFun.iterate")
(fun () -> iterate (-1) succ 10)
*)
module Monad(X : sig type t end) = struct
type 'a t = X.t -> 'a
let return x _ = x

5
src/core/CCFun.mli
View file

@ -76,6 +76,11 @@ val opaque_identity : 'a -> 'a
in OCaml >= 4.03).
@since 0.18 *)
val iterate : int -> ('a -> 'a) -> 'a -> 'a
(** [iterate n f] is [f] iterated [n] times. That is to say, [iterate 0 f x] is
[x], [iterate 1 f x] is [f x], [iterate 2 f x] is [f (f x)], etc.
@since 2.1 *)
(** {2 Monad}
Functions with a fixed domain are monads in their codomain. *)

6
src/core/CCHash.ml
View file

@ -21,6 +21,12 @@ let combine3 a b c =
let combine4 a b c d =
combine2 (combine2 a b) (combine2 c d)
let combine5 a b c d e =
combine2 (combine2 a b) (combine2 (combine2 c d) e)
let combine6 a b c d e f =
combine2 (combine2 a b) (combine2 (combine2 c d) (combine2 e f))
(** {2 Combinators} *)
let const h _ = h

6
src/core/CCHash.mli
View file

@ -64,6 +64,12 @@ val combine2 : hash -> hash -> hash
val combine3 : hash -> hash -> hash -> hash
val combine4 : hash -> hash -> hash -> hash -> hash
val combine5 : hash -> hash -> hash -> hash -> hash -> hash
(** @since 2.1 *)
val combine6 : hash -> hash -> hash -> hash -> hash -> hash -> hash
(** @since 2.1 *)
(** {2 Iterators} *)
type 'a sequence = ('a -> unit) -> unit

2
src/core/CCHashtbl.ml
View file

@ -205,7 +205,7 @@ module type S = sig
@since 0.16 *)
val of_seq_count : key sequence -> int t
(** Similar to {!add_seq_count}, but allocates a new table and returns it
(** Like {!add_seq_count}, but allocates a new table and returns it
@since 0.16 *)
val to_list : 'a t -> (key * 'a) list

10
src/core/CCHashtbl.mli
View file

@ -76,7 +76,7 @@ module Poly : sig
@since 0.16 *)
val of_seq_count : 'a sequence -> ('a, int) Hashtbl.t
(** Similar to {!add_seq_count}, but allocates a new table and returns it.
(** Like {!add_seq_count}, but allocates a new table and returns it.
@since 0.16 *)
val to_list : ('a,'b) Hashtbl.t -> ('a * 'b) list
@ -106,8 +106,7 @@ module Poly : sig
val pp : 'a printer -> 'b printer -> ('a, 'b) Hashtbl.t printer
(** Printer for table.
@since 0.13
Renamed from [print].
@since 2.0 *)
Renamed from [print] since 2.0. *)
end
include module type of Poly
@ -178,7 +177,7 @@ module type S = sig
@since 0.16 *)
val of_seq_count : key sequence -> int t
(** Similar to {!add_seq_count}, but allocates a new table and returns it.
(** Like {!add_seq_count}, but allocates a new table and returns it.
@since 0.16 *)
val to_list : 'a t -> (key * 'a) list
@ -208,8 +207,7 @@ module type S = sig
val pp : key printer -> 'a printer -> 'a t printer
(** Printer for tables.
@since 0.13
Renamed from {!print}.
@since 2.0 *)
Renamed from [print] since 2.0. *)
end
module Make(X : Hashtbl.HashedType) :

2
src/core/CCHeap.ml
View file

@ -161,7 +161,7 @@ module type S = sig
(** [of_list l] is [add_list empty l]. *)
val add_seq : t -> elt sequence -> t
(** Similar to {!add_list}.
(** Like {!add_list}.
@since 0.16 *)
val of_seq : elt sequence -> t

6
src/core/CCHeap.mli
View file

@ -81,7 +81,7 @@ module type S = sig
(** {2 Conversions}
The interface of [of_gen], [of_seq], [of_klist]
has changed @since 0.16 (the old signatures
has changed since 0.16 (the old signatures
are now [add_seq], [add_gen], [add_klist]). *)
val to_list : t -> elt list
@ -100,7 +100,7 @@ module type S = sig
(** [of_list l] is [add_list empty l]. Complexity: [O(n log n)]. *)
val add_seq : t -> elt sequence -> t (** @since 0.16 *)
(** Similar to {!add_list}. *)
(** Like {!add_list}. *)
val of_seq : elt sequence -> t
(** Build a heap from a given [sequence]. Complexity: [O(n log n)]. *)
@ -133,7 +133,7 @@ module type S = sig
val pp : ?sep:string -> elt printer -> t printer
(** @since 0.16
Renamed from {!print} @since 2.0 *)
Renamed from {!print} since 2.0 *)
end
module Make(E : PARTIAL_ORD) : S with type elt = E.t

4
src/core/CCIO.mli
View file

@ -83,7 +83,7 @@ val with_out : ?mode:int -> ?flags:open_flag list ->
val with_out_a : ?mode:int -> ?flags:open_flag list ->
string -> (out_channel -> 'a) -> 'a
(** Similar to {!with_out} but with the [[Open_append; Open_creat; Open_wronly]]
(** Like {!with_out} but with the [[Open_append; Open_creat; Open_wronly]]
flags activated, to append to the file.
@raise Sys_error in case of error (same as {!open_out} and {!close_out}). *)
@ -196,7 +196,7 @@ module File : sig
type walk_item = [`File | `Dir] * t
val walk : t -> walk_item gen
(** Similar to {!read_dir} (with [recurse=true]), this function walks
(** Like {!read_dir} (with [recurse=true]), this function walks
a directory recursively and yields either files or directories.
Is a file anything that doesn't satisfy {!is_directory} (including
symlinks, etc.)

90
src/core/CCInt.ml
View file

@ -3,12 +3,52 @@
type t = int
let equal (a:int) b = a=b
let equal (a:int) b = Pervasives.(=) a b
let compare a b = compare a b
let hash i = i land max_int
let range i j yield =
let rec up i j yield =
if i=j then yield i
else (
yield i;
up (i+1) j yield
)
and down i j yield =
if i=j then yield i
else (
yield i;
down (i-1) j yield
)
in
if i<=j then up i j yield else down i j yield
(*$= & ~printer:Q.Print.(list int)
[0;1;2;3;4;5] (range 0 5 |> Sequence.to_list)
[0] (range 0 0 |> Sequence.to_list)
[5;4;3;2] (range 5 2 |> Sequence.to_list)
*)
let range' i j yield =
if i<j then range i (j-1) yield
else if i=j then ()
else range i (j+1) yield
(*$= & ~printer:Q.Print.(list int)
[] (range' 0 0 |> Sequence.to_list)
[0;1;2;3;4] (range' 0 5 |> Sequence.to_list)
[5;4;3] (range' 5 2 |> Sequence.to_list)
*)
module Infix = struct
include Pervasives
let (--) = range
let (--^) = range'
end
include Infix
let sign i =
if i < 0 then -1
else if i>0 then 1
@ -211,51 +251,3 @@ let range_by ~step i j yield =
(CCInt.range_by ~step:1 i j |> Sequence.to_list) \
(CCInt.range i j |> Sequence.to_list) )
*)
let range i j yield =
let rec up i j yield =
if i=j then yield i
else (
yield i;
up (i+1) j yield
)
and down i j yield =
if i=j then yield i
else (
yield i;
down (i-1) j yield
)
in
if i<=j then up i j yield else down i j yield
(*$= & ~printer:Q.Print.(list int)
[0;1;2;3;4;5] (range 0 5 |> Sequence.to_list)
[0] (range 0 0 |> Sequence.to_list)
[5;4;3;2] (range 5 2 |> Sequence.to_list)
*)
let range' i j yield =
if i<j then range i (j-1) yield
else if i=j then ()
else range i (j+1) yield
(*$= & ~printer:Q.Print.(list int)
[] (range' 0 0 |> Sequence.to_list)
[0;1;2;3;4] (range' 0 5 |> Sequence.to_list)
[5;4;3] (range' 5 2 |> Sequence.to_list)
*)
module Infix = struct
let (=) = (=)
let (<>) = (<>)
let (<) = (<)
let (>) = (>)
let (<=) = (<=)
let (>=) = (>=)
let (--) = range
let (--^) = range'
end
include Infix
let min = min
let max = max

14
src/core/CCInt.mli
View file

@ -115,6 +115,20 @@ module Infix : sig
val (--^) : t -> t -> t sequence
(** Alias to {!range'}.
@since 1.2 *)
val (+) : t -> t -> t (** @since 2.1 *)
val (-) : t -> t -> t (** @since 2.1 *)
val (~-) : t -> t (** @since 2.1 *)
val ( * ) : t -> t -> t (** @since 2.1 *)
val (/) : t -> t -> t (** @since 2.1 *)
val (mod) : t -> t -> t (** @since 2.1 *)
val (land) : t -> t -> t (** @since 2.1 *)
val (lor) : t -> t -> t (** @since 2.1 *)
val (lxor) : t -> t -> t (** @since 2.1 *)
val lnot : t -> t (** @since 2.1 *)
val (lsl) : t -> int -> t (** @since 2.1 *)
val (lsr) : t -> int -> t (** @since 2.1 *)
val (asr) : t -> int -> t (** @since 2.1 *)
end
include module type of Infix

51
src/core/CCInt32.ml Normal file
View file

@ -0,0 +1,51 @@
(* This file is free software, part of containers. See file "license" for more details. *)
include Int32
let equal (x:t) y = Pervasives.(=) x y
module Infix = struct
let (+) = add
let (-) = sub
let (~-) = neg
let ( * ) = mul
let (/) = div
let (mod) = rem
let (land) = logand
let (lor) = logor
let (lxor) = logxor
let lnot = lognot
let (lsl) = shift_left
let (lsr) = shift_right_logical
let (asr) = shift_right
let (=) = equal
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (<=) = Pervasives.(<=)
let (>) = Pervasives.(>)
let (>=) = Pervasives.(>=)
end
include Infix
let hash x = Pervasives.abs (to_int x)
(** {2 Conversion} *)
let of_string_exn = of_string
let of_string x = try Some (of_string_exn x) with Failure _ -> None
let of_string_opt = of_string

147
src/core/CCInt32.mli Normal file
View file

@ -0,0 +1,147 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Int32}
Helpers for 32-bit integers.
This module provides operations on the type int32 of signed 32-bit integers.
Unlike the built-in int type, the type int32 is guaranteed to be exactly
32-bit wide on all platforms. All arithmetic operations over int32 are taken
modulo 2{^32}.
Performance notice: values of type int32 occupy more memory space than values
of type int, and arithmetic operations on int32 are generally slower than
those on int. Use int32 only when the application requires exact 32-bit arithmetic.
@since 2.1 *)
include module type of struct include Int32 end
val ( + ) : t -> t -> t
(** Addition. *)
val ( - ) : t -> t -> t
(** Subtraction. *)
val ( ~- ) : t -> t
(** Unary negation. *)
val ( * ) : t -> t -> t
(** Multiplication. *)
val ( / ) : t -> t -> t
(** Integer division. Raise [Division_by_zero] if the second
argument is zero. This division rounds the real quotient of
its arguments towards zero, as specified for {!Pervasives.(/)}. *)
val ( mod ) : t -> t -> t
(** [x mod y ] is the integer remainder.
If [y <> zero], the result of [x mod y] satisfies the following property:
[x = ((x / y) * y) + (x mod y)].
If [y = 0], [x mod y] raises [Division_by_zero]. *)
val ( land ) : t -> t -> t
(** Bitwise logical and. *)
val ( lor ) : t -> t -> t
(** Bitwise logical or. *)
val ( lxor ) : t -> t -> t
(** Bitwise logical exclusive or. *)
val lnot : t -> t
(** Bitwise logical negation. *)
val ( lsl ) : t -> int -> t
(** [ x lsl y] shifts [x] to the left by [y] bits, filling in with zeroes.
The result is unspecified if [y < 0] or [y >= 32]. *)
val ( lsr ) : t -> int -> t
(** [x lsr y] shifts [x] to the right by [y] bits.
This is a logical shift: zeroes are inserted in the vacated bits
regardless of the sign of [x].
The result is unspecified if [y < 0] or [y >= 32]. *)
val ( asr ) : t -> int -> t
(** [x asr y] shifts [x] to the right by [y] bits.
This is an arithmetic shift: the sign bit of [x] is replicated
and inserted in the vacated bits.
The result is unspecified if [y < 0] or [y >= 32]. *)
module Infix : sig
val (+) : t -> t -> t
val (-) : t -> t -> t
val (~-) : t -> t
val ( * ) : t -> t -> t
val (/) : t -> t -> t
val (mod) : t -> t -> t
val (land) : t -> t -> t
val (lor) : t -> t -> t
val (lxor) : t -> t -> t
val lnot : t -> t
val (lsl) : t -> int -> t
val (lsr) : t -> int -> t
val (asr) : t -> int -> t
val (=) : t -> t -> bool
val (<>) : t -> t -> bool
val (>) : t -> t -> bool
val (>=) : t -> t -> bool
val (<=) : t -> t -> bool
val (<) : t -> t -> bool
end
val equal : t -> t -> bool
(** The equal function for 32-bit integers.
Like {!Pervasives.(=) x y)}. *)
val hash : t -> int
(** Like {!Pervasives.abs (to_int x)}. *)
(** {2 Conversion} *)
val to_int : t -> int
(** Convert the given 32-bit integer (type [int32]) to an
integer (type [int]). On 32-bit platforms, the 32-bit integer
is taken modulo 2{^31}, i.e. the high-order bit is lost
during the conversion. On 64-bit platforms, the conversion is exact. *)
val of_int : int -> t
(** Alias to {!Int32.of_int}. *)
val to_float : t -> float
(** Convert the given 32-bit integer to a floating-point number. *)
val of_float : float -> t
(** Alias to {!Int32.of_float}.
Convert the given floating-point number to a 32-bit integer,
discarding the fractional part (truncate towards 0).
The result of the conversion is undefined if, after truncation, the number
is outside the range \[{!CCInt32.min_int}, {!CCInt32.max_int}\]. *)
val to_string : t -> string
(** Return the string representation of its argument, in signed decimal. *)
val of_string_exn : string -> t
(** Alias to {!Int32.of_string}.
Convert the given string to a 32-bit integer.
The string is read in decimal (by default, or if the string
begins with [0u]) or in hexadecimal, octal or binary if the
string begins with [0x], [0o] or [0b] respectively.
The [0u] prefix reads the input as an unsigned integer in the range
[[0, 2*CCInt32.max_int+1]]. If the input exceeds {!CCInt32.max_int}
it is converted to the signed integer
[CCInt32.min_int + input - CCInt32.max_int - 1].
The [_] (underscore) character can appear anywhere in the string
and is ignored.
Raise [Failure "Int32.of_string"] if the given string is not
a valid representation of an integer, or if the integer represented
exceeds the range of integers representable in type [int32]. *)
val of_string : string -> t option
(** Safe version of {!of_string_exn}.
Like {!of_string_exn}, but return [None] instead of raising. *)
val of_string_opt : string -> t option
(** Alias to {!of_string}. *)

76
src/core/CCInt64.ml
View file

@ -2,54 +2,56 @@
include Int64
let (+) = add
let (-) = sub
let (~-) = neg
let ( * ) = mul
let (/) = div
let (mod) = rem
let (land) = logand
let (lor) = logor
let (lxor) = logxor
let lnot = lognot
let (lsl) = shift_left
let (lsr) = shift_right_logical
let (asr) = shift_right
let equal (x:t) y = Pervasives.(=) x y
module Infix = struct
let (+) = add
let (-) = sub
let (~-) = neg
let ( * ) = mul
let (/) = div
let (mod) = rem
let (land) = logand
let (lor) = logor
let (lxor) = logxor
let lnot = lognot
let (lsl) = shift_left
let (lsr) = shift_right_logical
let (asr) = shift_right
let (=) = equal
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (<=) = Pervasives.(<=)
let (>) = Pervasives.(>)
let (>=) = Pervasives.(>=)
end
include Infix
let hash x = Pervasives.abs (to_int x)
(** {2 Conversion} *)
let of_int_exn = of_int
let of_int x = try Some (of_int_exn x) with Failure _ -> None
let of_nativeint_exn = of_nativeint
let of_nativeint x = try Some (of_nativeint_exn x) with Failure _ -> None
let of_int32_exn = of_int32
let of_int32 x = try Some (of_int32_exn x) with Failure _ -> None
let of_float_exn = of_float
let of_float x = try Some (of_float_exn x) with Failure _ -> None
let of_string_exn = of_string
let of_string x = try Some (of_string_exn x) with Failure _ -> None
let of_string_opt = of_string

74
src/core/CCInt64.mli
View file

@ -2,11 +2,11 @@
(** {1 Int64}
Helpers for 64-bit integers.
Helpers for 64-bit integers
@since 0.13 *)
type t = int64
include module type of struct include Int64 end
val (+) : t -> t -> t
(** Addition. *)
@ -66,6 +66,30 @@ val (asr) : t -> int -> t
and inserted in the vacated bits.
The result is unspecified if [y < 0] or [y >= 64]. *)
(** Infix operators
@since 2.1 *)
module Infix : sig
val (+) : t -> t -> t
val (-) : t -> t -> t
val (~-) : t -> t
val ( * ) : t -> t -> t
val (/) : t -> t -> t
val (mod) : t -> t -> t
val (land) : t -> t -> t
val (lor) : t -> t -> t
val (lxor) : t -> t -> t
val lnot : t -> t
val (lsl) : t -> int -> t
val (lsr) : t -> int -> t
val (asr) : t -> int -> t
val (=) : t -> t -> bool
val (<>) : t -> t -> bool
val (>) : t -> t -> bool
val (>=) : t -> t -> bool
val (<=) : t -> t -> bool
val (<) : t -> t -> bool
end
val equal : t -> t -> bool
(** The equal function for 64-bit integers.
Like {!Pervasives.(=) x y)}. *)
@ -89,14 +113,13 @@ val to_int : t -> int
is taken modulo 2{^31}, i.e. the top 33 bits are lost
during the conversion. *)
val of_int : int -> t option
(** Safe version of {!of_int_exn}. *)
val of_int : int -> t
(** Alias to {!Int64.of_int}.
NOTE: used to return an option, but the function actually never fails. *)
val of_int_exn : int -> t
(** Alias to {!Int64.of_int}.
Convert the given integer (type [int]) to a 64-bit integer
(type [int64]).
@raise Failure in case of failure. *)
@deprecated since 2.1 *)
val to_int32 : t -> int32
(** Convert the given 64-bit integer (type [int64]) to a
@ -104,14 +127,13 @@ val to_int32 : t -> int32
is taken modulo 2{^32}, i.e. the top 32 bits are lost
during the conversion. *)
val of_int32 : int32 -> t option
(** Safe version of {!of_int32_exn}. *)
val of_int32 : int32 -> t
(** Alias to {!Int64.of_int32}.
NOTE: use to return an option, but the function actually never fails. *)
val of_int32_exn : int32 -> t
(** Alias to {!Int64.of_int32}
Convert the given 32-bit integer (type [int32])
to a 64-bit integer (type [int64]).
@raise Failure in case of failure. *)
(** Alias to {!Int64.of_int32}.
@deprecated since 2.1 *)
val to_nativeint : t -> nativeint
(** Convert the given 64-bit integer (type [int64]) to a
@ -119,28 +141,28 @@ val to_nativeint : t -> nativeint
is taken modulo 2{^32}. On 64-bit platforms,
the conversion is exact. *)
val of_nativeint : nativeint -> t option
(** Safe version of {!of_nativeint_exn}. *)
val of_nativeint : nativeint -> t
(** Alias to {!Int64.of_nativeint}.
NOTE: use to return an option, but the function actually never fails. *)
val of_nativeint_exn : nativeint -> t
(** Alias to {!Int64.of_nativeint}.
Convert the given native integer (type [nativeint])
to a 64-bit integer (type [int64]).
@raise Failure in case of failure. *)
@deprecated since 2.1 *)
val to_float : t -> float
(** Convert the given 64-bit integer to a floating-point number. *)
val of_float : float -> t option
(** Safe version of {!of_float_exn}. *)
val of_float_exn : float -> t
val of_float : float -> t
(** Alias to {!Int64.of_float}.
Convert the given floating-point number to a 64-bit integer,
discarding the fractional part (truncate towards 0).
The result of the conversion is undefined if, after truncation,
the number is outside the range \[{!CCInt64.min_int}, {!CCInt64.max_int}\].
@raise Failure in case of failure. *)
NOTE: used to return an option, but the function never fails. *)
val of_float_exn : float -> t
(** Alias to {!Int64.of_float}.
@deprecated since 2.1 *)
val to_string : t -> string
(** Return the string representation of its argument, in decimal. *)
@ -148,10 +170,14 @@ val to_string : t -> string
val of_string : string -> t option
(** Safe version of {!of_string_exn}. *)
val of_string_opt : string -> t option
(** Alias to {!of_string}.
@since 2.1 *)
val of_string_exn : string -> t
(** Alias to {!Int64.of_string}.
Convert the given string to a 64-bit integer.
The string is read in decimal (by default, or if the string
The string is read in decimal (by default, or if the string
begins with [0u]) or in hexadecimal, octal or binary if the
string begins with [0x], [0o] or [0b] respectively.

56
src/core/CCList.ml
View file

@ -580,13 +580,7 @@ let sorted_merge ~cmp l1 l2 =
List.length (sorted_merge ~cmp:CCInt.compare l1 l2) = List.length l1 + List.length l2)
*)
let sort_uniq (type elt) ~cmp l =
let module S = Set.Make(struct
type t = elt
let compare = cmp
end) in
let set = fold_right S.add l S.empty in
S.elements set
let sort_uniq ~cmp l = List.sort_uniq cmp l
(*$T
sort_uniq ~cmp:CCInt.compare [1;2;5;3;6;1;4;2;3] = [1;2;3;4;5;6]
@ -792,6 +786,54 @@ let sublists_of_len ?(last=fun _ -> None) ?offset n l =
[[1;2]; [3;4]] (subs 2 [1;2;3;4;5])
*)
let intersperse x l =
let rec aux_direct i x l = match l with
| [] -> []
| [_] -> l
| _ when i=0 -> aux_tailrec [] x l
| y :: tail -> y :: x :: aux_direct (i-1) x tail
and aux_tailrec acc x l = match l with
| [] -> List.rev acc
| [y] -> List.rev (y::acc)
| y :: tail -> aux_tailrec (x :: y :: acc) x tail
in
aux_direct 1_000 x l
(*$=
[] (intersperse 0 [])
[1] (intersperse 0 [1])
[1;0;2;0;3;0;4] (intersperse 0 [1;2;3;4])
*)
(*$Q
Q.(pair int (list int)) (fun (x,l) -> \
length (intersperse x l) = (if length l <= 1 then length l else 2 * length l-1))
Q.(pair int (list int)) (fun (x,l) -> \
rev (intersperse x l) = intersperse x (rev l))
*)
let interleave l1 l2 : _ list =
let rec aux acc l1 l2 = match l1, l2 with
| [], [] -> List.rev acc
| [], _ -> List.rev (List.rev_append l2 acc)
| _, [] -> List.rev (List.rev_append l1 acc)
| x1 :: tl1, x2 :: tl2 ->
aux (x2 :: x1 :: acc) tl1 tl2
in
aux [] l1 l2
(*$=
[1;2;3;4;5] (interleave [1;3] [2;4;5])
[1;2;3] (interleave [1] [2;3])
*)
(*$Q
Q.(pair (small_list int)(small_list int)) (fun (l1,l2) -> \
length (interleave l1 l2) = length l1 + length l2)
Q.(small_list int) (fun l -> l = interleave [] l)
Q.(small_list int) (fun l -> l = interleave l [])
*)
let take_while p l =
let rec direct i p l = match l with
| [] -> []

13
src/core/CCList.mli
View file

@ -45,7 +45,7 @@ val (@) : 'a t -> 'a t -> 'a t
Concatenate two lists. *)
val filter : ('a -> bool) -> 'a t -> 'a t
(** Safe version of {!List.filter}.
(** Safe version of {!List.filter}.
[filter p l] returns all the elements of the list [l]
that satisfy the predicate [p]. The order of the elements
in the input list is preserved. *)
@ -95,7 +95,7 @@ val init : int -> (int -> 'a) -> 'a t
@since 0.6 *)
val combine : 'a list -> 'b list -> ('a * 'b) list
(** Similar to {!List.combine} but tail-recursive.
(** Like {!List.combine} but tail-recursive.
Transform a pair of lists into a list of pairs:
[combine [a1; ...; an] [b1; ...; bn]] is
[[(a1,b1); ...; (an,bn)]].
@ -202,6 +202,15 @@ val sublists_of_len :
@raise Invalid_argument if [offset <= 0] or [n <= 0].
@since 1.0 *)
val intersperse : 'a -> 'a list -> 'a list
(** Insert the first argument between every element of the list
@since 2.1 *)
val interleave : 'a list -> 'a list -> 'a list
(** [interleave [x1…xn] [y1…ym]] is [x1,y1,x2,y2,…] and finishes with
the suffix of the longest list
@since 2.1 *)
val pure : 'a -> 'a t
(** [pure] is [return]. *)

51
src/core/CCNativeint.ml Normal file
View file

@ -0,0 +1,51 @@
(* This file is free software, part of containers. See file "license" for more details. *)
include Nativeint
let equal (x:t) y = Pervasives.(=) x y
module Infix = struct
let (+) = add
let (-) = sub
let (~-) = neg
let ( * ) = mul
let (/) = div
let (mod) = rem
let (land) = logand
let (lor) = logor
let (lxor) = logxor
let lnot = lognot
let (lsl) = shift_left
let (lsr) = shift_right_logical
let (asr) = shift_right
let (=) = equal
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (<=) = Pervasives.(<=)
let (>) = Pervasives.(>)
let (>=) = Pervasives.(>=)
end
include Infix
let hash x = Pervasives.abs (to_int x)
(** {2 Conversion} *)
let of_string_exn = of_string
let of_string x = try Some (of_string_exn x) with Failure _ -> None
let of_string_opt = of_string

148
src/core/CCNativeint.mli Normal file
View file

@ -0,0 +1,148 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Nativeint}
Helpers for processor-native integers
This module provides operations on the type [nativeint] of signed 32-bit integers
(on 32-bit platforms) or signed 64-bit integers (on 64-bit platforms).
This integer type has exactly the same width as that of a pointer type in the C compiler.
All arithmetic operations over nativeint are taken modulo 2{^32} or 2{^64} depending
on the word size of the architecture.
Performance notice: values of type [nativeint] occupy more memory space than values of type [int],
and arithmetic operations on [nativeint] are generally slower than those on [int].
Use [nativeint] only when the application requires the extra bit of precision over the [int] type.
@since 2.1 *)
include module type of struct include Nativeint end
val ( + ) : t -> t -> t
(** Addition. *)
val ( - ) : t -> t -> t
(** Subtraction. *)
val ( ~- ) : t -> t
(** Unary negation. *)
val ( * ) : t -> t -> t
(** Multiplication. *)
val ( / ) : t -> t -> t
(** Integer division. Raise [Division_by_zero] if the second
argument is zero. This division rounds the real quotient of
its arguments towards zero, as specified for {!Pervasives.(/)}. *)
val ( mod ) : t -> t -> t
(** [x mod y ] is the integer remainder.
If [y <> zero], the result of [x mod y] satisfies the following properties:
[zero <= x mod y < abs y] and
[x = ((x / y) * y) + (x mod y)].
If [y = 0], [x mod y] raises [Division_by_zero]. *)
val ( land ) : t -> t -> t
(** Bitwise logical and. *)
val ( lor ) : t -> t -> t
(** Bitwise logical or. *)
val ( lxor ) : t -> t -> t
(** Bitwise logical exclusive or. *)
val lnot : t -> t
(** Bitwise logical negation. *)
val ( lsl ) : t -> int -> t
(** [ x lsl y] shifts [x] to the left by [y] bits.
The result is unspecified if [y < 0] or [y >= bitsize], where [bitsize] is [32] on a 32-bit platform
and [64] on a 64-bit platform. *)
val ( lsr ) : t -> int -> t
(** [x lsr y] shifts [x] to the right by [y] bits.
This is a logical shift: zeroes are inserted in the vacated bits
regardless of the sign of [x].
The result is unspecified if [y < 0] or [y >= bitsize]. *)
val ( asr ) : t -> int -> t
(** [x asr y] shifts [x] to the right by [y] bits.
This is an arithmetic shift: the sign bit of [x] is replicated
and inserted in the vacated bits.
The result is unspecified if [y < 0] or [y >= bitsize]. *)
module Infix : sig
val (+) : t -> t -> t
val (-) : t -> t -> t
val (~-) : t -> t
val ( * ) : t -> t -> t
val (/) : t -> t -> t
val (mod) : t -> t -> t
val (land) : t -> t -> t
val (lor) : t -> t -> t
val (lxor) : t -> t -> t
val lnot : t -> t
val (lsl) : t -> int -> t
val (lsr) : t -> int -> t
val (asr) : t -> int -> t
val (=) : t -> t -> bool
val (<>) : t -> t -> bool
val (>) : t -> t -> bool
val (>=) : t -> t -> bool
val (<=) : t -> t -> bool
val (<) : t -> t -> bool
end
val equal : t -> t -> bool
(** The equal function for native integers.
Like {!Pervasives.(=) x y)}. *)
val hash : t -> int
(** Like {!Pervasives.abs (to_int x)}. *)
(** {2 Conversion} *)
val to_int : t -> int
(** Convert the given native integer (type [nativeint]) to an
integer (type [int]). The high-order bit is lost
during the conversion. *)
val of_int : int -> t
(** Alias to {!Nativeint.of_int}.
Convert the given integer (type [int]) to a native integer (type [nativeint]). *)
val to_float : t -> float
(** Convert the given native integer to a floating-point number. *)
val of_float : float -> t
(** Alias to {!Nativeint.of_float}.
Convert the given floating-point number to a native integer,
discarding the fractional part (truncate towards 0).
The result of the conversion is undefined if, after truncation, the number
is outside the range \[{!CCNativeint.min_int}, {!CCNativeint.max_int}\]. *)
val to_string : t -> string
(** Return the string representation of its argument, in decimal. *)
val of_string_exn : string -> t
(** Alias to {!Nativeint.of_string}.
Convert the given string to a native integer.
The string is read in decimal (by default, or if the string
begins with [0u]) or in hexadecimal, octal or binary if the
string begins with [0x], [0o] or [0b] respectively.
The [0u] prefix reads the input as an unsigned integer in the range
[[0, 2*CCNativeint.max_int+1]]. If the input exceeds {!CCNativeint.max_int}
it is converted to the signed integer
[CCInt64.min_int + input - CCNativeint.max_int - 1].
Raise [Failure "Nativeint.of_string"] if the given string is not
a valid representation of an integer, or if the integer represented
exceeds the range of integers representable in type [nativeint]. *)
val of_string : string -> t option
(** Safe version of {!of_string_exn}.
Like {!of_string_exn}, but return [None] instead of raising. *)
val of_string_opt : string -> t option
(** Alias to {!of_string}. *)

5
src/core/CCRandom.ml
View file

@ -228,3 +228,8 @@ let uniformity_test ?(size_hint=10) k rng st =
(*$T split_list
run ~st:(QCheck_runner.random_state()) ( uniformity_test 50_000 (split_list 10 ~len:3) )
*)
(*$R
let open Containers in
ignore @@ List.random_choose [1;2;3] (Random.get_state())
*)

2
src/core/CCRandom.mli
View file

@ -3,7 +3,7 @@
(** {1 Random Generators} *)
include module type of Random
include module type of struct include Random end
type state = Random.State.t

2
src/core/CCResult.mli
View file

@ -14,7 +14,7 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Basics} *)
include module type of Result
include module type of struct include Result end
(** @since 1.5 *)
type (+'good, +'bad) t = ('good, 'bad) Result.result =

8
src/core/CCString.ml
View file

@ -44,7 +44,7 @@ module type S = sig
val length : t -> int
val blit : t -> int -> Bytes.t -> int -> int -> unit
(** Similar to {!String.blit}.
(** Like {!String.blit}.
Compatible with the [-safe-string] option.
@raise Invalid_argument if indices are not valid *)
@ -84,7 +84,7 @@ let rev s =
(*$Q
Q.printable_string (fun s -> \
rev s = (to_list s |> List.rev |> of_list))
*)
*)
(*$=
@ -696,7 +696,7 @@ let prefix ~pre s =
else (
let rec check i =
if i=len then true
else if String.unsafe_get s i != String.unsafe_get pre i then false
else if Pervasives.(<>) (String.unsafe_get s i) (String.unsafe_get pre i) then false
else check (i+1)
in
check 0
@ -719,7 +719,7 @@ let suffix ~suf s =
let off = String.length s - len in
let rec check i =
if i=len then true
else if String.unsafe_get s (off+i) != String.unsafe_get suf i then false
else if Pervasives.(<>) (String.unsafe_get s (off+i)) (String.unsafe_get suf i) then false
else check (i+1)
in
check 0

29
src/core/CCString.mli
View file

@ -19,7 +19,7 @@ module type S = sig
(** Return the length (number of characters) of the given string. *)
val blit : t -> int -> Bytes.t -> int -> int -> unit
(** Similar to {!String.blit}.
(** Like {!String.blit}.
Compatible with the [-safe-string] option.
@raise Invalid_argument if indices are not valid. *)
@ -38,30 +38,29 @@ module type S = sig
(** {2 Conversions} *)
val to_gen : t -> char gen
(** Return the [gen] of characters contained in the string *)
(** Return the [gen] of characters contained in the string. *)
val to_seq : t -> char sequence
(** Return the [sequence] of characters contained in the string *)
(** Return the [sequence] of characters contained in the string. *)
val to_klist : t -> char klist
(** Return the [klist] of characters contained in the string *)
(** Return the [klist] of characters contained in the string. *)
val to_list : t -> char list
(** Return the list of characters contained in the string. *)
val pp_buf : Buffer.t -> t -> unit
(** Renamed from [pp].
@since 2.0 *)
(** Renamed from [pp] since 2.0. *)
val pp : Format.formatter -> t -> unit
(** Print the string within quotes.
Renamed from [print].
@since 2.0 *)
Renamed from [print] since 2.0. *)
end
(** {2 Strings} *)
include module type of String
include module type of struct include String end
val equal : string -> string -> bool
(** Equality function on strings. *)
@ -75,7 +74,7 @@ val is_empty : string -> bool
val hash : string -> int
val init : int -> (int -> char) -> string
(** Analog to [Array.init].
(** Like [Array.init].
@since 0.3.3 *)
val rev : string -> string
@ -127,7 +126,7 @@ val find_all_l : ?start:int -> sub:string -> string -> int list
@since 0.17 *)
val mem : ?start:int -> sub:string -> string -> bool
(** [mem ~sub s] is true iff [sub] is a substring of [s].
(** [mem ~sub s] is [true] iff [sub] is a substring of [s].
@since 0.12 *)
val rfind : sub:string -> string -> int
@ -339,10 +338,10 @@ end
module Split : sig
(** Specification of what to do with empty blocks, as in [split ~by:"-" "-a-b-"].
- [{first=false; last=false}] will return [""; "a"; "b"; ""].
- [{first=true; last=false}] will return ["a"; "b" ""].
- [{first=false; last=true}] will return [""; "a"; "b"].
- [{first=true; last=true}] will return ["a"; "b"].
- [{first=false; last=false}] will return [""; "a"; "b"; ""]
- [{first=true; last=false}] will return ["a"; "b" ""]
- [{first=false; last=true}] will return [""; "a"; "b"]
- [{first=true; last=true}] will return ["a"; "b"]
The default value of all remaining functions is [Drop_none].
@since 1.5

334
src/core/CCUtf8_string.ml Normal file
View file

@ -0,0 +1,334 @@
(** {1 UTF8 strings} *)
(** Ref {{: https://en.wikipedia.org/wiki/UTF-8} Wikipedia}
We only deal with UTF8 strings as they naturally map to OCaml bytestrings *)
type uchar = Uchar.t
type 'a gen = unit -> 'a option
type 'a sequence = ('a -> unit) -> unit
let equal (a:string) b = Pervasives.(=) a b
let hash : string -> int = Hashtbl.hash
let pp = Format.pp_print_string
include String
let to_string x = x
(** State for decoding *)
module Dec = struct
type t = {
s: string;
len: int; (* max offset *)
mutable i: int; (* offset *)
}
let make ?(idx=0) (s:string) : t =
{ s=s; i=idx; len=String.length s; }
end
let n_bytes = length
exception Malformed of string * int
(** Malformed string at given offset *)
(* decode next char. Mutate state, calls [yield c] if a char [c] is
read, [stop ()] otherwise.
@raise Malformed if an invalid substring is met *)
let next_ (type a) (st : Dec.t) ~(yield:uchar -> a) ~(stop:unit -> a) () : a =
let open Dec in
let malformed st = raise (Malformed (st.s,st.i)) in
(* read a multi-byte character.
@param acc the accumulator (containing the first byte of the char)
@param n_bytes number of bytes to read (i.e. [width char - 1])
@param overlong minimal bound on second byte (to detect overlong encoding)
*)
let read_multi ?(overlong=0) n_bytes acc =
(* inner loop j = 1..jmax *)
let rec aux j acc =
let c = Char.code st.s.[ st.i + j] in
(* check that c is in 0b10xxxxxx *)
if c lsr 6 <> 0b10 then malformed st;
(* overlong encoding? *)
if j=1 && overlong<>0 && (c land 0b111111) < overlong then malformed st;
(* except for first, each char gives 6 bits *)
let next = (acc lsl 6) lor (c land 0b111111) in
if j = n_bytes then (
(* done reading the codepoint *)
if Uchar.is_valid next then (
st.i <- st.i + j + 1; (* +1 for first char *)
yield (Uchar.unsafe_of_int next)
) else (
malformed st;
)
) else (
aux (j+1) next
)
in
assert (n_bytes >= 1);
(* is the string long enough to contain the whole codepoint? *)
if st.i + n_bytes < st.len then (
aux 1 acc (* start with j=1, first char is already processed! *)
) else (
(* char is truncated *)
malformed st;
)
in
if st.i >= st.len then (
stop ()
) else (
let c = st.s.[ st.i ] in
(* find leading byte, and detect some impossible cases
according to https://en.wikipedia.org/wiki/Utf8#Codepage_layout *)
match c with
| '\000' .. '\127' ->
st.i <- 1 + st.i;
yield (Uchar.of_int @@ Char.code c) (* 0xxxxxxx *)
| '\194' .. '\223' -> read_multi 1 ((Char.code c) land 0b11111) (* 110yyyyy *)
| '\225' .. '\239' -> read_multi 2 ((Char.code c) land 0b1111) (* 1110zzzz *)
| '\241' .. '\244' -> read_multi 3 ((Char.code c) land 0b111) (* 11110uuu *)
| '\224' ->
(* overlong: if next byte is < than [0b001000000] then the char
would fit in 1 byte *)
read_multi ~overlong:0b00100000 2 ((Char.code c) land 0b1111) (* 1110zzzz *)
| '\240' ->
(* overlong: if next byte is < than [0b000100000] then the char
would fit in 2 bytes *)
read_multi ~overlong:0b00010000 3 ((Char.code c) land 0b111) (* 11110uuu *)
| '\128' .. '\193' (* 192,193 are forbidden *)
| '\245' .. '\255' -> malformed st;
)
let to_gen ?(idx=0) str : uchar gen =
let st = Dec.make ~idx str in
fun () ->
next_ st
~yield:(fun c -> Some c)
~stop:(fun () -> None)
()
exception Stop
let to_seq ?(idx=0) s : uchar sequence =
fun yield ->
let st = Dec.make ~idx s in
try
while true do
next_ st ~yield
~stop:(fun () -> raise Stop)
()
done
with Stop -> ()
let iter ?idx f s = to_seq ?idx s f
let fold ?idx f acc s =
let st = Dec.make ?idx s in
let rec aux acc =
next_ st
~yield:(fun x ->
let acc = f acc x in
aux acc)
~stop:(fun () -> acc)
()
in
aux acc
let n_chars = fold (fun x _ -> x+1) 0
let to_list ?(idx=0) s : uchar list =
fold ~idx (fun acc x -> x :: acc) [] s |> List.rev
(* Convert a code point (int) into a string;
There are various equally trivial versions of this around.
*)
let code_to_string buf (c:uchar) : unit =
let c = Uchar.to_int c in
let mask = 0b111111 in
assert (Uchar.is_valid c);
if c <= 0x7f then (
Buffer.add_char buf (Char.unsafe_chr c)
) else if c <= 0x7ff then (
Buffer.add_char buf (Char.unsafe_chr (0xc0 lor (c lsr 6)));
Buffer.add_char buf (Char.unsafe_chr (0x80 lor (c land mask)));
) else if c <= 0xffff then (
Buffer.add_char buf (Char.unsafe_chr (0xe0 lor (c lsr 12)));
Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((c lsr 6) land mask)));
Buffer.add_char buf (Char.unsafe_chr (0x80 lor (c land mask)));
) else if c <= 0x1fffff then (
Buffer.add_char buf (Char.unsafe_chr (0xf0 lor (c lsr 18)));
Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((c lsr 12) land mask)));
Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((c lsr 6) land mask)));
Buffer.add_char buf (Char.unsafe_chr (0x80 lor (c land mask)));
) else (
Buffer.add_char buf (Char.unsafe_chr (0xf8 lor (c lsr 24)));
Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((c lsr 18) land mask)));
Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((c lsr 12) land mask)));
Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((c lsr 6) land mask)));
Buffer.add_char buf (Char.unsafe_chr (0x80 lor (c land mask)));
)
let of_gen g : t =
let buf = Buffer.create 32 in
let rec aux () = match g() with
| None -> Buffer.contents buf
| Some c -> code_to_string buf c; aux ()
in
aux ()
let of_seq seq : t =
let buf = Buffer.create 32 in
seq (code_to_string buf);
Buffer.contents buf
let of_list l : t =
let buf = Buffer.create 32 in
List.iter (code_to_string buf) l;
Buffer.contents buf
let map f s : t =
let buf = Buffer.create (n_bytes s) in
iter (fun c -> code_to_string buf (f c)) s;
Buffer.contents buf
let filter_map f s : t =
let buf = Buffer.create (n_bytes s) in
iter
(fun c -> match f c with
| None -> ()
| Some c -> code_to_string buf c)
s;
Buffer.contents buf
let flat_map f s : t =
let buf = Buffer.create (n_bytes s) in
iter (fun c -> iter (code_to_string buf) (f c)) s;
Buffer.contents buf
let append = Pervasives.(^)
let unsafe_of_string s = s
let is_valid (s:string) : bool =
try
let st = Dec.make s in
while true do
next_ st
~yield:(fun _ -> ())
~stop:(fun () -> raise Stop)
()
done;
assert false
with
| Malformed _ -> false
| Stop -> true
let of_string_exn s =
if is_valid s then s
else invalid_arg "CCUtf8_string.of_string_exn"
let of_string s = if is_valid s then Some s else None
(*$inject
let printer s = String.escaped (to_string s)
let pp_uchar (c:Uchar.t) = Printf.sprintf "0x%x" (Uchar.to_int c)
let uutf_is_valid s =
try
Uutf.String.fold_utf_8
(fun () _ -> function
| `Malformed _ -> raise Exit
| `Uchar _ -> ())
() s;
true
with Exit ->
false
let uutf_to_seq s f =
Uutf.String.fold_utf_8
(fun () _ -> function
| `Malformed _ -> f (Uchar.of_int 0xfffd)
| `Uchar c -> f c)
() s
*)
(*$R
let s = of_string_exn "このため、" in
let s' = to_seq s |> of_seq in
assert_equal ~cmp:equal ~printer s s'
*)
(*$QR
Q.string (fun s ->
Q.assume (CCString.for_all (fun c -> Char.code c < 128) s);
is_valid s)
*)
(*$QR & ~long_factor:10
Q.string (fun s ->
Q.assume (CCString.for_all (fun c -> Char.code c < 128) s);
s = (of_string_exn s |> to_seq |> of_seq |> to_string)
)
*)
(*$QR & ~long_factor:10
Q.string (fun s ->
Q.assume (CCString.for_all (fun c -> Char.code c < 128) s);
String.length s = List.length (of_string_exn s |> to_list)
)
*)
(*$T
not (is_valid "\192\181")
not (is_valid "\193\143")
not (is_valid "\224\151\167")
not (is_valid "\224\137\165")
is_valid "\240\151\189\163"
*)
(*$QR & ~long_factor:40
Q.string (fun s ->
Q.assume (is_valid s);
let s = of_string_exn s in
let s2 = s |> to_seq |> of_seq in
if s=s2 then true
else Q.Test.fail_reportf "s=%S, s2=%S" (to_string s)(to_string s2)
)
*)
(*$QR & ~long_factor:40
Q.string (fun s ->
Q.assume (is_valid s);
let s = of_string_exn s in
let s2 = s |> to_gen |> of_gen in
if s=s2 then true
else Q.Test.fail_reportf "s=%S, s2=%S" (to_string s)(to_string s2)
)
*)
(* compare with uutf *)
(*$QR & ~long_factor:40 ~count:100_000
Q.string (fun s ->
let v1 = is_valid s in
let v2 = uutf_is_valid s in
if v1=v2 then true
else Q.Test.fail_reportf "s:%S, valid: %B, uutf_valid: %B" s v1 v2
)
*)
(*$QR & ~long_factor:40 ~count:100_000
Q.string (fun s ->
Q.assume (is_valid s && uutf_is_valid s);
let pp s = Q.Print.(list pp_uchar) s in
let l_uutf = uutf_to_seq s |> Sequence.to_list in
let l_co = of_string_exn s |> to_seq |> Sequence.to_list in
if l_uutf = l_co then true
else Q.Test.fail_reportf "uutf: '%s', containers: '%s', is_valid %B, uutf_is_valid %B"
(pp l_uutf) (pp l_co) (is_valid s) (uutf_is_valid s)
)
*)

91
src/core/CCUtf8_string.mli Normal file
View file

@ -0,0 +1,91 @@
(** {1 Unicode String, in UTF8} *)
(** A unicode string represented by a utf8 bytestring. This representation
is convenient for manipulating normal OCaml strings that are encoded
in UTF8.
We perform only basic decoding and encoding between codepoints and
bytestrings.
For more elaborate operations,
please use the excellent {{: http://erratique.ch/software/uutf} Uutf}.
@since 2.1
{b status}: experimental
*)
type uchar = Uchar.t
type 'a gen = unit -> 'a option
type 'a sequence = ('a -> unit) -> unit
type t = private string
(** A UTF8 string *)
val equal : t -> t -> bool
val hash : t -> int
val compare : t -> t -> int
val pp : Format.formatter -> t -> unit
val to_string : t -> string
(** Identity. *)
exception Malformed of string * int
(** Malformed string at given offset *)
val to_gen : ?idx:int -> t -> uchar gen
(** Generator of unicode codepoints.
@param idx offset where to start the decoding. *)
val to_seq : ?idx:int -> t -> uchar sequence
(** Sequence of unicode codepoints.
@param idx offset where to start the decoding. *)
val to_list : ?idx:int -> t -> uchar list
(** List of unicode codepoints.
@param idx offset where to start the decoding. *)
val fold : ?idx:int -> ('a -> uchar -> 'a) -> 'a -> t -> 'a
val iter : ?idx:int -> (uchar -> unit) -> t -> unit
val n_chars : t -> int
(** Number of characters. *)
val n_bytes : t -> int
(** Number of bytes. *)
val map : (uchar -> uchar) -> t -> t
val filter_map : (uchar -> uchar option) -> t -> t
val flat_map : (uchar -> t) -> t -> t
val append : t -> t -> t
val concat : t -> t list -> t
val of_seq : uchar sequence -> t
val of_gen : uchar gen -> t
val of_list : uchar list -> t
val of_string_exn : string -> t
(** Validate string by checking it is valid UTF8.
@raise Invalid_argument if the string is not valid UTF8. *)
val of_string : string -> t option
(** Safe version of {!of_string_exn}. *)
val is_valid : string -> bool
(** Valid UTF8? *)
val unsafe_of_string : string -> t
(** Conversion from a string without validating.
Upon iteration, if an invalid substring is met, Malformed will be raised. *)

4
src/core/CCVector.ml
View file

@ -653,7 +653,7 @@ let to_seq_rev v k =
let slice_seq v start len =
assert (start >= 0 && len >= 0);
fun k ->
assert (start+len < v.size);
assert (start+len <= v.size);
for i = start to start+len-1 do
let x = Array.unsafe_get v.vec i in
k x
@ -661,6 +661,8 @@ let slice_seq v start len =
(*$T
slice_seq (of_list [0;1;2;3;4]) 1 3 |> CCList.of_seq = [1;2;3]
slice_seq (of_list [0;1;2;3;4]) 1 4 |> CCList.of_seq = [1;2;3;4]
slice_seq (of_list [0;1;2;3;4]) 0 5 |> CCList.of_seq = [0;1;2;3;4]
*)
let slice v = (v.vec, 0, v.size)

1
src/core/_tags
View file

@ -1 +0,0 @@
<CCHash.*>: inline(20)

3
src/core/containers.ml
View file

@ -27,11 +27,13 @@ module Hashtbl = struct
end
module Heap = CCHeap
module Int = CCInt
module Int32 = CCInt32
module Int64 = CCInt64
module IO = CCIO
module List = CCList
module ListLabels = CCListLabels
module Map = CCMap
module Nativeint = CCNativeint
module Option = CCOpt
module Ord = CCOrd
module Pair = CCPair
@ -43,5 +45,6 @@ module Set = CCSet
module String = CCString
module Vector = CCVector
module Monomorphic = CCMonomorphic
module Utf8_string = CCUtf8_string
include Monomorphic

2
src/core/jbuild
View file

@ -5,5 +5,5 @@
(wrapped false)
(flags (:standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -nolabels -open CCMonomorphic))
(ocamlopt_flags (:standard (:include ../flambda.flags)))
(libraries (bytes result containers.monomorphic))
(libraries (result uchar containers.monomorphic))
))

6
src/data/CCBV.mli
View file

@ -51,7 +51,7 @@ val set : t -> int -> unit
(** Set i-th bit, extending the bitvector if needed. *)
val get : t -> int -> bool
(** Is the i-th bit true? Returns false if the index is too high. *)
(** Is the i-th bit true? Return false if the index is too high. *)
val reset : t -> int -> unit
(** Set i-th bit to 0, extending the bitvector if needed. *)
@ -82,8 +82,8 @@ val of_list : int list -> t
bitvector will have [length t] equal to 1 more than max of list indices. *)
val first : t -> int option
(** First set bit, or return None.
changed type at 1.2 *)
(** First set bit, or return [None].
Changed type at 1.2 *)
val first_exn : t -> int
(** First set bit, or

133
src/data/CCBijection.ml Normal file
View file

@ -0,0 +1,133 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Bijection} *)
type 'a sequence = ('a -> unit) -> unit
module type OrderedType = sig
type t
val compare : t -> t -> int
end
module type S = sig
type t
type left
type right
val empty : t
val is_empty : t -> bool
val equal : t -> t -> bool
val compare : t -> t -> int
val add : left -> right -> t -> t
val cardinal : t -> int
val mem : left -> right -> t -> bool
val mem_left : left -> t -> bool
val mem_right : right -> t -> bool
val find_left : left -> t -> right
val find_right : right -> t -> left
val remove : left -> right -> t -> t
val remove_left : left -> t -> t
val remove_right : right -> t -> t
val list_left : t -> (left * right) list
val list_right : t -> (right * left) list
val add_seq : (left * right) sequence -> t -> t
val of_seq : (left * right) sequence -> t
val to_seq : t -> (left * right) sequence
val add_list : (left * right) list -> t -> t
val of_list : (left * right) list -> t
val to_list : t -> (left * right) list
end
module Make(L : OrderedType)(R : OrderedType) = struct
type left = L.t
type right = R.t
module MapL = Map.Make(L)
module MapR = Map.Make(R)
type t = {
left : right MapL.t;
right : left MapR.t;
}
let empty = {
left = MapL.empty;
right = MapR.empty;
}
let cardinal m = MapL.cardinal m.left
let is_empty m =
let res = MapL.is_empty m.left in
assert (res = MapR.is_empty m.right);
res
let equal a b = MapL.equal (fun a b -> R.compare a b = 0) a.left b.left
let compare a b = MapL.compare R.compare a.left b.left
let add a b m = {
left =
(try let found = MapR.find b m.right in
if L.compare found a <> 0 then MapL.remove found m.left else m.left
with Not_found -> m.left)
|> MapL.add a b;
right =
(try let found = MapL.find a m.left in
if R.compare found b <> 0 then MapR.remove found m.right else m.right
with Not_found -> m.right)
|> MapR.add b a;
}
let find_left key m = MapL.find key m.left
let find_right key m = MapR.find key m.right
let mem left right m = try R.compare right (find_left left m) = 0 with Not_found -> false
let mem_left key m = MapL.mem key m.left
let mem_right key m = MapR.mem key m.right
let remove a b m =
if mem a b m then
{
left = MapL.remove a m.left;
right = MapR.remove b m.right;
}
else m
let remove_left a m =
let right = try MapR.remove (find_left a m) m.right with Not_found -> m.right in
{ right; left = MapL.remove a m.left }
let remove_right b m =
let left = try MapL.remove (find_right b m) m.left with Not_found -> m.left in
{ left; right = MapR.remove b m.right }
let list_left m = MapL.bindings m.left
let list_right m = MapR.bindings m.right
let add_list l m = List.fold_left (fun m (a,b) -> add a b m) m l
let of_list l = add_list l empty
let to_list = list_left
let add_seq seq m =
let m = ref m in
seq (fun (k,v) -> m := add k v !m);
!m
let of_seq l = add_seq l empty
let to_seq m yield = MapL.iter (fun k v -> yield (k,v)) m.left
end
(*$inject
open Containers
module M = Make(Int)(String)
*)
(*$=
2 (M.of_list [1,"1"; 2, "2"] |> M.cardinal)
"1" (M.of_list [1,"1"; 2, "2"] |> M.find_left 1)
"2" (M.of_list [1,"1"; 2, "2"] |> M.find_left 2)
1 (M.of_list [1,"1"; 2, "2"] |> M.find_right "1")
2 (M.of_list [1,"1"; 2, "2"] |> M.find_right "2")
*)

84
src/data/CCBijection.mli Normal file
View file

@ -0,0 +1,84 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Bijection}
Represents 1-to-1 mappings between two types. Each element from the "left"
is mapped to one "right" value, and conversely.
@since 2.1 *)
type 'a sequence = ('a -> unit) -> unit
module type OrderedType = sig
type t
val compare : t -> t -> int
end
module type S = sig
type t
type left
type right
val empty : t
val is_empty : t -> bool
val equal : t -> t -> bool
val compare : t -> t -> int
val add : left -> right -> t -> t
(** Add [left] and [right] correspondence to bijection such that
[left] and [right] are unique in their respective sets and only
correspond to each other. *)
val cardinal : t -> int
(** Number of bindings. O(n) time *)
val mem : left -> right -> t -> bool
(** Checks both sides for key membership. *)
val mem_left : left -> t -> bool
(** Checks for membership of correspondence using [left] key *)
val mem_right : right -> t -> bool
(** Checks for membership of correspondence using [right] key *)
val find_left : left -> t -> right
(** @raise Not_found if left is not found *)
val find_right : right -> t -> left
(** @raise Not_found if right is not found *)
val remove : left -> right -> t -> t
(** Removes the [left], [right] binding if it exists. Returns the
same bijection otherwise. *)
val remove_left : left -> t -> t
(** Remove the binding with [left] key if it exists. Returns the
same bijection otherwise *)
val remove_right : right -> t -> t
(** Remove the binding with [right] key if it exists. Returns the
same bijection otherwise *)
val list_left : t -> (left * right) list
(** returns the bindings as a list of ([left], [right]) values *)
val list_right : t -> (right * left) list
(** returns the bindings as a list of ([right, [left]) values *)
val add_seq : (left * right) sequence -> t -> t
val of_seq : (left * right) sequence -> t
val to_seq : t -> (left * right) sequence
val add_list : (left * right) list -> t -> t
val of_list : (left * right) list -> t
val to_list : t -> (left * right) list
end
module Make(L : OrderedType)(R : OrderedType) : S
with type left = L.t and type right = R.t

2
src/data/CCBitField.mli
View file

@ -9,8 +9,6 @@
{[
module B = CCBitField.Make(struct end);;
#install_printer B.pp;;
let x = B.mk_field ()
let y = B.mk_field ()
let z = B.mk_field ()

2
src/data/CCCache.mli
View file

@ -72,7 +72,7 @@ val iter : ('a,'b) t -> ('a -> 'b -> unit) -> unit
(** Iterate on cached values. Should yield [size cache] pairs. *)
val add : ('a, 'b) t -> 'a -> 'b -> bool
(** Manually add a cached value. Returns [true] if the value has successfully
(** Manually add a cached value. Return [true] if the value has successfully
been added, and [false] if the value was already bound.
@since 1.5 *)

8
src/data/CCDeque.mli
View file

@ -4,7 +4,7 @@
(** {1 Imperative deque}
This structure provides fast access to its front and back elements,
with O(1) operations *)
with O(1) operations. *)
type 'a t
(** Contains 'a elements, queue in both ways *)
@ -79,8 +79,8 @@ type 'a sequence = ('a -> unit) -> unit
val of_seq : 'a sequence -> 'a t
(** Create a deque from the sequence.
@since 0.13 optional argument [deque] disappears, use
{!add_seq_back} instead. *)
Optional argument [deque] disappears, use {!add_seq_back} instead since
0.13 *)
val to_seq : 'a t -> 'a sequence
(** Iterate on the elements. *)
@ -90,7 +90,7 @@ val of_gen : 'a gen -> 'a t
@since 0.13 *)
val to_gen : 'a t -> 'a gen
(** Iterate on elements of the deque.
(** Iterate on the elements of the deque.
@since 0.13 *)
val add_seq_front : 'a t -> 'a sequence -> unit

380
src/data/CCFun_vec.ml Normal file
View file

@ -0,0 +1,380 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(*$inject
let _listuniq =
let g = Q.(small_list (pair small_int small_int)) in
Q.map_same_type
(fun l ->
CCList.sort_uniq ~cmp:(fun a b -> Pervasives.compare (fst a)(fst b)) l
) g
;;
*)
(** {1 Hash Tries} *)
type 'a sequence = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
type 'a printer = Format.formatter -> 'a -> unit
type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list]
(* TODO
(** {2 Transient IDs} *)
module Transient = struct
type state = { mutable frozen: bool }
type t = Nil | St of state
let empty = Nil
let equal a b = Pervasives.(==) a b
let create () = St {frozen=false}
let active = function Nil -> false | St st -> not st.frozen
let frozen = function Nil -> true | St st -> st.frozen
let freeze = function Nil -> () | St st -> st.frozen <- true
let with_ f =
let r = create() in
try
let x = f r in
freeze r;
x
with e ->
freeze r;
raise e
exception Frozen
end
*)
(* function array *)
module A = struct
type 'a t = 'a array
let length_log = 5
let max_length = 32
let mask = max_length-1
let () = assert (max_length = 1 lsl length_log)
let length = Array.length
let iteri = Array.iteri
let iter = Array.iter
let fold = Array.fold_left
let map = Array.map
let iteri_rev f a =
for i = length a-1 downto 0 do f i a.(i) done
let create () = [| |]
let empty = [| |]
let is_empty a = length a = 0
let return x = [| x |]
let get a i =
if i<0 || i >= length a then invalid_arg "A.get";
Array.unsafe_get a i
(* push at the back *)
let push x a =
let n = length a in
if n = max_length then invalid_arg "A.push";
let arr = Array.make (n+1) x in
Array.blit a 0 arr 0 n;
arr
let pop a =
let n = length a in
if n=0 then invalid_arg "A.pop";
Array.sub a 0 (n-1)
let append a b =
let n_a = length a in
let n_b = length b in
if n_a + n_b > max_length then invalid_arg "A.append";
if n_a = 0 then b
else if n_b = 0 then a
else (
let arr = Array.make (n_a+n_b) (a.(0)) in
Array.blit a 0 arr 0 n_a;
Array.blit b 0 arr n_a n_b;
arr
)
let set ~mut a i x =
if i<0 || i > length a || i >= max_length then invalid_arg "A.set";
if i=length a then (
(* insert in a longer copy *)
let arr = Array.make (i+1) x in
Array.blit a 0 arr 0 i;
arr
) else if mut then (
(* replace element at [i] in place *)
a.(i) <- x;
a
) else (
(* replace element at [i] in copy *)
let arr = Array.copy a in
arr.(i) <- x;
arr
)
end
(** {2 Functors} *)
type 'a t = {
size: int;
leaves: 'a A.t;
subs: 'a t A.t;
}
(* invariant:
- [A.length leaves < A.max_length ==> A.is_empty subs]
- either:
* [exists n. forall i. subs[i].size = n] (all subtrees of same size)
* [exists n i.
(forall j<i. sub[j].size=32^{n+1}-1) &
(forall j>=i, sub[j].size<32^{n+1}-1)]
(prefix of subs has size of complete binary tree; suffix has
smaller size (actually decreasing))
*)
let empty = {size=0; leaves=A.empty; subs=A.empty}
let is_empty {size;_} = size=0
(*$T
is_empty empty
*)
let length {size;_} = size
(*$T
not (is_empty (return 2))
length (return 2) = 1
*)
let return x = {leaves=A.return x; subs=A.empty; size=1}
type idx_l =
| I_one of int
| I_cons of int * idx_l
(* split an index into a low and high parts *)
let low_idx_ i = i land A.mask
let high_idx_ i = i lsr A.length_log
let combine_idx i j = (i lsl A.length_log) lor j
(* split an index into a high part, < 32, and a low part *)
let split_idx i : idx_l =
let rec aux high low =
if high = 0 then low
else if high < A.max_length then I_cons (high-1, low)
else aux (high_idx_ high) (I_cons (low_idx_ high, low))
in
aux (high_idx_ i) (I_one(low_idx_ i))
let get_ (i:int) (m:'a t) : 'a =
let rec aux l m = match l with
| I_one x ->
assert (x < A.length m.leaves);
A.get m.leaves x
| I_cons (x, tl) -> aux tl (A.get m.subs x)
in
aux (split_idx i) m
(*$Q
_listuniq (fun l -> \
let m = of_list l in \
List.for_all (fun (i,y) -> get_exn i m = y) @@ List.mapi CCPair.make l)
*)
let get_exn i v =
if i >= 0 && i < length v then get_ i v else raise Not_found
let get i v =
if i >= 0 && i < length v then Some (get_ i v) else None
let push_ (i:int) (x:'a) (m:'a t) : 'a t =
let rec aux l m = match l with
| I_one i ->
assert (i=A.length m.leaves);
assert (A.length m.leaves < A.max_length);
assert (A.is_empty m.subs);
{m with size=m.size+1; leaves=A.push x m.leaves}
| I_cons (i,tl) -> aux_replace_sub tl m i
and aux_replace_sub l m x =
assert (x <= A.length m.subs);
(* insert in subtree, possibly a new one *)
let sub_m =
if x < A.length m.subs then A.get m.subs x else empty
in
let sub_m = aux l sub_m in
{m with size=m.size+1; subs=A.set ~mut:false m.subs x sub_m}
in
aux (split_idx i) m
let push x (v:_ t) : _ t = push_ v.size x v
let pop_ i (m:'a t) : 'a * 'a t =
let rec aux l m = match l with
| I_one x ->
assert (x+1 = A.length m.leaves); (* last one *)
let x = A.get m.leaves x in
x, {m with size=m.size-1; leaves=A.pop m.leaves}
| I_cons (x,tl) -> aux_remove_sub tl m x
and aux_remove_sub l m x =
let sub = A.get m.subs x in
let y, sub' = aux l sub in
if is_empty sub' then (
assert (i+1 = A.length m.subs); (* last one *)
y, {m with size=m.size-1; subs=A.pop m.subs}
) else (
y, {m with size=m.size-1; subs=A.set ~mut:false m.subs x sub}
)
in
aux (split_idx i) m
let pop_exn (v:'a t) : 'a * 'a t =
if v.size=0 then failwith "Fun_vec.pop_exn";
pop_ v.size v
let pop (v:'a t) : ('a * 'a t) option =
if v.size=0 then None else Some (pop_ v.size v)
let iteri ~f (m : 'a t) : unit =
(* basically, a 32-way BFS traversal.
The queue contains subtrees to explore, along with their high_idx_ offsets *)
let q : (int * 'a t) Queue.t = Queue.create() in
Queue.push (0,m) q;
while not (Queue.is_empty q) do
let high, m = Queue.pop q in
A.iteri (fun i x -> f (combine_idx high i) x) m.leaves;
A.iteri (fun i sub -> Queue.push (combine_idx i high, sub) q) m.subs;
done
let iteri_rev ~f (m : 'a t) : unit =
(* like {!iteri} but last element comes first *)
let rec aux high m =
A.iteri_rev (fun i sub -> aux (combine_idx i high) sub) m.subs;
(* only now, explore current leaves *)
A.iteri_rev (fun i x -> f (combine_idx high i) x) m.leaves;
in
aux 0 m
let foldi ~f ~x m =
let acc = ref x in
iteri m
~f:(fun i x -> acc := f !acc i x);
!acc
let foldi_rev ~f ~x m =
let acc = ref x in
iteri_rev m
~f:(fun i x -> acc := f !acc i x);
!acc
let iter ~f m = iteri ~f:(fun _ x -> f x) m
let fold ~f ~x m = foldi ~f:(fun acc _ x -> f acc x) ~x m
let fold_rev ~f ~x m = foldi_rev ~f:(fun acc _ x -> f acc x) ~x m
let rec map f m : _ t =
{ subs=A.map (map f) m.subs;
leaves=A.map f m.leaves;
size=m.size;
}
(*$QR
Q.(pair (fun1 Observable.int bool)(small_list int)) (fun (f,l) ->
let f = Q.Fn.apply f in
(List.map f l) = (of_list l |> map f |> to_list)
)
*)
let append a b =
if is_empty b then a
else fold ~f:(fun v x -> push x v) ~x:a b
(*$QR
Q.(pair (small_list int)(small_list int)) (fun (l1,l2) ->
(l1 @ l2) = (append (of_list l1)(of_list l2) |> to_list)
)
*)
let add_list v l = List.fold_left (fun v x -> push x v) v l
let of_list l = add_list empty l
let to_list m = fold_rev m ~f:(fun acc x -> x::acc) ~x:[]
(*$QR
Q.(small_list int) (fun l ->
l = to_list (of_list l))
*)
let add_seq v seq =
let v = ref v in
seq (fun x -> v := push x !v);
!v
let of_seq s = add_seq empty s
let to_seq m yield = iteri ~f:(fun _ v -> yield v) m
(*$Q
_listuniq (fun l -> \
(List.sort Pervasives.compare l) = \
(l |> Sequence.of_list |> of_seq |> to_seq |> Sequence.to_list \
|> List.sort Pervasives.compare) )
*)
let rec add_gen m g = match g() with
| None -> m
| Some x -> add_gen (push x m) g
let of_gen g = add_gen empty g
(* traverse the tree by increasing hash order, where the order compares
hashes lexicographically by A.length_log-wide chunks of bits,
least-significant chunks first *)
let to_gen m =
let q_cur : 'a Queue.t = Queue.create() in
let q_sub : 'a t Queue.t = Queue.create() in
Queue.push m q_sub;
let rec next() =
if not (Queue.is_empty q_cur) then (
Some (Queue.pop q_cur)
) else if not (Queue.is_empty q_sub) then (
let m = Queue.pop q_sub in
A.iter (fun x -> Queue.push x q_cur) m.leaves;
A.iter (fun sub -> Queue.push sub q_sub) m.subs;
next()
) else None
in next
(*$Q
_listuniq (fun l -> \
(List.sort Pervasives.compare l) = \
(l |> Gen.of_list |> of_gen |> to_gen |> Gen.to_list \
|> List.sort Pervasives.compare) )
*)
let choose m = to_gen m ()
(*$T
choose empty = None
choose (of_list [1,1; 2,2]) <> None
*)
let choose_exn m = match choose m with
| None -> raise Not_found
| Some (k,v) -> k, v
let pp ppv out m =
let first = ref true in
iter m
~f:(fun v ->
if !first then first := false else Format.fprintf out ";@ ";
ppv out v
)

143
src/data/CCFun_vec.mli Normal file
View file

@ -0,0 +1,143 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Functional Vectors} *)
(** Tree with a large branching factor for logarithmic operations with
a low multiplicative factor.
{b status: experimental. DO NOT USE (yet)}
@since 2.1
*)
type 'a sequence = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
type 'a printer = Format.formatter -> 'a -> unit
type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list]
(* TODO: restore this
(** {2 Transient Identifiers} *)
module Transient : sig
type t
(** Identifiers for transient modifications. A transient modification
is uniquely identified by a [Transient.t]. Once [Transient.freeze r]
is called, [r] cannot be used to modify the structure again. *)
val create : unit -> t
(** Create a new, active ID. *)
val equal : t -> t -> bool
(** Equality between IDs. *)
val frozen : t -> bool
(** [frozen i] returns [true] if [freeze i] was called before. In this case,
the ID cannot be used for modifications again. *)
val active : t -> bool
(** [active i] is [not (frozen i)]. *)
val freeze : t -> unit
(** [freeze i] makes [i] unusable for new modifications. The values
created with [i] will now be immutable. *)
val with_ : (t -> 'a) -> 'a
(** [with_ f] creates a transient ID [i], calls [f i],
freezes the ID [i] and returns the result of [f i]. *)
exception Frozen
(** Raised when a frozen ID is used. *)
end
*)
(** {2 Signature} *)
type 'a t
val empty : 'a t
val is_empty : _ t -> bool
val return : 'a -> 'a t
val length : _ t -> int
val push : 'a -> 'a t -> 'a t
(** Add element at the end. *)
val get : int -> 'a t -> 'a option
val get_exn : int -> 'a t -> 'a
(** @raise Not_found if key not present. *)
val pop_exn : 'a t -> 'a * 'a t
(** Pop last element. *)
val iter : f:('a -> unit) -> 'a t -> unit
val iteri : f:(int -> 'a -> unit) -> 'a t -> unit
(** Iterate on elements with their index, in increasing order. *)
val iteri_rev : f:(int -> 'a -> unit) -> 'a t -> unit
(** Iterate on elements with their index, but starting from the end. *)
val fold : f:('b -> 'a -> 'b) -> x:'b -> 'a t -> 'b
val foldi : f:('b -> int -> 'a -> 'b) -> x:'b -> 'a t -> 'b
val append : 'a t -> 'a t -> 'a t
val map : ('a -> 'b) -> 'a t -> 'b t
val choose : 'a t -> 'a option
(* TODO
val push_mut : id:Transient.t -> 'a -> 'a t -> 'a t
(** [add_mut ~id k v m] behaves like [add k v m], except it will mutate
in place whenever possible. Changes done with an [id] might affect all
versions of the structure obtained with the same [id] (but not
other versions).
@raise Transient.Frozen if [id] is frozen. *)
val pop_mut : id:Transient.t -> 'a t -> 'a * 'a t
(** Same as {!remove}, but modifies in place whenever possible.
@raise Transient.Frozen if [id] is frozen. *)
val append_mut : id:Transient.t -> into:'a t -> 'a t -> 'a t
*)
(** {6 Conversions} *)
val to_list : 'a t -> 'a list
val of_list : 'a list -> 'a t
val add_list : 'a t -> 'a list -> 'a t
val add_seq : 'a t -> 'a sequence -> 'a t
val of_seq : 'a sequence -> 'a t
val to_seq : 'a t -> 'a sequence
val add_gen : 'a t -> 'a gen -> 'a t
val of_gen : 'a gen -> 'a t
val to_gen : 'a t -> 'a gen
(* TODO
val add_list_mut : id:Transient.t -> 'a t -> 'a list -> 'a t
(** @raise Frozen if the ID is frozen. *)
val add_seq_mut : id:Transient.t -> 'a t -> 'a sequence -> 'a t
(** @raise Frozen if the ID is frozen. *)
val add_gen_mut : id:Transient.t -> 'a t -> 'a gen -> 'a t
(** @raise Frozen if the ID is frozen. *)
*)
(** {6 IO} *)
val pp : 'a printer -> 'a t printer

4
src/data/CCGraph.mli
View file

@ -118,7 +118,7 @@ module Traverse : sig
graph:('v, 'e) t ->
'v sequence ->
'v sequence_once
(** One-shot traversal of the graph using a tag set and the given bag *)
(** One-shot traversal of the graph using a tag set and the given bag. *)
val dfs: tbl:'v set ->
graph:('v, 'e) t ->
@ -147,7 +147,7 @@ module Traverse : sig
('v * int * ('v,'e) path) sequence_once
(** Dijkstra algorithm, traverses a graph in increasing distance order.
Yields each vertex paired with its distance to the set of initial vertices
(the smallest distance needed to reach the node from the initial vertices)
(the smallest distance needed to reach the node from the initial vertices).
@param dist distance from origin of the edge to destination,
must be strictly positive. Default is 1 for every edge. *)

2
src/data/CCHet.mli
View file

@ -1,7 +1,7 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Associative containers with Heterogenerous Values}
(** {1 Associative containers with Heterogeneous Values}
This is similar to {!CCMixtbl}, but the injection is directly used as
a key.

5
src/data/CCMixmap.mli
View file

@ -26,9 +26,10 @@
assert (M.get ~inj:inj_str 3 m = None)
]}
change of API, the map is last argument to make piping with [|>] easier since 0.16.
@since 0.9
@since 0.16 change of API, the map is last argument to
make piping with [|>] easier. *)
*)
type 'a injection
(** An accessor for values of type 'a in any map. Values put

2
src/data/CCMixset.mli
View file

@ -35,7 +35,7 @@ val newkey : unit -> 'a key
Not thread-safe. *)
val empty : t
(** Empty set *)
(** Empty set. *)
val set : key:'a key -> 'a -> t -> t
(** [set ~key v set] maps [key] to [v] in [set]. It means that

4
src/data/CCMultiMap.mli
View file

@ -52,7 +52,7 @@ module type S = sig
(** Intersection of multimaps. *)
val diff : t -> t -> t
(** Difference of maps, ie bindings of the first that are not
(** Difference of maps, i.e. bindings of the first that are not
in the second. *)
val equal : t -> t -> bool
@ -62,7 +62,7 @@ module type S = sig
(** Total order on multimaps. *)
val submap : t -> t -> bool
(** [submap m1 m2] is true iff all bindings of [m1] are also in [m2]. *)
(** [submap m1 m2] is [true] iff all bindings of [m1] are also in [m2]. *)
val to_seq : t -> (key * value) sequence

4
src/data/CCPersistentArray.mli
View file

@ -63,14 +63,14 @@ val set : 'a t -> int -> 'a -> 'a t
range [0] to [Array.length a - 1]. *)
val length : 'a t -> int
(** Returns the length of the persistent array. *)
(** Return the length of the persistent array. *)
val copy : 'a t -> 'a t
(** [copy a] returns a fresh copy of [a]. Both copies are independent. *)
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
(** Applies the given function to all elements of the array, and returns
(** Apply the given function to all elements of the array, and return
a persistent array initialized by the results of f. In the case of [mapi],
the function is also given the index of the element.
It is equivalent to [fun f t -> init (fun i -> f (get t i))]. *)

2
src/data/CCRAL.mli
View file

@ -171,7 +171,7 @@ module Infix : sig
(** Alias to {!map}. *)
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
(** Alias to {!app} *)
(** Alias to {!app}. *)
val (--) : int -> int -> int t
(** Alias to {!range}. *)

17
src/data/CCRingBuffer.mli
View file

@ -10,10 +10,9 @@
{b status: experimental}
@since 0.9
Change in the API to provide only a bounded buffer since 1.3
Change in the API to provide only a bounded buffer
@since 1.3
@since 0.9
*)
(** {2 Underlying Array} *)
@ -82,7 +81,7 @@ module type S = sig
(** [create size] creates a new bounded buffer with given size.
The underlying array is allocated immediately and no further (large)
allocation will happen from now on.
@raise Invalid_argument if the arguments is [< 1]. *)
@raise Invalid_argument if the argument is [< 1]. *)
val copy : t -> t
(** Make a fresh copy of the buffer. *)
@ -94,12 +93,12 @@ module type S = sig
(** Number of elements currently stored in the buffer. *)
val is_full : t -> bool
(** true if pushing an element would erase another element.
(** [true] if pushing an element would erase another element.
@since 1.3 *)
val blit_from : t -> Array.t -> int -> int -> unit
(** [blit_from buf from_buf o len] copies the slice [o, ... o + len - 1] from
a input buffer [from_buf] to the end of the buffer.
an input buffer [from_buf] to the end of the buffer.
If the slice is too large for the buffer, only the last part of the array
will be copied.
@raise Invalid_argument if [o,len] is not a valid slice of [s]. *)
@ -143,12 +142,12 @@ module type S = sig
being its relative index within [buf]. *)
val get_front : t -> int -> Array.elt
(** [get_front buf i] returns the [i]-th element of [buf] from the front, ie
(** [get_front buf i] returns the [i]-th element of [buf] from the front, i.e.
the one returned by [take_front buf] after [i-1] calls to [junk_front buf].
@raise Invalid_argument if the index is invalid (> [length buf]). *)
val get_back : t -> int -> Array.elt
(** [get_back buf i] returns the [i]-th element of [buf] from the back, ie
(** [get_back buf i] returns the [i]-th element of [buf] from the back, i.e.
the one returned by [take_back buf] after [i-1] calls to [junk_back buf].
@raise Invalid_argument if the index is invalid (> [length buf]). *)
@ -200,7 +199,7 @@ end
(** An efficient byte based ring buffer *)
module Byte : S with module Array = Array.Byte
(** Makes a ring buffer module with the given array type. *)
(** Makes a ring buffer module with the given array type *)
module MakeFromArray(A : Array.S) : S with module Array = A
(** Buffer using regular arrays *)

2
src/data/CCWBTree.ml
View file

@ -121,7 +121,7 @@ module type S = sig
and [o = Some v] if [k, v] belonged to the map *)
val merge : f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
(** Similar to {!Map.S.merge} *)
(** Like {!Map.S.merge} *)
val extract_min : 'a t -> key * 'a * 'a t
(** [extract_min m] returns [k, v, m'] where [k,v] is the pair with the

2
src/data/CCWBTree.mli
View file

@ -86,7 +86,7 @@ module type S = sig
and [o = Some v] if [k, v] belonged to the map. *)
val merge : f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
(** Similar to {!Map.S.merge}. *)
(** Like {!Map.S.merge}. *)
val extract_min : 'a t -> key * 'a * 'a t
(** [extract_min m] returns [k, v, m'] where [k,v] is the pair with the

4
src/data/CCZipper.mli
View file

@ -7,13 +7,13 @@
type 'a t = 'a list * 'a list
(** The pair [l, r] represents the list [List.rev_append l r], but
with the focus on [r]. *)
with the focus on [r] *)
val empty : 'a t
(** Empty zipper. *)
val is_empty : _ t -> bool
(** Empty zipper? Returns true iff the two lists are empty. *)
(** Empty zipper? Returns [true] iff the two lists are empty. *)
val to_list : 'a t -> 'a list
(** Convert the zipper back to a list.

2
src/data/jbuild
View file

@ -5,5 +5,5 @@
(wrapped false)
(flags (:standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string))
(ocamlopt_flags (:standard (:include ../flambda.flags)))
(libraries (bytes result))
(libraries (result))
))

14
src/iter/CCKList.mli
View file

@ -155,22 +155,22 @@ val merge : 'a ord -> 'a t -> 'a t -> 'a t
(** Merge two sorted iterators into a sorted iterator. *)
val zip : 'a t -> 'b t -> ('a * 'b) t
(** Combine elements pairwise. Stops as soon as one of the lists stops.
(** Combine elements pairwise. Stop as soon as one of the lists stops.
@since 0.13 *)
val unzip : ('a * 'b) t -> 'a t * 'b t
(** Splits each tuple in the list.
(** Split each tuple in the list.
@since 0.13 *)
(** {2 Misc} *)
val sort : cmp:'a ord -> 'a t -> 'a t
(** Eager sort. Requires the iterator to be finite. [O(n ln(n))] time
(** Eager sort. Require the iterator to be finite. [O(n ln(n))] time
and space.
@since 0.3.3 *)
val sort_uniq : cmp:'a ord -> 'a t -> 'a t
(** Eager sort that removes duplicate values. Requires the iterator to be
(** Eager sort that removes duplicate values. Require the iterator to be
finite. [O(n ln(n))] time and space.
@since 0.3.3 *)
@ -243,14 +243,14 @@ end
val of_list : 'a list -> 'a t
val to_list : 'a t -> 'a list
(** Gather all values into a list *)
(** Gather all values into a list. *)
val of_array : 'a array -> 'a t
(** Iterate on the array.
@since 0.13 *)
val to_array : 'a t -> 'a array
(** Convert into array. Iterates twice.
(** Convert into array. Iterate twice.
@since 0.13 *)
val to_rev_list : 'a t -> 'a list
@ -268,4 +268,4 @@ val of_gen : 'a gen -> 'a t
val pp : ?sep:string -> 'a printer -> 'a t printer
(** Print the list with the given separator (default ",").
Does not print opening/closing delimiters. *)
Do not print opening/closing delimiters. *)

4
src/iter/CCKTree.mli
View file

@ -91,7 +91,7 @@ val find : pset:'a pset -> ('a -> 'b option) -> 'a t -> 'b option
| `Cst n -> Format.fprintf fmt "%d" n
| `Plus n -> Format.fprintf fmt "%d" n;;
Format.printf "%a@." (CCKTree.print pp_node) (fib 8);;
Format.printf "%a@." (CCKTree.pp pp_node) (fib 8);;
]}
*)
@ -114,7 +114,7 @@ module Dot : sig
] (** Dot attributes for nodes *)
type graph = (string * attribute list t list)
(** A dot graph is a name, plus a list of trees labelled with attributes. *)
(** A dot graph is a name, plus a list of trees labelled with attributes *)
val mk_id : ('a, Buffer.t, unit, attribute) format4 -> 'a
(** Using a formatter string, build an ID. *)

12
src/iter/CCLazy_list.ml
View file

@ -82,9 +82,21 @@ let rec flat_map ~f l =
Lazy.force res
)
let default ~default l =
lazy (
match l with
| lazy Nil -> Lazy.force default
| lazy l -> l
)
(*$=
[1] (default (return 1) empty |> to_list)
*)
module Infix = struct
let (>|=) x f = map ~f x
let (>>=) x f = flat_map ~f x
let (<|>) a b = default ~default:b a
end
include Infix

7
src/iter/CCLazy_list.mli
View file

@ -17,7 +17,7 @@ val return : 'a -> 'a t
(** Return a computed value. *)
val is_empty : _ t -> bool
(** Evaluates the head. *)
(** Evaluate the head. *)
val length : _ t -> int
(** [length l] returns the number of elements in [l], eagerly (linear time).
@ -45,9 +45,14 @@ val append : 'a t -> 'a t -> 'a t
val flat_map : f:('a -> 'b t) -> 'a t -> 'b t
(** Monadic flatten + map. *)
val default : default:'a t -> 'a t -> 'a t
(** Choice operator.
@since 2.1 *)
module Infix : sig
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
val (<|>) : 'a t -> 'a t -> 'a t (** Alias to {!default}. @since 2.1 *)
end
include module type of Infix

2
src/iter/jbuild
View file

@ -5,5 +5,5 @@
(wrapped false)
(flags (:standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string))
(ocamlopt_flags (:standard (:include ../flambda.flags)))
(libraries (bytes result))
(libraries (result))
))

8
src/monomorphic/CCMonomorphic.ml
View file

@ -3,4 +3,12 @@
include Pervasives
let (=.) : float -> float -> bool = (=)
let (<>.) : float -> float -> bool = (<>)
let (<.) : float -> float -> bool = (<)
let (>.) : float -> float -> bool = (>)
let (<=.) : float -> float -> bool = (<=)
let (>=.) : float -> float -> bool = (>=)
let (==) = `Consider_using_CCEqual_physical
let (!=) = `Consider_using_CCEqual_physical

20
src/monomorphic/CCMonomorphic.mli
View file

@ -15,5 +15,25 @@ val compare : int -> int -> int
val min : int -> int -> int
val max : int -> int -> int
(** {2 Infix operators for Floats} *)
val (=.) : float -> float -> bool (** @since 2.1 *)
val (<>.) : float -> float -> bool (** @since 2.1 *)
val (<.) : float -> float -> bool (** @since 2.1 *)
val (>.) : float -> float -> bool (** @since 2.1 *)
val (<=.) : float -> float -> bool (** @since 2.1 *)
val (>=.) : float -> float -> bool (** @since 2.1 *)
(** {2 Shadow Dangerous Operators} *)
val (==) : [`Consider_using_CCEqual_physical]
[@@ocaml.deprecated "Please use CCEqual.physical or Pervasives.(==) instead."]
(** @since 2.1 *)
val (!=) : [`Consider_using_CCEqual_physical]
[@@ocaml.deprecated "Please use [not CCEqual.physical] or Pervasives.(!=) instead."]

2
src/sexp/jbuild
View file

@ -5,7 +5,7 @@
(wrapped false)
(flags (:standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string))
(ocamlopt_flags (:standard (:include ../flambda.flags)))
(libraries (bytes result))
(libraries (result))
))
(ocamllex (CCSexp_lex))

2
src/threads/CCLock.mli
View file

@ -24,7 +24,7 @@ val try_with_lock : 'a t -> ('a -> 'b) -> 'b option
fails, [try_with_lock l f] fails too but the lock is released.
@since 0.22 *)
(** Type allowing to manipulate the lock as a reference
(** Type allowing to manipulate the lock as a reference.
@since 0.13 *)
module LockRef : sig
type 'a t

10
src/threads/CCPool.mli
View file

@ -3,7 +3,7 @@
(** {1 Thread Pool, and Futures}
Renamed and heavily updated from [CCFuture]
Renamed and heavily updated from [CCFuture].
@since 0.16 *)
type +'a state =
@ -36,7 +36,7 @@ module Make(P : PARAM) : sig
(** [active ()] is true as long as [stop()] has not been called yet. *)
val stop : unit -> unit
(** After calling [stop ()], Most functions will raise Stopped.
(** After calling [stop ()], most functions will raise Stopped.
This has the effect of preventing new tasks from being executed. *)
(** {6 Futures}
@ -45,7 +45,7 @@ module Make(P : PARAM) : sig
that are executed in the pool using {!run}. *)
module Fut : sig
type 'a t
(** A future value of type 'a *)
(** A future value of type ['a] *)
type 'a future = 'a t
@ -70,7 +70,7 @@ module Make(P : PARAM) : sig
val get : 'a t -> 'a
(** Blocking get: wait for the future to be evaluated, and get the value,
or the exception that failed the future is returned.
raise e if the future failed with e. *)
Raise e if the future failed with e. *)
val state : 'a t -> 'a state
(** State of the future. *)
@ -106,7 +106,7 @@ module Make(P : PARAM) : sig
in the array fails, [sequence_a l] fails too. *)
val map_a : ('a -> 'b t) -> 'a array -> 'b array t
(** [map_l f a] maps [f] on every element of [a], and will return
(** [map_a f a] maps [f] on every element of [a], and will return
the array of every result if all calls succeed, or an error otherwise. *)
val sequence_l : 'a t list -> 'a list t

2
src/threads/CCTimer.mli
View file

@ -3,7 +3,7 @@
(** {1 Event timer}
Used to be part of [CCFuture]
Used to be part of [CCFuture].
@since 0.16 *)
type t

12
src/top/containers_top.ml
View file

@ -17,11 +17,11 @@ let install_printers = List.iter install_printer
let () =
install_printers
[ "CCHashtbl.print"
; "CCBV.print"
; "CCDeque.print"
; "CCFQueue.print"
; "CCIntMap.print"
; "CCPersistentArray.print"
[ "CCHashtbl.pp"
; "CCBV.pp"
; "CCDeque.pp"
; "CCFQueue.pp"
; "CCIntMap.pp"
; "CCPersistentArray.pp"
; "CCSexp.pp"
]

2
src/unix/jbuild
View file

@ -6,5 +6,5 @@
(optional)
(flags (:standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string))
(ocamlopt_flags (:standard (:include ../flambda.flags)))
(libraries (bytes result unix))
(libraries (result unix))
))