Compare commits

...

75 commits

Author SHA1 Message Date
Emmanuel Arrighi
35803e586c CCFormat(fix): restaure the behaviour of CCFormat.opt 2026-02-06 19:42:59 +01:00
Emmanuel Arrighi
8f30ce25b6 Revert "CCFun(cleanup): align CCFun.compose with the stdlib"
This reverts commit b649ac9dc5.
2026-02-06 19:42:59 +01:00
Emmanuel Arrighi
b8f1048ce4 CCString(cleanup): remove function always existing in stdlib > 4.08 2026-02-06 19:42:59 +01:00
Emmanuel Arrighi
9eb002304f CCSet(cleanup): remove function always in Stdlib for > 4.08 2026-02-06 19:42:59 +01:00
Emmanuel Arrighi
d80d36106b CCSeq(chore): sync with stdlib 2026-02-06 19:42:59 +01:00
Emmanuel Arrighi
405dfa4891 chore: inline the doc of the included modules 2026-02-06 14:36:44 +01:00
Emmanuel Arrighi
30f7ac7551 CCResult(cleanup): sync CCResult with Stdlib.Result. 2026-02-06 14:28:56 +01:00
Emmanuel Arrighi
3af76f266c CCPair(chore): sync CCPair with Stdlib.Pair 2026-02-06 12:34:00 +01:00
Emmanuel Arrighi
bb31265e52 CCOption(cleanup): remove functions that are in the stdlib 2026-02-06 12:16:28 +01:00
Emmanuel Arrighi
5e60c0d237 CCNativeint(cleanup): cleanup with bump ocaml version to 4.08 2026-02-06 11:28:06 +01:00
Emmanuel Arrighi
571f9f3793 CCMap(cleanup): clean function that are in the stdlib 2026-02-06 11:17:18 +01:00
Fardale
0cd4bbf240 CCList(cleanup): clean functions that are in the stdlib 2026-02-06 10:44:54 +01:00
Fardale
52fc619335 CCInt(chore): conditionally define function existing in newer OCaml 2026-02-06 10:44:54 +01:00
Fardale
b8684b77df CCInt64(chore): conditionally define function existing in newer OCaml 2026-02-06 10:44:54 +01:00
Fardale
bf7f4897c6 CCInt32(chore): add condition around functions existing in newer OCaml 2026-02-06 10:44:54 +01:00
Fardale
8268e29c48 CCHashtbl(cleanup): remove function always present on 4.08 2026-02-06 10:44:54 +01:00
Fardale
3516c5dc0e CCFormat(feat): add option and result, change opt
Add CCFormat.option and CCFormat.result as aliases to
Format.pp_print_option and Format.pp_print_result. Make CCFormat.opt an
alias of CCFormat.option, as such this add an optional argument to print
the case "None" but change the default behaviour. Previously, it as
printing "some _" or "none" now it print something only in the case of
"Some x" and just "x".
2026-02-06 10:44:54 +01:00
Fardale
b649ac9dc5 CCFun(cleanup): align CCFun.compose with the stdlib
Conditionally define CCFun.compose and align its definition with the
stdlib. The arguments are now swapped.
2026-02-06 10:44:54 +01:00
Fardale
74b787f7e6 CCEither(cleanup): conditionnally use the Either module
Include the Either module when available (ocaml >= 4.12)
2026-02-06 10:44:54 +01:00
Fardale
f05c07d20d CCChar(cleanup): remove CCChar.compare from the mli
Char.compare already existe
2026-02-06 10:44:54 +01:00
Fardale
50cb263a6e update CHANGELOG with current breaking changes 2026-02-06 10:44:51 +01:00
Fardale
6a6ccbbc5c CCInt64(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
Fardale
9e3baf8ff1 CCInt32(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
Fardale
88f093b64d CCInt(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
Fardale
0522770173 CCFloat(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
Fardale
5576ad71cc CCBool(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
Fardale
fcbde4b187 CCArray(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
Simon Cruanes
5461dcc07a
prepare for 3.17
Some checks failed
format / format (push) Has been cancelled
Build and Test / build (push) Has been cancelled
2026-01-12 20:16:42 -05:00
Simon Cruanes
d4fdff884f
more benchs
Some checks are pending
format / format (push) Waiting to run
Build and Test / build (push) Waiting to run
2026-01-11 13:52:16 -05:00
Simon Cruanes
eab2e1d33f
try to make the test_random uniformity test more robust
Some checks failed
format / format (push) Has been cancelled
Build and Test / build (push) Has been cancelled
just increase the sample size.
2025-12-20 11:19:45 -05:00
Simon Cruanes
c72b60fd6f
do simplify the code a bit
closer to the original solution, too. Avoids a redundant `:= []`.
2025-12-20 11:15:15 -05:00
Simon Cruanes
ddc87518a7
another test for lists 2025-12-20 11:08:39 -05:00
Simon Cruanes
15b421c54e
faster List.take_drop thanks to a trick by nojb
https://discuss.ocaml.org/t/efficient-implementation-of-list-split/17616/2
pretty cool.
2025-12-20 11:08:30 -05:00
Simon Cruanes
c1b13f1c7f
feat: add CCAtomic.update_cas
Some checks failed
format / format (push) Has been cancelled
Build and Test / build (push) Has been cancelled
2025-12-08 13:41:29 -05:00
Simon Cruanes
f51b56ffbc
cleanup
Some checks failed
format / format (push) Has been cancelled
Build and Test / build (push) Has been cancelled
2025-11-25 20:38:19 -05:00
Simon Cruanes
02c4d51fd0
chore: CI 2025-11-25 20:12:06 -05:00
Simon Cruanes
7c8adbd9fc
move to ocamlformat 0.27, format code 2025-11-25 20:11:54 -05:00
Simon Cruanes
954ea61d22
doc + benchs 2025-11-25 20:04:47 -05:00
Simon Cruanes
b069461fe2
test: enrich pvec test 2025-11-25 20:01:16 -05:00
Simon Cruanes
f13fb6f471
feat pvec: add flat_map 2025-11-25 19:59:23 -05:00
Simon Cruanes
01402388e4
fix warning 2025-11-25 19:21:11 -05:00
István Donkó
14ad490c7e fix: insert missing symbol into range doc comments
Some checks failed
Build and Test / build (push) Has been cancelled
Build and Test / format (push) Has been cancelled
2025-10-27 12:03:46 -04:00
Simon Cruanes
3b49ad2a4e
Merge pull request #478 from jmid/cbor-roundtrip-prop-patch
Some checks failed
Build and Test / build (push) Has been cancelled
Build and Test / format (push) Has been cancelled
Patch CBor round-trip QCheck test to hold for nan's too
2025-07-11 15:22:25 -04:00
Jan Midtgaard
1a11459991 Auto-format code 2025-07-09 16:06:47 +02:00
Jan Midtgaard
0290aa9754 Use CCList.equal for backward compatibility 2025-07-09 15:48:24 +02:00
Jan Midtgaard
9df429005d Patch CBor roundtrip property to hold for nan's too 2025-07-09 12:25:39 +02:00
Simon Cruanes
99dba20fa6
prepare for 3.16
Some checks failed
Build and Test / build (push) Has been cancelled
Build and Test / format (push) Has been cancelled
2025-05-27 09:22:31 -04:00
Simon Cruanes
f934db1e9c
fix: compat with OCaml 5.4
Some checks are pending
Build and Test / build (push) Waiting to run
Build and Test / format (push) Waiting to run
close #477
2025-05-26 23:44:02 -04:00
Simon Cruanes
14ad8c1f2a
format
Some checks failed
Build and Test / build (push) Has been cancelled
Build and Test / format (push) Has been cancelled
2025-05-06 22:24:04 -04:00
Simon Cruanes
0ff9614520
feat: add containers.leb128 library
adapted from pbrt
2025-05-06 21:53:26 -04:00
Simon Cruanes
ab7d0fcc09
fix: oob(!!) in CCHash.bytes
Some checks are pending
Build and Test / build (push) Waiting to run
Build and Test / format (push) Waiting to run
2025-05-06 10:01:31 -04:00
Simon Cruanes
b55d3cfe6a
tests for hashing strings 2025-05-06 10:01:31 -04:00
Simon Cruanes
4613aafb30
feat: add CCFun.with_return
Some checks failed
Build and Test / build (push) Has been cancelled
Build and Test / format (push) Has been cancelled
2025-02-07 16:57:56 -05:00
Adlertz, Niclas
4294dc7ca3 Add square brackets in comment for CCList.return
Some checks failed
Build and Test / build (push) Has been cancelled
Build and Test / format (push) Has been cancelled
2025-01-28 22:19:11 -05:00
Simon Cruanes
31ad563044
Merge pull request #467 from mobotsar/enrich_char
Additional functions for the `Char` module to check common character properties
2025-01-04 17:09:24 -05:00
Alexander
2dcaa12fb7 Fixed docstring typo. 2025-01-04 11:19:57 -05:00
Alexander
bace9fe209 Fixed tests to work with older OCaml versions that lack String.for_all. 2025-01-04 10:11:03 -05:00
Alexander
1486cbf5a1 Added tests for CCChar predicates. 2025-01-04 10:00:36 -05:00
Alexander
b95e2de65b Added functions to the Char module to check common character properties. 2025-01-04 09:18:51 -05:00
Simon Cruanes
f310bc5771
more CI 2025-01-03 21:22:05 -05:00
Simon Cruanes
6d962a70d0
grr CI 2025-01-03 13:10:23 -05:00
Simon Cruanes
517d4605d5
try to update CI 2025-01-03 12:58:59 -05:00
Simon Cruanes
b0f673fbbb
add more tests for CCString.{r,}take_while 2025-01-03 12:54:01 -05:00
Simon Cruanes
c6f6a012b4
Merge pull request #465 from mobotsar/main
Add `take_while` and `rtake_while` to `CCString`, addressing #463
2025-01-03 12:48:57 -05:00
Alexander Lucas
1e06423e87 Fixed formatting of t_string.ml tests for take_while, etc. 2025-01-01 10:33:05 -05:00
Alexander Lucas
8bb3801a52 Fixed formatting of CCString.rtake_while. 2025-01-01 10:22:42 -05:00
Alexander Lucas
d29ed7ee72 Renamed predicate parameter of take_while, rtake_while from p to f, aligining it with pre-existing drop_while. 2025-01-01 09:55:26 -05:00
Alexander Lucas
330cba94de added tests for take_while, rtake_while. 2025-01-01 09:46:22 -05:00
Alexander Lucas
699b370220 Updated String and StringLabels interfaces to reflect take_while, rtake_while. 2025-01-01 09:34:06 -05:00
mobotsar
85ca948012
Merge branch 'c-cube:main' into main 2025-01-01 09:19:25 -05:00
mobotsar
6c8569a7d9
Update CCString.mli to align parameter names in mli descriptions and implementations. 2025-01-01 00:48:58 -05:00
mobotsar
1498158a4f
Update CCString.mli for take_while, rtake_while 2025-01-01 00:47:17 -05:00
mobotsar
d8c00f96be
Update CCString.ml with take_while, rtake_while
Added two functions to the `CCString` module addressing #463 following the style of `CCString.drop_while` and `CCString.rdrop_while`. Corresponding `CCString.mli` changes to follow.
2025-01-01 00:35:55 -05:00
mobotsar
510db54150 Update CCEither.mli fixing type in docstring
Changed "form OCaml 4.12" to "from OCaml 4.12".
2024-12-31 23:05:02 -05:00
mobotsar
2e8d70f073
Update CCEither.mli fixing type in docstring
Changed "form OCaml 4.12" to "from OCaml 4.12".
2024-12-31 22:25:55 -05:00
82 changed files with 1268 additions and 1227 deletions

28
.github/workflows/format.yml vendored Normal file
View file

@ -0,0 +1,28 @@
name: format
on:
push:
branches:
- main
pull_request:
jobs:
format:
name: format
strategy:
matrix:
ocaml-compiler:
- '5.3'
runs-on: 'ubuntu-latest'
steps:
- uses: actions/checkout@main
- name: Use OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v3
with:
ocaml-compiler: ${{ matrix.ocaml-compiler }}
dune-cache: true
allow-prerelease-opam: true
- run: opam install ocamlformat.0.27.0
- run: opam exec -- make format-check

View file

@ -13,9 +13,9 @@ jobs:
- uses: actions/checkout@main
- name: Use OCaml
uses: ocaml/setup-ocaml@v2
uses: ocaml/setup-ocaml@v3
with:
ocaml-compiler: '4.14'
ocaml-compiler: '5.2'
dune-cache: false
- name: Deps

View file

@ -19,14 +19,14 @@ jobs:
- '4.08'
- '4.10'
- '4.14'
- '5.2'
- '5.3'
- 'ocaml-variants.5.0.0+options,ocaml-option-bytecode-only'
runs-on: ${{ matrix.os }}
steps:
- uses: actions/checkout@main
- name: Use OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v2
uses: ocaml/setup-ocaml@v3
with:
ocaml-compiler: ${{ matrix.ocaml-compiler }}
dune-cache: true
@ -52,7 +52,7 @@ jobs:
steps:
- uses: actions/checkout@main
- name: Use OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v2
uses: ocaml/setup-ocaml@v3
with:
ocaml-compiler: ${{ matrix.ocaml-compiler }}
dune-cache: true
@ -62,23 +62,3 @@ jobs:
opam install containers-data --deps-only # no test deps
- run: opam exec -- dune build '@install'
- run: opam exec -- dune runtest -j 1 -p containers --profile=release # test only core on non-ubuntu platform
format:
name: format
strategy:
matrix:
ocaml-compiler:
- '5.2'
runs-on: 'ubuntu-latest'
steps:
- uses: actions/checkout@main
- name: Use OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v2
with:
ocaml-compiler: ${{ matrix.ocaml-compiler }}
dune-cache: true
allow-prerelease-opam: true
- run: opam install ocamlformat.0.26.2
- run: opam exec -- make format-check

View file

@ -1,4 +1,4 @@
version = 0.26.2
version = 0.27.0
profile=conventional
margin=80
if-then-else=k-r
@ -12,3 +12,4 @@ field-space=tight-decl
leading-nested-match-parens=true
module-item-spacing=compact
quiet=true
parse-docstrings=false

View file

@ -1,6 +1,34 @@
# Changelog
## main
- breaking: CCListLabel.compare and CCListLabel.equal takes the function on the elements as named arguments
- breaking: CCListLabel.init now takes the length as a named arguments to follow the Stdlib
- breaking: change the semantic of CCFloat.{min,max} with respect to NaN to follow the Stdlib
- breaking: change the semantic of CCInt.rem with respect to negative number to follow the Stdlib
- breaking: change the order of argument of CCMap.add_seq to align with the stdlib.
## 3.17
- feat: add `CCAtomic.update_cas`
- feat: add `Pvec.flat_map`
- faster `List.take_drop` thanks to a trick by nojb
- move to ocamlformat 0.27, format code
- test: enrich pvec test
- Patch CBor roundtrip property to hold for nan's too (thanks @jmid)
## 3.16
- breaking: Renamed predicate parameter of `take_while`, `rtake_while` from `p` to `f`, aligining it with pre-existing `drop_while`.
- feat: add `containers.leb128` library
- feat: add `CCFun.with_return`
- Added functions to the `Char` module to check common character properties.
- feat: add `CCVector.findi`
- fix: compat with OCaml 5.4
- fix: oob(!!) in CCHash.bytes
## 3.15
@ -38,6 +66,7 @@
## 3.13
- breaking: bump minimum version of OCaml to 4.08
- breaking: delete containers-thread (which was deprecated)
- breaking: pp: modify `Ext.t` so it takes surrounding value
- breaking: remove CCShims

View file

@ -128,8 +128,9 @@ module PersistentHashtbl (H : Hashtbl.HashedType) = struct
t := Add (k, v', t');
Table.remove tbl k;
t'
with Not_found -> (* not member, nothing to do *)
t
with Not_found ->
(* not member, nothing to do *)
t
(*$R
let h = H.of_seq my_seq in

View file

@ -97,6 +97,14 @@ module L = struct
else
Sek.Persistent.of_list 0 [ x; x + 1; x + 2; x + 3 ]
let f_pvec x =
if x mod 10 = 0 then
Pvec.empty
else if x mod 5 = 1 then
Pvec.of_list [ x; x + 1 ]
else
Pvec.of_list [ x; x + 1; x + 2; x + 3 ]
let flat_map_kont f l =
let rec aux f l kont =
match l with
@ -118,6 +126,7 @@ module L = struct
let l = CCList.(1 -- n) in
let ral = CCRAL.of_list l in
let sek = Sek.Persistent.of_list 0 l in
let pvec = Pvec.of_list l in
let flatten_map_ l () =
ignore @@ Sys.opaque_identity @@ List.flatten (CCList.map f_ l)
and flatmap_kont l () = ignore @@ Sys.opaque_identity @@ flat_map_kont f_ l
@ -128,6 +137,8 @@ module L = struct
ignore @@ Sys.opaque_identity @@ CCRAL.flat_map f_ral_ l
and flatmap_sek s () =
ignore @@ Sys.opaque_identity @@ Sek.Persistent.flatten_map 0 f_sek_ s
and flat_map_pvec v () =
ignore @@ Sys.opaque_identity @@ Pvec.flat_map f_pvec v
in
B.throughputN time ~repeat
[
@ -137,6 +148,7 @@ module L = struct
"flatten o map", flatten_map_ l, ();
"ral_flatmap", flatmap_ral_ ral, ();
"sek_flatmap", flatmap_sek sek, ();
"pvec.flatmap", flat_map_pvec pvec, ();
]
(* APPEND *)
@ -180,6 +192,33 @@ module L = struct
(* FLATTEN *)
(*
let[@tail_mod_cons] rec append_to_flattened first_list tail =
match first_list, tail with
| _, [] -> first_list
| x1 :: x2 :: x3 :: x4 :: first_list', _ ->
x1 :: x2 :: x3 :: x4 :: append_to_flattened first_list' tail
| [ x1; x2; x3 ], _ -> x1 :: x2 :: x3 :: append_to_flattened [] tail
| [ x1; x2 ], _ -> x1 :: x2 :: append_to_flattened [] tail
| [ x ], first_list' :: tail' -> x :: append_to_flattened first_list' tail'
| [], first_list' :: tail' -> append_to_flattened first_list' tail'
let flatten_trmc l = append_to_flattened [] l
*)
let[@tail_mod_cons] rec flatten_trmc = function
| [] -> []
| l1 :: tl -> append_to_flattened l1 tl
and[@tail_mod_cons] append_to_flattened first_list tail =
match first_list with
| [] -> flatten_trmc tail
| x1 :: [] -> x1 :: flatten_trmc tail
| [ x1; x2 ] -> x1 :: x2 :: flatten_trmc tail
| [ x1; x2; x3 ] -> x1 :: x2 :: x3 :: flatten_trmc tail
| x1 :: x2 :: x3 :: x4 :: first_list' ->
x1 :: x2 :: x3 :: x4 :: append_to_flattened first_list' tail
let bench_flatten ?(time = 2) n =
let fold_right_append_ l () =
opaque_ignore (List.fold_right List.append l [] : _ list)
@ -195,7 +234,7 @@ module L = struct
opaque_ignore (Pvec.fold_left Pvec.append Pvec.empty v : _ Pvec.t)
in
let l =
CCList.mapi (fun i x -> CCList.(x -- (x + min i 100))) CCList.(1 -- n)
CCList.mapi (fun i x -> CCList.(x -- (x + (i mod 100)))) CCList.(1 -- n)
in
let sek =
Sek.Persistent.of_list (Sek.Persistent.create 0)
@ -208,6 +247,8 @@ module L = struct
[
"CCList.flatten", (fun () -> ignore (CCList.flatten l)), ();
"List.flatten", (fun () -> ignore (List.flatten l)), ();
"List.flatten_trmc", (fun () -> ignore (flatten_trmc l)), ();
"List.concat_map id", (fun () -> ignore (List.concat_map Fun.id l)), ();
"fold_right append", fold_right_append_ l, ();
"funvec.(fold append)", funvec_flatten v, ();
"pvec.(fold append)", pvec_flatten pv, ();
@ -284,7 +325,7 @@ module L = struct
for i = 0 to n - 1 do
opaque_ignore (CCRAL.set l i (-i))
done
(* TODO: implement set
(* TODO: implement set
and bench_funvec l () =
for _i = 0 to n-1 do opaque_ignore (CCFun_vec.set (* TODO *)) done
*)
@ -447,7 +488,7 @@ module L = struct
[
app_int (bench_flatten ~time:2) 100;
app_int (bench_flatten ~time:2) 10_000;
app_int (bench_flatten ~time:4) 100_000;
app_int (bench_flatten ~time:2) 100_000;
];
"append"
@>> B.Tree.concat
@ -810,8 +851,8 @@ module Tbl = struct
end in
(module T)
let persistent_hashtbl_ref :
type a. a key_type -> (module MUT with type key = a) =
let persistent_hashtbl_ref : type a.
a key_type -> (module MUT with type key = a) =
fun key ->
let (module Key), name = arg_make key in
let module T = Ref_impl.PersistentHashtbl (Key) in

View file

@ -1,6 +1,6 @@
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
version: "3.15"
version: "3.17"
synopsis: "A set of advanced datatypes for containers"
maintainer: ["c-cube"]
authors: ["c-cube"]

View file

@ -1,6 +1,6 @@
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
version: "3.15"
version: "3.17"
synopsis:
"A modular, clean and powerful extension of the OCaml standard library"
maintainer: ["c-cube"]

View file

@ -1,42 +1,60 @@
(lang dune 3.0)
(name containers)
(generate_opam_files true)
(version 3.15)
(version 3.17)
(authors c-cube)
(maintainers c-cube)
(license BSD-2-Clause)
(homepage "https://github.com/c-cube/ocaml-containers/")
(source (github c-cube/ocaml-containers))
(source
(github c-cube/ocaml-containers))
(package
(name containers)
(synopsis "A modular, clean and powerful extension of the OCaml standard library")
(tags (stdlib containers iterators list heap queue))
(depends
(ocaml (>= 4.08))
either
dune-configurator
(qcheck-core (and (>= 0.18) :with-test))
(yojson :with-test)
(iter :with-test)
(gen :with-test)
(csexp :with-test)
(uutf :with-test)
(odoc :with-doc))
(depopts
base-unix
base-threads))
(name containers)
(synopsis
"A modular, clean and powerful extension of the OCaml standard library")
(tags
(stdlib containers iterators list heap queue))
(depends
(ocaml
(>= 4.08))
either
dune-configurator
(qcheck-core
(and
(>= 0.18)
:with-test))
(yojson :with-test)
(iter :with-test)
(gen :with-test)
(csexp :with-test)
(uutf :with-test)
(odoc :with-doc))
(depopts base-unix base-threads))
(package
(name containers-data)
(synopsis "A set of advanced datatypes for containers")
(tags (containers RAL function vector okasaki))
(depends
(ocaml (>= 4.08))
(containers (= :version))
(qcheck-core (and (>= 0.18) :with-test))
(iter :with-test)
(gen :with-test)
(mdx :with-test)
(odoc :with-doc)))
(name containers-data)
(synopsis "A set of advanced datatypes for containers")
(tags
(containers RAL function vector okasaki))
(depends
(ocaml
(>= 4.08))
(containers
(= :version))
(qcheck-core
(and
(>= 0.18)
:with-test))
(iter :with-test)
(gen :with-test)
(mdx :with-test)
(odoc :with-doc)))

View file

@ -108,7 +108,8 @@ module Bitfield = struct
if self.emit_failure_if_too_wide then
fpf out
"(* check that int size is big enough *)@,\
@[let () = assert (Sys.int_size >= %d);;@]" (total_width self);
@[let () = assert (Sys.int_size >= %d);;@]"
(total_width self);
fpf out "@]"
let gen_mli self : code =

View file

@ -93,7 +93,7 @@ let sort_indices cmp a =
Array.sort (fun k1 k2 -> cmp a.(k1) a.(k2)) b;
b
let sort_ranking cmp a = sort_indices compare (sort_indices cmp a)
let sort_ranking cmp a = sort_indices CCInt.compare (sort_indices cmp a)
let rev a =
let b = Array.copy a in
@ -455,15 +455,6 @@ let pp_i ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ())
let to_string ?(sep = ", ") item_to_string a =
Array.to_list a |> List.map item_to_string |> String.concat sep
let to_seq a =
let rec aux i () =
if i >= length a then
Seq.Nil
else
Seq.Cons (a.(i), aux (i + 1))
in
aux 0
let to_iter a k = iter k a
let to_gen a =

View file

@ -240,14 +240,6 @@ val to_iter : 'a t -> 'a iter
in modification of the iterator.
@since 2.8 *)
val to_seq : 'a t -> 'a Seq.t
(** [to_seq a] returns a [Seq.t] of the elements of an array [a].
The input array [a] is shared with the sequence and modification of it will result
in modification of the sequence.
Renamed from [to_std_seq] since 3.0.
@since 3.0
*)
val to_gen : 'a t -> 'a gen
(** [to_gen a] returns a [gen] of the elements of an array [a]. *)

View file

@ -219,13 +219,6 @@ val fold2 : f:('acc -> 'a -> 'b -> 'acc) -> init:'acc -> 'a t -> 'b t -> 'acc
@raise Invalid_argument if [a] and [b] have distinct lengths.
@since 0.20 *)
val iter2 : f:('a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** [iter2 ~f a b] iterates on the two arrays [a] and [b] stepwise.
It is equivalent to [f a0 b0; ; f a.(length a - 1) b.(length b - 1); ()].
@raise Invalid_argument if [a] and [b] have distinct lengths.
@since 0.20 *)
val shuffle : 'a t -> unit
(** [shuffle a] randomly shuffles the array [a], in place. *)
@ -248,14 +241,6 @@ val to_iter : 'a t -> 'a iter
in modification of the iterator.
@since 2.8 *)
val to_seq : 'a t -> 'a Seq.t
(** [to_seq a] returns a [Seq.t] of the elements of an array [a].
The input array [a] is shared with the sequence and modification of it will result
in modification of the sequence.
Renamed from [to_std_seq] since 3.0.
@since 3.0
*)
val to_gen : 'a t -> 'a gen
(** [to_gen a] returns a [gen] of the elements of an array [a]. *)
@ -286,14 +271,6 @@ val pp_i :
By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to
(fun out -> Format.fprintf out ",@ "). *)
val map2 : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** [map2 ~f a b] applies function [f] to all elements of [a] and [b],
and builds an array with the results returned by [f]:
[[| f a.(0) b.(0); ; f a.(length a - 1) b.(length b - 1)|]].
@raise Invalid_argument if [a] and [b] have distinct lengths.
@since 0.20 *)
val rev : 'a t -> 'a t
(** [rev a] copies the array [a] and reverses it in place.
@since 0.20 *)
@ -308,7 +285,7 @@ val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
element of [a] is discarded. *)
val monoid_product : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** [monoid_product ~f a b] passes all combinaisons of tuples from the two arrays [a] and [b]
(** [monoid_product ~f a b] passes all combinaisons of tuples from the two arrays [a] and [b]
to the function [f].
@since 2.8 *)

View file

@ -46,3 +46,24 @@ let[@inline never] decr r =
(* atomic *)
[@@@endif]
(** Update loop with a compare-and-swap, and some basic backoff behavior.
[update_cas atomic f] is, in essence,
[let res, x = f !atomic in atomic := x; res]
done atomically. [f] might be called multiple times and must be as cheap
as possible.
@since 3.17 *)
let update_cas (type res) (self : 'a t) (f : 'a -> res * 'a) : res =
let exception Ret of res in
let backoff = ref 1 in
try
while true do
let old_val = get self in
let res, new_val = f old_val in
if compare_and_set self old_val new_val then raise_notrace (Ret res);
Containers_domain.relax_loop !backoff;
backoff := min 128 (2 * !backoff)
done;
assert false
with Ret r -> r

View file

@ -1,9 +1,6 @@
(* This file is free software, part of containers. See file "license" for more details. *)
type t = bool
let equal (a : bool) b = Stdlib.( = ) a b
let compare (a : bool) b = Stdlib.compare a b
include Bool
let if_then f x =
if x then
@ -17,12 +14,6 @@ let if_then_else f g x =
else
g ()
let to_int (x : bool) : int =
if x then
1
else
0
let of_int x : t = x <> 0
type 'a printer = Format.formatter -> 'a -> unit

View file

@ -2,13 +2,8 @@
(** Basic Bool functions *)
type t = bool
val compare : t -> t -> int
(** [compare b1 b2] is the total ordering on booleans [b1] and [b2], similar to {!Stdlib.compare}. *)
val equal : t -> t -> bool
(** [equal b1 b2] is [true] if [b1] and [b2] are the same. *)
include module type of Bool
(** @inline *)
val if_then : (unit -> 'a) -> t -> 'a option
(** [if_then f x] is [Some (f ())] if [x] is true and None otherwise.
@ -18,10 +13,6 @@ val if_then_else : (unit -> 'a) -> (unit -> 'a) -> t -> 'a
(** [if_then_else f g x] is [f ()] if [x] is true and [g ()] otherwise.
@since 3.13 *)
val to_int : t -> int
(** [to_int true = 1], [to_int false = 0].
@since 2.7 *)
val of_int : int -> t
(** [of_int i] is the same as [i <> 0]
@since 2.7 *)

View file

@ -23,3 +23,12 @@ module Infix = struct
end
include Infix
let is_uppercase_ascii c = c > '\064' && c < '\091'
let is_lowercase_ascii c = c > '\096' && c < '\123'
let is_letter_ascii c =
(is_lowercase_ascii [@inlined]) c || (is_uppercase_ascii [@inlined]) c
let is_digit_ascii c = c > '\047' && c < '\058'
let is_whitespace_ascii c = c = '\032' || (c > '\008' && c < '\014')

View file

@ -9,12 +9,6 @@ include module type of struct
include Char
end
val compare : t -> t -> int
(** The comparison function for characters, with the same specification as
{!Stdlib.compare}. Along with the type [t], this function [compare]
allows the module [Char] to be passed as argument to the functors
{!Set.Make} and {!Map.Make}. *)
val of_int_exn : int -> t
(** Alias to {!Char.chr}.
Return the character with the given ASCII code.
@ -40,6 +34,32 @@ val pp_buf : Buffer.t -> t -> unit
val pp : Format.formatter -> t -> unit
(** Renamed from [print] since 2.0. *)
val is_uppercase_ascii : t -> bool
(** [is_uppercase_ascii c] is true exactly when [c] is an
uppercase ASCII character, i.e. ['\064'] < [c] < ['\091'].
@since 3.16 *)
val is_lowercase_ascii : t -> bool
(** [is_lowercase_ascii c] is true exactly when [c] is a
lowercase ASCII character, i.e. ['\096'] < [c] < ['\123'].
@since 3.16 *)
val is_letter_ascii : t -> bool
(** [is_letter_ascii c] is true exactly when [c] is an ASCII
letter, i.e. [is_uppercase_ascii c || is_lowercase_ascii c].
@since 3.16 *)
val is_digit_ascii : t -> bool
(** [is_digit_ascii c] is true exactly when [c] is an
ASCII digit, i.e. ['\047'] < [c] < ['\058'].
@since 3.16 *)
val is_whitespace_ascii : t -> bool
(** [is_whitespace_ascii c] is true exactly when [c] is an ASCII
whitespace character as defined by Unicode, i.e. either [c = ' ']
or ['\008'] < [c] < ['\014'].
@since 3.16 *)
(** {2 Infix Operators}
@since 3.3 *)

View file

@ -5,6 +5,12 @@ type 'a equal = 'a -> 'a -> bool
type 'a ord = 'a -> 'a -> int
type 'a printer = Format.formatter -> 'a -> unit
[@@@ifge 4.12]
include Either
[@@@else_]
(** {2 Basics} *)
type ('a, 'b) t = ('a, 'b) Either.t =
@ -62,6 +68,8 @@ let compare ~left ~right e1 e2 =
| Left l1, Left l2 -> left l1 l2
| Right r1, Right r2 -> right r1 r2
[@@@endif]
(** {2 IO} *)
let pp ~left ~right fmt = function

View file

@ -2,7 +2,7 @@
(** Either Monad
Module that is compatible with Either form OCaml 4.12 but can be use with any
Module that is compatible with Either from OCaml 4.12 but can be use with any
ocaml version compatible with container
@since 3.2
@ -13,6 +13,13 @@ type 'a equal = 'a -> 'a -> bool
type 'a ord = 'a -> 'a -> int
type 'a printer = Format.formatter -> 'a -> unit
[@@@ifge 4.12]
include module type of Either
(** @inline *)
[@@@else_]
(** {2 Basics} *)
type ('a, 'b) t = ('a, 'b) Either.t =
@ -70,6 +77,8 @@ val compare :
('a, 'b) t ->
int
[@@@endif]
(** {2 IO} *)
val pp : left:'a printer -> right:'b printer -> ('a, 'b) t printer

View file

@ -1,13 +1,6 @@
(* This file is free software, part of containers. See file "license" for more details. *)
type t = float
type fpclass = Stdlib.fpclass =
| FP_normal
| FP_subnormal
| FP_zero
| FP_infinite
| FP_nan
include Float
module Infix = struct
let ( = ) : t -> t -> bool = Stdlib.( = )
@ -27,47 +20,11 @@ include Infix
[@@@ocaml.warning "-32"]
let nan = Stdlib.nan
let infinity = Stdlib.infinity
let neg_infinity = Stdlib.neg_infinity
let max_value = infinity
let min_value = neg_infinity
let max_finite_value = Stdlib.max_float
let epsilon = Stdlib.epsilon_float
let pi = 0x1.921fb54442d18p+1
let is_nan x = Stdlib.(classify_float x = Stdlib.FP_nan)
let add = ( +. )
let sub = ( -. )
let mul = ( *. )
let div = ( /. )
let neg = ( ~-. )
let abs = Stdlib.abs_float
let scale = ( *. )
let min (x : t) y =
match Stdlib.classify_float x, Stdlib.classify_float y with
| FP_nan, _ -> y
| _, FP_nan -> x
| _ ->
if x < y then
x
else
y
let max (x : t) y =
match Stdlib.classify_float x, Stdlib.classify_float y with
| FP_nan, _ -> y
| _, FP_nan -> x
| _ ->
if x > y then
x
else
y
let equal (a : float) b = a = b
let hash : t -> int = Hashtbl.hash
let compare (a : float) b = Stdlib.compare a b
[@@@ocaml.warning "+32"]
type 'a printer = Format.formatter -> 'a -> unit
@ -91,22 +48,7 @@ let sign_exn (a : float) =
else
compare a 0.
let round x =
let low = floor x in
let high = ceil x in
if x -. low > high -. x then
high
else
low
let to_int (a : float) = Stdlib.int_of_float a
let of_int (a : int) = Stdlib.float_of_int a
let to_string (a : float) = Stdlib.string_of_float a
let of_string_exn (a : string) = Stdlib.float_of_string a
let of_string_opt (a : string) =
try Some (Stdlib.float_of_string a) with Failure _ -> None
let random n st = Random.State.float st n
let random_small = random 100.0
let random_range i j st = i +. random (j -. i) st

View file

@ -3,17 +3,8 @@
(** Basic operations on floating-point numbers
@since 0.6.1 *)
type t = float
type fpclass = Stdlib.fpclass =
| FP_normal
| FP_subnormal
| FP_zero
| FP_infinite
| FP_nan
val nan : t
(** [nan] is Not a Number (NaN). Equal to {!Stdlib.nan}. *)
include module type of Float
(** @inline *)
val max_value : t
(** [max_value] is Positive infinity. Equal to {!Stdlib.infinity}. *)
@ -24,50 +15,13 @@ val min_value : t
val max_finite_value : t
(** [max_finite_value] is the largest finite float value. Equal to {!Stdlib.max_float}. *)
val epsilon : t
(** [epsilon] is the smallest positive float x such that [1.0 +. x <> 1.0].
Equal to {!Stdlib.epsilon_float}. *)
val pi : t
(** [pi] is the constant pi. The ratio of a circumference to its diameter.
@since 3.0 *)
val is_nan : t -> bool
(** [is_nan f] returns [true] if f is NaN, [false] otherwise. *)
val add : t -> t -> t
(** [add x y] is equal to [x +. y]. *)
val sub : t -> t -> t
(** [sub x y] is equal to [x -. y]. *)
val neg : t -> t
(** [neg x] is equal to [~-. x]. *)
val abs : t -> t
(** [abs x] is the absolute value of the floating-point number [x].
Equal to {!Stdlib.abs_float}. *)
val scale : t -> t -> t
(** [scale x y] is equal to [x *. y]. *)
val min : t -> t -> t
(** [min x y] returns the min of the two given values [x] and [y]. *)
val max : t -> t -> t
(** [max x y] returns the max of the two given values [x] and [y]. *)
val equal : t -> t -> bool
(** [equal x y] is [true] if [x] and [y] are the same. *)
val compare : t -> t -> int
(** [compare x y] is {!Stdlib.compare x y}. *)
type 'a printer = Format.formatter -> 'a -> unit
type 'a random_gen = Random.State.t -> 'a
val pp : t printer
val hash : t -> int
val random : t -> t random_gen
val random_small : t random_gen
val random_range : t -> t -> t random_gen
@ -76,11 +30,6 @@ val fsign : t -> t
(** [fsign x] is one of [-1., -0., +0., +1.], or [nan] if [x] is NaN.
@since 0.7 *)
val round : t -> t
(** [round x] returns the closest integer value, either above or below.
For [n + 0.5], [round] returns [n].
@since 0.20 *)
exception TrapNaN of string
val sign_exn : t -> int
@ -89,23 +38,11 @@ val sign_exn : t -> int
Note that infinities have defined signs in OCaml.
@since 0.7 *)
val to_int : t -> int
(** Alias to {!int_of_float}.
Unspecified if outside of the range of integers. *)
val of_int : int -> t
(** Alias to {!float_of_int}. *)
val to_string : t -> string
val of_string_exn : string -> t
(** Alias to {!float_of_string}.
@raise Failure in case of failure.
@since 1.2 *)
val of_string_opt : string -> t option
(** @since 3.0 *)
val equal_precision : epsilon:t -> t -> t -> bool
(** Equality with allowed error up to a non negative epsilon value. *)

View file

@ -31,6 +31,8 @@ let break fmt (m, n) = Format.pp_print_break fmt m n
let newline = Format.pp_force_newline
let substring out (s, i, len) : unit = string out (String.sub s i len)
let text = Format.pp_print_text
let option = Format.pp_print_option
let result = Format.pp_print_result
let string_lines out (s : string) : unit =
fprintf out "@[<v>";

View file

@ -99,11 +99,20 @@ val arrayi : ?sep:unit printer -> (int * 'a) printer -> 'a array printer
val seq : ?sep:unit printer -> 'a printer -> 'a Seq.t printer
val iter : ?sep:unit printer -> 'a printer -> 'a iter printer
val option : ?none:unit printer -> 'a printer -> 'a option printer
(** [option ?none pp] prints options as follows:
- [Some x] will become [pp x]
- [None] will become [none ()]
Alias of {!Format.pp_print_option}
@since NEXT_RELEASE *)
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". *)
val result : ok:'a printer -> error:'e printer -> ('a, 'e) result printer
(** In the tuple printers, the [sep] argument is only available.
@since 0.17 *)

View file

@ -61,6 +61,13 @@ let rec iterate n f x =
else
iterate (n - 1) f (f x)
let[@inline] with_return (type ret) f : ret =
let exception E of ret in
let return x = raise_notrace (E x) in
match f return with
| res -> res
| exception E res -> res
module Infix = struct
(* default implem for some operators *)
let ( %> ) = compose

View file

@ -78,6 +78,22 @@ val iterate : int -> ('a -> 'a) -> 'a -> 'a
[x], [iterate 1 f x] is [f x], [iterate 2 f x] is [f (f x)], etc.
@since 2.1 *)
val with_return : (('ret -> 'a) -> 'ret) -> 'ret
(** [with_return f] is [f return], where [return] is a function
that can be invoked to exit the scope early.
For example:
{[
let find_array arr x =
let@ return = with_return in
for i = 0 to Array.length arr-1 do
if arr.(i) = x then return i;
done;
-1
]}
@since 3.15 *)
(** {2 Infix}
Infix operators. *)

View file

@ -101,7 +101,7 @@ let max_len_b_ = 128
let bytes (x : bytes) =
let h = ref fnv_offset_basis in
for i = 0 to min max_len_b_ (Bytes.length x) do
for i = 0 to min max_len_b_ (Bytes.length x - 1) do
(h := Int64.(mul !h fnv_prime));
let byte = Char.code (Bytes.unsafe_get x i) in
h := Int64.(logxor !h (of_int byte))

View file

@ -189,11 +189,6 @@ module type S = sig
using [f] in an unspecified order.
@since 3.3 *)
val add_seq : 'a t -> (key * 'a) Seq.t -> unit
(** Add the corresponding pairs to the table, using {!Hashtbl.add}.
Renamed from [add_std_seq] since 3.0.
@since 3.0 *)
val add_seq_with :
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> unit
(** Add the corresponding pairs to the table, using {!Hashtbl.add}.
@ -211,11 +206,6 @@ module type S = sig
using [f] in an unspecified order.
@since 3.3 *)
val of_seq : (key * 'a) Seq.t -> 'a t
(** From the given bindings, added in order.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t
(** From the given bindings, added in order.
If a key occurs multiple times in the input, the values are combined
@ -349,8 +339,6 @@ module Make (X : Hashtbl.HashedType) :
| exception Not_found -> add tbl k v
| v2 -> replace tbl k (f k v v2))
let add_seq tbl seq = Seq.iter (fun (k, v) -> add tbl k v) seq
let add_seq_with ~f tbl seq =
Seq.iter
(fun (k, v) ->
@ -366,7 +354,6 @@ module Make (X : Hashtbl.HashedType) :
tbl
let of_iter i = mk_tbl_ add_iter i
let of_seq i = mk_tbl_ add_seq i
let of_iter_with ~f i = mk_tbl_ (add_iter_with ~f) i
let of_seq_with ~f i = mk_tbl_ (add_seq_with ~f) i
let add_iter_count tbl i = i (fun k -> incr tbl k)

View file

@ -253,11 +253,6 @@ module type S = sig
using [f] in an unspecified order.
@since 3.3 *)
val add_seq : 'a t -> (key * 'a) Seq.t -> unit
(** Add the corresponding pairs to the table, using {!Hashtbl.add}.
Renamed from [add_std_seq] since 3.0.
@since 3.0 *)
val add_seq_with :
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> unit
(** Add the corresponding pairs to the table, using {!Hashtbl.add}.
@ -275,11 +270,6 @@ module type S = sig
using [f] in an unspecified order.
@since 3.3 *)
val of_seq : (key * 'a) Seq.t -> 'a t
(** From the given bindings, added in order.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t
(** From the given bindings, added in order.
If a key occurs multiple times in the input, the values are combined

View file

@ -2,24 +2,8 @@
include Int
type t = int
type 'a iter = ('a -> unit) -> unit
let zero = 0
let one = 1
let minus_one = -1
let add = ( + )
let sub = ( - )
let mul = ( * )
let div = ( / )
let succ = succ
let pred = pred
let abs = abs
let max_int = max_int
let min_int = min_int
let equal (a : int) b = Stdlib.( = ) a b
let compare (a : int) b = compare a b
(* use FNV:
https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function *)
let hash (n : int) : int =
@ -65,7 +49,6 @@ let range' i j yield =
range i (j + 1) yield
let sign i = compare i 0
let neg i = -i
let pow a b =
let rec aux acc = function
@ -119,9 +102,13 @@ end
include Infix
[@@@iflt 4.13]
let min : t -> t -> t = Stdlib.min
let max : t -> t -> t = Stdlib.max
[@@@endif]
let floor_div a n =
if a < 0 && n >= 0 then
((a + 1) / n) - 1
@ -147,11 +134,8 @@ let random_small = random 100
let random_range i j st = i + random (j - i) st
let pp fmt = Format.pp_print_int fmt
let most_significant_bit = -1 lxor (-1 lsr 1)
let to_string = string_of_int
let of_string s = try Some (int_of_string s) with Failure _ -> None
let of_string_exn = Stdlib.int_of_string
let to_float = float_of_int
let of_float = int_of_float
type output = char -> unit
@ -248,11 +232,3 @@ let popcount (b : int) : int =
let b = add b (shift_right_logical b 32) in
let b = logand b 0x7fL in
to_int b
let logand = ( land )
let logor = ( lor )
let logxor = ( lxor )
let lognot = lnot
let shift_left = ( lsl )
let shift_right = ( asr )
let shift_right_logical = ( lsr )

View file

@ -5,65 +5,6 @@
include module type of Int
(** @inline *)
type t = int
val zero : t
(** [zero] is the integer [0].
@since 3.0 *)
val one : t
(** [one] is the integer [1].
@since 3.0 *)
val minus_one : t
(** [minus_one] is the integer [-1].
@since 3.0 *)
val add : t -> t -> t
(** [add x y] is [x + y].
@since 3.0 *)
val sub : t -> t -> t
(** [sub x y] is [x - y].
@since 3.0 *)
val mul : t -> t -> t
(** [mul x y] is [x * y].
@since 3.0 *)
val div : t -> t -> t
(** [div x y] is [x / y]
@since 3.0 *)
val succ : t -> t
(** [succ x] is [x + 1].
@since 3.0 *)
val pred : t -> t
(** [pred x] is [x - 1].
@since 3.0 *)
val abs : t -> t
(** [abs x] is the absolute value of [x]. It is [x] if [x] is positive
and [neg x] otherwise.
@since 3.0 *)
val max_int : t
(** [max_int] is the maximum integer.
@since 3.0 *)
val min_int : t
(** [min_int] is the minimum integer.
@since 3.0 *)
val compare : t -> t -> int
(** [compare x y] is the comparison function for integers
with the same specification as {!Stdlib.compare}. *)
val equal : t -> t -> bool
(** [equal x y] is [true] iff [x] and [y] are equal.
Equality function for integers. *)
val hash : t -> int
(** [hash x] computes the hash of [x]. *)
@ -71,11 +12,6 @@ val sign : t -> int
(** [sign x] return [0] if [x = 0], [-1] if [x < 0] and [1] if [x > 0].
Same as [compare x 0].*)
val neg : t -> t
(** [neg x] is [- x].
Unary negation.
@since 0.5 *)
val pow : t -> t -> t
(** [pow base exponent] returns [base] raised to the power of [exponent].
[pow x y = x^y] for positive integers [x] and [y].
@ -103,22 +39,6 @@ val random_range : int -> int -> t random_gen
val pp : t printer
(** [pp ppf x] prints the integer [x] on [ppf]. *)
val to_float : t -> float
(** [to_float] is the same as [float_of_int]
@since 3.0*)
[@@@ocaml.warning "-32"]
val of_float : float -> t
(** [to_float] is the same as [int_of_float]
@since 3.0*)
[@@@ocaml.warning "+32"]
val to_string : t -> string
(** [to_string x] returns the string representation of the integer [x], in signed decimal.
@since 0.13 *)
val of_string : string -> t option
(** [of_string s] converts the given string [s] into an integer.
Safe version of {!of_string_exn}.
@ -130,11 +50,6 @@ val of_string_exn : string -> t
@raise Failure in case of failure.
@since 3.0 *)
val of_float : float -> t
(** [of_float x] converts the given floating-point number [x] to an integer.
Alias to {!int_of_float}.
@since 3.0 *)
val pp_binary : t printer
(** [pp_binary ppf x] prints [x] on [ppf].
Print as "0b00101010".
@ -144,6 +59,8 @@ val to_string_binary : t -> string
(** [to_string_binary x] returns the string representation of the integer [x], in binary.
@since 0.20 *)
[@@@iflt 4.13]
val min : t -> t -> t
(** [min x y] returns the minimum of the two integers [x] and [y].
@since 0.17 *)
@ -152,6 +69,8 @@ val max : t -> t -> t
(** [max x y] returns the maximum of the two integers [x] and [y].
@since 0.17 *)
[@@@endif]
val range_by : step:t -> t -> t -> t iter
(** [range_by ~step i j] iterates on integers from [i] to [j] included,
where the difference between successive elements is [step].
@ -173,34 +92,6 @@ val popcount : t -> int
(** Number of bits set to 1
@since 3.0 *)
val logand : t -> t -> t
(** [logand] is the same as [(land)].
@since 3.0 *)
val logor : t -> t -> t
(** [logand] is the same as [(lor)].
@since 3.0 *)
val logxor : t -> t -> t
(** [logxor] is the same as [(lxor)].
@since 3.0 *)
val lognot : t -> t
(** [logand] is the same as [lnot].
@since 3.0 *)
val shift_left : t -> int -> t
(** [shift_left] is the same as [(lsl)].
@since 3.0 *)
val shift_right : t -> int -> t
(** [shift_right] is the same as [(asr)].
@since 3.0 *)
val shift_right_logical : t -> int -> t
(** [shift_right_logical] is the same as [(lsr)].
@since 3.0 *)
(** {2 Infix Operators}
@since 0.17 *)

View file

@ -2,9 +2,18 @@
include Int32
[@@@iflt 4.13]
let min : t -> t -> t = Stdlib.min
let max : t -> t -> t = Stdlib.max
[@@@endif]
[@@@iflt 5.1]
let hash x = Stdlib.abs (to_int x)
[@@@endif]
let sign i = compare i zero
let pow a b =
@ -110,7 +119,6 @@ let random_range i j st = add i (random (sub j i) st)
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
let most_significant_bit = logxor (neg 1l) (shift_right_logical (neg 1l) 1)
type output = char -> unit

View file

@ -18,6 +18,8 @@ include module type of struct
include Int32
end
[@@@iflt 4.13]
val min : t -> t -> t
(** [min x y] returns the minimum of the two integers [x] and [y].
@since 3.0 *)
@ -26,10 +28,15 @@ val max : t -> t -> t
(** [max x y] returns the maximum of the two integers [x] and [y].
@since 3.0 *)
[@@@endif]
[@@@iflt 5.1]
val hash : t -> int
(** [hash x] computes the hash of [x].
Like {!Stdlib.abs (to_int x)}. *)
[@@@endif]
val sign : t -> int
(** [sign x] return [0] if [x = 0], [-1] if [x < 0] and [1] if [x > 0].
Same as [compare x zero].
@ -81,9 +88,6 @@ val of_string : string -> t option
(** [of_string s] is the safe version of {!of_string_exn}.
Like {!of_string_exn}, but return [None] instead of raising. *)
val of_string_opt : string -> t option
(** [of_string_opt s] is an alias to {!of_string}. *)
val of_string_exn : string -> t
(** [of_string_exn s] converts the given string [s] into a 32-bit integer.
Alias to {!Int32.of_string}.

View file

@ -2,8 +2,13 @@
include Int64
[@@@iflt 4.13]
let min : t -> t -> t = Stdlib.min
let max : t -> t -> t = Stdlib.max
[@@@endif]
let sign i = compare i zero
(* use FNV:
@ -126,7 +131,6 @@ let random_range i j st = add i (random (sub j i) st)
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
let most_significant_bit = logxor (neg 1L) (shift_right_logical (neg 1L) 1)
type output = char -> unit

View file

@ -18,6 +18,8 @@ include module type of struct
include Int64
end
[@@@iflt 4.13]
val min : t -> t -> t
(** [min x y] returns the minimum of the two integers [x] and [y].
@since 3.0 *)
@ -26,10 +28,15 @@ val max : t -> t -> t
(** [max x y] returns the maximum of the two integers [x] and [y].
@since 3.0 *)
[@@@endif]
[@@@iflt 5.1]
val hash : t -> int
(** [hash x] computes the hash of [x], a non-negative integer.
Uses FNV since 3.10 *)
[@@@endif]
val hash_to_int64 : t -> t
(** Like {!hash} but does not truncate.
Uses FNV.
@ -86,10 +93,6 @@ val of_string : string -> t option
(** [of_string s] is the safe version of {!of_string_exn}.
Like {!of_string_exn}, but return [None] instead of raising. *)
val of_string_opt : string -> t option
(** [of_string_opt s] is an alias to {!of_string}.
@since 2.1 *)
val of_string_exn : string -> t
(** [of_string_exn s] converts the given string [s] into a 64-bit integer.
Alias to {!Int64.of_string}.

View file

@ -1,43 +1,15 @@
(* backport new functions from stdlib here *)
[@@@ocaml.warning "-32"]
let rec compare_lengths l1 l2 =
match l1, l2 with
| [], [] -> 0
| [], _ :: _ -> -1
| _ :: _, [] -> 1
| _ :: tail1, _ :: tail2 -> compare_lengths tail1 tail2
let rec compare_length_with l n =
match l, n with
| _ when n < 0 -> 1
| [], 0 -> 0
| [], _ -> -1
| _ :: tail, _ -> compare_length_with tail (n - 1)
let rec assoc_opt x = function
| [] -> None
| (y, v) :: _ when Stdlib.( = ) x y -> Some v
| _ :: tail -> assoc_opt x tail
let rec assq_opt x = function
| [] -> None
| (y, v) :: _ when Stdlib.( == ) x y -> Some v
| _ :: tail -> assq_opt x tail
[@@@ocaml.warning "+32"]
(* end of backport *)
include List
let empty = []
[@@@iflt 5.1]
let is_empty = function
| [] -> true
| _ :: _ -> false
[@@@endif]
let mguard c =
if c then
[ () ]
@ -391,25 +363,27 @@ let[@tail_mod_cons] rec unfold f seed =
| Some (v, next) -> v :: unfold f next
[@@@endif]
[@@@iflt 4.12]
let rec compare f l1 l2 =
let rec compare cmp l1 l2 =
match l1, l2 with
| [], [] -> 0
| _, [] -> 1
| [], _ -> -1
| x1 :: l1', x2 :: l2' ->
let c = f x1 x2 in
let c = cmp x1 x2 in
if c <> 0 then
c
else
compare f l1' l2'
compare cmp l1' l2'
let rec equal f l1 l2 =
let rec equal eq l1 l2 =
match l1, l2 with
| [], [] -> true
| [], _ | _, [] -> false
| x1 :: l1', x2 :: l2' -> f x1 x2 && equal f l1' l2'
| x1 :: l1', x2 :: l2' -> eq x1 x2 && equal eq l1' l2'
[@@@endif]
[@@@iflt 5.1]
let rec flat_map_kont f l kont =
@ -778,6 +752,12 @@ let sorted_diff_uniq ~cmp l1 l2 =
in
recurse ~cmp [] l1 l2
let rec drop n l =
match l with
| [] -> []
| _ when n = 0 -> l
| _ :: l' -> drop (n - 1) l'
[@@@iflt 4.14]
let take n l =
@ -798,6 +778,8 @@ let take n l =
in
direct direct_depth_default_ n l
let take_drop n l = take n l, drop n l
[@@@else_]
let[@tail_mod_cons] rec take n l =
@ -809,20 +791,29 @@ let[@tail_mod_cons] rec take n l =
else
[]
[@@@endif]
let take_drop n l =
(* fun idea from nojb in
https://discuss.ocaml.org/t/efficient-implementation-of-list-split/17616/2 *)
let[@tail_mod_cons] rec loop (res_drop : _ ref) n l =
match l with
| [] -> []
| x :: tl ->
if n = 0 then (
res_drop := l;
[]
) else
x :: loop res_drop (n - 1) tl
in
let res_drop = ref [] in
let res_take = loop res_drop n l in
res_take, !res_drop
let rec drop n l =
match l with
| [] -> []
| _ when n = 0 -> l
| _ :: l' -> drop (n - 1) l'
[@@@endif]
let hd_tl = function
| [] -> failwith "hd_tl"
| x :: l -> x, l
let take_drop n l = take n l, drop n l
let sublists_of_len ?(last = fun _ -> None) ?offset n l =
if n < 1 then invalid_arg "sublists_of_len: n must be > 0";
let offset =
@ -969,6 +960,8 @@ let find_pred_exn p l =
| None -> raise Not_found
| Some x -> x
[@@@iflt 5.1]
let find_mapi f l =
let rec aux f i = function
| [] -> None
@ -979,8 +972,13 @@ let find_mapi f l =
in
aux f 0 l
[@@@endif]
[@@@iflt 4.10]
let find_map f l = find_mapi (fun _ -> f) l
[@@@endif]
let find_idx p l =
find_mapi
(fun i x ->
@ -999,6 +997,8 @@ let remove ~eq x l =
in
remove' eq x [] l
[@@@iflt 5.1]
let filter_map f l =
let rec recurse acc l =
match l with
@ -1013,6 +1013,8 @@ let filter_map f l =
in
recurse [] l
[@@@endif]
let keep_some l = filter_map (fun x -> x) l
let keep_ok l =
@ -1215,6 +1217,9 @@ let inter ~eq l1 l2 =
in
inter eq [] l1 l2
[@@@iflt 5.1]
(* Because our map is tail rec between 4.13 and 5.1 *)
let mapi f l =
let r = ref 0 in
map
@ -1224,6 +1229,8 @@ let mapi f l =
y)
l
[@@@endif]
let iteri f l =
let rec aux f i l =
match l with
@ -1547,11 +1554,6 @@ let to_string ?(start = "") ?(stop = "") ?(sep = ", ") item_to_string l =
let to_iter l k = List.iter k l
let rec to_seq l () =
match l with
| [] -> Seq.Nil
| x :: tl -> Seq.Cons (x, to_seq tl)
let of_iter i =
let l = ref [] in
i (fun x -> l := x :: !l);

View file

@ -16,10 +16,14 @@ type +'a t = 'a list
val empty : 'a t
(** [empty] is [[]]. *)
[@@@iflt 5.1]
val is_empty : _ t -> bool
(** [is_empty l] returns [true] iff [l = []].
@since 0.11 *)
[@@@endif]
val cons_maybe : 'a option -> 'a t -> 'a t
(** [cons_maybe (Some x) l] is [x :: l].
[cons_maybe None l] is [l].
@ -127,11 +131,6 @@ val count_true_false : ('a -> bool) -> 'a list -> int * int
that satisfy the predicate [p], and [int2] the number of elements that do not satisfy [p].
@since 2.4 *)
val init : int -> (int -> 'a) -> 'a t
(** [init len f] is [f 0; f 1; …; f (len-1)].
@raise Invalid_argument if len < 0.
@since 0.6 *)
val combine : 'a list -> 'b list -> ('a * 'b) list
(** [combine [a1; …; an] [b1; …; bn]] is [[(a1,b1); …; (an,bn)]].
Transform two lists into a list of pairs.
@ -161,25 +160,17 @@ val split : ('a * 'b) t -> 'a t * 'b t
@since 1.2, but only
@since 2.2 with labels *)
[@@@iflt 4.12]
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
(** [compare cmp l1 l2] compares the two lists [l1] and [l2]
using the given comparison function [cmp]. *)
val compare_lengths : 'a t -> 'b t -> int
(** [compare_lengths l1 l2] compare the lengths of the two lists [l1] and [l2].
Equivalent to [compare (length l1) (length l2)] but more efficient.
@since 1.5, but only
@since 2.2 with labels *)
val compare_length_with : 'a t -> int -> int
(** [compare_length_with l x] compares the length of the list [l] to an integer [x].
Equivalent to [compare (length l) x] but more efficient.
@since 1.5, but only
@since 2.2 with labels *)
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** [equal p l1 l2] returns [true] if [l1] and [l2] are equal. *)
[@@@endif]
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** [flat_map f l] maps and flattens at the same time (safe). Evaluation order is not guaranteed. *)
@ -384,7 +375,7 @@ val mguard : bool -> unit t
@since 3.1 *)
val return : 'a -> 'a t
(** [return x] is [x]. *)
(** [return x] is [[x]]. *)
val take : int -> 'a t -> 'a t
(** [take n l] takes the [n] first elements of the list [l], drop the rest. *)
@ -437,26 +428,28 @@ val find_pred : ('a -> bool) -> 'a t -> 'a option
or returns [None] if no element satisfies [p].
@since 0.11 *)
val find_opt : ('a -> bool) -> 'a t -> 'a option
(** [find_opt p l] is the safe version of {!find}.
@since 1.5, but only
@since 2.2 with labels *)
val find_pred_exn : ('a -> bool) -> 'a t -> 'a
(** [find_pred_exn p l] is the unsafe version of {!find_pred}.
@raise Not_found if no such element is found.
@since 0.11 *)
[@@@iflt 4.10]
val find_map : ('a -> 'b option) -> 'a t -> 'b option
(** [find_map f l] traverses [l], applying [f] to each element. If for
some element [x], [f x = Some y], then [Some y] is returned. Otherwise
the call returns [None].
@since 0.11 *)
[@@@endif]
[@@@iflt 5.1]
val find_mapi : (int -> 'a -> 'b option) -> 'a t -> 'b option
(** [find_mapi f l] is like {!find_map}, but also pass the index to the predicate function.
@since 0.11 *)
[@@@endif]
val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
and [p x] holds. Otherwise returns [None]. *)
@ -467,11 +460,6 @@ val remove : eq:('a -> 'a -> bool) -> key:'a -> 'a t -> 'a t
@since 0.11 *)
(* FIXME: the original CCList.mli uses ~x instead of ~key !! *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
(** [filter_map f l] is the sublist of [l] containing only elements for which
[f] returns [Some e].
Map and remove elements at the same time. *)
val keep_some : 'a option t -> 'a t
(** [keep_some l] retains only elements of the form [Some x].
Like [filter_map CCFun.id].
@ -574,16 +562,6 @@ val group_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list list
(** {2 Indices} *)
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
(** [mapi f l] is like {!map}, but the function [f] is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** [iteri f l] is like {!val-iter}, but the function [f] is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val iteri2 : (int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** [iteri2 f l1 l2] applies [f] to the two lists [l1] and [l2] simultaneously.
The integer passed to [f] indicates the index of element.
@ -758,14 +736,6 @@ val assoc_opt : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b option
@since 1.5, but only
@since 2.0 with labels *)
val assq_opt : 'a -> ('a * 'b) t -> 'b option
(** [assq_opt k alist] returns [Some v] if the given key [k] is present into [alist].
Like [Assoc.assoc_opt] but use physical equality instead of structural equality
to compare keys.
Safe version of {!assq}.
@since 1.5, but only
@since 2.0 with labels *)
val mem_assoc : ?eq:('a -> 'a -> bool) -> 'a -> ('a * _) t -> bool
(** [mem_assoc ?eq k alist] returns [true] iff [k] is a key in [alist].
Like [Assoc.mem].
@ -884,11 +854,6 @@ val to_iter : 'a t -> 'a iter
(** [to_iter l] returns a [iter] of the elements of the list [l].
@since 2.8 *)
val to_seq : 'a t -> 'a Seq.t
(** [to_seq l] returns a [Seq.t] of the elements of the list [l].
Renamed from [to_std_seq] since 3.0.
@since 3.0 *)
val of_iter : 'a iter -> 'a t
(** [of_iter iter] builds a list from a given [iter].
In the result, elements appear in the same order as they did in the source [iter].
@ -899,12 +864,6 @@ val of_seq_rev : 'a Seq.t -> 'a t
Renamed from [to_std_seq_rev] since 3.0.
@since 3.0 *)
val of_seq : 'a Seq.t -> 'a t
(** [of_seq seq] builds a list from a given [Seq.t].
In the result, elements appear in the same order as they did in the source [Seq.t].
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val to_gen : 'a t -> 'a gen
(** [to_gen l] returns a [gen] of the elements of the list [l]. *)

View file

@ -18,18 +18,18 @@ type 'a t = 'a list
val empty : 'a t
(** [empty] is [[]]. *)
[@@@iflt 5.1]
val is_empty : _ t -> bool
(** [is_empty l] returns [true] iff [l = []].
@since 0.11 *)
[@@@endif]
val map : f:('a -> 'b) -> 'a t -> 'b t
(** [map ~f [a0; a1; …; an]] applies function [f] in turn to [[a0; a1; …; an]].
Safe version of {!List.map}. *)
val cons : 'a -> 'a t -> 'a t
(** [cons x l] is [x::l].
@since 0.12 *)
val append : 'a t -> 'a t -> 'a t
(** [append l1 l2] returns the list that is the concatenation of [l1] and [l2].
Safe version of {!List.append}. *)
@ -160,11 +160,6 @@ val count_true_false : f:('a -> bool) -> 'a list -> int * int
that satisfy the predicate [f], and [int2] the number of elements that do not satisfy [f].
@since 2.4 *)
val init : int -> f:(int -> 'a) -> 'a t
(** [init len ~f] is [f 0; f 1; …; f (len-1)].
@raise Invalid_argument if len < 0.
@since 0.6 *)
val combine : 'a list -> 'b list -> ('a * 'b) list
(** [combine [a1; …; an] [b1; …; bn]] is [[(a1,b1); …; (an,bn)]].
Transform two lists into a list of pairs.
@ -194,25 +189,17 @@ val split : ('a * 'b) t -> 'a t * 'b t
@since 1.2, but only
@since 2.2 with labels *)
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
[@@@iflt 4.12]
val compare : cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** [compare cmp l1 l2] compares the two lists [l1] and [l2]
using the given comparison function [cmp]. *)
val compare_lengths : 'a t -> 'b t -> int
(** [compare_lengths l1 l2] compare the lengths of the two lists [l1] and [l2].
Equivalent to [compare (length l1) (length l2)] but more efficient.
@since 1.5, but only
@since 2.2 with labels *)
val compare_length_with : 'a t -> int -> int
(** [compare_length_with l x] compares the length of the list [l] to an integer [x].
Equivalent to [compare (length l) x] but more efficient.
@since 1.5, but only
@since 2.2 with labels *)
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val equal : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** [equal p l1 l2] returns [true] if [l1] and [l2] are equal. *)
[@@@endif]
val flat_map : f:('a -> 'b t) -> 'a t -> 'b t
(** [flat_map ~f l] maps and flattens at the same time (safe). Evaluation order is not guaranteed. *)
@ -470,26 +457,28 @@ val find_pred : f:('a -> bool) -> 'a t -> 'a option
or returns [None] if no element satisfies [f].
@since 0.11 *)
val find_opt : f:('a -> bool) -> 'a t -> 'a option
(** [find_opt ~f l] is the safe version of {!find}.
@since 1.5, but only
@since 2.2 with labels *)
val find_pred_exn : f:('a -> bool) -> 'a t -> 'a
(** [find_pred_exn ~f l] is the unsafe version of {!find_pred}.
@raise Not_found if no such element is found.
@since 0.11 *)
[@@@iflt 4.10]
val find_map : f:('a -> 'b option) -> 'a t -> 'b option
(** [find_map ~f l] traverses [l], applying [f] to each element. If for
some element [x], [f x = Some y], then [Some y] is returned. Otherwise
the call returns [None].
@since 0.11 *)
[@@@endif]
[@@@iflt 5.1]
val find_mapi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
(** [find_mapi ~f l] is like {!find_map}, but also pass the index to the predicate function.
@since 0.11 *)
[@@@endif]
val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option
(** [find_idx ~f x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
and [f x] holds. Otherwise returns [None]. *)
@ -501,11 +490,6 @@ val remove :
@since 0.11 *)
(* FIXME: the original CCList.mli uses ~x instead of ~key !! *)
val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
(** [filter_map ~f l] is the sublist of [l] containing only elements for which
[f] returns [Some e].
Map and remove elements at the same time. *)
val keep_some : 'a option t -> 'a t
(** [keep_some l] retains only elements of the form [Some x].
Like [filter_map CCFun.id].
@ -612,16 +596,6 @@ val group_succ : eq:(('a -> 'a -> bool)[@keep_label]) -> 'a list -> 'a list list
(** {2 Indices} *)
val mapi : f:(int -> 'a -> 'b) -> 'a t -> 'b t
(** [mapi ~f l] is like {!map}, but the function [f] is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val iteri : f:(int -> 'a -> unit) -> 'a t -> unit
(** [iteri ~f l] is like {!iter}, but the function [f] is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val iteri2 : f:(int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** [iteri2 ~f l1 l2] applies [f] to the two lists [l1] and [l2] simultaneously.
The integer passed to [f] indicates the index of element.
@ -900,11 +874,6 @@ val to_iter : 'a t -> 'a iter
(** [to_iter l] returns a [iter] of the elements of the list [l].
@since 2.8 *)
val to_seq : 'a t -> 'a Seq.t
(** [to_seq l] returns a [Seq.t] of the elements of the list [l].
Renamed from [to_std_seq] since 3.0.
@since 3.0 *)
val of_iter : 'a iter -> 'a t
(** [of_iter iter] builds a list from a given [iter].
In the result, elements appear in the same order as they did in the source [iter].
@ -915,12 +884,6 @@ val of_seq_rev : 'a Seq.t -> 'a t
Renamed from [of_std_seq_rev] since 3.0.
@since 3.0 *)
val of_seq : 'a Seq.t -> 'a t
(** [of_seq seq] builds a list from a given [Seq.t].
In the result, elements appear in the same order as they did in the source [Seq.t].
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val to_gen : 'a t -> 'a gen
(** [to_gen l] returns a [gen] of the elements of the list [l]. *)

View file

@ -20,47 +20,6 @@ module type S = sig
and returns [default] otherwise (if [k] doesn't belong in [m]).
@since 0.16 *)
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
(** [update k f m] calls [f (Some v)] if [find k m = v],
otherwise it calls [f None]. In any case, if the result is [None]
[k] is removed from [m], and if the result is [Some v'] then
[add k v' m] is returned. *)
val choose_opt : 'a t -> (key * 'a) option
(** [choose_opt m] returns one binding of the given map [m], or [None] if [m] is empty.
Safe version of {!choose}.
@since 1.5 *)
val min_binding_opt : 'a t -> (key * 'a) option
(** [min_binding_opt m] returns the smallest binding of the given map [m],
or [None] if [m] is empty.
Safe version of {!min_binding}.
@since 1.5 *)
val max_binding_opt : 'a t -> (key * 'a) option
(** [max_binding_opt m] returns the largest binding of the given map [m],
or [None] if [m] is empty.
Safe version of {!max_binding}.
@since 1.5 *)
val find_opt : key -> 'a t -> 'a option
(** [find_opt k m] returns [Some v] if the current binding of [k] in [m] is [v],
or [None] if the key [k] is not present.
Safe version of {!find}.
@since 1.5 *)
val find_first : (key -> bool) -> 'a t -> key * 'a
(** [find_first f m] where [f] is a monotonically increasing function, returns the binding of [m]
with the lowest key [k] such that [f k], or raises [Not_found] if no such key exists.
See {!Map.S.find_first}.
@since 1.5 *)
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
(** [find_first_opt f m] where [f] is a monotonically increasing function, returns an option containing
the binding of [m] with the lowest key [k] such that [f k], or [None] if no such key exists.
Safe version of {!find_first}.
@since 1.5 *)
val merge_safe :
f:(key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) ->
'a t ->
@ -69,24 +28,12 @@ module type S = sig
(** [merge_safe ~f a b] merges the maps [a] and [b] together.
@since 0.17 *)
val add_seq : 'a t -> (key * 'a) Seq.t -> 'a t
(** [add_seq m seq] adds the given [Seq.t] of bindings to the map [m].
Like {!add_list}.
Renamed from [add_std_seq] since 3.0.
@since 3.0 *)
val add_seq_with :
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> 'a t
(** [add_seq ~f m l] adds the given seq [l] of bindings to the map [m],
using [f] to combine values that have the same key.
@since 3.3 *)
val of_seq : (key * 'a) Seq.t -> 'a t
(** [of_seq seq] builds a map from the given [Seq.t] of bindings.
Like {!of_list}.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t
(** [of_seq_with ~f l] builds a map from the given seq [l] of bindings [k_i -> v_i],
added in order using {!add}.
@ -178,62 +125,6 @@ module Make (O : Map.OrderedType) = struct
(* backport functions from recent stdlib.
they will be shadowed by inclusion of [S] if present. *)
[@@@ocaml.warning "-32"]
let union f a b =
M.merge
(fun k v1 v2 ->
match v1, v2 with
| None, None -> assert false
| None, (Some _ as r) -> r
| (Some _ as r), None -> r
| Some v1, Some v2 -> f k v1 v2)
a b
let update k f m =
let x = try f (Some (M.find k m)) with Not_found -> f None in
match x with
| None -> M.remove k m
| Some v' -> M.add k v' m
let choose_opt m = try Some (M.choose m) with Not_found -> None
let find_opt k m = try Some (M.find k m) with Not_found -> None
let max_binding_opt m = try Some (M.max_binding m) with Not_found -> None
let min_binding_opt m = try Some (M.min_binding m) with Not_found -> None
exception Find_binding_exit
let find_first_opt f m =
let res = ref None in
try
M.iter
(fun k v ->
if f k then (
res := Some (k, v);
raise Find_binding_exit
))
m;
None
with Find_binding_exit -> !res
let find_first f m =
match find_first_opt f m with
| None -> raise Not_found
| Some (k, v) -> k, v
(* linear time, must traverse the whole map… *)
let find_last_opt f m =
let res = ref None in
M.iter (fun k v -> if f k then res := Some (k, v)) m;
!res
let find_last f m =
match find_last_opt f m with
| None -> raise Not_found
| Some (k, v) -> k, v
[@@@ocaml.warning "+32"]
(* === include M.
This will shadow some values depending on OCaml's current version
=== *)
@ -253,11 +144,6 @@ module Make (O : Map.OrderedType) = struct
| Some v1, Some v2 -> f k (`Both (v1, v2)))
a b
let add_seq m s =
let m = ref m in
Seq.iter (fun (k, v) -> m := add k v !m) s;
!m
let add_seq_with ~f m s =
let combine k v = function
| None -> Some v
@ -265,7 +151,6 @@ module Make (O : Map.OrderedType) = struct
in
Seq.fold_left (fun m (k, v) -> update k (combine k v) m) m s
let of_seq s = add_seq empty s
let of_seq_with ~f s = add_seq_with ~f empty s
let add_iter m s =
@ -296,10 +181,20 @@ module Make (O : Map.OrderedType) = struct
in
List.fold_left (fun m (k, v) -> update k (combine k v) m) m l
[@@@iflt 5.1]
let of_list l = add_list empty l
[@@@endif]
let of_list_with ~f l = add_list_with ~f empty l
[@@@iflt 5.1]
let to_list m = fold (fun k v acc -> (k, v) :: acc) m []
[@@@endif]
let pp ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ())
?(pp_arrow = fun fmt () -> Format.fprintf fmt "@ -> ")
?(pp_sep = fun fmt () -> Format.fprintf fmt ",@ ") pp_k pp_v fmt m =

View file

@ -16,6 +16,7 @@ module type OrderedType = Map.OrderedType
module type S = sig
include Map.S
(** @inline *)
val get : key -> 'a t -> 'a option
(** [get k m] returns [Some v] if the current binding of [k] in [m] is [v],
@ -27,47 +28,6 @@ module type S = sig
and returns [default] otherwise (if [k] doesn't belong in [m]).
@since 0.16 *)
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
(** [update k f m] calls [f (Some v)] if [find k m = v],
otherwise it calls [f None]. In any case, if the result is [None]
[k] is removed from [m], and if the result is [Some v'] then
[add k v' m] is returned. *)
val choose_opt : 'a t -> (key * 'a) option
(** [choose_opt m] returns one binding of the given map [m], or [None] if [m] is empty.
Safe version of {!choose}.
@since 1.5 *)
val min_binding_opt : 'a t -> (key * 'a) option
(** [min_binding_opt m] returns the smallest binding of the given map [m],
or [None] if [m] is empty.
Safe version of {!min_binding}.
@since 1.5 *)
val max_binding_opt : 'a t -> (key * 'a) option
(** [max_binding_opt m] returns the largest binding of the given map [m],
or [None] if [m] is empty.
Safe version of {!max_binding}.
@since 1.5 *)
val find_opt : key -> 'a t -> 'a option
(** [find_opt k m] returns [Some v] if the current binding of [k] in [m] is [v],
or [None] if the key [k] is not present.
Safe version of {!find}.
@since 1.5 *)
val find_first : (key -> bool) -> 'a t -> key * 'a
(** [find_first f m] where [f] is a monotonically increasing function, returns the binding of [m]
with the lowest key [k] such that [f k], or raises [Not_found] if no such key exists.
See {!Map.S.find_first}.
@since 1.5 *)
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
(** [find_first_opt f m] where [f] is a monotonically increasing function, returns an option containing
the binding of [m] with the lowest key [k] such that [f k], or [None] if no such key exists.
Safe version of {!find_first}.
@since 1.5 *)
val merge_safe :
f:(key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) ->
'a t ->
@ -76,12 +36,6 @@ module type S = sig
(** [merge_safe ~f a b] merges the maps [a] and [b] together.
@since 0.17 *)
val add_seq : 'a t -> (key * 'a) Seq.t -> 'a t
(** [add_seq m seq] adds the given [Seq.t] of bindings to the map [m].
Like {!add_list}.
Renamed from [add_std_seq] since 3.0.
@since 3.0 *)
val add_seq_with :
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> 'a t
(** [add_seq ~f m l] adds the given seq [l] of bindings to the map [m],
@ -91,12 +45,6 @@ module type S = sig
later in the seq than [v2].
@since 3.3 *)
val of_seq : (key * 'a) Seq.t -> 'a t
(** [of_seq seq] builds a map from the given [Seq.t] of bindings.
Like {!of_list}.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t
(** [of_seq_with ~f l] builds a map from the given seq [l] of bindings [k_i -> v_i],
added in order using {!add}.

View file

@ -2,8 +2,13 @@
include Nativeint
[@@@iflt 4.13]
let min : t -> t -> t = Stdlib.min
let max : t -> t -> t = Stdlib.max
[@@@endif]
let hash x = Stdlib.abs (to_int x)
let sign i = compare i zero
@ -95,8 +100,7 @@ let random_range i j st = add i (random (sub j i) st)
(** {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
let of_string = of_string_opt
let most_significant_bit = logxor (neg 1n) (shift_right_logical (neg 1n) 1)
type output = char -> unit

View file

@ -2,14 +2,14 @@
(** 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
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].
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 *)
@ -18,6 +18,7 @@
include module type of struct
include Nativeint
end
(** @inline *)
val min : t -> t -> t
(** [min x y] returns the minimum of the two integers [x] and [y].
@ -117,7 +118,7 @@ val pp_binary : t printer
module Infix : sig
val ( + ) : t -> t -> t
(** [x + y] is the sum of [x] and [y].
(** [x + y] is the sum of [x] and [y].
Addition. *)
val ( - ) : t -> t -> t

View file

@ -2,11 +2,7 @@
(** {1 Options} *)
type 'a t = 'a option
let[@inline] map f = function
| None -> None
| Some x -> Some (f x)
include Option
let map_or ~default f = function
| None -> default
@ -16,30 +12,7 @@ let map_lazy default_fn f = function
| None -> default_fn ()
| Some x -> f x
let is_some = function
| None -> false
| Some _ -> true
let is_none = function
| None -> true
| Some _ -> false
let compare f o1 o2 =
match o1, o2 with
| None, None -> 0
| Some _, None -> 1
| None, Some _ -> -1
| Some x, Some y -> f x y
let equal f o1 o2 =
match o1, o2 with
| None, None -> true
| Some _, None | None, Some _ -> false
| Some x, Some y -> f x y
let return x = Some x
let some = return
let none = None
let[@inline] flat_map f o =
match o with
@ -51,7 +24,6 @@ let[@inline] flat_map_l f o =
| None -> []
| Some x -> f x
let[@inline] bind o f = flat_map f o
let ( >>= ) = bind
let pure x = Some x
let k_compose f g x = f x |> flat_map g
@ -99,11 +71,6 @@ let for_all p = function
| None -> true
| Some x -> p x
let iter f o =
match o with
| None -> ()
| Some x -> f x
let fold f acc o =
match o with
| None -> acc
@ -121,11 +88,6 @@ let apply_or f x =
let ( |?> ) x f = apply_or f x
let value x ~default =
match x with
| None -> default
| Some y -> y
let get_exn = function
| Some x -> x
| None -> invalid_arg "CCOption.get_exn"
@ -164,11 +126,6 @@ let wrap2 ?(handler = fun _ -> true) f x y =
else
raise e
let to_list o =
match o with
| None -> []
| Some x -> [ x ]
let of_list = function
| x :: _ -> Some x
| [] -> None
@ -254,11 +211,6 @@ let to_iter o k =
| None -> ()
| Some x -> k x
let to_seq o () =
match o with
| None -> Seq.Nil
| Some x -> Seq.Cons (x, Seq.empty)
let pp ppx out = function
| None -> Format.pp_print_string out "None"
| Some x -> Format.fprintf out "@[Some %a@]" ppx x

View file

@ -5,10 +5,8 @@
This module replaces `CCOpt`.
@since 3.6 *)
type +'a t = 'a option
val map : ('a -> 'b) -> 'a t -> 'b t
(** [map f o] applies the function [f] to the element inside [o], if any. *)
include module type of Option
(** @inline *)
val map_or : default:'b -> ('a -> 'b) -> 'a t -> 'b
(** [map_or ~default f o] is [f x] if [o = Some x], [default] otherwise.
@ -18,33 +16,9 @@ val map_lazy : (unit -> 'b) -> ('a -> 'b) -> 'a t -> 'b
(** [map_lazy default_fn f o] is [f x] if [o = Some x], [default_fn ()] otherwise.
@since 1.2 *)
val is_some : _ t -> bool
(** [is_some (Some x)] returns [true] otherwise it returns [false]. *)
val is_none : _ t -> bool
(** [is_none None] returns [true] otherwise it returns [false].
@since 0.11 *)
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
(** [compare comp o1 o2] compares two options [o1] and [o2],
using custom comparators [comp] for the value.
[None] is always assumed to be less than [Some _]. *)
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** [equal p o1 o2] tests for equality between option types [o1] and [o2],
using a custom equality predicate [p]. *)
val return : 'a -> 'a t
(** [return x] is a monadic return, that is [return x = Some x]. *)
val some : 'a -> 'a t
(** Alias to {!return}.
@since 3.5 *)
val none : 'a t
(** Alias to {!None}.
@since 3.5 *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** [flat_map f o] is equivalent to {!map} followed by {!flatten}.
Flip version of {!(>>=)}. *)
@ -53,11 +27,6 @@ val flat_map_l : ('a -> 'b list) -> 'a t -> 'b list
(** [flat_map_l f o] is [[]] if [o] is [None], or [f x] if [o] is [Some x].
@since 3.12 *)
val bind : 'a t -> ('a -> 'b t) -> 'b t
(** [bind o f] is [f v] if [o] is [Some v], [None] otherwise.
Monadic bind.
@since 3.0 *)
val k_compose : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t
(** Kleisli composition. Monadic equivalent of {!CCFun.compose}
@since 3.13.1 *)
@ -65,9 +34,6 @@ val k_compose : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** [map2 f o1 o2] maps ['a option] and ['b option] to a ['c option] using [f]. *)
val iter : ('a -> unit) -> 'a t -> unit
(** [iter f o] applies [f] to [o]. Iterate on 0 or 1 element. *)
val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** [fold f init o] is [f init x] if [o] is [Some x], or [init] if [o] is [None].
Fold on 0 or 1 element. *)
@ -102,10 +68,6 @@ val apply_or : ('a -> 'a t) -> 'a -> 'a
turning functions like "remove" into "remove_if_it_exists".
@since 3.13.1 *)
val value : 'a t -> default:'a -> 'a
(** [value o ~default] is similar to the Stdlib's [Option.value] and to {!get_or}.
@since 2.8 *)
val get_exn : 'a t -> 'a
[@@ocaml.deprecated "use CCOption.get_exn_or instead"]
(** [get_exn o] returns [x] if [o] is [Some x] or fails if [o] is [None].
@ -207,9 +169,6 @@ include module type of Infix
(** {2 Conversion and IO} *)
val to_list : 'a t -> 'a list
(** [to_list o] returns [[x]] if [o] is [Some x] or the empty list [[]] if [o] is [None]. *)
val of_list : 'a list -> 'a t
(** [of_list l] returns [Some x] (x being the head of the list l), or [None] if [l] is the empty list. *)
@ -246,13 +205,6 @@ val to_gen : 'a t -> 'a gen
(** [to_gen o] is [o] as a [gen]. [Some x] is the singleton [gen] containing [x]
and [None] is the empty [gen]. *)
val to_seq : 'a t -> 'a Seq.t
(** [to_seq o] is [o] as a sequence [Seq.t]. [Some x] is the singleton sequence containing [x]
and [None] is the empty sequence.
Same as {!Stdlib.Option.to_seq}
Renamed from [to_std_seq] since 3.0.
@since 3.0 *)
val to_iter : 'a t -> 'a iter
(** [to_iter o] returns an internal iterator, like in the library [Iter].
@since 2.8 *)

View file

@ -2,27 +2,53 @@
(** {1 Tuple Functions} *)
[@@@ifge 5.4]
include Pair
[@@@else_]
type ('a, 'b) t = 'a * 'b
let make x y = x, y
let fst = fst
let snd = snd
let swap (x, y) = y, x
let map_fst f (x, y) = f x, y
let map_snd f (x, y) = x, f y
let map f g (x, y) = f x, g y
[@@@endif]
let map_same f (x, y) = f x, f y
let map2 f g (a, b) (x, y) = f a x, g b y
let map_same2 f (a, b) (x, y) = f a x, f b y
let fst_map f (x, _) = f x
let snd_map f (_, x) = f x
[@@@iflt 5.4]
let iter f (x, y) = f x y
let swap (x, y) = y, x
[@@@endif]
let ( <<< ) = map_fst
let ( >>> ) = map_snd
let ( *** ) = map
let ( &&& ) f g x = f x, g x
let merge f (x, y) = f x y
[@@@iflt 5.4]
let fold = merge
[@@@endif]
let dup x = x, x
let dup_map f x = x, f x
[@@@iflt 5.4]
let equal f g (x1, y1) (x2, y2) = f x1 x2 && g y1 y2
let compare f g (x1, y1) (x2, y2) =
@ -32,6 +58,8 @@ let compare f g (x1, y1) (x2, y2) =
else
g y1 y2
[@@@endif]
let to_string ?(sep = ", ") a_to_string b_to_string (x, y) =
Printf.sprintf "%s%s%s" (a_to_string x) sep (b_to_string y)

View file

@ -2,12 +2,28 @@
(** Tuple Functions *)
[@@@ifge 5.4]
include module type of Pair
(** @inline *)
[@@@else_]
type ('a, 'b) t = 'a * 'b
val make : 'a -> 'b -> ('a, 'b) t
(** Make a tuple from its components.
@since 0.16 *)
val fst : 'a * 'b -> 'a
(** [fst (a, b)] returns [a] *)
val snd : 'a * 'b -> 'b
(** [snd (a, b)] returns [b] *)
val swap : 'a * 'b -> 'b * 'a
(** Swap the components of the tuple. *)
val map_fst : ('a -> 'b) -> 'a * 'c -> 'b * 'c
(** [map_fst f (x, y)] returns [(f x, y)].
Renamed from [map1] since 3.0. *)
@ -19,6 +35,8 @@ val map_snd : ('a -> 'b) -> 'c * 'a -> 'c * 'b
val map : ('a -> 'c) -> ('b -> 'd) -> 'a * 'b -> 'c * 'd
(** Synonym to {!( *** )}. Map on both sides of a tuple. *)
[@@@endif]
val map_same : ('a -> 'b) -> 'a * 'a -> 'b * 'b
(** Like {!map} but specialized for pairs with elements of the same type. *)
@ -45,10 +63,11 @@ val snd_map : ('a -> 'b) -> _ * 'a -> 'b
Rename from [map_snd] since 3.0.
@since 0.3.3 *)
[@@@iflt 5.4]
val iter : ('a -> 'b -> unit) -> 'a * 'b -> unit
val swap : 'a * 'b -> 'b * 'a
(** Swap the components of the tuple. *)
[@@@endif]
val ( <<< ) : ('a -> 'b) -> 'a * 'c -> 'b * 'c
(** Map on the left side of the tuple. *)
@ -66,10 +85,14 @@ val ( &&& ) : ('a -> 'b) -> ('a -> 'c) -> 'a -> 'b * 'c
val merge : ('a -> 'b -> 'c) -> 'a * 'b -> 'c
(** Uncurrying (merges the two components of a tuple). *)
[@@@iflt 5.4]
val fold : ('a -> 'b -> 'c) -> 'a * 'b -> 'c
(** Synonym to {!merge}.
@since 0.3.3 *)
[@@@endif]
val dup : 'a -> 'a * 'a
(** [dup x = (x,x)] (duplicate the value).
@since 0.3.3 *)
@ -79,12 +102,16 @@ val dup_map : ('a -> 'b) -> 'a -> 'a * 'b
to the second copy.
@since 0.3.3 *)
[@@@iflt 5.4]
val equal :
('a -> 'a -> bool) -> ('b -> 'b -> bool) -> 'a * 'b -> 'a * 'b -> bool
val compare :
('a -> 'a -> int) -> ('b -> 'b -> int) -> 'a * 'b -> 'a * 'b -> int
[@@@endif]
val to_string :
?sep:string -> ('a -> string) -> ('b -> string) -> 'a * 'b -> string
(** Print tuple in a string

View file

@ -9,13 +9,7 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Basics} *)
type nonrec (+'good, +'bad) result = ('good, 'bad) result =
| Ok of 'good
| Error of 'bad
type (+'good, +'bad) t = ('good, 'bad) result =
| Ok of 'good
| Error of 'bad
include Result
let return x = Ok x
let fail s = Error s
@ -65,30 +59,14 @@ let opt_map f e =
| Ok x -> Ok (Some x)
| Error e -> Error e)
let map f e =
match e with
| Ok x -> Ok (f x)
| Error s -> Error s
let map_err f e =
match e with
| Ok _ as res -> res
| Error y -> Error (f y)
let map_err = map_error
let map2 f g e =
match e with
| Ok x -> Ok (f x)
| Error s -> Error (g s)
let iter f e =
match e with
| Ok x -> f x
| Error _ -> ()
let iter_err f e =
match e with
| Ok _ -> ()
| Error err -> f err
let iter_err = iter_error
exception Get_error
@ -132,6 +110,13 @@ let flat_map f e =
| Ok x -> f x
| Error s -> Error s
[@@@iflt 5.4]
let retract = function
| Ok v | Error v -> v
[@@@endif]
let k_compose f g x = f x |> flat_map g
let ( >=> ) = k_compose
let ( <=< ) f g = g >=> f
@ -149,24 +134,11 @@ let compare ~err cmp a b =
| _, Ok _ -> -1
| Error s, Error s' -> err s s'
let fold ~ok ~error x =
match x with
| Ok x -> ok x
| Error s -> error s
let fold_ok f acc r =
match r with
| Ok x -> f acc x
| Error _ -> acc
let is_ok = function
| Ok _ -> true
| Error _ -> false
let is_error = function
| Ok _ -> false
| Error _ -> true
(** {2 Wrappers} *)
let guard f = try Ok (f ()) with e -> Error e
@ -185,18 +157,18 @@ let ( <*> ) f x =
| Error s -> fail s
| Ok f -> map f x
let join t =
match t with
| Ok (Ok o) -> Ok o
| Ok (Error e) -> Error e
| Error _ as e -> e
[@@@iflt 5.4]
let both x y =
let product x y =
match x, y with
| Ok o, Ok o' -> Ok (o, o')
| Ok _, Error e -> Error e
| Error e, _ -> Error e
[@@@endif]
let both = product
(** {2 Collections} *)
let map_l f l =
@ -331,19 +303,12 @@ end
(** {2 Conversions} *)
let to_opt = function
| Ok x -> Some x
| Error _ -> None
let to_opt = to_option
let of_opt = function
| None -> Error "of_opt"
| Some x -> Ok x
let to_seq e () =
match e with
| Ok x -> Seq.Cons (x, Seq.empty)
| Error _ -> Seq.Nil
let to_iter e k =
match e with
| Ok x -> k x

View file

@ -16,13 +16,8 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Basics} *)
type nonrec (+'good, +'bad) result = ('good, 'bad) result =
| Ok of 'good
| Error of 'bad
type (+'good, +'bad) t = ('good, 'bad) result =
| Ok of 'good
| Error of 'bad
include module type of Result
(** @inline *)
val return : 'a -> ('a, 'err) t
(** Successfully return a value. *)
@ -68,22 +63,15 @@ val opt_map : ('a -> ('b, 'c) t) -> 'a option -> ('b option, 'c) t
(** Map a fallible operation through an option.
@since 3.7 *)
val map : ('a -> 'b) -> ('a, 'err) t -> ('b, 'err) t
(** Map on success. *)
val map_err : ('err1 -> 'err2) -> ('a, 'err1) t -> ('a, 'err2) t
(** Map on the error variant. *)
(** Alias of [map_error] *)
val map2 : ('a -> 'b) -> ('err1 -> 'err2) -> ('a, 'err1) t -> ('b, 'err2) t
(** Like {!map}, but also with a function that can transform
the error message in case of failure. *)
val iter : ('a -> unit) -> ('a, _) t -> unit
(** Apply the function only in case of [Ok]. *)
val iter_err : ('err -> unit) -> (_, 'err) t -> unit
(** Apply the function in case of [Error].
@since 2.4 *)
(** Alias of {!iter_error} *)
exception Get_error
@ -120,6 +108,13 @@ val catch : ('a, 'err) t -> ok:('a -> 'b) -> err:('err -> 'b) -> 'b
val flat_map : ('a -> ('b, 'err) t) -> ('a, 'err) t -> ('b, 'err) t
[@@@iflt 5.4]
val retract : ('a, 'a) t -> 'a
(** [retract r] collapse [r] to [v] if [r] is either [Ok v] or [Error v]. *)
[@@@endif]
val k_compose :
('a -> ('b, 'err) t) -> ('b -> ('c, 'err) t) -> 'a -> ('c, 'err) t
(** Kleisli composition. Monadic equivalent of {!CCFun.compose}.
@ -128,23 +123,11 @@ val k_compose :
val equal : err:'err equal -> 'a equal -> ('a, 'err) t equal
val compare : err:'err ord -> 'a ord -> ('a, 'err) t ord
val fold : ok:('a -> 'b) -> error:('err -> 'b) -> ('a, 'err) t -> 'b
(** [fold ~ok ~error e] opens [e] and, if [e = Ok x], returns
[ok x], otherwise [e = Error s] and it returns [error s]. *)
val fold_ok : ('a -> 'b -> 'a) -> 'a -> ('b, _) t -> 'a
(** [fold_ok f acc r] will compute [f acc x] if [r=Ok x],
and return [acc] otherwise, as if the result were a mere option.
@since 1.2 *)
val is_ok : ('a, 'err) t -> bool
(** Return true if [Ok].
@since 1.0 *)
val is_error : ('a, 'err) t -> bool
(** Return true if [Error].
@since 1.0 *)
(** {2 Wrappers} *)
val guard : (unit -> 'a) -> ('a, exn) t
@ -172,15 +155,18 @@ val wrap3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> ('d, exn) t
val pure : 'a -> ('a, 'err) t
(** Synonym of {!return}. *)
val join : (('a, 'err) t, 'err) t -> ('a, 'err) t
(** [join t], in case of success, returns [Ok o] from [Ok (Ok o)]. Otherwise,
it fails with [Error e] where [e] is the unwrapped error of [t]. *)
[@@@iflt 5.4]
val both : ('a, 'err) t -> ('b, 'err) t -> ('a * 'b, 'err) t
(** [both a b], in case of success, returns [Ok (o, o')] with the ok values
val product : ('a, 'err) t -> ('b, 'err) t -> ('a * 'b, 'err) t
(** [product a b], in case of success, returns [Ok (o, o')] with the ok values
of [a] and [b]. Otherwise, it fails, and the error of [a] is chosen over the
error of [b] if both fail. *)
[@@@endif]
val both : ('a, 'err) t -> ('b, 'err) t -> ('a * 'b, 'err) t
(** Alias of {!product} *)
(** {2 Infix} *)
module Infix : sig
@ -279,7 +265,7 @@ end
(** {2 Conversions} *)
val to_opt : ('a, _) t -> 'a option
(** Convert a result to an option. *)
(** Alias of {!to_option} *)
val of_opt : 'a option -> ('a, string) t
(** [of_opt opt] converts [Some v] to [Ok v] and [None] to [Error "of_opt"].*)
@ -287,10 +273,6 @@ val of_opt : 'a option -> ('a, string) t
val to_iter : ('a, _) t -> 'a iter
(** @since 2.8 *)
val to_seq : ('a, _) t -> 'a Seq.t
(** Renamed from [to_std_seq] since 3.0.
@since 3.0 *)
type ('a, 'b) error =
[ `Ok of 'a
| `Error of 'b

View file

@ -9,10 +9,19 @@ type 'a printer = Format.formatter -> 'a -> unit
include Seq
let nil () = Nil
[@@@iflt 4.11]
let cons a b () = Cons (a, b)
let empty = nil
[@@@endif]
[@@@iflt 5.4]
let singleton x () = Cons (x, nil)
[@@@endif]
[@@@iflt 4.11]
let init n f =
let rec aux i () =
if i >= n then
@ -22,6 +31,8 @@ let init n f =
in
aux 0
[@@@endif]
let rec _forever x () = Cons (x, _forever x)
let rec _repeat n x () =
@ -37,11 +48,15 @@ let repeat ?n x =
let rec forever f () = Cons (f (), forever f)
[@@@iflt 4.14]
let is_empty l =
match l () with
| Nil -> true
| Cons _ -> false
[@@@endif]
let head_exn l =
match l () with
| Nil -> raise Not_found
@ -62,11 +77,15 @@ let tail l =
| Nil -> None
| Cons (_, l) -> Some l
[@@@iflt 4.14]
let uncons l =
match l () with
| Nil -> None
| Cons (h, t) -> Some (h, t)
[@@@endif]
let rec equal eq l1 l2 =
match l1 (), l2 () with
| Nil, Nil -> true
@ -100,14 +119,9 @@ let foldi f acc res =
in
aux acc 0 res
let fold_lefti = foldi
[@@@iflt 4.14]
let rec iter f l =
match l () with
| Nil -> ()
| Cons (x, l') ->
f x;
iter f l'
let fold_lefti = foldi
let iteri f l =
let rec aux f l i =
@ -151,11 +165,6 @@ let rec drop_while p l () =
| Cons (x, l') when p x -> drop_while p l' ()
| Cons _ as res -> res
let rec map f l () =
match l () with
| Nil -> Nil
| Cons (x, l') -> Cons (f x, map f l')
let mapi f l =
let rec aux f l i () =
match l () with
@ -164,36 +173,55 @@ let mapi f l =
in
aux f l 0
let rec fmap f (l : 'a t) () =
match l () with
| Nil -> Nil
| Cons (x, l') ->
(match f x with
| None -> fmap f l' ()
| Some y -> Cons (y, fmap f l'))
[@@@endif]
[@@@iflt 5.4]
let rec filter p l () =
match l () with
| Nil -> Nil
| Cons (x, l') ->
if p x then
Cons (x, filter p l')
else
filter p l' ()
let filteri f l =
let rec aux f l i () =
match l () with
| Nil -> Nil
| Cons (x, tl) ->
if f i x then
Cons (x, aux f tl (i + 1))
else
aux f tl (i + 1) ()
in
aux f l 0
[@@@endif]
let fmap = filter_map
[@@@iflt 4.11]
let rec append l1 l2 () =
match l1 () with
| Nil -> l2 ()
| Cons (x, l1') -> Cons (x, append l1' l2)
let rec cycle l () = append l (cycle l) ()
[@@@endif]
[@@@iflt 4.14]
let rec cycle l =
if is_empty l then
l
else
fun () ->
append l (cycle l) ()
let rec iterate f a () = Cons (a, iterate f (f a))
[@@@endif]
[@@@iflt 4.11]
let rec unfold f acc () =
match f acc with
| None -> Nil
| Some (x, acc') -> Cons (x, unfold f acc')
[@@@endif]
[@@@iflt 4.14]
let rec for_all p l =
match l () with
| Nil -> true
@ -221,6 +249,35 @@ let rec find_map f l =
| None -> find_map f tl
| e -> e)
[@@@endif]
[@@@iflt 5.1]
let find_index p l =
let rec aux i l =
match l () with
| Nil -> None
| Cons (x, tl) ->
if p x then
Some i
else
aux (i + 1) tl
in
aux 0 l
let find_mapi f l =
let rec aux i l =
match l () with
| Nil -> None
| Cons (x, tl) ->
(match f i x with
| Some _ as res -> res
| None -> aux (i + 1) tl)
in
aux 0 l
[@@@endif]
[@@@iflt 5.1]
let rec scan f acc res () =
Cons
( acc,
@ -229,18 +286,13 @@ let rec scan f acc res () =
| Nil -> Nil
| Cons (s, cont) -> scan f (f acc s) cont () )
let rec flat_map f l () =
match l () with
| Nil -> Nil
| Cons (x, l') -> _flat_map_app f (f x) l' ()
and _flat_map_app f l l' () =
match l () with
| Nil -> flat_map f l' ()
| Cons (x, tl) -> Cons (x, _flat_map_app f tl l')
[@@@endif]
[@@@iflt 4.13]
let concat_map = flat_map
[@@@endif]
let product_with f l1 l2 =
let rec _next_left h1 tl1 h2 tl2 () =
match tl1 () with
@ -264,6 +316,8 @@ let product_with f l1 l2 =
in
_next_left [] l1 [] l2
[@@@iflt 4.14]
let map_product = product_with
let product l1 l2 = product_with (fun x y -> x, y) l1 l2
@ -273,6 +327,8 @@ let rec group eq l () =
| Cons (x, l') ->
Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l'))
[@@@endif]
let rec _uniq eq prev l () =
match prev, l () with
| _, Nil -> Nil
@ -285,16 +341,13 @@ let rec _uniq eq prev l () =
let uniq eq l = _uniq eq None l
let rec filter_map f l () =
match l () with
| Nil -> Nil
| Cons (x, l') ->
(match f x with
| None -> filter_map f l' ()
| Some y -> Cons (y, filter_map f l'))
[@@@iflt 4.13]
let flatten l = flat_map (fun x -> x) l
let concat = flatten
let concat l = flat_map (fun x -> x) l
[@@@endif]
let flatten = concat
let range i j =
let rec aux i j () =
@ -317,12 +370,18 @@ let ( --^ ) i j =
else
range i (j + 1)
let rec fold2 f acc l1 l2 =
[@@@iflt 4.14]
let rec fold_left2 f acc l1 l2 =
match l1 (), l2 () with
| Nil, _ | _, Nil -> acc
| Cons (x1, l1'), Cons (x2, l2') -> fold2 f (f acc x1 x2) l1' l2'
| Cons (x1, l1'), Cons (x2, l2') -> fold_left2 f (f acc x1 x2) l1' l2'
let fold_left2 = fold2
[@@@endif]
let fold2 = fold_left2
[@@@iflt 4.14]
let rec map2 f l1 l2 () =
match l1 (), l2 () with
@ -346,17 +405,21 @@ let rec exists2 f l1 l2 =
| Nil, _ | _, Nil -> false
| Cons (x1, l1'), Cons (x2, l2') -> f x1 x2 || exists2 f l1' l2'
let rec merge cmp l1 l2 () =
let rec sorted_merge cmp l1 l2 () =
match l1 (), l2 () with
| Nil, tl2 -> tl2
| tl1, Nil -> tl1
| Cons (x1, l1'), Cons (x2, l2') ->
if cmp x1 x2 < 0 then
Cons (x1, merge cmp l1' l2)
Cons (x1, sorted_merge cmp l1' l2)
else
Cons (x2, merge cmp l1 l2')
Cons (x2, sorted_merge cmp l1 l2')
let sorted_merge = merge
[@@@endif]
let merge = sorted_merge
[@@@iflt 4.14]
let rec zip a b () =
match a (), b () with
@ -377,6 +440,8 @@ let unzip l =
let split = unzip
[@@@endif]
let zip_i seq =
let rec loop i seq () =
match seq () with
@ -387,7 +452,6 @@ let zip_i seq =
(** {2 Implementations} *)
let return x () = Cons (x, nil)
let pure = return
let ( >>= ) xs f = flat_map f xs
let ( >|= ) xs f = map f xs
@ -530,11 +594,15 @@ let rec memoize f =
(** {2 Fair Combinations} *)
[@@@iflt 4.14]
let rec interleave a b () =
match a () with
| Nil -> b ()
| Cons (x, tail) -> Cons (x, interleave b tail)
[@@@endif]
let rec fair_flat_map f a () =
match a () with
| Nil -> Nil

View file

@ -17,38 +17,60 @@ include module type of Seq
(** @inline *)
val nil : 'a t
val empty : 'a t
[@@@iflt 4.11]
val cons : 'a -> 'a t -> 'a t
[@@@endif]
[@@@iflt 5.4]
val singleton : 'a -> 'a t
[@@@endif]
[@@@iflt 4.14]
val init : int -> (int -> 'a) -> 'a t
(** [init n f] corresponds to the sequence [f 0; f 1; ...; f (n-1)].
@raise Invalid_argument if n is negative.
@since 3.10 *)
[@@@endif]
val repeat : ?n:int -> 'a -> 'a t
(** [repeat ~n x] repeats [x] [n] times then stops. If [n] is omitted,
then [x] is repeated forever. *)
[@@@iflt 4.14]
val forever : (unit -> 'a) -> 'a t
(** [forever f] corresponds to the infinite sequence containing all the [f ()].
@since 3.10 *)
val cycle : 'a t -> 'a t
(** Cycle through the iterator infinitely. The iterator shouldn't be empty. *)
(** Cycle through the sequence infinitely. The sequence should be persistent.
@since NEXT_RELEASE the sequence can be empty, in this case cycle return an empty sequence. *)
val iterate : ('a -> 'a) -> 'a -> 'a t
(** [iterate f a] corresponds to the infinite sequence containing [a], [f a], [f (f a)],
...
@since 3.10 *)
[@@@endif]
[@@@iflt 4.11]
val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
(** [unfold f acc] calls [f acc] and:
- if [f acc = Some (x, acc')], yield [x], continue with [unfold f acc'].
- if [f acc = None], stops. *)
[@@@endif]
[@@@iflt 4.14]
val is_empty : 'a t -> bool
(** [is_empty xs] checks in the sequence [xs] is empty *)
(** [is_empty xs] checks in the sequence [xs] is empty. [is_empty] acces the first element of the sequence, this can causes issue if the sequence is ephemeral. *)
[@@@endif]
val head : 'a t -> 'a option
(** Head of the list. *)
@ -64,10 +86,14 @@ val tail_exn : 'a t -> 'a t
(** Unsafe version of {!tail}.
@raise Not_found if the list is empty. *)
[@@@iflt 4.14]
val uncons : 'a t -> ('a * 'a t) option
(** [uncons xs] return [None] if [xs] is empty other
@since 3.10 *)
[@@@endif]
val equal : 'a equal -> 'a t equal
(** Equality step by step. Eager. *)
@ -86,12 +112,12 @@ val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
0) and [x] is the element of the sequence.
@since 3.10 *)
[@@@iflt 4.14]
val fold_lefti : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** Alias of {!foldi}.
@since 3.10 *)
val iter : ('a -> unit) -> 'a t -> unit
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Iterate with index (starts at 0). *)
@ -104,19 +130,33 @@ val take : int -> 'a t -> 'a t
val take_while : ('a -> bool) -> 'a t -> 'a t
val drop : int -> 'a t -> 'a t
val drop_while : ('a -> bool) -> 'a t -> 'a t
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
(** Map with index (starts at 0). *)
[@@@endif]
[@@@iflt 5.4]
val filteri : (int -> 'a -> bool) -> 'a t -> 'a t
(** Similar to {!filter} but the predicate takes aditionally the index of the elements. *)
[@@@endif]
val fmap : ('a -> 'b option) -> 'a t -> 'b t
val filter : ('a -> bool) -> 'a t -> 'a t
(** Alias of {!filter_map}. *)
[@@@iflt 4.11]
val append : 'a t -> 'a t -> 'a t
[@@@endif]
val product_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Fair product of two (possibly infinite) lists into a new list. Lazy.
The first parameter is used to combine each pair of elements. *)
[@@@iflt 4.14]
val map_product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Alias of {!product_with}.
@since 3.10 *)
@ -129,11 +169,15 @@ val group : 'a equal -> 'a t -> 'a t t
For instance [group (=) [1;1;1;2;2;3;3;1]] yields
[[1;1;1]; [2;2]; [3;3]; [1]]. *)
[@@@endif]
val uniq : 'a equal -> 'a t -> 'a t
(** [uniq eq l] returns [l] but removes consecutive duplicates. Lazy.
In other words, if several values that are equal follow one another,
only the first of them is kept. *)
[@@@iflt 4.14]
val for_all : ('a -> bool) -> 'a t -> bool
(** [for_all p [a1; ...; an]] checks if all elements of the sequence satisfy the
predicate [p]. That is, it returns [(p a1) && ... && (p an)] for a
@ -158,23 +202,37 @@ val find_map : ('a -> 'b option) -> 'a t -> 'b option
[f ai = Some _] and return [None] otherwise.
@since 3.10 *)
[@@@endif]
[@@@iflt 5.1]
val find_index : ('a -> bool) -> 'a t -> int option
(** [find_index p xs] returns [Some i], where [i] is the index of the first value of [xs] satisfying [p]. It returns [None] if no value of [xs] satifies [p]. *)
val find_mapi : (int -> 'a -> 'b option) -> 'a t -> 'b option
(** Similar to {!find_map} but the predicate take aditionnaly the index of the element. *)
[@@@endif]
[@@@iflt 4.14]
val scan : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a t
(** [scan f init xs] is the sequence containing the intermediate result of
[fold f init xs].
@since 3.10 *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
[@@@endif]
[@@@iflt 4.13]
val concat_map : ('a -> 'b t) -> 'a t -> 'b t
(** Alias of {!flat_map}
@since 3.10 *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
val flatten : 'a t t -> 'a t
val concat : 'a t t -> 'a t
(** Alias of {!flatten}.
@since 3.10 *)
(** @since 3.10 *)
[@@@endif]
val flatten : 'a t t -> 'a t
(** Alias of {!concat} *)
val range : int -> int -> int t
@ -183,16 +241,22 @@ val ( -- ) : int -> int -> int t
[a] and [b] (therefore, never empty). *)
val ( --^ ) : int -> int -> int t
(** [a -- b] is the integer range from [a] to [b], where [b] is excluded. *)
(** [a --^ b] is the integer range from [a] to [b], where [b] is excluded. *)
(** {2 Operations on two Collections} *)
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
(** Fold on two collections at once. Stop as soon as one of them ends. *)
[@@@iflt 4.14]
val fold_left2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
(** Alias for {!fold2}.
@since 3.10 *)
(** Fold on two collections at once. Stop as soon as one of them ends.
@since 3.10 *)
[@@@endif]
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
(** Alias for {!fold_left2}. *)
[@@@iflt 4.14]
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Map on two collections at once. Stop as soon as one of the
@ -204,12 +268,19 @@ val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
val merge : 'a ord -> 'a t -> 'a t -> 'a t
(** Merge two sorted iterators into a sorted iterator. *)
[@@@endif]
[@@@iflt 4.14]
val sorted_merge : 'a ord -> 'a t -> 'a t -> 'a t
(** Alias of {!merge}.
@since 3.10 *)
(** Merge two sorted iterators into a sorted iterator.
@since 3.10 *)
[@@@endif]
val merge : 'a ord -> 'a t -> 'a t -> 'a t
(** Alias of {!sorted_merge}. *)
[@@@iflt 4.14]
val zip : 'a t -> 'b t -> ('a * 'b) t
(** Combine elements pairwise. Stop as soon as one of the lists stops. *)
@ -221,6 +292,8 @@ val split : ('a * 'b) t -> 'a t * 'b t
(** Alias of {!unzip}.
@since 3.10 *)
[@@@endif]
val zip_i : 'a t -> (int * 'a) t
(** [zip_i seq] zips the index of each element with the element itself.
@since 3.8
@ -241,9 +314,13 @@ val memoize : 'a t -> 'a t
(** {2 Fair Combinations} *)
[@@@iflt 4.14]
val interleave : 'a t -> 'a t -> 'a t
(** Fair interleaving of both streams. *)
[@@@endif]
val fair_flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** Fair version of {!flat_map}. *)
@ -252,7 +329,6 @@ val fair_app : ('a -> 'b) t -> 'a t -> 'b t
(** {2 Implementations} *)
val return : 'a -> 'a t
val pure : 'a -> 'a t
val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t

View file

@ -10,43 +10,11 @@ module type OrderedType = Set.OrderedType
module type S = sig
include Set.S
val min_elt_opt : t -> elt option
(** Safe version of {!min_elt}.
@since 1.5 *)
val max_elt_opt : t -> elt option
(** Safe version of {!max_elt}.
@since 1.5 *)
val choose_opt : t -> elt option
(** Safe version of {!choose}.
@since 1.5 *)
val find_opt : elt -> t -> elt option
(** Safe version of {!find}.
@since 1.5 *)
val find_first : (elt -> bool) -> t -> elt
(** Find minimum element satisfying predicate.
@since 1.5 *)
val find_first_opt : (elt -> bool) -> t -> elt option
(** Safe version of {!find_first}.
@since 1.5 *)
val find_first_map : (elt -> 'a option) -> t -> 'a option
(** [find_first_map f s] find the minimum element [x] of [s] such that [f x = Some y]
and return [Some y]. Otherwise returns [None].
@since 3.12 *)
val find_last : (elt -> bool) -> t -> elt
(** Find maximum element satisfying predicate.
@since 1.5 *)
val find_last_opt : (elt -> bool) -> t -> elt option
(** Safe version of {!find_last}.
@since 1.5 *)
val find_last_map : (elt -> 'a option) -> t -> 'a option
(** [find_last_map f s] find the maximum element [x] of [s] such that [f x = Some y]
and return [Some y]. Otherwise returns [None].
@ -56,16 +24,9 @@ module type S = sig
(** Build a set from the given [iter] of elements.
@since 2.8 *)
val of_seq : elt Seq.t -> t
(** Build a set from the given [seq] of elements.
@since 3.0 *)
val add_iter : t -> elt iter -> t
(** @since 2.8 *)
val add_seq : elt Seq.t -> t -> t
(** @since 3.0 *)
val to_iter : t -> elt iter
(** [to_iter t] converts the set [t] to a [iter] of the elements.
@since 2.8 *)
@ -103,31 +64,8 @@ module Make (O : Map.OrderedType) = struct
[@@@ocaml.warning "-32"]
let find_opt x s = try Some (S.find x s) with Not_found -> None
let choose_opt s = try Some (S.choose s) with Not_found -> None
let min_elt_opt s = try Some (S.min_elt s) with Not_found -> None
let max_elt_opt s = try Some (S.max_elt s) with Not_found -> None
exception Find_binding_exit
let find_first_opt f m =
let res = ref None in
try
S.iter
(fun x ->
if f x then (
res := Some x;
raise Find_binding_exit
))
m;
None
with Find_binding_exit -> !res
let find_first f m =
match find_first_opt f m with
| None -> raise Not_found
| Some x -> x
let find_first_map f m =
let res = ref None in
try
@ -142,22 +80,10 @@ module Make (O : Map.OrderedType) = struct
None
with Find_binding_exit -> !res
(* linear time, must traverse the whole set… *)
let find_last_opt f m =
let res = ref None in
S.iter (fun x -> if f x then res := Some x) m;
!res
let find_last f m =
match find_last_opt f m with
| None -> raise Not_found
| Some x -> x
[@@@ocaml.warning "+32"]
include S
(* Use find_last which is linear time on OCaml < 4.05 *)
let find_last_map f m =
let res = ref None in
let _ =
@ -172,13 +98,6 @@ module Make (O : Map.OrderedType) = struct
in
!res
let add_seq seq set =
let set = ref set in
Seq.iter (fun x -> set := add x !set) seq;
!set
let of_seq s = add_seq s empty
let add_iter set i =
let set = ref set in
i (fun x -> set := add x !set);

View file

@ -16,43 +16,11 @@ module type OrderedType = Set.OrderedType
module type S = sig
include Set.S
val min_elt_opt : t -> elt option
(** Safe version of {!min_elt}.
@since 1.5 *)
val max_elt_opt : t -> elt option
(** Safe version of {!max_elt}.
@since 1.5 *)
val choose_opt : t -> elt option
(** Safe version of {!choose}.
@since 1.5 *)
val find_opt : elt -> t -> elt option
(** Safe version of {!find}.
@since 1.5 *)
val find_first : (elt -> bool) -> t -> elt
(** Find minimum element satisfying predicate.
@since 1.5 *)
val find_first_opt : (elt -> bool) -> t -> elt option
(** Safe version of {!find_first}.
@since 1.5 *)
val find_first_map : (elt -> 'a option) -> t -> 'a option
(** [find_first_map f s] find the minimum element [x] of [s] such that [f x = Some y]
and return [Some y]. Otherwise returns [None].
@since 3.12 *)
val find_last : (elt -> bool) -> t -> elt
(** Find maximum element satisfying predicate.
@since 1.5 *)
val find_last_opt : (elt -> bool) -> t -> elt option
(** Safe version of {!find_last}.
@since 1.5 *)
val find_last_map : (elt -> 'a option) -> t -> 'a option
(** [find_last_map f s] find the maximum element [x] of [s] such that [f x = Some y]
and return [Some y]. Otherwise returns [None].
@ -62,16 +30,9 @@ module type S = sig
(** Build a set from the given [iter] of elements.
@since 2.8 *)
val of_seq : elt Seq.t -> t
(** Build a set from the given [seq] of elements.
@since 3.0 *)
val add_iter : t -> elt iter -> t
(** @since 2.8 *)
val add_seq : elt Seq.t -> t -> t
(** @since 3.0 *)
val to_iter : t -> elt iter
(** [to_iter t] converts the set [t] to a [iter] of the elements.
@since 2.8 *)

View file

@ -585,6 +585,24 @@ let take n s =
else
s
let take_while f s =
let i = ref 0 in
while !i < String.length s && f (String.unsafe_get s !i) do
incr i
done;
String.sub s 0 !i
let rtake_while f s =
let s_len_pred = String.length s - 1 in
let i = ref s_len_pred in
while !i >= 0 && f (String.unsafe_get s !i) do
decr i
done;
if !i < s_len_pred then
String.sub s (!i + 1) (s_len_pred - !i)
else
""
let drop n s =
if n < String.length s then
String.sub s n (String.length s - n)
@ -674,24 +692,11 @@ let of_gen g =
let to_iter s k = String.iter k s
let rec _to_seq s i len () =
if len = 0 then
Seq.Nil
else
Seq.Cons (s.[i], _to_seq s (i + 1) (len - 1))
let to_seq s = _to_seq s 0 (String.length s)
let of_iter i =
let b = Buffer.create 32 in
i (Buffer.add_char b);
Buffer.contents b
let of_seq seq =
let b = Buffer.create 32 in
Seq.iter (Buffer.add_char b) seq;
Buffer.contents b
let to_list s = _to_list s [] 0 (String.length s)
let of_list l =

View file

@ -49,11 +49,6 @@ val to_iter : t -> char iter
(** [to_iter s] returns the [iter] of characters contained in the string [s].
@since 2.8 *)
val to_seq : t -> char Seq.t
(** [to_seq s] returns the [Seq.t] of characters contained in the string [s].
Renamed from [to std_seq] since 3.0.
@since 3.0 *)
val to_list : t -> char list
(** [to_list s] returns the [list] of characters contained in the string [s]. *)
@ -98,11 +93,6 @@ val of_iter : char iter -> string
(** [of_iter iter] converts an [iter] of characters to a string.
@since 2.8 *)
val of_seq : char Seq.t -> string
(** [of_seq seq] converts a [seq] of characters to a string.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_list : char list -> string
(** [of_list lc] converts a list of characters [lc] to a string. *)
@ -113,7 +103,7 @@ val to_array : string -> char array
(** [to_array s] returns the array of characters contained in the string [s]. *)
val find : ?start:int -> sub:string -> string -> int
(** [find ~start ~sub s] returns the starting index of the first occurrence of [sub] within [s] or [-1].
(** [find ~start ~sub s] returns the starting index of the first occurrence of [sub] within [s] or [-1].
@param start starting position in [s]. *)
val find_all : ?start:int -> sub:string -> string -> int gen
@ -182,6 +172,16 @@ val take : int -> string -> string
(** [take n s] keeps only the [n] first chars of [s].
@since 0.17 *)
val take_while : (char -> bool) -> string -> string
(** [take_while f s] keeps only the longest prefix [t] of [s] such that every
character [c] in [t] satisfies [f c].
@since 3.16 *)
val rtake_while : (char -> bool) -> string -> string
(** [rtake_while f s] keeps only the longest suffix [t] of [s] such that every
character [c] in [t] satisfies [f c].
@since 3.16 *)
val drop : int -> string -> string
(** [drop n s] removes the [n] first chars of [s].
@since 0.17 *)
@ -462,10 +462,6 @@ module Split : sig
@since 0.16 *)
end
val split_on_char : char -> string -> string list
(** [split_on_char by s] splits the string [s] along the given char [by].
@since 1.2 *)
val split : by:string -> string -> string list
(** [split ~by s] splits the string [s] along the given string [by].
Alias to {!Split.list_cpy}.

View file

@ -49,11 +49,6 @@ val to_iter : t -> char iter
(** [to_iter s] returns the [iter] of characters contained in the string [s].
@since 2.8 *)
val to_seq : t -> char Seq.t
(** [to_seq s] returns the [Seq.t] of characters contained in the string [s].
Renamed from [to std_seq] since 3.0.
@since 3.0 *)
val to_list : t -> char list
(** [to_list s] returns the [list] of characters contained in the string [s]. *)
@ -103,11 +98,6 @@ val of_iter : char iter -> string
(** [of_iter iter] converts an [iter] of characters to a string.
@since 2.8 *)
val of_seq : char Seq.t -> string
(** [of_seq seq] converts a [seq] of characters to a string.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_list : char list -> string
(** [of_list lc] converts a list of characters [lc] to a string. *)
@ -118,7 +108,7 @@ val to_array : string -> char array
(** [to_array s] returns the array of characters contained in the string [s]. *)
val find : ?start:int -> sub:(string[@keep_label]) -> string -> int
(** [find ?start ~sub s] returns the starting index of the first occurrence of [sub] within [s] or [-1].
(** [find ?start ~sub s] returns the starting index of the first occurrence of [sub] within [s] or [-1].
@param start starting position in [s]. *)
val find_all : ?start:int -> sub:(string[@keep_label]) -> string -> int gen
@ -193,6 +183,16 @@ val take : int -> string -> string
(** [take n s] keeps only the [n] first chars of [s].
@since 0.17 *)
val take_while : f:(char -> bool) -> string -> string
(** [take_while ~f s] keeps only the longest prefix [t] of [s] such that every
character [c] in [t] satisfies [f c].
@since 3.16 *)
val rtake_while : f:(char -> bool) -> string -> string
(** [rtake_while ~f s] keeps only the longest suffix [t] of [s] such that every
character [c] in [t] satisfies [f c].
@since 3.16 *)
val drop : int -> string -> string
(** [drop n s] removes the [n] first chars of [s].
@since 0.17 *)
@ -502,10 +502,6 @@ module Split : sig
@since 0.16 *)
end
val split_on_char : by:char -> string -> string list
(** [split_on_char ~by s] splits the string [s] along the given char [by].
@since 1.2 *)
val split : by:(string[@keep_label]) -> string -> string list
(** [split ~by s] splits the string [s] along the given string [by].
Alias to {!Split.list_cpy}.

View file

@ -65,8 +65,10 @@ let next_ (type a) (st : Dec.t) ~(yield : uchar -> a) ~(stop : unit -> a) () : a
(* except for first, each char gives 6 bits *)
let next = (acc lsl 6) lor (c land 0b111111) in
if j = n_bytes then
if (* done reading the codepoint *)
Uchar.is_valid next then (
if
(* done reading the codepoint *)
Uchar.is_valid next
then (
st.i <- st.i + j + 1;
(* +1 for first char *)
yield (Uchar.unsafe_of_int next)

View file

@ -222,7 +222,7 @@ val find : ('a -> bool) -> ('a, _) t -> 'a option
val findi : ('a -> bool) -> ('a, _) t -> (int * 'a) option
(** Find an element and its index that satisfies the predicate.
@since NEXT_RELEASE *)
@since 3.15 *)
val find_exn : ('a -> bool) -> ('a, _) t -> 'a
(** Find an element that satisfies the predicate, or

View file

@ -6,7 +6,7 @@
(action
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
(flags :standard -nolabels -open CCMonomorphic)
(libraries either containers.monomorphic))
(libraries either containers.monomorphic containers.domain))
(ocamllex
(modules CCSexp_lex))

View file

@ -31,5 +31,5 @@ let uniformity_test ?(size_hint = 10) k rng st =
let () =
let st = Random.State.make_self_init () in
let ok = run ~st (uniformity_test 50_000 (split_list 10 ~len:3)) in
let ok = run ~st (uniformity_test 500_000 (split_list 10 ~len:3)) in
if not ok then failwith "uniformity check failed"

View file

@ -37,8 +37,7 @@ let _empty = Shallow Zero
let _single x = Shallow (One x)
let _double x y = Shallow (Two (x, y))
let _deep :
type l0 l1.
let _deep : type l0 l1.
int ->
('a, l0 succ) digit ->
('a * 'a) t lazy_t ->

View file

@ -139,7 +139,7 @@ val ( -- ) : int -> int -> int t
@since 0.10 *)
val ( --^ ) : int -> int -> int t
(** [a -- b] is the integer range from [a] to [b], where [b] is excluded.
(** [a --^ b] is the integer range from [a] to [b], where [b] is excluded.
@since 0.17 *)
val pp : 'a printer -> 'a t printer

View file

@ -221,8 +221,7 @@ module Traverse = struct
]
type ('v, 'e) t =
[ `Enter of
'v * int * ('v, 'e) path
[ `Enter of 'v * int * ('v, 'e) path
(* unique index in traversal, path from start *)
| `Exit of 'v
| `Edge of 'v * 'e * 'v * edge_kind

View file

@ -150,8 +150,7 @@ module Traverse : sig
]
type ('v, 'e) t =
[ `Enter of
'v * int * ('v, 'e) path
[ `Enter of 'v * int * ('v, 'e) path
(* unique index in traversal, path from start *)
| `Exit of 'v
| `Edge of 'v * 'e * 'v * edge_kind

View file

@ -202,8 +202,10 @@ module A_SPARSE = struct
let open Stdlib in
Array.blit a.arr real_idx arr (real_idx + 1) (n - real_idx));
{ a with bits; arr }
) else if (* replace element at [real_idx] *)
mut then (
) else if
(* replace element at [real_idx] *)
mut
then (
a.arr.(real_idx) <- x;
a
) else (

View file

@ -0,0 +1,7 @@
(** A partial stub for {!Domain}. *)
val is_main_domain : unit -> bool
val cpu_relax : unit -> unit
val relax_loop : int -> unit
(** Call {!cpu_relax} n times *)

14
src/domain/dune Normal file
View file

@ -0,0 +1,14 @@
(library
(name containers_domain)
(synopsis "Compatibility library for the Domain module")
(public_name containers.domain)
(modules containers_domain))
(executable
(modules gen)
(name gen))
(rule
(targets containers_domain.ml)
(action
(run ./gen.exe)))

28
src/domain/gen.ml Normal file
View file

@ -0,0 +1,28 @@
let domain_4 =
{|
let is_main_domain () = true
let cpu_relax = ignore
let relax_loop : int -> unit = ignore
|}
let domain_5 =
{|
let is_main_domain = Domain.is_main_domain
let cpu_relax = Domain.cpu_relax
let relax_loop i =
for _j = 1 to i do cpu_relax () done
|}
let write_file file s =
let oc = open_out file in
output_string oc s;
close_out oc
let () =
let version = Scanf.sscanf Sys.ocaml_version "%d.%d.%s" (fun x y _ -> x, y) in
write_file "containers_domain.ml"
(if version >= (5, 0) then
domain_5
else
domain_4);
()

View file

@ -0,0 +1,98 @@
(* adapted from ocaml-protoc from code by c-cube *)
module Byte_slice = CCByte_slice
module Byte_buffer = CCByte_buffer
module Decode = struct
let skip (sl : Byte_slice.t) off : int =
let shift = ref 0 in
let continue = ref true in
let off = ref off in
let n_consumed = ref 0 in
while !continue do
if sl.len <= 0 then invalid_arg "out of bound";
incr n_consumed;
let b = Char.code (Bytes.get sl.bs !off) in
let cur = b land 0x7f in
if cur <> b then (
(* at least one byte follows this one *)
incr off;
shift := !shift + 7
) else if !shift < 63 || b land 0x7f <= 1 then
continue := false
else
invalid_arg "leb128 varint is too long"
done;
!n_consumed
let u64 (sl : Byte_slice.t) (off : int) : int64 * int =
let shift = ref 0 in
let res = ref 0L in
let continue = ref true in
let off = ref off in
let n_consumed = ref 0 in
while !continue do
if sl.len <= 0 then invalid_arg "out of bound";
incr n_consumed;
let b = Char.code (Bytes.get sl.bs !off) in
let cur = b land 0x7f in
if cur <> b then (
(* at least one byte follows this one *)
(res := Int64.(logor !res (shift_left (of_int cur) !shift)));
incr off;
shift := !shift + 7
) else if !shift < 63 || b land 0x7f <= 1 then (
(res := Int64.(logor !res (shift_left (of_int b) !shift)));
continue := false
) else
invalid_arg "leb128 varint is too long"
done;
!res, !n_consumed
let[@inline] uint_truncate sl off =
let v, n_consumed = u64 sl off in
Int64.to_int v, n_consumed
let[@inline] decode_zigzag (v : int64) : int64 =
Int64.(logxor (shift_right v 1) (neg (logand v Int64.one)))
let[@inline] i64 sl off : int64 * int =
let v, n_consumed = u64 sl off in
decode_zigzag v, n_consumed
let[@inline] int_truncate sl off =
let v, n_consumed = u64 sl off in
Int64.to_int (decode_zigzag v), n_consumed
end
module Encode = struct
let[@inline] encode_zigzag (i : int64) : int64 =
Int64.(logxor (shift_left i 1) (shift_right i 63))
external varint_size : (int64[@unboxed]) -> int
= "caml_cc_leb128_varint_size_byte" "caml_cc_leb128_varint_size"
[@@noalloc]
(** Compute how many bytes this int would occupy as varint *)
external varint_slice : bytes -> (int[@untagged]) -> (int64[@unboxed]) -> unit
= "caml_cc_leb128_varint_byte" "caml_cc_leb128_varint"
[@@noalloc]
(** Write this int as varint into the given slice *)
let[@inline] u64 (buf : Byte_buffer.t) (i : int64) =
let n = varint_size i in
Byte_buffer.ensure_free buf n;
assert (buf.len + n <= Bytes.length buf.bs);
varint_slice buf.bs buf.len i;
buf.len <- buf.len + n
let[@inline] i64 buf i : unit = u64 buf (encode_zigzag i)
let[@inline] uint buf i : unit = u64 buf (Int64.of_int i)
let[@inline] int buf i : unit = u64 buf (encode_zigzag (Int64.of_int i))
end

View file

@ -0,0 +1,49 @@
(** LEB128 encoding and decoding.
See https://en.wikipedia.org/wiki/LEB128 . *)
module Byte_slice = CCByte_slice
module Byte_buffer = CCByte_buffer
module Decode : sig
val decode_zigzag : int64 -> int64
(** Turn an unsigned integer into a signed one.
See https://en.wikipedia.org/wiki/Variable-length_quantity#Zigzag_encoding
*)
val skip : Byte_slice.t -> int -> int
(** [skip slice off] reads an integer at offset [off], and returns how many
bytes the integer occupies. *)
val u64 : Byte_slice.t -> int -> int64 * int
(** [u64 slice off] reads an integer at offset [off], and returns a pair
[v, n_consumed]. [v] is the read integer, [n_consumed] is the number of
bytes consumed during reading. *)
val i64 : Byte_slice.t -> int -> int64 * int
(** Read a signed int64 by reading a u64 and zigzag decoding it *)
val int_truncate : Byte_slice.t -> int -> int * int
(** Like {!i64} but truncates to integer. Returns a pair [v, n_consumed]. *)
val uint_truncate : Byte_slice.t -> int -> int * int
(** Like {!u64} but truncates to integer. *)
end
module Encode : sig
val encode_zigzag : int64 -> int64
(** Turn a signed int64 into a u64 via zigzag encoding. *)
val u64 : Byte_buffer.t -> int64 -> unit
(** Write a unsigned int *)
val i64 : Byte_buffer.t -> int64 -> unit
(** Write a signed int via zigzag encoding *)
val uint : Byte_buffer.t -> int -> unit
(** Turn an uint into a u64 and write it *)
val int : Byte_buffer.t -> int -> unit
(** Turn an int into a int64 and write it *)
end

11
src/leb128/dune Normal file
View file

@ -0,0 +1,11 @@
(library
(name containers_leb128)
(public_name containers.leb128)
(synopsis
"LEB128 encoding (https://en.wikipedia.org/wiki/LEB128) for cephalopod")
(libraries containers)
(foreign_stubs
(language c)
(flags :standard -std=c99 -O2)
(names stubs))
(ocamlopt_flags :standard -inline 100))

73
src/leb128/stubs.c Normal file
View file

@ -0,0 +1,73 @@
// readapted from ocaml-protoc, original code also from c-cube
#include <caml/alloc.h>
#include <caml/memory.h>
#include <caml/mlvalues.h>
#include <stdbool.h>
#include <stdint.h>
static inline int ix_leb128_varint_size(uint64_t i) {
/* generated with:
for i in range(1,10):
ceiling = (1 << (i*7))-1
print(f'if (i <= {ceiling}L) return {i};')
*/
if (i <= 127L) return 1;
if (i <= 16383L) return 2;
if (i <= 2097151L) return 3;
if (i <= 268435455L) return 4;
if (i <= 34359738367L) return 5;
if (i <= 4398046511103L) return 6;
if (i <= 562949953421311L) return 7;
if (i <= 72057594037927935L) return 8;
if (i <= 9223372036854775807L) return 9;
return 10;
}
// number of bytes for i
CAMLprim value caml_cc_leb128_varint_size(int64_t i) {
int res = ix_leb128_varint_size(i);
return Val_int(res);
}
// boxed version, for bytecode
CAMLprim value caml_cc_leb128_varint_size_byte(value v_i) {
CAMLparam1(v_i);
int64_t i = Int64_val(v_i);
int res = ix_leb128_varint_size(i);
CAMLreturn(Val_int(res));
}
// write i at str[idx…] in varint
static inline void ix_leb128_varint(unsigned char *str, uint64_t i) {
while (true) {
uint64_t cur = i & 0x7f;
if (cur == i) {
*str = (unsigned char)cur;
break;
} else {
*str = (unsigned char)(cur | 0x80);
i = i >> 7;
++str;
}
}
}
// write `i` starting at `idx`
CAMLprim value caml_cc_leb128_varint(value _str, intnat idx, int64_t i) {
unsigned char *str = Bytes_val(_str);
ix_leb128_varint(str + idx, i);
return Val_unit;
}
CAMLprim value caml_cc_leb128_varint_byte(value _str, value _idx, value _i) {
CAMLparam3(_str, _idx, _i);
unsigned char *str = Bytes_val(_str);
int idx = Int_val(_idx);
int64_t i = Int64_val(_i);
ix_leb128_varint(str + idx, i);
CAMLreturn(Val_unit);
}

View file

@ -352,6 +352,8 @@ let append a b =
else
fold_left push a b
let flat_map f v : _ t = fold_left (fun acc x -> append acc (f x)) empty v
let rec equal_tree eq t1 t2 =
match t1, t2 with
| Empty, Empty -> true

View file

@ -84,6 +84,11 @@ val append : 'a t -> 'a t -> 'a t
val map : ('a -> 'b) -> 'a t -> 'b t
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** A basic, fairly slow [flat_map] operation like {!CCList.flat_map}.
It exists for convenience but is not where this data structure shines.
@since 3.17 *)
val choose : 'a t -> 'a option
(** Return an element. It is unspecified which one is returned. *)

View file

@ -99,12 +99,28 @@ let rec shrink (c : Cbor.t) : Cbor.t Q.Iter.t =
let+ s = Q.Shrink.string s in
`Bytes s
let arb = Q.make ~shrink ~print:Cbor.to_string_diagnostic gen_c;;
let arb = Q.make ~shrink ~print:Cbor.to_string_diagnostic gen_c
let rec eq_c c c' =
match c, c' with
| `Null, `Null | `Undefined, `Undefined -> true
| `Simple i, `Simple i' -> Int.equal i i'
| `Bool b, `Bool b' -> Bool.equal b b'
| `Int i, `Int i' -> Int64.equal i i'
| `Float f, `Float f' -> Float.equal f f'
| `Bytes s, `Bytes s' -> String.equal s s'
| `Text t, `Text t' -> String.equal t t'
| `Array a, `Array a' -> CCList.equal eq_c a a'
| `Map m, `Map m' ->
CCList.equal (fun (t0, t1) (t0', t1') -> eq_c t0 t0' && eq_c t1 t1') m m'
| `Tag (i, t), `Tag (i', t') -> Int.equal i i' && eq_c t t'
| _ -> false
;;
q ~count:1_000 ~long_factor:10 arb @@ fun c ->
let s = Cbor.encode c in
let c' = Cbor.decode_exn s in
if not (c = c') then
if not (eq_c c c') then
Q.Test.fail_reportf "@[<hv2>roundtrip failed:@ from %a@ to %a@]"
Cbor.pp_diagnostic c Cbor.pp_diagnostic c';
true

View file

@ -8,3 +8,76 @@ eq None (of_int 257);;
q
(Q.string_of_size (Q.Gen.return 1))
(fun s -> Stdlib.( = ) (to_string s.[0]) s)
;;
q (Q.int_range 65 90 |> Q.map Char.chr) CCChar.is_uppercase_ascii;;
q
(Q.int_range 0 64 |> Q.map Char.chr)
(fun c -> not @@ CCChar.is_uppercase_ascii c)
;;
q
(Q.int_range 91 127 |> Q.map Char.chr)
(fun c -> not @@ CCChar.is_uppercase_ascii c)
;;
q (Q.int_range 97 122 |> Q.map Char.chr) CCChar.is_lowercase_ascii;;
q
(Q.int_range 0 96 |> Q.map Char.chr)
(fun c -> not @@ CCChar.is_lowercase_ascii c)
;;
q
(Q.int_range 123 127 |> Q.map Char.chr)
(fun c -> not @@ CCChar.is_lowercase_ascii c)
;;
q (Q.int_range 48 57 |> Q.map Char.chr) CCChar.is_digit_ascii;;
q (Q.int_range 0 47 |> Q.map Char.chr) (fun c -> not @@ CCChar.is_digit_ascii c)
;;
q
(Q.int_range 58 127 |> Q.map Char.chr)
(fun c -> not @@ CCChar.is_digit_ascii c)
;;
eq true
(Stdlib.List.for_all CCChar.is_whitespace_ascii
[ '\n'; '\t'; ' '; '\010'; '\011'; '\012'; '\013' ])
;;
eq false
(Stdlib.List.exists CCChar.is_whitespace_ascii
[
'H';
'e';
'l';
'l';
'o';
'!';
'-';
'-';
'N';
'O';
't';
'h';
'i';
'n';
'a';
'\055';
'k';
'a';
'g';
'$';
'$';
'$';
'%';
'^';
'b';
'c';
'h';
'\008';
'h';
])

View file

@ -2,10 +2,10 @@ open CCFloat
module T = (val Containers_testlib.make ~__FILE__ ())
include T;;
t @@ fun () -> max nan 1. = 1.;;
t @@ fun () -> min nan 1. = 1.;;
t @@ fun () -> max 1. nan = 1.;;
t @@ fun () -> min 1. nan = 1.;;
t @@ fun () -> is_nan (max nan 1.);;
t @@ fun () -> is_nan (min nan 1.);;
t @@ fun () -> is_nan (max 1. nan);;
t @@ fun () -> is_nan (min 1. nan);;
q
Q.(pair float float)

View file

@ -21,3 +21,15 @@ true
t @@ fun () -> CCFun.((succ %> string_of_int) 2 = "3");;
t @@ fun () -> CCFun.((( * ) 3 % succ) 5 = 18);;
t @@ fun () -> CCFun.(succ @@ ( * ) 2 @@ pred @@ 3 = 5)
let find_array arr x =
let@ return = with_return in
for i = 0 to Array.length arr - 1 do
if arr.(i) = x then return i
done;
-1
;;
eq 1 @@ find_array [| "a"; "b"; "c" |] "b";;
eq 2 @@ find_array [| "a"; "b"; "c" |] "c";;
eq (-1) @@ find_array [| "a"; "b"; "c" |] "hello"

View file

@ -11,6 +11,8 @@ t @@ fun () -> char 'c' >= 0;;
t @@ fun () -> int 152352 = int 152352;;
t @@ fun () -> list_comm int [ 1; 2 ] = list_comm int [ 2; 1 ];;
t @@ fun () -> list_comm int [ 1; 2 ] <> list_comm int [ 2; 3 ];;
t @@ fun () -> string "abcd" >= 0;;
t @@ fun () -> string "abc" <> string "abcd";;
q Q.int (fun i ->
Q.assume (i >= 0);

View file

@ -721,6 +721,13 @@ q
let i = abs i in
let l1, l2 = take_drop i l in
l1 @ l2 = l)
;;
q
(Q.pair (Q.list Q.small_int) Q.int)
(fun (l, i) ->
let i = abs i in
take_drop i l = (take i l, drop i l))
let subs = sublists_of_len;;

View file

@ -229,7 +229,28 @@ t @@ fun () -> not (suffix ~suf:"cd" "abcde");;
t @@ fun () -> not (suffix ~suf:"abcd" "cd");;
eq ("ab", "cd") (take_drop 2 "abcd");;
eq ("abc", "") (take_drop 3 "abc");;
eq ("abc", "") (take_drop 5 "abc")
eq ("abc", "") (take_drop 5 "abc");;
q
Q.(printable_string)
(fun s ->
let predicate c = Char.code c mod 2 = 0 in
let prefix = take_while predicate s in
let suffix = drop_while predicate s in
if prefix ^ suffix <> s then
Q.Test.fail_reportf "s=%S, pre=%S, post=%S" s prefix suffix;
true)
;;
q
Q.(printable_string)
(fun s ->
let predicate c = Char.code c mod 2 = 0 in
let prefix = rdrop_while predicate s in
let suffix = rtake_while predicate s in
if prefix ^ suffix <> s then
Q.Test.fail_reportf "s=%S, pre=%S, post=%S" s prefix suffix;
true)
let eq' = eq ~printer:Q.Print.(option string);;
@ -280,6 +301,23 @@ eq ~printer:CCFun.id "" (unlines []);;
eq ~printer:CCFun.id "ab\nc\n" (unlines [ "ab"; "c" ]);;
q Q.printable_string (fun s -> trim (unlines (lines s)) = trim s);;
q Q.printable_string (fun s -> trim (unlines_gen (lines_gen s)) = trim s);;
eq ~printer:CCFun.id "" (take_while (Char.equal 'c') "heloo_cc");;
eq ~printer:CCFun.id "" (take_while (Char.equal 'c') "");;
eq ~printer:CCFun.id "c" (take_while (Char.equal 'c') "c");;
eq ~printer:CCFun.id "ccc" (take_while (Char.equal 'c') "cccujsuy");;
eq ~printer:CCFun.id "THIS"
(take_while (fun c -> Char.code c < 91) "THISisNotWHAtIwANTED")
;;
eq ~printer:CCFun.id "cc" (rtake_while (Char.equal 'c') "heloo_cc");;
eq ~printer:CCFun.id "" (rtake_while (Char.equal 'c') "");;
eq ~printer:CCFun.id "c" (rtake_while (Char.equal 'c') "c");;
eq ~printer:CCFun.id "" (rtake_while (Char.equal 'c') "cccujsuy");;
eq ~printer:CCFun.id "ANTED"
(rtake_while (fun c -> Char.code c < 91) "THISisNotWHAtIwANTED")
;;
q
Q.(small_list small_string)

View file

@ -119,6 +119,8 @@ module Ref_impl = struct
let to_list l = l
let to_seq = CCSeq.of_list
let add_list l l2 : _ t = List.append l l2
let append self l2 : _ t = List.append self l2
let flat_map sub l : _ t = CCList.flat_map (fun x -> sub @ [ x ]) l
let to_list_via_reviter m =
let l = ref [] in
@ -159,7 +161,9 @@ module Op = struct
| Push of 'a
| Pop
(* TODO: set *)
| Append of 'a list
| Add_list of 'a list
| Flat_map of 'a list
| Check_get of int
| Check_choose
| Check_is_empty
@ -176,6 +180,8 @@ module Op = struct
| Push _ :: tl -> loop (size + 1) tl
| Pop :: tl -> size >= 0 && loop (size - 1) tl
| Add_list l :: tl -> loop (size + List.length l) tl
| Append l :: tl -> loop (size + List.length l) tl
| Flat_map sub :: tl -> loop (size * (1 + List.length sub)) tl
| Check_get x :: tl -> x < size && loop size tl
| Check_choose :: tl
| Check_is_empty :: tl
@ -194,6 +200,8 @@ module Op = struct
| Push x -> spf "push %s" (show_x x)
| Pop -> "pop"
| Add_list l -> spf "add_list [%s]" (String.concat ";" @@ List.map show_x l)
| Append l -> spf "append [%s]" (String.concat ";" @@ List.map show_x l)
| Flat_map l -> spf "flat_map [%s]" (String.concat ";" @@ List.map show_x l)
| Check_get i -> spf "check_get %d" i
| Check_choose -> "check_choose"
| Check_is_empty -> "check_is_empty"
@ -211,6 +219,8 @@ module Op = struct
| Push x -> shrink_x x >|= fun x -> Push x
| Pop -> empty
| Add_list l -> list ~shrink:shrink_x l >|= fun x -> Add_list x
| Append l -> list ~shrink:shrink_x l >|= fun x -> Append x
| Flat_map l -> list ~shrink:shrink_x l >|= fun x -> Flat_map x
| Check_get _ | Check_choose | Check_is_empty | Check_len | Check_to_list
| Check_to_gen | Check_last | Check_rev_iter | Check_iter ->
empty
@ -252,6 +262,12 @@ module Op = struct
( 1,
small_list gen_x >|= fun l ->
Add_list l, size + List.length l );
( 1,
small_list gen_x >|= fun l ->
Append l, size + List.length l );
( 1,
list_size (0 -- 5) gen_x >|= fun l ->
Flat_map l, size * (1 + List.length l) );
];
]
in
@ -292,6 +308,12 @@ let check_ops ~show_x (ops : 'a Op.t list) : unit =
| Op.Add_list l ->
cur := add_list !cur l;
cur_ref := Ref_impl.add_list !cur_ref l
| Op.Append l ->
cur := append !cur (of_list l);
cur_ref := Ref_impl.append !cur_ref l
| Op.Flat_map sub ->
cur := flat_map (fun x -> push (of_list sub) x) !cur;
cur_ref := Ref_impl.flat_map sub !cur_ref
| Op.Check_get i -> if get !cur i <> Ref_impl.get i !cur_ref then fail ()
| Op.Check_is_empty ->
if is_empty !cur <> Ref_impl.is_empty !cur_ref then fail ()