Compare commits

...

53 commits

Author SHA1 Message Date
Fardale
0e32e32125
Merge 35803e586c into 5461dcc07a 2026-02-06 13:43:11 -05:00
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
76 changed files with 1043 additions and 1221 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

@ -19,7 +19,7 @@ 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 }}
@ -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@v3
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

@ -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.

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

@ -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

@ -92,7 +92,7 @@ let find_array arr x =
-1
]}
@since NEXT_RELEASE *)
@since 3.15 *)
(** {2 Infix}

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. *)
@ -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

@ -692,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
@ -472,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
@ -512,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

@ -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

@ -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

@ -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 ()