mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2026-03-14 17:26:18 -04:00
Compare commits
75 commits
273ba69ea3
...
35803e586c
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
35803e586c | ||
|
|
8f30ce25b6 | ||
|
|
b8f1048ce4 | ||
|
|
9eb002304f | ||
|
|
d80d36106b | ||
|
|
405dfa4891 | ||
|
|
30f7ac7551 | ||
|
|
3af76f266c | ||
|
|
bb31265e52 | ||
|
|
5e60c0d237 | ||
|
|
571f9f3793 | ||
|
|
0cd4bbf240 | ||
|
|
52fc619335 | ||
|
|
b8684b77df | ||
|
|
bf7f4897c6 | ||
|
|
8268e29c48 | ||
|
|
3516c5dc0e | ||
|
|
b649ac9dc5 | ||
|
|
74b787f7e6 | ||
|
|
f05c07d20d | ||
|
|
50cb263a6e | ||
|
|
6a6ccbbc5c | ||
|
|
9e3baf8ff1 | ||
|
|
88f093b64d | ||
|
|
0522770173 | ||
|
|
5576ad71cc | ||
|
|
fcbde4b187 | ||
|
|
5461dcc07a | ||
|
|
d4fdff884f | ||
|
|
eab2e1d33f | ||
|
|
c72b60fd6f | ||
|
|
ddc87518a7 | ||
|
|
15b421c54e | ||
|
|
c1b13f1c7f | ||
|
|
f51b56ffbc | ||
|
|
02c4d51fd0 | ||
|
|
7c8adbd9fc | ||
|
|
954ea61d22 | ||
|
|
b069461fe2 | ||
|
|
f13fb6f471 | ||
|
|
01402388e4 | ||
|
|
14ad490c7e | ||
|
|
3b49ad2a4e | ||
|
|
1a11459991 | ||
|
|
0290aa9754 | ||
|
|
9df429005d | ||
|
|
99dba20fa6 | ||
|
|
f934db1e9c | ||
|
|
14ad8c1f2a | ||
|
|
0ff9614520 | ||
|
|
ab7d0fcc09 | ||
|
|
b55d3cfe6a | ||
|
|
4613aafb30 | ||
|
|
4294dc7ca3 | ||
|
|
31ad563044 | ||
|
|
2dcaa12fb7 | ||
|
|
bace9fe209 | ||
|
|
1486cbf5a1 | ||
|
|
b95e2de65b | ||
|
|
f310bc5771 | ||
|
|
6d962a70d0 | ||
|
|
517d4605d5 | ||
|
|
b0f673fbbb | ||
|
|
c6f6a012b4 | ||
|
|
1e06423e87 | ||
|
|
8bb3801a52 | ||
|
|
d29ed7ee72 | ||
|
|
330cba94de | ||
|
|
699b370220 | ||
|
|
85ca948012 | ||
|
|
6c8569a7d9 | ||
|
|
1498158a4f | ||
|
|
d8c00f96be | ||
|
|
510db54150 | ||
|
|
2e8d70f073 |
65 changed files with 1145 additions and 728 deletions
28
.github/workflows/format.yml
vendored
Normal file
28
.github/workflows/format.yml
vendored
Normal 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
|
||||||
|
|
||||||
4
.github/workflows/gh-pages.yml
vendored
4
.github/workflows/gh-pages.yml
vendored
|
|
@ -13,9 +13,9 @@ jobs:
|
||||||
- uses: actions/checkout@main
|
- uses: actions/checkout@main
|
||||||
|
|
||||||
- name: Use OCaml
|
- name: Use OCaml
|
||||||
uses: ocaml/setup-ocaml@v2
|
uses: ocaml/setup-ocaml@v3
|
||||||
with:
|
with:
|
||||||
ocaml-compiler: '4.14'
|
ocaml-compiler: '5.2'
|
||||||
dune-cache: false
|
dune-cache: false
|
||||||
|
|
||||||
- name: Deps
|
- name: Deps
|
||||||
|
|
|
||||||
26
.github/workflows/main.yml
vendored
26
.github/workflows/main.yml
vendored
|
|
@ -19,14 +19,14 @@ jobs:
|
||||||
- '4.08'
|
- '4.08'
|
||||||
- '4.10'
|
- '4.10'
|
||||||
- '4.14'
|
- '4.14'
|
||||||
- '5.2'
|
- '5.3'
|
||||||
- 'ocaml-variants.5.0.0+options,ocaml-option-bytecode-only'
|
- 'ocaml-variants.5.0.0+options,ocaml-option-bytecode-only'
|
||||||
|
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
steps:
|
steps:
|
||||||
- uses: actions/checkout@main
|
- uses: actions/checkout@main
|
||||||
- name: Use OCaml ${{ matrix.ocaml-compiler }}
|
- name: Use OCaml ${{ matrix.ocaml-compiler }}
|
||||||
uses: ocaml/setup-ocaml@v2
|
uses: ocaml/setup-ocaml@v3
|
||||||
with:
|
with:
|
||||||
ocaml-compiler: ${{ matrix.ocaml-compiler }}
|
ocaml-compiler: ${{ matrix.ocaml-compiler }}
|
||||||
dune-cache: true
|
dune-cache: true
|
||||||
|
|
@ -52,7 +52,7 @@ jobs:
|
||||||
steps:
|
steps:
|
||||||
- uses: actions/checkout@main
|
- uses: actions/checkout@main
|
||||||
- name: Use OCaml ${{ matrix.ocaml-compiler }}
|
- name: Use OCaml ${{ matrix.ocaml-compiler }}
|
||||||
uses: ocaml/setup-ocaml@v2
|
uses: ocaml/setup-ocaml@v3
|
||||||
with:
|
with:
|
||||||
ocaml-compiler: ${{ matrix.ocaml-compiler }}
|
ocaml-compiler: ${{ matrix.ocaml-compiler }}
|
||||||
dune-cache: true
|
dune-cache: true
|
||||||
|
|
@ -62,23 +62,3 @@ jobs:
|
||||||
opam install containers-data --deps-only # no test deps
|
opam install containers-data --deps-only # no test deps
|
||||||
- run: opam exec -- dune build '@install'
|
- run: opam exec -- dune build '@install'
|
||||||
- run: opam exec -- dune runtest -j 1 -p containers --profile=release # test only core on non-ubuntu platform
|
- run: opam exec -- dune runtest -j 1 -p containers --profile=release # test only core on non-ubuntu platform
|
||||||
|
|
||||||
format:
|
|
||||||
name: format
|
|
||||||
strategy:
|
|
||||||
matrix:
|
|
||||||
ocaml-compiler:
|
|
||||||
- '5.2'
|
|
||||||
runs-on: 'ubuntu-latest'
|
|
||||||
steps:
|
|
||||||
- uses: actions/checkout@main
|
|
||||||
- name: Use OCaml ${{ matrix.ocaml-compiler }}
|
|
||||||
uses: ocaml/setup-ocaml@v2
|
|
||||||
with:
|
|
||||||
ocaml-compiler: ${{ matrix.ocaml-compiler }}
|
|
||||||
dune-cache: true
|
|
||||||
allow-prerelease-opam: true
|
|
||||||
|
|
||||||
- run: opam install ocamlformat.0.26.2
|
|
||||||
- run: opam exec -- make format-check
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
version = 0.26.2
|
version = 0.27.0
|
||||||
profile=conventional
|
profile=conventional
|
||||||
margin=80
|
margin=80
|
||||||
if-then-else=k-r
|
if-then-else=k-r
|
||||||
|
|
@ -12,3 +12,4 @@ field-space=tight-decl
|
||||||
leading-nested-match-parens=true
|
leading-nested-match-parens=true
|
||||||
module-item-spacing=compact
|
module-item-spacing=compact
|
||||||
quiet=true
|
quiet=true
|
||||||
|
parse-docstrings=false
|
||||||
|
|
|
||||||
27
CHANGELOG.md
27
CHANGELOG.md
|
|
@ -1,11 +1,34 @@
|
||||||
# Changelog
|
|
||||||
|
|
||||||
## main
|
## main
|
||||||
- breaking: CCListLabel.compare and CCListLabel.equal takes the function on the elements as named arguments
|
- 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: CCListLabel.init now takes the length as a named arguments to follow the Stdlib
|
||||||
- breaking: invert the argument of CCFun.compose to align it with the Stdlib
|
|
||||||
- breaking: change the semantic of CCFloat.{min,max} with respect to NaN 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 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
|
## 3.15
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -128,8 +128,9 @@ module PersistentHashtbl (H : Hashtbl.HashedType) = struct
|
||||||
t := Add (k, v', t');
|
t := Add (k, v', t');
|
||||||
Table.remove tbl k;
|
Table.remove tbl k;
|
||||||
t'
|
t'
|
||||||
with Not_found -> (* not member, nothing to do *)
|
with Not_found ->
|
||||||
t
|
(* not member, nothing to do *)
|
||||||
|
t
|
||||||
|
|
||||||
(*$R
|
(*$R
|
||||||
let h = H.of_seq my_seq in
|
let h = H.of_seq my_seq in
|
||||||
|
|
|
||||||
|
|
@ -97,6 +97,14 @@ module L = struct
|
||||||
else
|
else
|
||||||
Sek.Persistent.of_list 0 [ x; x + 1; x + 2; x + 3 ]
|
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 flat_map_kont f l =
|
||||||
let rec aux f l kont =
|
let rec aux f l kont =
|
||||||
match l with
|
match l with
|
||||||
|
|
@ -118,6 +126,7 @@ module L = struct
|
||||||
let l = CCList.(1 -- n) in
|
let l = CCList.(1 -- n) in
|
||||||
let ral = CCRAL.of_list l in
|
let ral = CCRAL.of_list l in
|
||||||
let sek = Sek.Persistent.of_list 0 l in
|
let sek = Sek.Persistent.of_list 0 l in
|
||||||
|
let pvec = Pvec.of_list l in
|
||||||
let flatten_map_ l () =
|
let flatten_map_ l () =
|
||||||
ignore @@ Sys.opaque_identity @@ List.flatten (CCList.map f_ l)
|
ignore @@ Sys.opaque_identity @@ List.flatten (CCList.map f_ l)
|
||||||
and flatmap_kont l () = ignore @@ Sys.opaque_identity @@ flat_map_kont 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
|
ignore @@ Sys.opaque_identity @@ CCRAL.flat_map f_ral_ l
|
||||||
and flatmap_sek s () =
|
and flatmap_sek s () =
|
||||||
ignore @@ Sys.opaque_identity @@ Sek.Persistent.flatten_map 0 f_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
|
in
|
||||||
B.throughputN time ~repeat
|
B.throughputN time ~repeat
|
||||||
[
|
[
|
||||||
|
|
@ -137,6 +148,7 @@ module L = struct
|
||||||
"flatten o map", flatten_map_ l, ();
|
"flatten o map", flatten_map_ l, ();
|
||||||
"ral_flatmap", flatmap_ral_ ral, ();
|
"ral_flatmap", flatmap_ral_ ral, ();
|
||||||
"sek_flatmap", flatmap_sek sek, ();
|
"sek_flatmap", flatmap_sek sek, ();
|
||||||
|
"pvec.flatmap", flat_map_pvec pvec, ();
|
||||||
]
|
]
|
||||||
|
|
||||||
(* APPEND *)
|
(* APPEND *)
|
||||||
|
|
@ -180,6 +192,33 @@ module L = struct
|
||||||
|
|
||||||
(* FLATTEN *)
|
(* 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 bench_flatten ?(time = 2) n =
|
||||||
let fold_right_append_ l () =
|
let fold_right_append_ l () =
|
||||||
opaque_ignore (List.fold_right List.append l [] : _ list)
|
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)
|
opaque_ignore (Pvec.fold_left Pvec.append Pvec.empty v : _ Pvec.t)
|
||||||
in
|
in
|
||||||
let l =
|
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
|
in
|
||||||
let sek =
|
let sek =
|
||||||
Sek.Persistent.of_list (Sek.Persistent.create 0)
|
Sek.Persistent.of_list (Sek.Persistent.create 0)
|
||||||
|
|
@ -208,6 +247,8 @@ module L = struct
|
||||||
[
|
[
|
||||||
"CCList.flatten", (fun () -> ignore (CCList.flatten l)), ();
|
"CCList.flatten", (fun () -> ignore (CCList.flatten l)), ();
|
||||||
"List.flatten", (fun () -> ignore (List.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, ();
|
"fold_right append", fold_right_append_ l, ();
|
||||||
"funvec.(fold append)", funvec_flatten v, ();
|
"funvec.(fold append)", funvec_flatten v, ();
|
||||||
"pvec.(fold append)", pvec_flatten pv, ();
|
"pvec.(fold append)", pvec_flatten pv, ();
|
||||||
|
|
@ -284,7 +325,7 @@ module L = struct
|
||||||
for i = 0 to n - 1 do
|
for i = 0 to n - 1 do
|
||||||
opaque_ignore (CCRAL.set l i (-i))
|
opaque_ignore (CCRAL.set l i (-i))
|
||||||
done
|
done
|
||||||
(* TODO: implement set
|
(* TODO: implement set
|
||||||
and bench_funvec l () =
|
and bench_funvec l () =
|
||||||
for _i = 0 to n-1 do opaque_ignore (CCFun_vec.set (* TODO *)) done
|
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) 100;
|
||||||
app_int (bench_flatten ~time:2) 10_000;
|
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"
|
"append"
|
||||||
@>> B.Tree.concat
|
@>> B.Tree.concat
|
||||||
|
|
@ -810,8 +851,8 @@ module Tbl = struct
|
||||||
end in
|
end in
|
||||||
(module T)
|
(module T)
|
||||||
|
|
||||||
let persistent_hashtbl_ref :
|
let persistent_hashtbl_ref : type a.
|
||||||
type a. a key_type -> (module MUT with type key = a) =
|
a key_type -> (module MUT with type key = a) =
|
||||||
fun key ->
|
fun key ->
|
||||||
let (module Key), name = arg_make key in
|
let (module Key), name = arg_make key in
|
||||||
let module T = Ref_impl.PersistentHashtbl (Key) in
|
let module T = Ref_impl.PersistentHashtbl (Key) in
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
# This file is generated by dune, edit dune-project instead
|
# This file is generated by dune, edit dune-project instead
|
||||||
opam-version: "2.0"
|
opam-version: "2.0"
|
||||||
version: "3.15"
|
version: "3.17"
|
||||||
synopsis: "A set of advanced datatypes for containers"
|
synopsis: "A set of advanced datatypes for containers"
|
||||||
maintainer: ["c-cube"]
|
maintainer: ["c-cube"]
|
||||||
authors: ["c-cube"]
|
authors: ["c-cube"]
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
# This file is generated by dune, edit dune-project instead
|
# This file is generated by dune, edit dune-project instead
|
||||||
opam-version: "2.0"
|
opam-version: "2.0"
|
||||||
version: "3.15"
|
version: "3.17"
|
||||||
synopsis:
|
synopsis:
|
||||||
"A modular, clean and powerful extension of the OCaml standard library"
|
"A modular, clean and powerful extension of the OCaml standard library"
|
||||||
maintainer: ["c-cube"]
|
maintainer: ["c-cube"]
|
||||||
|
|
|
||||||
78
dune-project
78
dune-project
|
|
@ -1,42 +1,60 @@
|
||||||
(lang dune 3.0)
|
(lang dune 3.0)
|
||||||
|
|
||||||
(name containers)
|
(name containers)
|
||||||
|
|
||||||
(generate_opam_files true)
|
(generate_opam_files true)
|
||||||
|
|
||||||
(version 3.15)
|
(version 3.17)
|
||||||
|
|
||||||
(authors c-cube)
|
(authors c-cube)
|
||||||
|
|
||||||
(maintainers c-cube)
|
(maintainers c-cube)
|
||||||
|
|
||||||
(license BSD-2-Clause)
|
(license BSD-2-Clause)
|
||||||
|
|
||||||
(homepage "https://github.com/c-cube/ocaml-containers/")
|
(homepage "https://github.com/c-cube/ocaml-containers/")
|
||||||
(source (github c-cube/ocaml-containers))
|
|
||||||
|
(source
|
||||||
|
(github c-cube/ocaml-containers))
|
||||||
|
|
||||||
(package
|
(package
|
||||||
(name containers)
|
(name containers)
|
||||||
(synopsis "A modular, clean and powerful extension of the OCaml standard library")
|
(synopsis
|
||||||
(tags (stdlib containers iterators list heap queue))
|
"A modular, clean and powerful extension of the OCaml standard library")
|
||||||
(depends
|
(tags
|
||||||
(ocaml (>= 4.08))
|
(stdlib containers iterators list heap queue))
|
||||||
either
|
(depends
|
||||||
dune-configurator
|
(ocaml
|
||||||
(qcheck-core (and (>= 0.18) :with-test))
|
(>= 4.08))
|
||||||
(yojson :with-test)
|
either
|
||||||
(iter :with-test)
|
dune-configurator
|
||||||
(gen :with-test)
|
(qcheck-core
|
||||||
(csexp :with-test)
|
(and
|
||||||
(uutf :with-test)
|
(>= 0.18)
|
||||||
(odoc :with-doc))
|
:with-test))
|
||||||
(depopts
|
(yojson :with-test)
|
||||||
base-unix
|
(iter :with-test)
|
||||||
base-threads))
|
(gen :with-test)
|
||||||
|
(csexp :with-test)
|
||||||
|
(uutf :with-test)
|
||||||
|
(odoc :with-doc))
|
||||||
|
(depopts base-unix base-threads))
|
||||||
|
|
||||||
(package
|
(package
|
||||||
(name containers-data)
|
(name containers-data)
|
||||||
(synopsis "A set of advanced datatypes for containers")
|
(synopsis "A set of advanced datatypes for containers")
|
||||||
(tags (containers RAL function vector okasaki))
|
(tags
|
||||||
(depends
|
(containers RAL function vector okasaki))
|
||||||
(ocaml (>= 4.08))
|
(depends
|
||||||
(containers (= :version))
|
(ocaml
|
||||||
(qcheck-core (and (>= 0.18) :with-test))
|
(>= 4.08))
|
||||||
(iter :with-test)
|
(containers
|
||||||
(gen :with-test)
|
(= :version))
|
||||||
(mdx :with-test)
|
(qcheck-core
|
||||||
(odoc :with-doc)))
|
(and
|
||||||
|
(>= 0.18)
|
||||||
|
:with-test))
|
||||||
|
(iter :with-test)
|
||||||
|
(gen :with-test)
|
||||||
|
(mdx :with-test)
|
||||||
|
(odoc :with-doc)))
|
||||||
|
|
|
||||||
|
|
@ -108,7 +108,8 @@ module Bitfield = struct
|
||||||
if self.emit_failure_if_too_wide then
|
if self.emit_failure_if_too_wide then
|
||||||
fpf out
|
fpf out
|
||||||
"(* check that int size is big enough *)@,\
|
"(* 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 "@]"
|
fpf out "@]"
|
||||||
|
|
||||||
let gen_mli self : code =
|
let gen_mli self : code =
|
||||||
|
|
|
||||||
|
|
@ -93,7 +93,7 @@ let sort_indices cmp a =
|
||||||
Array.sort (fun k1 k2 -> cmp a.(k1) a.(k2)) b;
|
Array.sort (fun k1 k2 -> cmp a.(k1) a.(k2)) b;
|
||||||
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 rev a =
|
||||||
let b = Array.copy a in
|
let b = Array.copy a in
|
||||||
|
|
|
||||||
|
|
@ -46,3 +46,24 @@ let[@inline never] decr r =
|
||||||
(* atomic *)
|
(* atomic *)
|
||||||
|
|
||||||
[@@@endif]
|
[@@@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
|
||||||
|
|
|
||||||
|
|
@ -23,3 +23,12 @@ module Infix = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
include Infix
|
include Infix
|
||||||
|
|
||||||
|
let is_uppercase_ascii c = c > '\064' && c < '\091'
|
||||||
|
let is_lowercase_ascii c = c > '\096' && c < '\123'
|
||||||
|
|
||||||
|
let is_letter_ascii c =
|
||||||
|
(is_lowercase_ascii [@inlined]) c || (is_uppercase_ascii [@inlined]) c
|
||||||
|
|
||||||
|
let is_digit_ascii c = c > '\047' && c < '\058'
|
||||||
|
let is_whitespace_ascii c = c = '\032' || (c > '\008' && c < '\014')
|
||||||
|
|
|
||||||
|
|
@ -34,6 +34,32 @@ val pp_buf : Buffer.t -> t -> unit
|
||||||
val pp : Format.formatter -> t -> unit
|
val pp : Format.formatter -> t -> unit
|
||||||
(** Renamed from [print] since 2.0. *)
|
(** Renamed from [print] since 2.0. *)
|
||||||
|
|
||||||
|
val is_uppercase_ascii : t -> bool
|
||||||
|
(** [is_uppercase_ascii c] is true exactly when [c] is an
|
||||||
|
uppercase ASCII character, i.e. ['\064'] < [c] < ['\091'].
|
||||||
|
@since 3.16 *)
|
||||||
|
|
||||||
|
val is_lowercase_ascii : t -> bool
|
||||||
|
(** [is_lowercase_ascii c] is true exactly when [c] is a
|
||||||
|
lowercase ASCII character, i.e. ['\096'] < [c] < ['\123'].
|
||||||
|
@since 3.16 *)
|
||||||
|
|
||||||
|
val is_letter_ascii : t -> bool
|
||||||
|
(** [is_letter_ascii c] is true exactly when [c] is an ASCII
|
||||||
|
letter, i.e. [is_uppercase_ascii c || is_lowercase_ascii c].
|
||||||
|
@since 3.16 *)
|
||||||
|
|
||||||
|
val is_digit_ascii : t -> bool
|
||||||
|
(** [is_digit_ascii c] is true exactly when [c] is an
|
||||||
|
ASCII digit, i.e. ['\047'] < [c] < ['\058'].
|
||||||
|
@since 3.16 *)
|
||||||
|
|
||||||
|
val is_whitespace_ascii : t -> bool
|
||||||
|
(** [is_whitespace_ascii c] is true exactly when [c] is an ASCII
|
||||||
|
whitespace character as defined by Unicode, i.e. either [c = ' ']
|
||||||
|
or ['\008'] < [c] < ['\014'].
|
||||||
|
@since 3.16 *)
|
||||||
|
|
||||||
(** {2 Infix Operators}
|
(** {2 Infix Operators}
|
||||||
|
|
||||||
@since 3.3 *)
|
@since 3.3 *)
|
||||||
|
|
|
||||||
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
(** Either Monad
|
(** Either Monad
|
||||||
|
|
||||||
Module that is compatible with Either form OCaml 4.12 but can be use with any
|
Module that is compatible with Either from OCaml 4.12 but can be use with any
|
||||||
ocaml version compatible with container
|
ocaml version compatible with container
|
||||||
|
|
||||||
@since 3.2
|
@since 3.2
|
||||||
|
|
|
||||||
|
|
@ -32,7 +32,6 @@ let newline = Format.pp_force_newline
|
||||||
let substring out (s, i, len) : unit = string out (String.sub s i len)
|
let substring out (s, i, len) : unit = string out (String.sub s i len)
|
||||||
let text = Format.pp_print_text
|
let text = Format.pp_print_text
|
||||||
let option = Format.pp_print_option
|
let option = Format.pp_print_option
|
||||||
let opt = option
|
|
||||||
let result = Format.pp_print_result
|
let result = Format.pp_print_result
|
||||||
|
|
||||||
let string_lines out (s : string) : unit =
|
let string_lines out (s : string) : unit =
|
||||||
|
|
@ -91,6 +90,11 @@ let iter ?(sep = return ",@ ") pp fmt seq =
|
||||||
sep fmt ();
|
sep fmt ();
|
||||||
pp fmt x)
|
pp fmt x)
|
||||||
|
|
||||||
|
let opt pp fmt x =
|
||||||
|
match x with
|
||||||
|
| None -> Format.pp_print_string fmt "none"
|
||||||
|
| Some x -> Format.fprintf fmt "some %a" pp x
|
||||||
|
|
||||||
let pair ?(sep = return ",@ ") ppa ppb fmt (a, b) =
|
let pair ?(sep = return ",@ ") ppa ppb fmt (a, b) =
|
||||||
Format.fprintf fmt "%a%a%a" ppa a sep () ppb b
|
Format.fprintf fmt "%a%a%a" ppa a sep () ppb b
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -100,13 +100,16 @@ val seq : ?sep:unit printer -> 'a printer -> 'a Seq.t printer
|
||||||
val iter : ?sep:unit printer -> 'a printer -> 'a iter printer
|
val iter : ?sep:unit printer -> 'a printer -> 'a iter printer
|
||||||
|
|
||||||
val option : ?none:unit printer -> 'a printer -> 'a option printer
|
val option : ?none:unit printer -> 'a printer -> 'a option printer
|
||||||
(** [opt ?none pp] prints options as follows:
|
(** [option ?none pp] prints options as follows:
|
||||||
- [Some x] will become [pp x]
|
- [Some x] will become [pp x]
|
||||||
- [None] will become [none ()]
|
- [None] will become [none ()]
|
||||||
|
Alias of {!Format.pp_print_option}
|
||||||
@since NEXT_RELEASE *)
|
@since NEXT_RELEASE *)
|
||||||
|
|
||||||
val opt : ?none:unit printer -> 'a printer -> 'a option printer
|
val opt : 'a printer -> 'a option printer
|
||||||
(** Alias of {!option} *)
|
(** [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
|
val result : ok:'a printer -> error:'e printer -> ('a, 'e) result printer
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -10,13 +10,7 @@ include Fun
|
||||||
|
|
||||||
let[@inline] and_pred f g x = f x && g x
|
let[@inline] and_pred f g x = f x && g x
|
||||||
let[@inline] or_pred f g x = f x || g x
|
let[@inline] or_pred f g x = f x || g x
|
||||||
|
let[@inline] compose f g x = g (f x)
|
||||||
[@@@iflt 5.2]
|
|
||||||
|
|
||||||
let[@inline] compose f g x = f (g x)
|
|
||||||
|
|
||||||
[@@@endif]
|
|
||||||
|
|
||||||
let[@inline] compose_binop f g x y = g (f x) (f y)
|
let[@inline] compose_binop f g x y = g (f x) (f y)
|
||||||
let[@inline] curry f x y = f (x, y)
|
let[@inline] curry f x y = f (x, y)
|
||||||
let[@inline] uncurry f (x, y) = f x y
|
let[@inline] uncurry f (x, y) = f x y
|
||||||
|
|
@ -67,9 +61,16 @@ let rec iterate n f x =
|
||||||
else
|
else
|
||||||
iterate (n - 1) f (f x)
|
iterate (n - 1) f (f x)
|
||||||
|
|
||||||
|
let[@inline] with_return (type ret) f : ret =
|
||||||
|
let exception E of ret in
|
||||||
|
let return x = raise_notrace (E x) in
|
||||||
|
match f return with
|
||||||
|
| res -> res
|
||||||
|
| exception E res -> res
|
||||||
|
|
||||||
module Infix = struct
|
module Infix = struct
|
||||||
(* default implem for some operators *)
|
(* default implem for some operators *)
|
||||||
let ( %> ) f g = compose g f
|
let ( %> ) = compose
|
||||||
let[@inline] ( % ) f g x = f (g x)
|
let[@inline] ( % ) f g x = f (g x)
|
||||||
let ( let@ ) = ( @@ )
|
let ( let@ ) = ( @@ )
|
||||||
let ( ||> ) (a, b) f = f a b
|
let ( ||> ) (a, b) f = f a b
|
||||||
|
|
|
||||||
|
|
@ -17,13 +17,8 @@ val or_pred : ('a -> bool) -> ('a -> bool) -> 'a -> bool
|
||||||
@since 3.13.1
|
@since 3.13.1
|
||||||
*)
|
*)
|
||||||
|
|
||||||
[@@@iflt 5.2]
|
val compose : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
|
||||||
|
(** [compose f g x] is [g (f x)]. Composition. *)
|
||||||
val compose : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c
|
|
||||||
(** [compose f g x] is [f (g x)]. Composition.
|
|
||||||
@since NEXT_RELEASE arguments are inversted *)
|
|
||||||
|
|
||||||
[@@@endif]
|
|
||||||
|
|
||||||
val compose_binop : ('a -> 'b) -> ('b -> 'b -> 'c) -> 'a -> 'a -> 'c
|
val compose_binop : ('a -> 'b) -> ('b -> 'b -> 'c) -> 'a -> 'a -> 'c
|
||||||
(** [compose_binop f g] is [fun x y -> g (f x) (f y)].
|
(** [compose_binop f g] is [fun x y -> g (f x) (f y)].
|
||||||
|
|
@ -83,14 +78,29 @@ val iterate : int -> ('a -> 'a) -> 'a -> 'a
|
||||||
[x], [iterate 1 f x] is [f x], [iterate 2 f x] is [f (f x)], etc.
|
[x], [iterate 1 f x] is [f x], [iterate 2 f x] is [f (f x)], etc.
|
||||||
@since 2.1 *)
|
@since 2.1 *)
|
||||||
|
|
||||||
|
val with_return : (('ret -> 'a) -> 'ret) -> 'ret
|
||||||
|
(** [with_return f] is [f return], where [return] is a function
|
||||||
|
that can be invoked to exit the scope early.
|
||||||
|
|
||||||
|
For example:
|
||||||
|
{[
|
||||||
|
let find_array arr x =
|
||||||
|
let@ return = with_return in
|
||||||
|
for i = 0 to Array.length arr-1 do
|
||||||
|
if arr.(i) = x then return i;
|
||||||
|
done;
|
||||||
|
-1
|
||||||
|
]}
|
||||||
|
|
||||||
|
@since 3.15 *)
|
||||||
|
|
||||||
(** {2 Infix}
|
(** {2 Infix}
|
||||||
|
|
||||||
Infix operators. *)
|
Infix operators. *)
|
||||||
|
|
||||||
module Infix : sig
|
module Infix : sig
|
||||||
val ( %> ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
|
val ( %> ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
|
||||||
(** [(f %> g) x] or [(%>) f g x] is [g (f x)]. Infix version of [compose].
|
(** [(f %> g) x] or [(%>) f g x] is [g (f x)]. Alias to [compose]. *)
|
||||||
The order of the arguments of [%>] and {!compose} are inverted. *)
|
|
||||||
|
|
||||||
val ( % ) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c
|
val ( % ) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c
|
||||||
(** [(f % g) x] or [(%) f g x] is [f (g x)]. Mathematical composition. *)
|
(** [(f % g) x] or [(%) f g x] is [f (g x)]. Mathematical composition. *)
|
||||||
|
|
|
||||||
|
|
@ -101,7 +101,7 @@ let max_len_b_ = 128
|
||||||
|
|
||||||
let bytes (x : bytes) =
|
let bytes (x : bytes) =
|
||||||
let h = ref fnv_offset_basis in
|
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));
|
(h := Int64.(mul !h fnv_prime));
|
||||||
let byte = Char.code (Bytes.unsafe_get x i) in
|
let byte = Char.code (Bytes.unsafe_get x i) in
|
||||||
h := Int64.(logxor !h (of_int byte))
|
h := Int64.(logxor !h (of_int byte))
|
||||||
|
|
|
||||||
|
|
@ -752,6 +752,12 @@ let sorted_diff_uniq ~cmp l1 l2 =
|
||||||
in
|
in
|
||||||
recurse ~cmp [] l1 l2
|
recurse ~cmp [] l1 l2
|
||||||
|
|
||||||
|
let rec drop n l =
|
||||||
|
match l with
|
||||||
|
| [] -> []
|
||||||
|
| _ when n = 0 -> l
|
||||||
|
| _ :: l' -> drop (n - 1) l'
|
||||||
|
|
||||||
[@@@iflt 4.14]
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
let take n l =
|
let take n l =
|
||||||
|
|
@ -772,6 +778,8 @@ let take n l =
|
||||||
in
|
in
|
||||||
direct direct_depth_default_ n l
|
direct direct_depth_default_ n l
|
||||||
|
|
||||||
|
let take_drop n l = take n l, drop n l
|
||||||
|
|
||||||
[@@@else_]
|
[@@@else_]
|
||||||
|
|
||||||
let[@tail_mod_cons] rec take n l =
|
let[@tail_mod_cons] rec take n l =
|
||||||
|
|
@ -783,20 +791,29 @@ let[@tail_mod_cons] rec take n l =
|
||||||
else
|
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 =
|
[@@@endif]
|
||||||
match l with
|
|
||||||
| [] -> []
|
|
||||||
| _ when n = 0 -> l
|
|
||||||
| _ :: l' -> drop (n - 1) l'
|
|
||||||
|
|
||||||
let hd_tl = function
|
let hd_tl = function
|
||||||
| [] -> failwith "hd_tl"
|
| [] -> failwith "hd_tl"
|
||||||
| x :: l -> x, l
|
| 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 =
|
let sublists_of_len ?(last = fun _ -> None) ?offset n l =
|
||||||
if n < 1 then invalid_arg "sublists_of_len: n must be > 0";
|
if n < 1 then invalid_arg "sublists_of_len: n must be > 0";
|
||||||
let offset =
|
let offset =
|
||||||
|
|
|
||||||
|
|
@ -375,7 +375,7 @@ val mguard : bool -> unit t
|
||||||
@since 3.1 *)
|
@since 3.1 *)
|
||||||
|
|
||||||
val return : 'a -> 'a t
|
val return : 'a -> 'a t
|
||||||
(** [return x] is [x]. *)
|
(** [return x] is [[x]]. *)
|
||||||
|
|
||||||
val take : int -> 'a t -> 'a t
|
val take : int -> 'a t -> 'a t
|
||||||
(** [take n l] takes the [n] first elements of the list [l], drop the rest. *)
|
(** [take n l] takes the [n] first elements of the list [l], drop the rest. *)
|
||||||
|
|
|
||||||
|
|
@ -20,47 +20,6 @@ module type S = sig
|
||||||
and returns [default] otherwise (if [k] doesn't belong in [m]).
|
and returns [default] otherwise (if [k] doesn't belong in [m]).
|
||||||
@since 0.16 *)
|
@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 :
|
val merge_safe :
|
||||||
f:(key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) ->
|
f:(key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) ->
|
||||||
'a t ->
|
'a t ->
|
||||||
|
|
@ -69,24 +28,12 @@ module type S = sig
|
||||||
(** [merge_safe ~f a b] merges the maps [a] and [b] together.
|
(** [merge_safe ~f a b] merges the maps [a] and [b] together.
|
||||||
@since 0.17 *)
|
@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 :
|
val add_seq_with :
|
||||||
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> 'a t
|
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],
|
(** [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.
|
using [f] to combine values that have the same key.
|
||||||
@since 3.3 *)
|
@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
|
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],
|
(** [of_seq_with ~f l] builds a map from the given seq [l] of bindings [k_i -> v_i],
|
||||||
added in order using {!add}.
|
added in order using {!add}.
|
||||||
|
|
@ -178,62 +125,6 @@ module Make (O : Map.OrderedType) = struct
|
||||||
(* backport functions from recent stdlib.
|
(* backport functions from recent stdlib.
|
||||||
they will be shadowed by inclusion of [S] if present. *)
|
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.
|
(* === include M.
|
||||||
This will shadow some values depending on OCaml's current version
|
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)))
|
| Some v1, Some v2 -> f k (`Both (v1, v2)))
|
||||||
a b
|
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 add_seq_with ~f m s =
|
||||||
let combine k v = function
|
let combine k v = function
|
||||||
| None -> Some v
|
| None -> Some v
|
||||||
|
|
@ -265,7 +151,6 @@ module Make (O : Map.OrderedType) = struct
|
||||||
in
|
in
|
||||||
Seq.fold_left (fun m (k, v) -> update k (combine k v) m) m s
|
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 of_seq_with ~f s = add_seq_with ~f empty s
|
||||||
|
|
||||||
let add_iter m s =
|
let add_iter m s =
|
||||||
|
|
@ -296,10 +181,20 @@ module Make (O : Map.OrderedType) = struct
|
||||||
in
|
in
|
||||||
List.fold_left (fun m (k, v) -> update k (combine k v) m) m l
|
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
|
let of_list l = add_list empty l
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let of_list_with ~f l = add_list_with ~f empty l
|
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 []
|
let to_list m = fold (fun k v acc -> (k, v) :: acc) m []
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let pp ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ())
|
let pp ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ())
|
||||||
?(pp_arrow = fun fmt () -> Format.fprintf fmt "@ -> ")
|
?(pp_arrow = fun fmt () -> Format.fprintf fmt "@ -> ")
|
||||||
?(pp_sep = fun fmt () -> Format.fprintf fmt ",@ ") pp_k pp_v fmt m =
|
?(pp_sep = fun fmt () -> Format.fprintf fmt ",@ ") pp_k pp_v fmt m =
|
||||||
|
|
|
||||||
|
|
@ -16,6 +16,7 @@ module type OrderedType = Map.OrderedType
|
||||||
|
|
||||||
module type S = sig
|
module type S = sig
|
||||||
include Map.S
|
include Map.S
|
||||||
|
(** @inline *)
|
||||||
|
|
||||||
val get : key -> 'a t -> 'a option
|
val get : key -> 'a t -> 'a option
|
||||||
(** [get k m] returns [Some v] if the current binding of [k] in [m] is [v],
|
(** [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]).
|
and returns [default] otherwise (if [k] doesn't belong in [m]).
|
||||||
@since 0.16 *)
|
@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 :
|
val merge_safe :
|
||||||
f:(key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) ->
|
f:(key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) ->
|
||||||
'a t ->
|
'a t ->
|
||||||
|
|
@ -76,12 +36,6 @@ module type S = sig
|
||||||
(** [merge_safe ~f a b] merges the maps [a] and [b] together.
|
(** [merge_safe ~f a b] merges the maps [a] and [b] together.
|
||||||
@since 0.17 *)
|
@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 :
|
val add_seq_with :
|
||||||
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> 'a t
|
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],
|
(** [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].
|
later in the seq than [v2].
|
||||||
@since 3.3 *)
|
@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
|
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],
|
(** [of_seq_with ~f l] builds a map from the given seq [l] of bindings [k_i -> v_i],
|
||||||
added in order using {!add}.
|
added in order using {!add}.
|
||||||
|
|
|
||||||
|
|
@ -2,8 +2,13 @@
|
||||||
|
|
||||||
include Nativeint
|
include Nativeint
|
||||||
|
|
||||||
|
[@@@iflt 4.13]
|
||||||
|
|
||||||
let min : t -> t -> t = Stdlib.min
|
let min : t -> t -> t = Stdlib.min
|
||||||
let max : t -> t -> t = Stdlib.max
|
let max : t -> t -> t = Stdlib.max
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let hash x = Stdlib.abs (to_int x)
|
let hash x = Stdlib.abs (to_int x)
|
||||||
let sign i = compare i zero
|
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} *)
|
(** {2 Conversion} *)
|
||||||
|
|
||||||
let of_string_exn = of_string
|
let of_string_exn = of_string
|
||||||
let of_string x = try Some (of_string_exn x) with Failure _ -> None
|
let of_string = of_string_opt
|
||||||
let of_string_opt = of_string
|
|
||||||
let most_significant_bit = logxor (neg 1n) (shift_right_logical (neg 1n) 1)
|
let most_significant_bit = logxor (neg 1n) (shift_right_logical (neg 1n) 1)
|
||||||
|
|
||||||
type output = char -> unit
|
type output = char -> unit
|
||||||
|
|
|
||||||
|
|
@ -2,14 +2,14 @@
|
||||||
|
|
||||||
(** Helpers for processor-native integers
|
(** Helpers for processor-native integers
|
||||||
|
|
||||||
This module provides operations on the type [nativeint] of signed 32-bit 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).
|
(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.
|
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
|
All arithmetic operations over nativeint are taken modulo 2{^32} or 2{^64} depending
|
||||||
on the word size of the architecture.
|
on the word size of the architecture.
|
||||||
|
|
||||||
Performance notice: values of type [nativeint] occupy more memory space than values of type [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].
|
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.
|
Use [nativeint] only when the application requires the extra bit of precision over the [int] type.
|
||||||
|
|
||||||
@since 2.1 *)
|
@since 2.1 *)
|
||||||
|
|
@ -18,6 +18,7 @@
|
||||||
include module type of struct
|
include module type of struct
|
||||||
include Nativeint
|
include Nativeint
|
||||||
end
|
end
|
||||||
|
(** @inline *)
|
||||||
|
|
||||||
val min : t -> t -> t
|
val min : t -> t -> t
|
||||||
(** [min x y] returns the minimum of the two integers [x] and [y].
|
(** [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
|
module Infix : sig
|
||||||
val ( + ) : t -> t -> t
|
val ( + ) : t -> t -> t
|
||||||
(** [x + y] is the sum of [x] and [y].
|
(** [x + y] is the sum of [x] and [y].
|
||||||
Addition. *)
|
Addition. *)
|
||||||
|
|
||||||
val ( - ) : t -> t -> t
|
val ( - ) : t -> t -> t
|
||||||
|
|
|
||||||
|
|
@ -2,11 +2,7 @@
|
||||||
|
|
||||||
(** {1 Options} *)
|
(** {1 Options} *)
|
||||||
|
|
||||||
type 'a t = 'a option
|
include Option
|
||||||
|
|
||||||
let[@inline] map f = function
|
|
||||||
| None -> None
|
|
||||||
| Some x -> Some (f x)
|
|
||||||
|
|
||||||
let map_or ~default f = function
|
let map_or ~default f = function
|
||||||
| None -> default
|
| None -> default
|
||||||
|
|
@ -16,30 +12,7 @@ let map_lazy default_fn f = function
|
||||||
| None -> default_fn ()
|
| None -> default_fn ()
|
||||||
| Some x -> f x
|
| 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 return x = Some x
|
||||||
let some = return
|
|
||||||
let none = None
|
|
||||||
|
|
||||||
let[@inline] flat_map f o =
|
let[@inline] flat_map f o =
|
||||||
match o with
|
match o with
|
||||||
|
|
@ -51,7 +24,6 @@ let[@inline] flat_map_l f o =
|
||||||
| None -> []
|
| None -> []
|
||||||
| Some x -> f x
|
| Some x -> f x
|
||||||
|
|
||||||
let[@inline] bind o f = flat_map f o
|
|
||||||
let ( >>= ) = bind
|
let ( >>= ) = bind
|
||||||
let pure x = Some x
|
let pure x = Some x
|
||||||
let k_compose f g x = f x |> flat_map g
|
let k_compose f g x = f x |> flat_map g
|
||||||
|
|
@ -99,11 +71,6 @@ let for_all p = function
|
||||||
| None -> true
|
| None -> true
|
||||||
| Some x -> p x
|
| Some x -> p x
|
||||||
|
|
||||||
let iter f o =
|
|
||||||
match o with
|
|
||||||
| None -> ()
|
|
||||||
| Some x -> f x
|
|
||||||
|
|
||||||
let fold f acc o =
|
let fold f acc o =
|
||||||
match o with
|
match o with
|
||||||
| None -> acc
|
| None -> acc
|
||||||
|
|
@ -121,11 +88,6 @@ let apply_or f x =
|
||||||
|
|
||||||
let ( |?> ) x f = 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
|
let get_exn = function
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
| None -> invalid_arg "CCOption.get_exn"
|
| None -> invalid_arg "CCOption.get_exn"
|
||||||
|
|
@ -164,11 +126,6 @@ let wrap2 ?(handler = fun _ -> true) f x y =
|
||||||
else
|
else
|
||||||
raise e
|
raise e
|
||||||
|
|
||||||
let to_list o =
|
|
||||||
match o with
|
|
||||||
| None -> []
|
|
||||||
| Some x -> [ x ]
|
|
||||||
|
|
||||||
let of_list = function
|
let of_list = function
|
||||||
| x :: _ -> Some x
|
| x :: _ -> Some x
|
||||||
| [] -> None
|
| [] -> None
|
||||||
|
|
@ -254,11 +211,6 @@ let to_iter o k =
|
||||||
| None -> ()
|
| None -> ()
|
||||||
| Some x -> k x
|
| 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
|
let pp ppx out = function
|
||||||
| None -> Format.pp_print_string out "None"
|
| None -> Format.pp_print_string out "None"
|
||||||
| Some x -> Format.fprintf out "@[Some %a@]" ppx x
|
| Some x -> Format.fprintf out "@[Some %a@]" ppx x
|
||||||
|
|
|
||||||
|
|
@ -5,10 +5,8 @@
|
||||||
This module replaces `CCOpt`.
|
This module replaces `CCOpt`.
|
||||||
@since 3.6 *)
|
@since 3.6 *)
|
||||||
|
|
||||||
type +'a t = 'a option
|
include module type of Option
|
||||||
|
(** @inline *)
|
||||||
val map : ('a -> 'b) -> 'a t -> 'b t
|
|
||||||
(** [map f o] applies the function [f] to the element inside [o], if any. *)
|
|
||||||
|
|
||||||
val map_or : default:'b -> ('a -> 'b) -> 'a t -> 'b
|
val map_or : default:'b -> ('a -> 'b) -> 'a t -> 'b
|
||||||
(** [map_or ~default f o] is [f x] if [o = Some x], [default] otherwise.
|
(** [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.
|
(** [map_lazy default_fn f o] is [f x] if [o = Some x], [default_fn ()] otherwise.
|
||||||
@since 1.2 *)
|
@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
|
val return : 'a -> 'a t
|
||||||
(** [return x] is a monadic return, that is [return x = Some x]. *)
|
(** [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
|
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
|
||||||
(** [flat_map f o] is equivalent to {!map} followed by {!flatten}.
|
(** [flat_map f o] is equivalent to {!map} followed by {!flatten}.
|
||||||
Flip version of {!(>>=)}. *)
|
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].
|
(** [flat_map_l f o] is [[]] if [o] is [None], or [f x] if [o] is [Some x].
|
||||||
@since 3.12 *)
|
@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
|
val k_compose : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t
|
||||||
(** Kleisli composition. Monadic equivalent of {!CCFun.compose}
|
(** Kleisli composition. Monadic equivalent of {!CCFun.compose}
|
||||||
@since 3.13.1 *)
|
@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
|
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]. *)
|
(** [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
|
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 f init o] is [f init x] if [o] is [Some x], or [init] if [o] is [None].
|
||||||
Fold on 0 or 1 element. *)
|
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".
|
turning functions like "remove" into "remove_if_it_exists".
|
||||||
@since 3.13.1 *)
|
@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
|
val get_exn : 'a t -> 'a
|
||||||
[@@ocaml.deprecated "use CCOption.get_exn_or instead"]
|
[@@ocaml.deprecated "use CCOption.get_exn_or instead"]
|
||||||
(** [get_exn o] returns [x] if [o] is [Some x] or fails if [o] is [None].
|
(** [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} *)
|
(** {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
|
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. *)
|
(** [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]
|
(** [to_gen o] is [o] as a [gen]. [Some x] is the singleton [gen] containing [x]
|
||||||
and [None] is the empty [gen]. *)
|
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
|
val to_iter : 'a t -> 'a iter
|
||||||
(** [to_iter o] returns an internal iterator, like in the library [Iter].
|
(** [to_iter o] returns an internal iterator, like in the library [Iter].
|
||||||
@since 2.8 *)
|
@since 2.8 *)
|
||||||
|
|
|
||||||
|
|
@ -2,27 +2,53 @@
|
||||||
|
|
||||||
(** {1 Tuple Functions} *)
|
(** {1 Tuple Functions} *)
|
||||||
|
|
||||||
|
[@@@ifge 5.4]
|
||||||
|
|
||||||
|
include Pair
|
||||||
|
|
||||||
|
[@@@else_]
|
||||||
|
|
||||||
type ('a, 'b) t = 'a * 'b
|
type ('a, 'b) t = 'a * 'b
|
||||||
|
|
||||||
let make x y = x, y
|
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_fst f (x, y) = f x, y
|
||||||
let map_snd f (x, y) = x, f y
|
let map_snd f (x, y) = x, f y
|
||||||
let map f g (x, y) = f x, g y
|
let map f g (x, y) = f x, g y
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let map_same f (x, y) = f x, f y
|
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 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 map_same2 f (a, b) (x, y) = f a x, f b y
|
||||||
let fst_map f (x, _) = f x
|
let fst_map f (x, _) = f x
|
||||||
let snd_map f (_, x) = f x
|
let snd_map f (_, x) = f x
|
||||||
|
|
||||||
|
[@@@iflt 5.4]
|
||||||
|
|
||||||
let iter f (x, y) = f x y
|
let iter f (x, y) = f x y
|
||||||
let swap (x, y) = y, x
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let ( <<< ) = map_fst
|
let ( <<< ) = map_fst
|
||||||
let ( >>> ) = map_snd
|
let ( >>> ) = map_snd
|
||||||
let ( *** ) = map
|
let ( *** ) = map
|
||||||
let ( &&& ) f g x = f x, g x
|
let ( &&& ) f g x = f x, g x
|
||||||
let merge f (x, y) = f x y
|
let merge f (x, y) = f x y
|
||||||
|
|
||||||
|
[@@@iflt 5.4]
|
||||||
|
|
||||||
let fold = merge
|
let fold = merge
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let dup x = x, x
|
let dup x = x, x
|
||||||
let dup_map f x = x, f 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 equal f g (x1, y1) (x2, y2) = f x1 x2 && g y1 y2
|
||||||
|
|
||||||
let compare f g (x1, y1) (x2, y2) =
|
let compare f g (x1, y1) (x2, y2) =
|
||||||
|
|
@ -32,6 +58,8 @@ let compare f g (x1, y1) (x2, y2) =
|
||||||
else
|
else
|
||||||
g y1 y2
|
g y1 y2
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let to_string ?(sep = ", ") a_to_string b_to_string (x, y) =
|
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)
|
Printf.sprintf "%s%s%s" (a_to_string x) sep (b_to_string y)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -2,12 +2,28 @@
|
||||||
|
|
||||||
(** Tuple Functions *)
|
(** Tuple Functions *)
|
||||||
|
|
||||||
|
[@@@ifge 5.4]
|
||||||
|
|
||||||
|
include module type of Pair
|
||||||
|
(** @inline *)
|
||||||
|
|
||||||
|
[@@@else_]
|
||||||
|
|
||||||
type ('a, 'b) t = 'a * 'b
|
type ('a, 'b) t = 'a * 'b
|
||||||
|
|
||||||
val make : 'a -> 'b -> ('a, 'b) t
|
val make : 'a -> 'b -> ('a, 'b) t
|
||||||
(** Make a tuple from its components.
|
(** Make a tuple from its components.
|
||||||
@since 0.16 *)
|
@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
|
val map_fst : ('a -> 'b) -> 'a * 'c -> 'b * 'c
|
||||||
(** [map_fst f (x, y)] returns [(f x, y)].
|
(** [map_fst f (x, y)] returns [(f x, y)].
|
||||||
Renamed from [map1] since 3.0. *)
|
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
|
val map : ('a -> 'c) -> ('b -> 'd) -> 'a * 'b -> 'c * 'd
|
||||||
(** Synonym to {!( *** )}. Map on both sides of a tuple. *)
|
(** Synonym to {!( *** )}. Map on both sides of a tuple. *)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
val map_same : ('a -> 'b) -> 'a * 'a -> 'b * 'b
|
val map_same : ('a -> 'b) -> 'a * 'a -> 'b * 'b
|
||||||
(** Like {!map} but specialized for pairs with elements of the same type. *)
|
(** 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.
|
Rename from [map_snd] since 3.0.
|
||||||
@since 0.3.3 *)
|
@since 0.3.3 *)
|
||||||
|
|
||||||
|
[@@@iflt 5.4]
|
||||||
|
|
||||||
val iter : ('a -> 'b -> unit) -> 'a * 'b -> unit
|
val iter : ('a -> 'b -> unit) -> 'a * 'b -> unit
|
||||||
|
|
||||||
val swap : 'a * 'b -> 'b * 'a
|
[@@@endif]
|
||||||
(** Swap the components of the tuple. *)
|
|
||||||
|
|
||||||
val ( <<< ) : ('a -> 'b) -> 'a * 'c -> 'b * 'c
|
val ( <<< ) : ('a -> 'b) -> 'a * 'c -> 'b * 'c
|
||||||
(** Map on the left side of the tuple. *)
|
(** 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
|
val merge : ('a -> 'b -> 'c) -> 'a * 'b -> 'c
|
||||||
(** Uncurrying (merges the two components of a tuple). *)
|
(** Uncurrying (merges the two components of a tuple). *)
|
||||||
|
|
||||||
|
[@@@iflt 5.4]
|
||||||
|
|
||||||
val fold : ('a -> 'b -> 'c) -> 'a * 'b -> 'c
|
val fold : ('a -> 'b -> 'c) -> 'a * 'b -> 'c
|
||||||
(** Synonym to {!merge}.
|
(** Synonym to {!merge}.
|
||||||
@since 0.3.3 *)
|
@since 0.3.3 *)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
val dup : 'a -> 'a * 'a
|
val dup : 'a -> 'a * 'a
|
||||||
(** [dup x = (x,x)] (duplicate the value).
|
(** [dup x = (x,x)] (duplicate the value).
|
||||||
@since 0.3.3 *)
|
@since 0.3.3 *)
|
||||||
|
|
@ -79,12 +102,16 @@ val dup_map : ('a -> 'b) -> 'a -> 'a * 'b
|
||||||
to the second copy.
|
to the second copy.
|
||||||
@since 0.3.3 *)
|
@since 0.3.3 *)
|
||||||
|
|
||||||
|
[@@@iflt 5.4]
|
||||||
|
|
||||||
val equal :
|
val equal :
|
||||||
('a -> 'a -> bool) -> ('b -> 'b -> bool) -> 'a * 'b -> 'a * 'b -> bool
|
('a -> 'a -> bool) -> ('b -> 'b -> bool) -> 'a * 'b -> 'a * 'b -> bool
|
||||||
|
|
||||||
val compare :
|
val compare :
|
||||||
('a -> 'a -> int) -> ('b -> 'b -> int) -> 'a * 'b -> 'a * 'b -> int
|
('a -> 'a -> int) -> ('b -> 'b -> int) -> 'a * 'b -> 'a * 'b -> int
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
val to_string :
|
val to_string :
|
||||||
?sep:string -> ('a -> string) -> ('b -> string) -> 'a * 'b -> string
|
?sep:string -> ('a -> string) -> ('b -> string) -> 'a * 'b -> string
|
||||||
(** Print tuple in a string
|
(** Print tuple in a string
|
||||||
|
|
|
||||||
|
|
@ -9,13 +9,7 @@ type 'a printer = Format.formatter -> 'a -> unit
|
||||||
|
|
||||||
(** {2 Basics} *)
|
(** {2 Basics} *)
|
||||||
|
|
||||||
type nonrec (+'good, +'bad) result = ('good, 'bad) result =
|
include Result
|
||||||
| Ok of 'good
|
|
||||||
| Error of 'bad
|
|
||||||
|
|
||||||
type (+'good, +'bad) t = ('good, 'bad) result =
|
|
||||||
| Ok of 'good
|
|
||||||
| Error of 'bad
|
|
||||||
|
|
||||||
let return x = Ok x
|
let return x = Ok x
|
||||||
let fail s = Error s
|
let fail s = Error s
|
||||||
|
|
@ -65,30 +59,14 @@ let opt_map f e =
|
||||||
| Ok x -> Ok (Some x)
|
| Ok x -> Ok (Some x)
|
||||||
| Error e -> Error e)
|
| Error e -> Error e)
|
||||||
|
|
||||||
let map f e =
|
let map_err = map_error
|
||||||
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 map2 f g e =
|
let map2 f g e =
|
||||||
match e with
|
match e with
|
||||||
| Ok x -> Ok (f x)
|
| Ok x -> Ok (f x)
|
||||||
| Error s -> Error (g s)
|
| Error s -> Error (g s)
|
||||||
|
|
||||||
let iter f e =
|
let iter_err = iter_error
|
||||||
match e with
|
|
||||||
| Ok x -> f x
|
|
||||||
| Error _ -> ()
|
|
||||||
|
|
||||||
let iter_err f e =
|
|
||||||
match e with
|
|
||||||
| Ok _ -> ()
|
|
||||||
| Error err -> f err
|
|
||||||
|
|
||||||
exception Get_error
|
exception Get_error
|
||||||
|
|
||||||
|
|
@ -132,6 +110,13 @@ let flat_map f e =
|
||||||
| Ok x -> f x
|
| Ok x -> f x
|
||||||
| Error s -> Error s
|
| 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 f g x = f x |> flat_map g
|
||||||
let ( >=> ) = k_compose
|
let ( >=> ) = k_compose
|
||||||
let ( <=< ) f g = g >=> f
|
let ( <=< ) f g = g >=> f
|
||||||
|
|
@ -149,24 +134,11 @@ let compare ~err cmp a b =
|
||||||
| _, Ok _ -> -1
|
| _, Ok _ -> -1
|
||||||
| Error s, Error s' -> err s s'
|
| 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 =
|
let fold_ok f acc r =
|
||||||
match r with
|
match r with
|
||||||
| Ok x -> f acc x
|
| Ok x -> f acc x
|
||||||
| Error _ -> acc
|
| Error _ -> acc
|
||||||
|
|
||||||
let is_ok = function
|
|
||||||
| Ok _ -> true
|
|
||||||
| Error _ -> false
|
|
||||||
|
|
||||||
let is_error = function
|
|
||||||
| Ok _ -> false
|
|
||||||
| Error _ -> true
|
|
||||||
|
|
||||||
(** {2 Wrappers} *)
|
(** {2 Wrappers} *)
|
||||||
|
|
||||||
let guard f = try Ok (f ()) with e -> Error e
|
let guard f = try Ok (f ()) with e -> Error e
|
||||||
|
|
@ -185,18 +157,18 @@ let ( <*> ) f x =
|
||||||
| Error s -> fail s
|
| Error s -> fail s
|
||||||
| Ok f -> map f x
|
| Ok f -> map f x
|
||||||
|
|
||||||
let join t =
|
[@@@iflt 5.4]
|
||||||
match t with
|
|
||||||
| Ok (Ok o) -> Ok o
|
|
||||||
| Ok (Error e) -> Error e
|
|
||||||
| Error _ as e -> e
|
|
||||||
|
|
||||||
let both x y =
|
let product x y =
|
||||||
match x, y with
|
match x, y with
|
||||||
| Ok o, Ok o' -> Ok (o, o')
|
| Ok o, Ok o' -> Ok (o, o')
|
||||||
| Ok _, Error e -> Error e
|
| Ok _, Error e -> Error e
|
||||||
| Error e, _ -> Error e
|
| Error e, _ -> Error e
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
|
let both = product
|
||||||
|
|
||||||
(** {2 Collections} *)
|
(** {2 Collections} *)
|
||||||
|
|
||||||
let map_l f l =
|
let map_l f l =
|
||||||
|
|
@ -331,19 +303,12 @@ end
|
||||||
|
|
||||||
(** {2 Conversions} *)
|
(** {2 Conversions} *)
|
||||||
|
|
||||||
let to_opt = function
|
let to_opt = to_option
|
||||||
| Ok x -> Some x
|
|
||||||
| Error _ -> None
|
|
||||||
|
|
||||||
let of_opt = function
|
let of_opt = function
|
||||||
| None -> Error "of_opt"
|
| None -> Error "of_opt"
|
||||||
| Some x -> Ok x
|
| 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 =
|
let to_iter e k =
|
||||||
match e with
|
match e with
|
||||||
| Ok x -> k x
|
| Ok x -> k x
|
||||||
|
|
|
||||||
|
|
@ -16,13 +16,8 @@ type 'a printer = Format.formatter -> 'a -> unit
|
||||||
|
|
||||||
(** {2 Basics} *)
|
(** {2 Basics} *)
|
||||||
|
|
||||||
type nonrec (+'good, +'bad) result = ('good, 'bad) result =
|
include module type of Result
|
||||||
| Ok of 'good
|
(** @inline *)
|
||||||
| Error of 'bad
|
|
||||||
|
|
||||||
type (+'good, +'bad) t = ('good, 'bad) result =
|
|
||||||
| Ok of 'good
|
|
||||||
| Error of 'bad
|
|
||||||
|
|
||||||
val return : 'a -> ('a, 'err) t
|
val return : 'a -> ('a, 'err) t
|
||||||
(** Successfully return a value. *)
|
(** 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.
|
(** Map a fallible operation through an option.
|
||||||
@since 3.7 *)
|
@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
|
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
|
val map2 : ('a -> 'b) -> ('err1 -> 'err2) -> ('a, 'err1) t -> ('b, 'err2) t
|
||||||
(** Like {!map}, but also with a function that can transform
|
(** Like {!map}, but also with a function that can transform
|
||||||
the error message in case of failure. *)
|
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
|
val iter_err : ('err -> unit) -> (_, 'err) t -> unit
|
||||||
(** Apply the function in case of [Error].
|
(** Alias of {!iter_error} *)
|
||||||
@since 2.4 *)
|
|
||||||
|
|
||||||
exception Get_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
|
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 :
|
val k_compose :
|
||||||
('a -> ('b, 'err) t) -> ('b -> ('c, 'err) t) -> 'a -> ('c, 'err) t
|
('a -> ('b, 'err) t) -> ('b -> ('c, 'err) t) -> 'a -> ('c, 'err) t
|
||||||
(** Kleisli composition. Monadic equivalent of {!CCFun.compose}.
|
(** 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 equal : err:'err equal -> 'a equal -> ('a, 'err) t equal
|
||||||
val compare : err:'err ord -> 'a ord -> ('a, 'err) t ord
|
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
|
val fold_ok : ('a -> 'b -> 'a) -> 'a -> ('b, _) t -> 'a
|
||||||
(** [fold_ok f acc r] will compute [f acc x] if [r=Ok x],
|
(** [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.
|
and return [acc] otherwise, as if the result were a mere option.
|
||||||
@since 1.2 *)
|
@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} *)
|
(** {2 Wrappers} *)
|
||||||
|
|
||||||
val guard : (unit -> 'a) -> ('a, exn) t
|
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
|
val pure : 'a -> ('a, 'err) t
|
||||||
(** Synonym of {!return}. *)
|
(** Synonym of {!return}. *)
|
||||||
|
|
||||||
val join : (('a, 'err) t, 'err) t -> ('a, 'err) t
|
[@@@iflt 5.4]
|
||||||
(** [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]. *)
|
|
||||||
|
|
||||||
val both : ('a, 'err) t -> ('b, 'err) t -> ('a * 'b, 'err) t
|
val product : ('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
|
(** [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
|
of [a] and [b]. Otherwise, it fails, and the error of [a] is chosen over the
|
||||||
error of [b] if both fail. *)
|
error of [b] if both fail. *)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
|
val both : ('a, 'err) t -> ('b, 'err) t -> ('a * 'b, 'err) t
|
||||||
|
(** Alias of {!product} *)
|
||||||
|
|
||||||
(** {2 Infix} *)
|
(** {2 Infix} *)
|
||||||
|
|
||||||
module Infix : sig
|
module Infix : sig
|
||||||
|
|
@ -279,7 +265,7 @@ end
|
||||||
(** {2 Conversions} *)
|
(** {2 Conversions} *)
|
||||||
|
|
||||||
val to_opt : ('a, _) t -> 'a option
|
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
|
val of_opt : 'a option -> ('a, string) t
|
||||||
(** [of_opt opt] converts [Some v] to [Ok v] and [None] to [Error "of_opt"].*)
|
(** [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
|
val to_iter : ('a, _) t -> 'a iter
|
||||||
(** @since 2.8 *)
|
(** @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 =
|
type ('a, 'b) error =
|
||||||
[ `Ok of 'a
|
[ `Ok of 'a
|
||||||
| `Error of 'b
|
| `Error of 'b
|
||||||
|
|
|
||||||
|
|
@ -9,10 +9,19 @@ type 'a printer = Format.formatter -> 'a -> unit
|
||||||
include Seq
|
include Seq
|
||||||
|
|
||||||
let nil () = Nil
|
let nil () = Nil
|
||||||
|
|
||||||
|
[@@@iflt 4.11]
|
||||||
|
|
||||||
let cons a b () = Cons (a, b)
|
let cons a b () = Cons (a, b)
|
||||||
let empty = nil
|
|
||||||
|
[@@@endif]
|
||||||
|
[@@@iflt 5.4]
|
||||||
|
|
||||||
let singleton x () = Cons (x, nil)
|
let singleton x () = Cons (x, nil)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
[@@@iflt 4.11]
|
||||||
|
|
||||||
let init n f =
|
let init n f =
|
||||||
let rec aux i () =
|
let rec aux i () =
|
||||||
if i >= n then
|
if i >= n then
|
||||||
|
|
@ -22,6 +31,8 @@ let init n f =
|
||||||
in
|
in
|
||||||
aux 0
|
aux 0
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let rec _forever x () = Cons (x, _forever x)
|
let rec _forever x () = Cons (x, _forever x)
|
||||||
|
|
||||||
let rec _repeat n x () =
|
let rec _repeat n x () =
|
||||||
|
|
@ -37,11 +48,15 @@ let repeat ?n x =
|
||||||
|
|
||||||
let rec forever f () = Cons (f (), forever f)
|
let rec forever f () = Cons (f (), forever f)
|
||||||
|
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
let is_empty l =
|
let is_empty l =
|
||||||
match l () with
|
match l () with
|
||||||
| Nil -> true
|
| Nil -> true
|
||||||
| Cons _ -> false
|
| Cons _ -> false
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let head_exn l =
|
let head_exn l =
|
||||||
match l () with
|
match l () with
|
||||||
| Nil -> raise Not_found
|
| Nil -> raise Not_found
|
||||||
|
|
@ -62,11 +77,15 @@ let tail l =
|
||||||
| Nil -> None
|
| Nil -> None
|
||||||
| Cons (_, l) -> Some l
|
| Cons (_, l) -> Some l
|
||||||
|
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
let uncons l =
|
let uncons l =
|
||||||
match l () with
|
match l () with
|
||||||
| Nil -> None
|
| Nil -> None
|
||||||
| Cons (h, t) -> Some (h, t)
|
| Cons (h, t) -> Some (h, t)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let rec equal eq l1 l2 =
|
let rec equal eq l1 l2 =
|
||||||
match l1 (), l2 () with
|
match l1 (), l2 () with
|
||||||
| Nil, Nil -> true
|
| Nil, Nil -> true
|
||||||
|
|
@ -100,14 +119,9 @@ let foldi f acc res =
|
||||||
in
|
in
|
||||||
aux acc 0 res
|
aux acc 0 res
|
||||||
|
|
||||||
let fold_lefti = foldi
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
let rec iter f l =
|
let fold_lefti = foldi
|
||||||
match l () with
|
|
||||||
| Nil -> ()
|
|
||||||
| Cons (x, l') ->
|
|
||||||
f x;
|
|
||||||
iter f l'
|
|
||||||
|
|
||||||
let iteri f l =
|
let iteri f l =
|
||||||
let rec aux f l i =
|
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 (x, l') when p x -> drop_while p l' ()
|
||||||
| Cons _ as res -> res
|
| 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 mapi f l =
|
||||||
let rec aux f l i () =
|
let rec aux f l i () =
|
||||||
match l () with
|
match l () with
|
||||||
|
|
@ -164,36 +173,55 @@ let mapi f l =
|
||||||
in
|
in
|
||||||
aux f l 0
|
aux f l 0
|
||||||
|
|
||||||
let rec fmap f (l : 'a t) () =
|
[@@@endif]
|
||||||
match l () with
|
[@@@iflt 5.4]
|
||||||
| Nil -> Nil
|
|
||||||
| Cons (x, l') ->
|
|
||||||
(match f x with
|
|
||||||
| None -> fmap f l' ()
|
|
||||||
| Some y -> Cons (y, fmap f l'))
|
|
||||||
|
|
||||||
let rec filter p l () =
|
let filteri f l =
|
||||||
match l () with
|
let rec aux f l i () =
|
||||||
| Nil -> Nil
|
match l () with
|
||||||
| Cons (x, l') ->
|
| Nil -> Nil
|
||||||
if p x then
|
| Cons (x, tl) ->
|
||||||
Cons (x, filter p l')
|
if f i x then
|
||||||
else
|
Cons (x, aux f tl (i + 1))
|
||||||
filter p l' ()
|
else
|
||||||
|
aux f tl (i + 1) ()
|
||||||
|
in
|
||||||
|
aux f l 0
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
|
let fmap = filter_map
|
||||||
|
|
||||||
|
[@@@iflt 4.11]
|
||||||
|
|
||||||
let rec append l1 l2 () =
|
let rec append l1 l2 () =
|
||||||
match l1 () with
|
match l1 () with
|
||||||
| Nil -> l2 ()
|
| Nil -> l2 ()
|
||||||
| Cons (x, l1') -> Cons (x, append l1' 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))
|
let rec iterate f a () = Cons (a, iterate f (f a))
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
[@@@iflt 4.11]
|
||||||
|
|
||||||
let rec unfold f acc () =
|
let rec unfold f acc () =
|
||||||
match f acc with
|
match f acc with
|
||||||
| None -> Nil
|
| None -> Nil
|
||||||
| Some (x, acc') -> Cons (x, unfold f acc')
|
| Some (x, acc') -> Cons (x, unfold f acc')
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
let rec for_all p l =
|
let rec for_all p l =
|
||||||
match l () with
|
match l () with
|
||||||
| Nil -> true
|
| Nil -> true
|
||||||
|
|
@ -221,6 +249,35 @@ let rec find_map f l =
|
||||||
| None -> find_map f tl
|
| None -> find_map f tl
|
||||||
| e -> e)
|
| 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 () =
|
let rec scan f acc res () =
|
||||||
Cons
|
Cons
|
||||||
( acc,
|
( acc,
|
||||||
|
|
@ -229,18 +286,13 @@ let rec scan f acc res () =
|
||||||
| Nil -> Nil
|
| Nil -> Nil
|
||||||
| Cons (s, cont) -> scan f (f acc s) cont () )
|
| Cons (s, cont) -> scan f (f acc s) cont () )
|
||||||
|
|
||||||
let rec flat_map f l () =
|
[@@@endif]
|
||||||
match l () with
|
[@@@iflt 4.13]
|
||||||
| 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')
|
|
||||||
|
|
||||||
let concat_map = flat_map
|
let concat_map = flat_map
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let product_with f l1 l2 =
|
let product_with f l1 l2 =
|
||||||
let rec _next_left h1 tl1 h2 tl2 () =
|
let rec _next_left h1 tl1 h2 tl2 () =
|
||||||
match tl1 () with
|
match tl1 () with
|
||||||
|
|
@ -264,6 +316,8 @@ let product_with f l1 l2 =
|
||||||
in
|
in
|
||||||
_next_left [] l1 [] l2
|
_next_left [] l1 [] l2
|
||||||
|
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
let map_product = product_with
|
let map_product = product_with
|
||||||
let product l1 l2 = product_with (fun x y -> x, y) l1 l2
|
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 (x, l') ->
|
||||||
Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l'))
|
Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l'))
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let rec _uniq eq prev l () =
|
let rec _uniq eq prev l () =
|
||||||
match prev, l () with
|
match prev, l () with
|
||||||
| _, Nil -> Nil
|
| _, Nil -> Nil
|
||||||
|
|
@ -285,16 +341,13 @@ let rec _uniq eq prev l () =
|
||||||
|
|
||||||
let uniq eq l = _uniq eq None l
|
let uniq eq l = _uniq eq None l
|
||||||
|
|
||||||
let rec filter_map f l () =
|
[@@@iflt 4.13]
|
||||||
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'))
|
|
||||||
|
|
||||||
let flatten l = flat_map (fun x -> x) l
|
let concat l = flat_map (fun x -> x) l
|
||||||
let concat = flatten
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
|
let flatten = concat
|
||||||
|
|
||||||
let range i j =
|
let range i j =
|
||||||
let rec aux i j () =
|
let rec aux i j () =
|
||||||
|
|
@ -317,12 +370,18 @@ let ( --^ ) i j =
|
||||||
else
|
else
|
||||||
range i (j + 1)
|
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
|
match l1 (), l2 () with
|
||||||
| Nil, _ | _, Nil -> acc
|
| 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 () =
|
let rec map2 f l1 l2 () =
|
||||||
match l1 (), l2 () with
|
match l1 (), l2 () with
|
||||||
|
|
@ -346,17 +405,21 @@ let rec exists2 f l1 l2 =
|
||||||
| Nil, _ | _, Nil -> false
|
| Nil, _ | _, Nil -> false
|
||||||
| Cons (x1, l1'), Cons (x2, l2') -> f x1 x2 || exists2 f l1' l2'
|
| 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
|
match l1 (), l2 () with
|
||||||
| Nil, tl2 -> tl2
|
| Nil, tl2 -> tl2
|
||||||
| tl1, Nil -> tl1
|
| tl1, Nil -> tl1
|
||||||
| Cons (x1, l1'), Cons (x2, l2') ->
|
| Cons (x1, l1'), Cons (x2, l2') ->
|
||||||
if cmp x1 x2 < 0 then
|
if cmp x1 x2 < 0 then
|
||||||
Cons (x1, merge cmp l1' l2)
|
Cons (x1, sorted_merge cmp l1' l2)
|
||||||
else
|
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 () =
|
let rec zip a b () =
|
||||||
match a (), b () with
|
match a (), b () with
|
||||||
|
|
@ -377,6 +440,8 @@ let unzip l =
|
||||||
|
|
||||||
let split = unzip
|
let split = unzip
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let zip_i seq =
|
let zip_i seq =
|
||||||
let rec loop i seq () =
|
let rec loop i seq () =
|
||||||
match seq () with
|
match seq () with
|
||||||
|
|
@ -387,7 +452,6 @@ let zip_i seq =
|
||||||
|
|
||||||
(** {2 Implementations} *)
|
(** {2 Implementations} *)
|
||||||
|
|
||||||
let return x () = Cons (x, nil)
|
|
||||||
let pure = return
|
let pure = return
|
||||||
let ( >>= ) xs f = flat_map f xs
|
let ( >>= ) xs f = flat_map f xs
|
||||||
let ( >|= ) xs f = map f xs
|
let ( >|= ) xs f = map f xs
|
||||||
|
|
@ -530,11 +594,15 @@ let rec memoize f =
|
||||||
|
|
||||||
(** {2 Fair Combinations} *)
|
(** {2 Fair Combinations} *)
|
||||||
|
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
let rec interleave a b () =
|
let rec interleave a b () =
|
||||||
match a () with
|
match a () with
|
||||||
| Nil -> b ()
|
| Nil -> b ()
|
||||||
| Cons (x, tail) -> Cons (x, interleave b tail)
|
| Cons (x, tail) -> Cons (x, interleave b tail)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let rec fair_flat_map f a () =
|
let rec fair_flat_map f a () =
|
||||||
match a () with
|
match a () with
|
||||||
| Nil -> Nil
|
| Nil -> Nil
|
||||||
|
|
|
||||||
|
|
@ -17,38 +17,60 @@ include module type of Seq
|
||||||
(** @inline *)
|
(** @inline *)
|
||||||
|
|
||||||
val nil : 'a t
|
val nil : 'a t
|
||||||
val empty : 'a t
|
|
||||||
|
[@@@iflt 4.11]
|
||||||
|
|
||||||
val cons : 'a -> 'a t -> 'a t
|
val cons : 'a -> 'a t -> 'a t
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
[@@@iflt 5.4]
|
||||||
|
|
||||||
val singleton : 'a -> 'a t
|
val singleton : 'a -> 'a t
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
val init : int -> (int -> 'a) -> 'a t
|
val init : int -> (int -> 'a) -> 'a t
|
||||||
(** [init n f] corresponds to the sequence [f 0; f 1; ...; f (n-1)].
|
(** [init n f] corresponds to the sequence [f 0; f 1; ...; f (n-1)].
|
||||||
@raise Invalid_argument if n is negative.
|
@raise Invalid_argument if n is negative.
|
||||||
@since 3.10 *)
|
@since 3.10 *)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
val repeat : ?n:int -> 'a -> 'a t
|
val repeat : ?n:int -> 'a -> 'a t
|
||||||
(** [repeat ~n x] repeats [x] [n] times then stops. If [n] is omitted,
|
(** [repeat ~n x] repeats [x] [n] times then stops. If [n] is omitted,
|
||||||
then [x] is repeated forever. *)
|
then [x] is repeated forever. *)
|
||||||
|
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
val forever : (unit -> 'a) -> 'a t
|
val forever : (unit -> 'a) -> 'a t
|
||||||
(** [forever f] corresponds to the infinite sequence containing all the [f ()].
|
(** [forever f] corresponds to the infinite sequence containing all the [f ()].
|
||||||
@since 3.10 *)
|
@since 3.10 *)
|
||||||
|
|
||||||
val cycle : 'a t -> 'a t
|
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
|
val iterate : ('a -> 'a) -> 'a -> 'a t
|
||||||
(** [iterate f a] corresponds to the infinite sequence containing [a], [f a], [f (f a)],
|
(** [iterate f a] corresponds to the infinite sequence containing [a], [f a], [f (f a)],
|
||||||
...
|
...
|
||||||
@since 3.10 *)
|
@since 3.10 *)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
[@@@iflt 4.11]
|
||||||
|
|
||||||
val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
|
val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
|
||||||
(** [unfold f acc] calls [f acc] and:
|
(** [unfold f acc] calls [f acc] and:
|
||||||
- if [f acc = Some (x, acc')], yield [x], continue with [unfold f acc'].
|
- if [f acc = Some (x, acc')], yield [x], continue with [unfold f acc'].
|
||||||
- if [f acc = None], stops. *)
|
- if [f acc = None], stops. *)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
val is_empty : 'a t -> bool
|
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
|
val head : 'a t -> 'a option
|
||||||
(** Head of the list. *)
|
(** Head of the list. *)
|
||||||
|
|
@ -64,10 +86,14 @@ val tail_exn : 'a t -> 'a t
|
||||||
(** Unsafe version of {!tail}.
|
(** Unsafe version of {!tail}.
|
||||||
@raise Not_found if the list is empty. *)
|
@raise Not_found if the list is empty. *)
|
||||||
|
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
val uncons : 'a t -> ('a * 'a t) option
|
val uncons : 'a t -> ('a * 'a t) option
|
||||||
(** [uncons xs] return [None] if [xs] is empty other
|
(** [uncons xs] return [None] if [xs] is empty other
|
||||||
@since 3.10 *)
|
@since 3.10 *)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
val equal : 'a equal -> 'a t equal
|
val equal : 'a equal -> 'a t equal
|
||||||
(** Equality step by step. Eager. *)
|
(** 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.
|
0) and [x] is the element of the sequence.
|
||||||
@since 3.10 *)
|
@since 3.10 *)
|
||||||
|
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
val fold_lefti : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
|
val fold_lefti : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
|
||||||
(** Alias of {!foldi}.
|
(** Alias of {!foldi}.
|
||||||
@since 3.10 *)
|
@since 3.10 *)
|
||||||
|
|
||||||
val iter : ('a -> unit) -> 'a t -> unit
|
|
||||||
|
|
||||||
val iteri : (int -> 'a -> unit) -> 'a t -> unit
|
val iteri : (int -> 'a -> unit) -> 'a t -> unit
|
||||||
(** Iterate with index (starts at 0). *)
|
(** 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 take_while : ('a -> bool) -> 'a t -> 'a t
|
||||||
val drop : int -> 'a t -> 'a t
|
val drop : int -> 'a t -> 'a t
|
||||||
val drop_while : ('a -> bool) -> '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
|
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
|
||||||
(** Map with index (starts at 0). *)
|
(** 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 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
|
val append : 'a t -> 'a t -> 'a t
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
val product_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
|
val product_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
|
||||||
(** Fair product of two (possibly infinite) lists into a new list. Lazy.
|
(** Fair product of two (possibly infinite) lists into a new list. Lazy.
|
||||||
The first parameter is used to combine each pair of elements. *)
|
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
|
val map_product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
|
||||||
(** Alias of {!product_with}.
|
(** Alias of {!product_with}.
|
||||||
@since 3.10 *)
|
@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
|
For instance [group (=) [1;1;1;2;2;3;3;1]] yields
|
||||||
[[1;1;1]; [2;2]; [3;3]; [1]]. *)
|
[[1;1;1]; [2;2]; [3;3]; [1]]. *)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
val uniq : 'a equal -> 'a t -> 'a t
|
val uniq : 'a equal -> 'a t -> 'a t
|
||||||
(** [uniq eq l] returns [l] but removes consecutive duplicates. Lazy.
|
(** [uniq eq l] returns [l] but removes consecutive duplicates. Lazy.
|
||||||
In other words, if several values that are equal follow one another,
|
In other words, if several values that are equal follow one another,
|
||||||
only the first of them is kept. *)
|
only the first of them is kept. *)
|
||||||
|
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
val for_all : ('a -> bool) -> 'a t -> bool
|
val for_all : ('a -> bool) -> 'a t -> bool
|
||||||
(** [for_all p [a1; ...; an]] checks if all elements of the sequence satisfy the
|
(** [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
|
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.
|
[f ai = Some _] and return [None] otherwise.
|
||||||
@since 3.10 *)
|
@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
|
val scan : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a t
|
||||||
(** [scan f init xs] is the sequence containing the intermediate result of
|
(** [scan f init xs] is the sequence containing the intermediate result of
|
||||||
[fold f init xs].
|
[fold f init xs].
|
||||||
@since 3.10 *)
|
@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
|
val concat_map : ('a -> 'b t) -> 'a t -> 'b t
|
||||||
(** Alias of {!flat_map}
|
(** Alias of {!flat_map}
|
||||||
@since 3.10 *)
|
@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
|
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
|
val range : int -> int -> int t
|
||||||
|
|
||||||
|
|
@ -183,16 +241,22 @@ val ( -- ) : int -> int -> int t
|
||||||
[a] and [b] (therefore, never empty). *)
|
[a] and [b] (therefore, never empty). *)
|
||||||
|
|
||||||
val ( --^ ) : int -> int -> int t
|
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} *)
|
(** {2 Operations on two Collections} *)
|
||||||
|
|
||||||
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
|
[@@@iflt 4.14]
|
||||||
(** Fold on two collections at once. Stop as soon as one of them ends. *)
|
|
||||||
|
|
||||||
val fold_left2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
|
val fold_left2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
|
||||||
(** Alias for {!fold2}.
|
(** Fold on two collections at once. Stop as soon as one of them ends.
|
||||||
@since 3.10 *)
|
@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
|
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
|
||||||
(** Map on two collections at once. Stop as soon as one of the
|
(** 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 for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
|
||||||
val exists2 : ('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
|
[@@@endif]
|
||||||
(** Merge two sorted iterators into a sorted iterator. *)
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
val sorted_merge : 'a ord -> 'a t -> 'a t -> 'a t
|
val sorted_merge : 'a ord -> 'a t -> 'a t -> 'a t
|
||||||
(** Alias of {!merge}.
|
(** Merge two sorted iterators into a sorted iterator.
|
||||||
@since 3.10 *)
|
@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
|
val zip : 'a t -> 'b t -> ('a * 'b) t
|
||||||
(** Combine elements pairwise. Stop as soon as one of the lists stops. *)
|
(** 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}.
|
(** Alias of {!unzip}.
|
||||||
@since 3.10 *)
|
@since 3.10 *)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
val zip_i : 'a t -> (int * 'a) t
|
val zip_i : 'a t -> (int * 'a) t
|
||||||
(** [zip_i seq] zips the index of each element with the element itself.
|
(** [zip_i seq] zips the index of each element with the element itself.
|
||||||
@since 3.8
|
@since 3.8
|
||||||
|
|
@ -241,9 +314,13 @@ val memoize : 'a t -> 'a t
|
||||||
|
|
||||||
(** {2 Fair Combinations} *)
|
(** {2 Fair Combinations} *)
|
||||||
|
|
||||||
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
val interleave : 'a t -> 'a t -> 'a t
|
val interleave : 'a t -> 'a t -> 'a t
|
||||||
(** Fair interleaving of both streams. *)
|
(** Fair interleaving of both streams. *)
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
val fair_flat_map : ('a -> 'b t) -> 'a t -> 'b t
|
val fair_flat_map : ('a -> 'b t) -> 'a t -> 'b t
|
||||||
(** Fair version of {!flat_map}. *)
|
(** Fair version of {!flat_map}. *)
|
||||||
|
|
||||||
|
|
@ -252,7 +329,6 @@ val fair_app : ('a -> 'b) t -> 'a t -> 'b t
|
||||||
|
|
||||||
(** {2 Implementations} *)
|
(** {2 Implementations} *)
|
||||||
|
|
||||||
val return : 'a -> 'a t
|
|
||||||
val pure : 'a -> 'a t
|
val pure : 'a -> 'a t
|
||||||
val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
|
val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
|
||||||
val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
|
val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
|
||||||
|
|
|
||||||
|
|
@ -10,43 +10,11 @@ module type OrderedType = Set.OrderedType
|
||||||
module type S = sig
|
module type S = sig
|
||||||
include Set.S
|
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
|
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]
|
(** [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].
|
and return [Some y]. Otherwise returns [None].
|
||||||
@since 3.12 *)
|
@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
|
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]
|
(** [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].
|
and return [Some y]. Otherwise returns [None].
|
||||||
|
|
@ -56,16 +24,9 @@ module type S = sig
|
||||||
(** Build a set from the given [iter] of elements.
|
(** Build a set from the given [iter] of elements.
|
||||||
@since 2.8 *)
|
@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
|
val add_iter : t -> elt iter -> t
|
||||||
(** @since 2.8 *)
|
(** @since 2.8 *)
|
||||||
|
|
||||||
val add_seq : elt Seq.t -> t -> t
|
|
||||||
(** @since 3.0 *)
|
|
||||||
|
|
||||||
val to_iter : t -> elt iter
|
val to_iter : t -> elt iter
|
||||||
(** [to_iter t] converts the set [t] to a [iter] of the elements.
|
(** [to_iter t] converts the set [t] to a [iter] of the elements.
|
||||||
@since 2.8 *)
|
@since 2.8 *)
|
||||||
|
|
@ -103,31 +64,8 @@ module Make (O : Map.OrderedType) = struct
|
||||||
|
|
||||||
[@@@ocaml.warning "-32"]
|
[@@@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
|
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 find_first_map f m =
|
||||||
let res = ref None in
|
let res = ref None in
|
||||||
try
|
try
|
||||||
|
|
@ -142,22 +80,10 @@ module Make (O : Map.OrderedType) = struct
|
||||||
None
|
None
|
||||||
with Find_binding_exit -> !res
|
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"]
|
[@@@ocaml.warning "+32"]
|
||||||
|
|
||||||
include S
|
include S
|
||||||
|
|
||||||
(* Use find_last which is linear time on OCaml < 4.05 *)
|
|
||||||
let find_last_map f m =
|
let find_last_map f m =
|
||||||
let res = ref None in
|
let res = ref None in
|
||||||
let _ =
|
let _ =
|
||||||
|
|
@ -172,13 +98,6 @@ module Make (O : Map.OrderedType) = struct
|
||||||
in
|
in
|
||||||
!res
|
!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 add_iter set i =
|
||||||
let set = ref set in
|
let set = ref set in
|
||||||
i (fun x -> set := add x !set);
|
i (fun x -> set := add x !set);
|
||||||
|
|
|
||||||
|
|
@ -16,43 +16,11 @@ module type OrderedType = Set.OrderedType
|
||||||
module type S = sig
|
module type S = sig
|
||||||
include Set.S
|
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
|
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]
|
(** [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].
|
and return [Some y]. Otherwise returns [None].
|
||||||
@since 3.12 *)
|
@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
|
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]
|
(** [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].
|
and return [Some y]. Otherwise returns [None].
|
||||||
|
|
@ -62,16 +30,9 @@ module type S = sig
|
||||||
(** Build a set from the given [iter] of elements.
|
(** Build a set from the given [iter] of elements.
|
||||||
@since 2.8 *)
|
@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
|
val add_iter : t -> elt iter -> t
|
||||||
(** @since 2.8 *)
|
(** @since 2.8 *)
|
||||||
|
|
||||||
val add_seq : elt Seq.t -> t -> t
|
|
||||||
(** @since 3.0 *)
|
|
||||||
|
|
||||||
val to_iter : t -> elt iter
|
val to_iter : t -> elt iter
|
||||||
(** [to_iter t] converts the set [t] to a [iter] of the elements.
|
(** [to_iter t] converts the set [t] to a [iter] of the elements.
|
||||||
@since 2.8 *)
|
@since 2.8 *)
|
||||||
|
|
|
||||||
|
|
@ -585,6 +585,24 @@ let take n s =
|
||||||
else
|
else
|
||||||
s
|
s
|
||||||
|
|
||||||
|
let take_while f s =
|
||||||
|
let i = ref 0 in
|
||||||
|
while !i < String.length s && f (String.unsafe_get s !i) do
|
||||||
|
incr i
|
||||||
|
done;
|
||||||
|
String.sub s 0 !i
|
||||||
|
|
||||||
|
let rtake_while f s =
|
||||||
|
let s_len_pred = String.length s - 1 in
|
||||||
|
let i = ref s_len_pred in
|
||||||
|
while !i >= 0 && f (String.unsafe_get s !i) do
|
||||||
|
decr i
|
||||||
|
done;
|
||||||
|
if !i < s_len_pred then
|
||||||
|
String.sub s (!i + 1) (s_len_pred - !i)
|
||||||
|
else
|
||||||
|
""
|
||||||
|
|
||||||
let drop n s =
|
let drop n s =
|
||||||
if n < String.length s then
|
if n < String.length s then
|
||||||
String.sub s n (String.length s - n)
|
String.sub s n (String.length s - n)
|
||||||
|
|
@ -674,24 +692,11 @@ let of_gen g =
|
||||||
|
|
||||||
let to_iter s k = String.iter k s
|
let 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 of_iter i =
|
||||||
let b = Buffer.create 32 in
|
let b = Buffer.create 32 in
|
||||||
i (Buffer.add_char b);
|
i (Buffer.add_char b);
|
||||||
Buffer.contents 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 to_list s = _to_list s [] 0 (String.length s)
|
||||||
|
|
||||||
let of_list l =
|
let of_list l =
|
||||||
|
|
|
||||||
|
|
@ -49,11 +49,6 @@ val to_iter : t -> char iter
|
||||||
(** [to_iter s] returns the [iter] of characters contained in the string [s].
|
(** [to_iter s] returns the [iter] of characters contained in the string [s].
|
||||||
@since 2.8 *)
|
@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
|
val to_list : t -> char list
|
||||||
(** [to_list s] returns the [list] of characters contained in the string [s]. *)
|
(** [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.
|
(** [of_iter iter] converts an [iter] of characters to a string.
|
||||||
@since 2.8 *)
|
@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
|
val of_list : char list -> string
|
||||||
(** [of_list lc] converts a list of characters [lc] to a 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]. *)
|
(** [to_array s] returns the array of characters contained in the string [s]. *)
|
||||||
|
|
||||||
val find : ?start:int -> sub:string -> string -> int
|
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]. *)
|
@param start starting position in [s]. *)
|
||||||
|
|
||||||
val find_all : ?start:int -> sub:string -> string -> int gen
|
val find_all : ?start:int -> sub:string -> string -> int gen
|
||||||
|
|
@ -182,6 +172,16 @@ val take : int -> string -> string
|
||||||
(** [take n s] keeps only the [n] first chars of [s].
|
(** [take n s] keeps only the [n] first chars of [s].
|
||||||
@since 0.17 *)
|
@since 0.17 *)
|
||||||
|
|
||||||
|
val take_while : (char -> bool) -> string -> string
|
||||||
|
(** [take_while f s] keeps only the longest prefix [t] of [s] such that every
|
||||||
|
character [c] in [t] satisfies [f c].
|
||||||
|
@since 3.16 *)
|
||||||
|
|
||||||
|
val rtake_while : (char -> bool) -> string -> string
|
||||||
|
(** [rtake_while f s] keeps only the longest suffix [t] of [s] such that every
|
||||||
|
character [c] in [t] satisfies [f c].
|
||||||
|
@since 3.16 *)
|
||||||
|
|
||||||
val drop : int -> string -> string
|
val drop : int -> string -> string
|
||||||
(** [drop n s] removes the [n] first chars of [s].
|
(** [drop n s] removes the [n] first chars of [s].
|
||||||
@since 0.17 *)
|
@since 0.17 *)
|
||||||
|
|
@ -462,10 +462,6 @@ module Split : sig
|
||||||
@since 0.16 *)
|
@since 0.16 *)
|
||||||
end
|
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
|
val split : by:string -> string -> string list
|
||||||
(** [split ~by s] splits the string [s] along the given string [by].
|
(** [split ~by s] splits the string [s] along the given string [by].
|
||||||
Alias to {!Split.list_cpy}.
|
Alias to {!Split.list_cpy}.
|
||||||
|
|
|
||||||
|
|
@ -49,11 +49,6 @@ val to_iter : t -> char iter
|
||||||
(** [to_iter s] returns the [iter] of characters contained in the string [s].
|
(** [to_iter s] returns the [iter] of characters contained in the string [s].
|
||||||
@since 2.8 *)
|
@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
|
val to_list : t -> char list
|
||||||
(** [to_list s] returns the [list] of characters contained in the string [s]. *)
|
(** [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.
|
(** [of_iter iter] converts an [iter] of characters to a string.
|
||||||
@since 2.8 *)
|
@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
|
val of_list : char list -> string
|
||||||
(** [of_list lc] converts a list of characters [lc] to a 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]. *)
|
(** [to_array s] returns the array of characters contained in the string [s]. *)
|
||||||
|
|
||||||
val find : ?start:int -> sub:(string[@keep_label]) -> string -> int
|
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]. *)
|
@param start starting position in [s]. *)
|
||||||
|
|
||||||
val find_all : ?start:int -> sub:(string[@keep_label]) -> string -> int gen
|
val find_all : ?start:int -> sub:(string[@keep_label]) -> string -> int gen
|
||||||
|
|
@ -193,6 +183,16 @@ val take : int -> string -> string
|
||||||
(** [take n s] keeps only the [n] first chars of [s].
|
(** [take n s] keeps only the [n] first chars of [s].
|
||||||
@since 0.17 *)
|
@since 0.17 *)
|
||||||
|
|
||||||
|
val take_while : f:(char -> bool) -> string -> string
|
||||||
|
(** [take_while ~f s] keeps only the longest prefix [t] of [s] such that every
|
||||||
|
character [c] in [t] satisfies [f c].
|
||||||
|
@since 3.16 *)
|
||||||
|
|
||||||
|
val rtake_while : f:(char -> bool) -> string -> string
|
||||||
|
(** [rtake_while ~f s] keeps only the longest suffix [t] of [s] such that every
|
||||||
|
character [c] in [t] satisfies [f c].
|
||||||
|
@since 3.16 *)
|
||||||
|
|
||||||
val drop : int -> string -> string
|
val drop : int -> string -> string
|
||||||
(** [drop n s] removes the [n] first chars of [s].
|
(** [drop n s] removes the [n] first chars of [s].
|
||||||
@since 0.17 *)
|
@since 0.17 *)
|
||||||
|
|
@ -502,10 +502,6 @@ module Split : sig
|
||||||
@since 0.16 *)
|
@since 0.16 *)
|
||||||
end
|
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
|
val split : by:(string[@keep_label]) -> string -> string list
|
||||||
(** [split ~by s] splits the string [s] along the given string [by].
|
(** [split ~by s] splits the string [s] along the given string [by].
|
||||||
Alias to {!Split.list_cpy}.
|
Alias to {!Split.list_cpy}.
|
||||||
|
|
|
||||||
|
|
@ -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 *)
|
(* except for first, each char gives 6 bits *)
|
||||||
let next = (acc lsl 6) lor (c land 0b111111) in
|
let next = (acc lsl 6) lor (c land 0b111111) in
|
||||||
if j = n_bytes then
|
if j = n_bytes then
|
||||||
if (* done reading the codepoint *)
|
if
|
||||||
Uchar.is_valid next then (
|
(* done reading the codepoint *)
|
||||||
|
Uchar.is_valid next
|
||||||
|
then (
|
||||||
st.i <- st.i + j + 1;
|
st.i <- st.i + j + 1;
|
||||||
(* +1 for first char *)
|
(* +1 for first char *)
|
||||||
yield (Uchar.unsafe_of_int next)
|
yield (Uchar.unsafe_of_int next)
|
||||||
|
|
|
||||||
|
|
@ -222,7 +222,7 @@ val find : ('a -> bool) -> ('a, _) t -> 'a option
|
||||||
|
|
||||||
val findi : ('a -> bool) -> ('a, _) t -> (int * 'a) option
|
val findi : ('a -> bool) -> ('a, _) t -> (int * 'a) option
|
||||||
(** Find an element and its index that satisfies the predicate.
|
(** Find an element and its index that satisfies the predicate.
|
||||||
@since NEXT_RELEASE *)
|
@since 3.15 *)
|
||||||
|
|
||||||
val find_exn : ('a -> bool) -> ('a, _) t -> 'a
|
val find_exn : ('a -> bool) -> ('a, _) t -> 'a
|
||||||
(** Find an element that satisfies the predicate, or
|
(** Find an element that satisfies the predicate, or
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,7 @@
|
||||||
(action
|
(action
|
||||||
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
||||||
(flags :standard -nolabels -open CCMonomorphic)
|
(flags :standard -nolabels -open CCMonomorphic)
|
||||||
(libraries either containers.monomorphic))
|
(libraries either containers.monomorphic containers.domain))
|
||||||
|
|
||||||
(ocamllex
|
(ocamllex
|
||||||
(modules CCSexp_lex))
|
(modules CCSexp_lex))
|
||||||
|
|
|
||||||
|
|
@ -31,5 +31,5 @@ let uniformity_test ?(size_hint = 10) k rng st =
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
let st = Random.State.make_self_init () in
|
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"
|
if not ok then failwith "uniformity check failed"
|
||||||
|
|
|
||||||
|
|
@ -37,8 +37,7 @@ let _empty = Shallow Zero
|
||||||
let _single x = Shallow (One x)
|
let _single x = Shallow (One x)
|
||||||
let _double x y = Shallow (Two (x, y))
|
let _double x y = Shallow (Two (x, y))
|
||||||
|
|
||||||
let _deep :
|
let _deep : type l0 l1.
|
||||||
type l0 l1.
|
|
||||||
int ->
|
int ->
|
||||||
('a, l0 succ) digit ->
|
('a, l0 succ) digit ->
|
||||||
('a * 'a) t lazy_t ->
|
('a * 'a) t lazy_t ->
|
||||||
|
|
|
||||||
|
|
@ -139,7 +139,7 @@ val ( -- ) : int -> int -> int t
|
||||||
@since 0.10 *)
|
@since 0.10 *)
|
||||||
|
|
||||||
val ( --^ ) : int -> int -> int t
|
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 *)
|
@since 0.17 *)
|
||||||
|
|
||||||
val pp : 'a printer -> 'a t printer
|
val pp : 'a printer -> 'a t printer
|
||||||
|
|
|
||||||
|
|
@ -221,8 +221,7 @@ module Traverse = struct
|
||||||
]
|
]
|
||||||
|
|
||||||
type ('v, 'e) t =
|
type ('v, 'e) t =
|
||||||
[ `Enter of
|
[ `Enter of 'v * int * ('v, 'e) path
|
||||||
'v * int * ('v, 'e) path
|
|
||||||
(* unique index in traversal, path from start *)
|
(* unique index in traversal, path from start *)
|
||||||
| `Exit of 'v
|
| `Exit of 'v
|
||||||
| `Edge of 'v * 'e * 'v * edge_kind
|
| `Edge of 'v * 'e * 'v * edge_kind
|
||||||
|
|
|
||||||
|
|
@ -150,8 +150,7 @@ module Traverse : sig
|
||||||
]
|
]
|
||||||
|
|
||||||
type ('v, 'e) t =
|
type ('v, 'e) t =
|
||||||
[ `Enter of
|
[ `Enter of 'v * int * ('v, 'e) path
|
||||||
'v * int * ('v, 'e) path
|
|
||||||
(* unique index in traversal, path from start *)
|
(* unique index in traversal, path from start *)
|
||||||
| `Exit of 'v
|
| `Exit of 'v
|
||||||
| `Edge of 'v * 'e * 'v * edge_kind
|
| `Edge of 'v * 'e * 'v * edge_kind
|
||||||
|
|
|
||||||
|
|
@ -202,8 +202,10 @@ module A_SPARSE = struct
|
||||||
let open Stdlib in
|
let open Stdlib in
|
||||||
Array.blit a.arr real_idx arr (real_idx + 1) (n - real_idx));
|
Array.blit a.arr real_idx arr (real_idx + 1) (n - real_idx));
|
||||||
{ a with bits; arr }
|
{ a with bits; arr }
|
||||||
) else if (* replace element at [real_idx] *)
|
) else if
|
||||||
mut then (
|
(* replace element at [real_idx] *)
|
||||||
|
mut
|
||||||
|
then (
|
||||||
a.arr.(real_idx) <- x;
|
a.arr.(real_idx) <- x;
|
||||||
a
|
a
|
||||||
) else (
|
) else (
|
||||||
|
|
|
||||||
7
src/domain/containers_domain.mli
Normal file
7
src/domain/containers_domain.mli
Normal 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
14
src/domain/dune
Normal 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
28
src/domain/gen.ml
Normal 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);
|
||||||
|
()
|
||||||
98
src/leb128/containers_leb128.ml
Normal file
98
src/leb128/containers_leb128.ml
Normal 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
|
||||||
49
src/leb128/containers_leb128.mli
Normal file
49
src/leb128/containers_leb128.mli
Normal 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
11
src/leb128/dune
Normal 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
73
src/leb128/stubs.c
Normal 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);
|
||||||
|
}
|
||||||
|
|
@ -352,6 +352,8 @@ let append a b =
|
||||||
else
|
else
|
||||||
fold_left push a b
|
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 =
|
let rec equal_tree eq t1 t2 =
|
||||||
match t1, t2 with
|
match t1, t2 with
|
||||||
| Empty, Empty -> true
|
| Empty, Empty -> true
|
||||||
|
|
|
||||||
|
|
@ -84,6 +84,11 @@ val append : 'a t -> 'a t -> 'a t
|
||||||
|
|
||||||
val map : ('a -> 'b) -> 'a t -> 'b 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
|
val choose : 'a t -> 'a option
|
||||||
(** Return an element. It is unspecified which one is returned. *)
|
(** Return an element. It is unspecified which one is returned. *)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -99,12 +99,28 @@ let rec shrink (c : Cbor.t) : Cbor.t Q.Iter.t =
|
||||||
let+ s = Q.Shrink.string s in
|
let+ s = Q.Shrink.string s in
|
||||||
`Bytes s
|
`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 ->
|
q ~count:1_000 ~long_factor:10 arb @@ fun c ->
|
||||||
let s = Cbor.encode c in
|
let s = Cbor.encode c in
|
||||||
let c' = Cbor.decode_exn s 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@]"
|
Q.Test.fail_reportf "@[<hv2>roundtrip failed:@ from %a@ to %a@]"
|
||||||
Cbor.pp_diagnostic c Cbor.pp_diagnostic c';
|
Cbor.pp_diagnostic c Cbor.pp_diagnostic c';
|
||||||
true
|
true
|
||||||
|
|
|
||||||
|
|
@ -8,3 +8,76 @@ eq None (of_int 257);;
|
||||||
q
|
q
|
||||||
(Q.string_of_size (Q.Gen.return 1))
|
(Q.string_of_size (Q.Gen.return 1))
|
||||||
(fun s -> Stdlib.( = ) (to_string s.[0]) s)
|
(fun s -> Stdlib.( = ) (to_string s.[0]) s)
|
||||||
|
;;
|
||||||
|
|
||||||
|
q (Q.int_range 65 90 |> Q.map Char.chr) CCChar.is_uppercase_ascii;;
|
||||||
|
|
||||||
|
q
|
||||||
|
(Q.int_range 0 64 |> Q.map Char.chr)
|
||||||
|
(fun c -> not @@ CCChar.is_uppercase_ascii c)
|
||||||
|
;;
|
||||||
|
|
||||||
|
q
|
||||||
|
(Q.int_range 91 127 |> Q.map Char.chr)
|
||||||
|
(fun c -> not @@ CCChar.is_uppercase_ascii c)
|
||||||
|
;;
|
||||||
|
|
||||||
|
q (Q.int_range 97 122 |> Q.map Char.chr) CCChar.is_lowercase_ascii;;
|
||||||
|
|
||||||
|
q
|
||||||
|
(Q.int_range 0 96 |> Q.map Char.chr)
|
||||||
|
(fun c -> not @@ CCChar.is_lowercase_ascii c)
|
||||||
|
;;
|
||||||
|
|
||||||
|
q
|
||||||
|
(Q.int_range 123 127 |> Q.map Char.chr)
|
||||||
|
(fun c -> not @@ CCChar.is_lowercase_ascii c)
|
||||||
|
;;
|
||||||
|
|
||||||
|
q (Q.int_range 48 57 |> Q.map Char.chr) CCChar.is_digit_ascii;;
|
||||||
|
q (Q.int_range 0 47 |> Q.map Char.chr) (fun c -> not @@ CCChar.is_digit_ascii c)
|
||||||
|
;;
|
||||||
|
|
||||||
|
q
|
||||||
|
(Q.int_range 58 127 |> Q.map Char.chr)
|
||||||
|
(fun c -> not @@ CCChar.is_digit_ascii c)
|
||||||
|
;;
|
||||||
|
|
||||||
|
eq true
|
||||||
|
(Stdlib.List.for_all CCChar.is_whitespace_ascii
|
||||||
|
[ '\n'; '\t'; ' '; '\010'; '\011'; '\012'; '\013' ])
|
||||||
|
;;
|
||||||
|
|
||||||
|
eq false
|
||||||
|
(Stdlib.List.exists CCChar.is_whitespace_ascii
|
||||||
|
[
|
||||||
|
'H';
|
||||||
|
'e';
|
||||||
|
'l';
|
||||||
|
'l';
|
||||||
|
'o';
|
||||||
|
'!';
|
||||||
|
'-';
|
||||||
|
'-';
|
||||||
|
'N';
|
||||||
|
'O';
|
||||||
|
't';
|
||||||
|
'h';
|
||||||
|
'i';
|
||||||
|
'n';
|
||||||
|
'a';
|
||||||
|
'\055';
|
||||||
|
'k';
|
||||||
|
'a';
|
||||||
|
'g';
|
||||||
|
'$';
|
||||||
|
'$';
|
||||||
|
'$';
|
||||||
|
'%';
|
||||||
|
'^';
|
||||||
|
'b';
|
||||||
|
'c';
|
||||||
|
'h';
|
||||||
|
'\008';
|
||||||
|
'h';
|
||||||
|
])
|
||||||
|
|
|
||||||
|
|
@ -21,3 +21,15 @@ true
|
||||||
t @@ fun () -> CCFun.((succ %> string_of_int) 2 = "3");;
|
t @@ fun () -> CCFun.((succ %> string_of_int) 2 = "3");;
|
||||||
t @@ fun () -> CCFun.((( * ) 3 % succ) 5 = 18);;
|
t @@ fun () -> CCFun.((( * ) 3 % succ) 5 = 18);;
|
||||||
t @@ fun () -> CCFun.(succ @@ ( * ) 2 @@ pred @@ 3 = 5)
|
t @@ fun () -> CCFun.(succ @@ ( * ) 2 @@ pred @@ 3 = 5)
|
||||||
|
|
||||||
|
let find_array arr x =
|
||||||
|
let@ return = with_return in
|
||||||
|
for i = 0 to Array.length arr - 1 do
|
||||||
|
if arr.(i) = x then return i
|
||||||
|
done;
|
||||||
|
-1
|
||||||
|
;;
|
||||||
|
|
||||||
|
eq 1 @@ find_array [| "a"; "b"; "c" |] "b";;
|
||||||
|
eq 2 @@ find_array [| "a"; "b"; "c" |] "c";;
|
||||||
|
eq (-1) @@ find_array [| "a"; "b"; "c" |] "hello"
|
||||||
|
|
|
||||||
|
|
@ -11,6 +11,8 @@ t @@ fun () -> char 'c' >= 0;;
|
||||||
t @@ fun () -> int 152352 = int 152352;;
|
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; 1 ];;
|
||||||
t @@ fun () -> list_comm int [ 1; 2 ] <> list_comm int [ 2; 3 ];;
|
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 Q.int (fun i ->
|
||||||
Q.assume (i >= 0);
|
Q.assume (i >= 0);
|
||||||
|
|
|
||||||
|
|
@ -721,6 +721,13 @@ q
|
||||||
let i = abs i in
|
let i = abs i in
|
||||||
let l1, l2 = take_drop i l in
|
let l1, l2 = take_drop i l in
|
||||||
l1 @ l2 = l)
|
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;;
|
let subs = sublists_of_len;;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -229,7 +229,28 @@ t @@ fun () -> not (suffix ~suf:"cd" "abcde");;
|
||||||
t @@ fun () -> not (suffix ~suf:"abcd" "cd");;
|
t @@ fun () -> not (suffix ~suf:"abcd" "cd");;
|
||||||
eq ("ab", "cd") (take_drop 2 "abcd");;
|
eq ("ab", "cd") (take_drop 2 "abcd");;
|
||||||
eq ("abc", "") (take_drop 3 "abc");;
|
eq ("abc", "") (take_drop 3 "abc");;
|
||||||
eq ("abc", "") (take_drop 5 "abc")
|
eq ("abc", "") (take_drop 5 "abc");;
|
||||||
|
|
||||||
|
q
|
||||||
|
Q.(printable_string)
|
||||||
|
(fun s ->
|
||||||
|
let predicate c = Char.code c mod 2 = 0 in
|
||||||
|
let prefix = take_while predicate s in
|
||||||
|
let suffix = drop_while predicate s in
|
||||||
|
if prefix ^ suffix <> s then
|
||||||
|
Q.Test.fail_reportf "s=%S, pre=%S, post=%S" s prefix suffix;
|
||||||
|
true)
|
||||||
|
;;
|
||||||
|
|
||||||
|
q
|
||||||
|
Q.(printable_string)
|
||||||
|
(fun s ->
|
||||||
|
let predicate c = Char.code c mod 2 = 0 in
|
||||||
|
let prefix = rdrop_while predicate s in
|
||||||
|
let suffix = rtake_while predicate s in
|
||||||
|
if prefix ^ suffix <> s then
|
||||||
|
Q.Test.fail_reportf "s=%S, pre=%S, post=%S" s prefix suffix;
|
||||||
|
true)
|
||||||
|
|
||||||
let eq' = eq ~printer:Q.Print.(option string);;
|
let eq' = eq ~printer:Q.Print.(option string);;
|
||||||
|
|
||||||
|
|
@ -280,6 +301,23 @@ eq ~printer:CCFun.id "" (unlines []);;
|
||||||
eq ~printer:CCFun.id "ab\nc\n" (unlines [ "ab"; "c" ]);;
|
eq ~printer:CCFun.id "ab\nc\n" (unlines [ "ab"; "c" ]);;
|
||||||
q Q.printable_string (fun s -> trim (unlines (lines s)) = trim s);;
|
q Q.printable_string (fun s -> trim (unlines (lines s)) = trim s);;
|
||||||
q Q.printable_string (fun s -> trim (unlines_gen (lines_gen s)) = trim s);;
|
q Q.printable_string (fun s -> trim (unlines_gen (lines_gen s)) = trim s);;
|
||||||
|
eq ~printer:CCFun.id "" (take_while (Char.equal 'c') "heloo_cc");;
|
||||||
|
eq ~printer:CCFun.id "" (take_while (Char.equal 'c') "");;
|
||||||
|
eq ~printer:CCFun.id "c" (take_while (Char.equal 'c') "c");;
|
||||||
|
eq ~printer:CCFun.id "ccc" (take_while (Char.equal 'c') "cccujsuy");;
|
||||||
|
|
||||||
|
eq ~printer:CCFun.id "THIS"
|
||||||
|
(take_while (fun c -> Char.code c < 91) "THISisNotWHAtIwANTED")
|
||||||
|
;;
|
||||||
|
|
||||||
|
eq ~printer:CCFun.id "cc" (rtake_while (Char.equal 'c') "heloo_cc");;
|
||||||
|
eq ~printer:CCFun.id "" (rtake_while (Char.equal 'c') "");;
|
||||||
|
eq ~printer:CCFun.id "c" (rtake_while (Char.equal 'c') "c");;
|
||||||
|
eq ~printer:CCFun.id "" (rtake_while (Char.equal 'c') "cccujsuy");;
|
||||||
|
|
||||||
|
eq ~printer:CCFun.id "ANTED"
|
||||||
|
(rtake_while (fun c -> Char.code c < 91) "THISisNotWHAtIwANTED")
|
||||||
|
;;
|
||||||
|
|
||||||
q
|
q
|
||||||
Q.(small_list small_string)
|
Q.(small_list small_string)
|
||||||
|
|
|
||||||
|
|
@ -119,6 +119,8 @@ module Ref_impl = struct
|
||||||
let to_list l = l
|
let to_list l = l
|
||||||
let to_seq = CCSeq.of_list
|
let to_seq = CCSeq.of_list
|
||||||
let add_list l l2 : _ t = List.append l l2
|
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 to_list_via_reviter m =
|
||||||
let l = ref [] in
|
let l = ref [] in
|
||||||
|
|
@ -159,7 +161,9 @@ module Op = struct
|
||||||
| Push of 'a
|
| Push of 'a
|
||||||
| Pop
|
| Pop
|
||||||
(* TODO: set *)
|
(* TODO: set *)
|
||||||
|
| Append of 'a list
|
||||||
| Add_list of 'a list
|
| Add_list of 'a list
|
||||||
|
| Flat_map of 'a list
|
||||||
| Check_get of int
|
| Check_get of int
|
||||||
| Check_choose
|
| Check_choose
|
||||||
| Check_is_empty
|
| Check_is_empty
|
||||||
|
|
@ -176,6 +180,8 @@ module Op = struct
|
||||||
| Push _ :: tl -> loop (size + 1) tl
|
| Push _ :: tl -> loop (size + 1) tl
|
||||||
| Pop :: tl -> size >= 0 && loop (size - 1) tl
|
| Pop :: tl -> size >= 0 && loop (size - 1) tl
|
||||||
| Add_list l :: tl -> loop (size + List.length l) 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_get x :: tl -> x < size && loop size tl
|
||||||
| Check_choose :: tl
|
| Check_choose :: tl
|
||||||
| Check_is_empty :: tl
|
| Check_is_empty :: tl
|
||||||
|
|
@ -194,6 +200,8 @@ module Op = struct
|
||||||
| Push x -> spf "push %s" (show_x x)
|
| Push x -> spf "push %s" (show_x x)
|
||||||
| Pop -> "pop"
|
| Pop -> "pop"
|
||||||
| Add_list l -> spf "add_list [%s]" (String.concat ";" @@ List.map show_x l)
|
| 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_get i -> spf "check_get %d" i
|
||||||
| Check_choose -> "check_choose"
|
| Check_choose -> "check_choose"
|
||||||
| Check_is_empty -> "check_is_empty"
|
| Check_is_empty -> "check_is_empty"
|
||||||
|
|
@ -211,6 +219,8 @@ module Op = struct
|
||||||
| Push x -> shrink_x x >|= fun x -> Push x
|
| Push x -> shrink_x x >|= fun x -> Push x
|
||||||
| Pop -> empty
|
| Pop -> empty
|
||||||
| Add_list l -> list ~shrink:shrink_x l >|= fun x -> Add_list x
|
| 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_get _ | Check_choose | Check_is_empty | Check_len | Check_to_list
|
||||||
| Check_to_gen | Check_last | Check_rev_iter | Check_iter ->
|
| Check_to_gen | Check_last | Check_rev_iter | Check_iter ->
|
||||||
empty
|
empty
|
||||||
|
|
@ -252,6 +262,12 @@ module Op = struct
|
||||||
( 1,
|
( 1,
|
||||||
small_list gen_x >|= fun l ->
|
small_list gen_x >|= fun l ->
|
||||||
Add_list l, size + List.length 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
|
in
|
||||||
|
|
@ -292,6 +308,12 @@ let check_ops ~show_x (ops : 'a Op.t list) : unit =
|
||||||
| Op.Add_list l ->
|
| Op.Add_list l ->
|
||||||
cur := add_list !cur l;
|
cur := add_list !cur l;
|
||||||
cur_ref := Ref_impl.add_list !cur_ref 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_get i -> if get !cur i <> Ref_impl.get i !cur_ref then fail ()
|
||||||
| Op.Check_is_empty ->
|
| Op.Check_is_empty ->
|
||||||
if is_empty !cur <> Ref_impl.is_empty !cur_ref then fail ()
|
if is_empty !cur <> Ref_impl.is_empty !cur_ref then fail ()
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue