mirror of
https://github.com/c-cube/iter.git
synced 2025-12-06 03:05:29 -05:00
Compare commits
28 commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
a525d4902c | ||
|
|
99fa66f1db | ||
|
|
21107dc7e7 | ||
|
|
cd2d47f268 | ||
|
|
f9c6c077c6 | ||
|
|
fc69ce4c91 | ||
|
|
d1af13a9dd | ||
|
|
f0f5396cc2 | ||
|
|
399e95b50f | ||
|
|
92d0022079 | ||
|
|
4f47de66fe | ||
|
|
90e44a59a9 | ||
|
|
63c99cf2ba | ||
|
|
4bf00eabad | ||
|
|
67c46b6ce4 | ||
|
|
6fdbc2c88f | ||
|
|
e72026b616 | ||
|
|
c446508746 | ||
|
|
d410860533 | ||
|
|
37a160579a | ||
|
|
c4c2630b60 | ||
|
|
02c3e954bf | ||
|
|
303686319d | ||
|
|
29cabc46eb | ||
|
|
b65be73022 | ||
|
|
8322b2b201 | ||
|
|
f1d14dd030 | ||
|
|
df3a3de2ae |
17 changed files with 270 additions and 163 deletions
14
.github/workflows/gh-pages.yml
vendored
14
.github/workflows/gh-pages.yml
vendored
|
|
@ -3,7 +3,7 @@ name: github pages
|
||||||
on:
|
on:
|
||||||
push:
|
push:
|
||||||
branches:
|
branches:
|
||||||
- master # Set a branch name to trigger deployment
|
- main # Set a branch name to trigger deployment
|
||||||
|
|
||||||
jobs:
|
jobs:
|
||||||
deploy:
|
deploy:
|
||||||
|
|
@ -11,16 +11,10 @@ jobs:
|
||||||
steps:
|
steps:
|
||||||
- uses: actions/checkout@main
|
- uses: actions/checkout@main
|
||||||
|
|
||||||
- name: Cache opam
|
- uses: ocaml/setup-ocaml@v3
|
||||||
id: cache-opam
|
|
||||||
uses: actions/cache@v2
|
|
||||||
with:
|
with:
|
||||||
path: ~/.opam
|
ocaml-compiler: '4.14.x'
|
||||||
key: opam-ubuntu-latest-4.12.0
|
allow-prerelease-opam: true
|
||||||
|
|
||||||
- uses: avsm/setup-ocaml@v1
|
|
||||||
with:
|
|
||||||
ocaml-version: '4.12.0'
|
|
||||||
|
|
||||||
- name: Pin
|
- name: Pin
|
||||||
run: opam pin -n .
|
run: opam pin -n .
|
||||||
|
|
|
||||||
11
.github/workflows/main.yml
vendored
11
.github/workflows/main.yml
vendored
|
|
@ -2,10 +2,8 @@ name: build
|
||||||
on:
|
on:
|
||||||
push:
|
push:
|
||||||
branches:
|
branches:
|
||||||
- master
|
- main
|
||||||
pull_request:
|
pull_request:
|
||||||
branches:
|
|
||||||
- master
|
|
||||||
jobs:
|
jobs:
|
||||||
run:
|
run:
|
||||||
name: Build
|
name: Build
|
||||||
|
|
@ -17,15 +15,16 @@ jobs:
|
||||||
# macOS is just too slow, ugh
|
# macOS is just too slow, ugh
|
||||||
#- macos-latest
|
#- macos-latest
|
||||||
ocaml-compiler:
|
ocaml-compiler:
|
||||||
- 4.03.x
|
|
||||||
- 4.08.x
|
- 4.08.x
|
||||||
- 4.12.x
|
- 4.14.x
|
||||||
|
# TODO: - 5.1.x # https://github.com/ocaml/setup-ocaml/issues/733
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
steps:
|
steps:
|
||||||
- uses: actions/checkout@v2
|
- uses: actions/checkout@v2
|
||||||
- uses: ocaml/setup-ocaml@v2
|
- uses: ocaml/setup-ocaml@v3
|
||||||
with:
|
with:
|
||||||
ocaml-compiler: ${{ matrix.ocaml-compiler }}
|
ocaml-compiler: ${{ matrix.ocaml-compiler }}
|
||||||
|
allow-prerelease-opam: true
|
||||||
- run: opam pin -n .
|
- run: opam pin -n .
|
||||||
- run: opam depext -yt iter
|
- run: opam depext -yt iter
|
||||||
- run: opam install -t . --deps-only
|
- run: opam install -t . --deps-only
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
version = 0.24.1
|
version = 0.26.2
|
||||||
profile=conventional
|
profile=conventional
|
||||||
margin=80
|
margin=80
|
||||||
if-then-else=k-r
|
if-then-else=k-r
|
||||||
|
|
|
||||||
18
CHANGELOG.md
18
CHANGELOG.md
|
|
@ -1,4 +1,22 @@
|
||||||
|
|
||||||
|
# 1.9
|
||||||
|
|
||||||
|
|
||||||
|
- Switch exceptions used for control flow from global to local
|
||||||
|
- Update Iter.ml to use mutable fields instead of refs (#44)
|
||||||
|
|
||||||
|
# 1.8
|
||||||
|
|
||||||
|
- add `Iter.map_while`
|
||||||
|
- fix bug in `map_by_2`, add tests
|
||||||
|
|
||||||
|
# 1.7
|
||||||
|
|
||||||
|
- add let operators in Infix
|
||||||
|
- require OCaml >= 4.08
|
||||||
|
- improve docs about random iterators
|
||||||
|
- fix: `IO.write_lines` should produce an empty file for an empty iter
|
||||||
|
|
||||||
# 1.6
|
# 1.6
|
||||||
|
|
||||||
- use dune 2.0
|
- use dune 2.0
|
||||||
|
|
|
||||||
|
|
@ -2,6 +2,7 @@
|
||||||
(names bench_persistent_read bench_persistent benchs)
|
(names bench_persistent_read bench_persistent benchs)
|
||||||
(libraries iter benchmark)
|
(libraries iter benchmark)
|
||||||
(optional)
|
(optional)
|
||||||
(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always)
|
(flags :standard -w +a-4-42-44-48-50-58-32-60-70@8 -safe-string -color
|
||||||
|
always)
|
||||||
(ocamlopt_flags :standard -O3 -color always -unbox-closures
|
(ocamlopt_flags :standard -O3 -color always -unbox-closures
|
||||||
-unbox-closures-factor 20))
|
-unbox-closures-factor 20))
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,7 @@
|
||||||
(executable
|
(executable
|
||||||
(name test_sexpr)
|
(name test_sexpr)
|
||||||
(libraries iter)
|
(libraries iter)
|
||||||
(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always)
|
(flags :standard -w +a-4-42-44-48-50-58-32-60-70@8 -safe-string -color
|
||||||
|
always)
|
||||||
(ocamlopt_flags :standard -O3 -color always -unbox-closures
|
(ocamlopt_flags :standard -O3 -color always -unbox-closures
|
||||||
-unbox-closures-factor 20))
|
-unbox-closures-factor 20))
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
opam-version: "2.0"
|
opam-version: "2.0"
|
||||||
name: "iter"
|
name: "iter"
|
||||||
version: "1.6"
|
version: "1.9"
|
||||||
authors: ["Simon Cruanes" "Gabriel Radanne"]
|
authors: ["Simon Cruanes" "Gabriel Radanne"]
|
||||||
maintainer: "simon.cruanes.2007@m4x.org"
|
maintainer: "simon.cruanes.2007@m4x.org"
|
||||||
license: "BSD-2-clause"
|
license: "BSD-2-clause"
|
||||||
|
|
@ -11,12 +11,8 @@ build: [
|
||||||
["dune" "runtest" "-p" name "-j" jobs] {with-test & arch != "arm32" & arch != "x86_32"}
|
["dune" "runtest" "-p" name "-j" jobs] {with-test & arch != "arm32" & arch != "x86_32"}
|
||||||
]
|
]
|
||||||
depends: [
|
depends: [
|
||||||
"base-bytes"
|
"ocaml" { >= "4.08.0" }
|
||||||
"result"
|
|
||||||
"seq"
|
|
||||||
"ocaml" { >= "4.03.0" }
|
|
||||||
"dune" { >= "2.0" }
|
"dune" { >= "2.0" }
|
||||||
"dune-configurator"
|
|
||||||
"qcheck-core" {with-test}
|
"qcheck-core" {with-test}
|
||||||
"ounit2" {with-test}
|
"ounit2" {with-test}
|
||||||
"mdx" {with-test & >= "1.3" }
|
"mdx" {with-test & >= "1.3" }
|
||||||
|
|
|
||||||
152
src/Iter.ml
152
src/Iter.ml
|
|
@ -1,9 +1,5 @@
|
||||||
(* This file is free software, part of iter. See file "license" for more details. *)
|
(* This file is free software, part of iter. See file "license" for more details. *)
|
||||||
|
|
||||||
(** {1 Simple and Efficient Iterators} *)
|
|
||||||
|
|
||||||
open Iter_shims_
|
|
||||||
|
|
||||||
type 'a t = ('a -> unit) -> unit
|
type 'a t = ('a -> unit) -> unit
|
||||||
(** Iter abstract iterator type *)
|
(** Iter abstract iterator type *)
|
||||||
|
|
||||||
|
|
@ -118,7 +114,9 @@ let map_by_2 f seq k =
|
||||||
let f y =
|
let f y =
|
||||||
match !r with
|
match !r with
|
||||||
| None -> r := Some y
|
| None -> r := Some y
|
||||||
| Some x -> k (f x y)
|
| Some x ->
|
||||||
|
r := None;
|
||||||
|
k (f x y)
|
||||||
in
|
in
|
||||||
seq f;
|
seq f;
|
||||||
match !r with
|
match !r with
|
||||||
|
|
@ -191,63 +189,75 @@ let keep_error seq k =
|
||||||
|
|
||||||
(** Mutable unrolled list to serve as intermediate storage *)
|
(** Mutable unrolled list to serve as intermediate storage *)
|
||||||
module MList = struct
|
module MList = struct
|
||||||
type 'a node = Nil | Cons of 'a array * int ref * 'a node ref
|
type 'a node =
|
||||||
|
| Nil
|
||||||
|
| Cons of { a: 'a array; mutable n: int; mutable tl: 'a node }
|
||||||
|
|
||||||
(* build and call callback on every element *)
|
(* build and call callback on every element *)
|
||||||
let of_iter_with seq k =
|
let of_iter_with seq k =
|
||||||
let start = ref Nil in
|
|
||||||
let chunk_size = ref 8 in
|
let chunk_size = ref 8 in
|
||||||
(* fill the list. prev: tail-reference from previous node *)
|
let acc = ref Nil in
|
||||||
let prev, cur = ref start, ref Nil in
|
let cur = ref Nil in
|
||||||
|
let tail = ref Nil in
|
||||||
|
|
||||||
|
let[@inline] replace_tail () =
|
||||||
|
match !acc with
|
||||||
|
| Nil -> acc := !cur
|
||||||
|
| _ ->
|
||||||
|
(match !tail with
|
||||||
|
| Nil -> ()
|
||||||
|
| Cons r -> r.tl <- !cur)
|
||||||
|
in
|
||||||
|
|
||||||
seq (fun x ->
|
seq (fun x ->
|
||||||
k x;
|
k x;
|
||||||
(* callback *)
|
(* callback *)
|
||||||
match !cur with
|
match !cur with
|
||||||
| Nil ->
|
| Nil ->
|
||||||
let n = !chunk_size in
|
let n = !chunk_size in
|
||||||
if n < 4096 then chunk_size := 2 * !chunk_size;
|
if n < 4096 then chunk_size := 2 * n;
|
||||||
cur := Cons (Array.make n x, ref 1, ref Nil)
|
cur := Cons { a = Array.make n x; n = 1; tl = Nil }
|
||||||
| Cons (a, n, next) ->
|
| Cons r ->
|
||||||
assert (!n < Array.length a);
|
assert (r.n < Array.length r.a);
|
||||||
a.(!n) <- x;
|
r.a.(r.n) <- x;
|
||||||
incr n;
|
r.n <- succ r.n;
|
||||||
if !n = Array.length a then (
|
if r.n = Array.length r.a then (
|
||||||
!prev := !cur;
|
replace_tail ();
|
||||||
prev := next;
|
tail := !cur;
|
||||||
cur := Nil
|
cur := Nil
|
||||||
));
|
));
|
||||||
!prev := !cur;
|
replace_tail ();
|
||||||
!start
|
!acc
|
||||||
|
|
||||||
let of_iter seq = of_iter_with seq (fun _ -> ())
|
let of_iter seq = of_iter_with seq (fun _ -> ())
|
||||||
|
|
||||||
let rec iter f l =
|
let rec iter f l =
|
||||||
match l with
|
match l with
|
||||||
| Nil -> ()
|
| Nil -> ()
|
||||||
| Cons (a, n, tl) ->
|
| Cons { a; n; tl } ->
|
||||||
for i = 0 to !n - 1 do
|
for i = 0 to n - 1 do
|
||||||
f a.(i)
|
f a.(i)
|
||||||
done;
|
done;
|
||||||
iter f !tl
|
iter f tl
|
||||||
|
|
||||||
let iteri f l =
|
let iteri f l =
|
||||||
let rec iteri i f l =
|
let rec iteri i f l =
|
||||||
match l with
|
match l with
|
||||||
| Nil -> ()
|
| Nil -> ()
|
||||||
| Cons (a, n, tl) ->
|
| Cons { a; n; tl } ->
|
||||||
for j = 0 to !n - 1 do
|
for j = 0 to n - 1 do
|
||||||
f (i + j) a.(j)
|
f (i + j) a.(j)
|
||||||
done;
|
done;
|
||||||
iteri (i + !n) f !tl
|
iteri (i + n) f tl
|
||||||
in
|
in
|
||||||
iteri 0 f l
|
iteri 0 f l
|
||||||
|
|
||||||
let rec iter_rev f l =
|
let rec iter_rev f l =
|
||||||
match l with
|
match l with
|
||||||
| Nil -> ()
|
| Nil -> ()
|
||||||
| Cons (a, n, tl) ->
|
| Cons { a; n; tl } ->
|
||||||
iter_rev f !tl;
|
iter_rev f tl;
|
||||||
for i = !n - 1 downto 0 do
|
for i = n - 1 downto 0 do
|
||||||
f a.(i)
|
f a.(i)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
|
@ -255,7 +265,7 @@ module MList = struct
|
||||||
let rec len acc l =
|
let rec len acc l =
|
||||||
match l with
|
match l with
|
||||||
| Nil -> acc
|
| Nil -> acc
|
||||||
| Cons (_, n, tl) -> len (acc + !n) !tl
|
| Cons { n; tl; _ } -> len (acc + n) tl
|
||||||
in
|
in
|
||||||
len 0 l
|
len 0 l
|
||||||
|
|
||||||
|
|
@ -263,8 +273,8 @@ module MList = struct
|
||||||
let rec get l i =
|
let rec get l i =
|
||||||
match l with
|
match l with
|
||||||
| Nil -> raise (Invalid_argument "MList.get")
|
| Nil -> raise (Invalid_argument "MList.get")
|
||||||
| Cons (a, n, _) when i < !n -> a.(i)
|
| Cons { a; n; _ } when i < n -> a.(i)
|
||||||
| Cons (_, n, tl) -> get !tl (i - !n)
|
| Cons { n; tl; _ } -> get tl (i - n)
|
||||||
|
|
||||||
let to_iter l k = iter k l
|
let to_iter l k = iter k l
|
||||||
|
|
||||||
|
|
@ -275,11 +285,11 @@ module MList = struct
|
||||||
let rec get_next _ =
|
let rec get_next _ =
|
||||||
match !cur with
|
match !cur with
|
||||||
| Nil -> None
|
| Nil -> None
|
||||||
| Cons (_, n, tl) when !i = !n ->
|
| Cons { n; tl; _ } when !i = n ->
|
||||||
cur := !tl;
|
cur := tl;
|
||||||
i := 0;
|
i := 0;
|
||||||
get_next arg
|
get_next arg
|
||||||
| Cons (a, _, _) ->
|
| Cons { a; _ } ->
|
||||||
let x = a.(!i) in
|
let x = a.(!i) in
|
||||||
incr i;
|
incr i;
|
||||||
Some x
|
Some x
|
||||||
|
|
@ -292,8 +302,8 @@ module MList = struct
|
||||||
let rec make (l, i) () =
|
let rec make (l, i) () =
|
||||||
match l with
|
match l with
|
||||||
| Nil -> Seq.Nil
|
| Nil -> Seq.Nil
|
||||||
| Cons (_, n, tl) when i = !n -> make (!tl, 0) ()
|
| Cons { n; tl; _ } when i = n -> make (tl, 0) ()
|
||||||
| Cons (a, _, _) -> Seq.Cons (a.(i), make (l, i + 1))
|
| Cons { a; _ } -> Seq.Cons (a.(i), make (l, i + 1))
|
||||||
in
|
in
|
||||||
make (l, 0)
|
make (l, 0)
|
||||||
end
|
end
|
||||||
|
|
@ -320,9 +330,8 @@ let sort ?(cmp = Stdlib.compare) seq =
|
||||||
let l = List.fast_sort cmp l in
|
let l = List.fast_sort cmp l in
|
||||||
fun k -> List.iter k l
|
fun k -> List.iter k l
|
||||||
|
|
||||||
exception Exit_sorted
|
|
||||||
|
|
||||||
let sorted ?(cmp = Stdlib.compare) seq =
|
let sorted ?(cmp = Stdlib.compare) seq =
|
||||||
|
let exception Exit_sorted in
|
||||||
let prev = ref None in
|
let prev = ref None in
|
||||||
try
|
try
|
||||||
seq (fun x ->
|
seq (fun x ->
|
||||||
|
|
@ -546,9 +555,8 @@ let diff (type a) ?(eq = ( = )) ?(hash = Hashtbl.hash) c1 c2 =
|
||||||
c2 (fun x -> Tbl.replace tbl x ());
|
c2 (fun x -> Tbl.replace tbl x ());
|
||||||
fun yield -> c1 (fun x -> if not (Tbl.mem tbl x) then yield x)
|
fun yield -> c1 (fun x -> if not (Tbl.mem tbl x) then yield x)
|
||||||
|
|
||||||
exception Subset_exit
|
|
||||||
|
|
||||||
let subset (type a) ?(eq = ( = )) ?(hash = Hashtbl.hash) c1 c2 =
|
let subset (type a) ?(eq = ( = )) ?(hash = Hashtbl.hash) c1 c2 =
|
||||||
|
let exception Subset_exit in
|
||||||
let module Tbl = Hashtbl.Make (struct
|
let module Tbl = Hashtbl.Make (struct
|
||||||
type t = a
|
type t = a
|
||||||
|
|
||||||
|
|
@ -620,9 +628,8 @@ let sumf seq : float =
|
||||||
sum := t);
|
sum := t);
|
||||||
!sum
|
!sum
|
||||||
|
|
||||||
exception ExitHead
|
|
||||||
|
|
||||||
let head seq =
|
let head seq =
|
||||||
|
let exception ExitHead in
|
||||||
let r = ref None in
|
let r = ref None in
|
||||||
try
|
try
|
||||||
seq (fun x ->
|
seq (fun x ->
|
||||||
|
|
@ -636,9 +643,8 @@ let head_exn seq =
|
||||||
| None -> invalid_arg "Iter.head_exn"
|
| None -> invalid_arg "Iter.head_exn"
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
|
|
||||||
exception ExitTake
|
|
||||||
|
|
||||||
let take n seq k =
|
let take n seq k =
|
||||||
|
let exception ExitTake in
|
||||||
let count = ref 0 in
|
let count = ref 0 in
|
||||||
try
|
try
|
||||||
seq (fun x ->
|
seq (fun x ->
|
||||||
|
|
@ -647,9 +653,8 @@ let take n seq k =
|
||||||
k x)
|
k x)
|
||||||
with ExitTake -> ()
|
with ExitTake -> ()
|
||||||
|
|
||||||
exception ExitTakeWhile
|
|
||||||
|
|
||||||
let take_while p seq k =
|
let take_while p seq k =
|
||||||
|
let exception ExitTakeWhile in
|
||||||
try
|
try
|
||||||
seq (fun x ->
|
seq (fun x ->
|
||||||
if p x then
|
if p x then
|
||||||
|
|
@ -658,9 +663,20 @@ let take_while p seq k =
|
||||||
raise_notrace ExitTakeWhile)
|
raise_notrace ExitTakeWhile)
|
||||||
with ExitTakeWhile -> ()
|
with ExitTakeWhile -> ()
|
||||||
|
|
||||||
exception ExitFoldWhile
|
let map_while f seq k =
|
||||||
|
let exception ExitMapWhile in
|
||||||
|
let consume x =
|
||||||
|
match f x with
|
||||||
|
| `Yield y -> k y
|
||||||
|
| `Return y ->
|
||||||
|
k y;
|
||||||
|
raise_notrace ExitMapWhile
|
||||||
|
| `Stop -> raise_notrace ExitMapWhile
|
||||||
|
in
|
||||||
|
try seq consume with ExitMapWhile -> ()
|
||||||
|
|
||||||
let fold_while f s seq =
|
let fold_while f s seq =
|
||||||
|
let exception ExitFoldWhile in
|
||||||
let state = ref s in
|
let state = ref s in
|
||||||
let consume x =
|
let consume x =
|
||||||
let acc, cont = f !state x in
|
let acc, cont = f !state x in
|
||||||
|
|
@ -699,18 +715,16 @@ let rev seq =
|
||||||
let l = MList.of_iter seq in
|
let l = MList.of_iter seq in
|
||||||
fun k -> MList.iter_rev k l
|
fun k -> MList.iter_rev k l
|
||||||
|
|
||||||
exception ExitForall
|
|
||||||
|
|
||||||
let for_all p seq =
|
let for_all p seq =
|
||||||
|
let exception ExitForall in
|
||||||
try
|
try
|
||||||
seq (fun x -> if not (p x) then raise_notrace ExitForall);
|
seq (fun x -> if not (p x) then raise_notrace ExitForall);
|
||||||
true
|
true
|
||||||
with ExitForall -> false
|
with ExitForall -> false
|
||||||
|
|
||||||
exception ExitExists
|
|
||||||
|
|
||||||
(** Exists there some element satisfying the predicate? *)
|
(** Exists there some element satisfying the predicate? *)
|
||||||
let exists p seq =
|
let exists p seq =
|
||||||
|
let exception ExitExists in
|
||||||
try
|
try
|
||||||
seq (fun x -> if p x then raise_notrace ExitExists);
|
seq (fun x -> if p x then raise_notrace ExitExists);
|
||||||
false
|
false
|
||||||
|
|
@ -718,9 +732,8 @@ let exists p seq =
|
||||||
|
|
||||||
let mem ?(eq = ( = )) x seq = exists (eq x) seq
|
let mem ?(eq = ( = )) x seq = exists (eq x) seq
|
||||||
|
|
||||||
exception ExitFind
|
|
||||||
|
|
||||||
let find_map f seq =
|
let find_map f seq =
|
||||||
|
let exception ExitFind in
|
||||||
let r = ref None in
|
let r = ref None in
|
||||||
(try
|
(try
|
||||||
seq (fun x ->
|
seq (fun x ->
|
||||||
|
|
@ -735,6 +748,7 @@ let find_map f seq =
|
||||||
let find = find_map
|
let find = find_map
|
||||||
|
|
||||||
let find_mapi f seq =
|
let find_mapi f seq =
|
||||||
|
let exception ExitFind in
|
||||||
let i = ref 0 in
|
let i = ref 0 in
|
||||||
let r = ref None in
|
let r = ref None in
|
||||||
(try
|
(try
|
||||||
|
|
@ -768,9 +782,8 @@ let[@inline] length seq =
|
||||||
seq (fun _ -> incr r);
|
seq (fun _ -> incr r);
|
||||||
!r
|
!r
|
||||||
|
|
||||||
exception ExitIsEmpty
|
|
||||||
|
|
||||||
let is_empty seq =
|
let is_empty seq =
|
||||||
|
let exception ExitIsEmpty in
|
||||||
try
|
try
|
||||||
seq (fun _ -> raise_notrace ExitIsEmpty);
|
seq (fun _ -> raise_notrace ExitIsEmpty);
|
||||||
true
|
true
|
||||||
|
|
@ -1018,9 +1031,14 @@ module Map = struct
|
||||||
let of_iter_ seq = fold (fun m (k, v) -> M.add k v m) M.empty seq
|
let of_iter_ seq = fold (fun m (k, v) -> M.add k v m) M.empty seq
|
||||||
let keys m = from_iter (fun k -> M.iter (fun x _ -> k x) m)
|
let keys m = from_iter (fun k -> M.iter (fun x _ -> k x) m)
|
||||||
let values m = from_iter (fun k -> M.iter (fun _ y -> k y) m)
|
let values m = from_iter (fun k -> M.iter (fun _ y -> k y) m)
|
||||||
|
|
||||||
|
[@@@ocaml.warning "-32"]
|
||||||
|
|
||||||
let of_list l = of_iter_ (of_list l)
|
let of_list l = of_iter_ (of_list l)
|
||||||
let to_list x = to_list (to_iter_ x)
|
let to_list x = to_list (to_iter_ x)
|
||||||
|
|
||||||
|
[@@@ocaml.warning "+32"]
|
||||||
|
|
||||||
include M
|
include M
|
||||||
|
|
||||||
let to_iter = to_iter_
|
let to_iter = to_iter_
|
||||||
|
|
@ -1119,6 +1137,10 @@ module Infix = struct
|
||||||
let[@inline] ( >|= ) x f = map f x
|
let[@inline] ( >|= ) x f = map f x
|
||||||
let[@inline] ( <*> ) funs args k = funs (fun f -> args (fun x -> k (f x)))
|
let[@inline] ( <*> ) funs args k = funs (fun f -> args (fun x -> k (f x)))
|
||||||
let ( <+> ) = append
|
let ( <+> ) = append
|
||||||
|
let[@inline] ( let+ ) x f = map f x
|
||||||
|
let[@inline] ( let* ) x f = flat_map f x
|
||||||
|
let ( and+ ) = product
|
||||||
|
let ( and* ) = product
|
||||||
end
|
end
|
||||||
|
|
||||||
include Infix
|
include Infix
|
||||||
|
|
@ -1192,22 +1214,28 @@ module IO = struct
|
||||||
close_in_noerr ic;
|
close_in_noerr ic;
|
||||||
raise e
|
raise e
|
||||||
|
|
||||||
let write_bytes_to ?(mode = 0o644) ?(flags = [ Open_creat; Open_wronly ])
|
let with_out_ ?(mode = 0o644) ?(flags = [ Open_creat; Open_wronly ]) filename
|
||||||
filename seq =
|
f =
|
||||||
let oc = open_out_gen flags mode filename in
|
let oc = open_out_gen flags mode filename in
|
||||||
try
|
try
|
||||||
seq (fun s -> output oc s 0 (Bytes.length s));
|
f oc;
|
||||||
close_out oc
|
close_out oc
|
||||||
with e ->
|
with e ->
|
||||||
close_out oc;
|
close_out oc;
|
||||||
raise e
|
raise e
|
||||||
|
|
||||||
|
let write_bytes_to ?mode ?flags filename it =
|
||||||
|
with_out_ ?mode ?flags filename (fun oc ->
|
||||||
|
it (fun s -> output oc s 0 (Bytes.length s)))
|
||||||
|
|
||||||
let write_to ?mode ?flags filename seq =
|
let write_to ?mode ?flags filename seq =
|
||||||
write_bytes_to ?mode ?flags filename (map Bytes.unsafe_of_string seq)
|
write_bytes_to ?mode ?flags filename (map Bytes.unsafe_of_string seq)
|
||||||
|
|
||||||
let write_bytes_lines ?mode ?flags filename seq =
|
let write_bytes_lines ?mode ?flags filename it =
|
||||||
let ret = Bytes.unsafe_of_string "\n" in
|
with_out_ ?mode ?flags filename (fun oc ->
|
||||||
write_bytes_to ?mode ?flags filename (snoc (intersperse ret seq) ret)
|
it (fun s ->
|
||||||
|
output oc s 0 (Bytes.length s);
|
||||||
|
output_char oc '\n'))
|
||||||
|
|
||||||
let write_lines ?mode ?flags filename seq =
|
let write_lines ?mode ?flags filename seq =
|
||||||
write_bytes_lines ?mode ?flags filename (map Bytes.unsafe_of_string seq)
|
write_bytes_lines ?mode ?flags filename (map Bytes.unsafe_of_string seq)
|
||||||
|
|
|
||||||
54
src/Iter.mli
54
src/Iter.mli
|
|
@ -259,11 +259,11 @@ val keep_some : 'a option t -> 'a t
|
||||||
Same as [filter_map (fun x->x)]
|
Same as [filter_map (fun x->x)]
|
||||||
@since 1.0 *)
|
@since 1.0 *)
|
||||||
|
|
||||||
val keep_ok : ('a, _) Result.result t -> 'a t
|
val keep_ok : ('a, _) result t -> 'a t
|
||||||
(** [keep_ok l] retains only elements of the form [Ok x].
|
(** [keep_ok l] retains only elements of the form [Ok x].
|
||||||
@since 1.0 *)
|
@since 1.0 *)
|
||||||
|
|
||||||
val keep_error : (_, 'e) Result.result t -> 'e t
|
val keep_error : (_, 'e) result t -> 'e t
|
||||||
(** [keep_error l] retains only elements of the form [Error x].
|
(** [keep_error l] retains only elements of the form [Error x].
|
||||||
@since 1.0 *)
|
@since 1.0 *)
|
||||||
|
|
||||||
|
|
@ -487,6 +487,18 @@ val take_while : ('a -> bool) -> 'a t -> 'a t
|
||||||
Will work on an infinite iterator [s] if the predicate is false for at
|
Will work on an infinite iterator [s] if the predicate is false for at
|
||||||
least one element of [s]. *)
|
least one element of [s]. *)
|
||||||
|
|
||||||
|
val map_while : ('a -> [ `Yield of 'b | `Return of 'b | `Stop ]) -> 'a t -> 'b t
|
||||||
|
(** Maps over elements of the iterator, stopping early if the mapped function
|
||||||
|
returns [`Stop] or [`Return x]. At each iteration:
|
||||||
|
{ul
|
||||||
|
{- If [f] returns [`Yield y], [y] is added to the sequence and the
|
||||||
|
iteration continues.}
|
||||||
|
{- If [f] returns [`Stop], nothing is added to the sequence and the
|
||||||
|
iteration stops.}
|
||||||
|
{- If [f] returns [`Return y], [y] is added to the sequence and the
|
||||||
|
iteration stops.}}
|
||||||
|
@since 1.8 *)
|
||||||
|
|
||||||
val fold_while : ('a -> 'b -> 'a * [ `Stop | `Continue ]) -> 'a -> 'b t -> 'a
|
val fold_while : ('a -> 'b -> 'a * [ `Stop | `Continue ]) -> 'a -> 'b t -> 'a
|
||||||
(** Folds over elements of the iterator, stopping early if the accumulator
|
(** Folds over elements of the iterator, stopping early if the accumulator
|
||||||
returns [('a, `Stop)]
|
returns [('a, `Stop)]
|
||||||
|
|
@ -707,6 +719,8 @@ end
|
||||||
|
|
||||||
(** {1 Random iterators} *)
|
(** {1 Random iterators} *)
|
||||||
|
|
||||||
|
(** {2 Generating} *)
|
||||||
|
|
||||||
val random_int : int -> int t
|
val random_int : int -> int t
|
||||||
(** Infinite iterator of random integers between 0 and
|
(** Infinite iterator of random integers between 0 and
|
||||||
the given higher bound (see Random.int) *)
|
the given higher bound (see Random.int) *)
|
||||||
|
|
@ -745,6 +759,26 @@ val sample : int -> 'a t -> 'a array
|
||||||
It returns an array of size [min (length seq) n].
|
It returns an array of size [min (length seq) n].
|
||||||
@since 0.7 *)
|
@since 0.7 *)
|
||||||
|
|
||||||
|
(** {2 Seeding}
|
||||||
|
|
||||||
|
Random iterators use [Random.int], [Random.float], [Random.bool],
|
||||||
|
etc., under the hood, so they will respect seeding of the random
|
||||||
|
generator in the usual way. I.e., if you do not initialize the
|
||||||
|
random generator with one of [Random.init], [Random.full_init], or
|
||||||
|
[Random.self_init] before calling these functions, they will yield
|
||||||
|
the same values across seperate invocations of your program.
|
||||||
|
|
||||||
|
Example:
|
||||||
|
|
||||||
|
{[
|
||||||
|
(* Ensure a fresh random seed each time the program is executed. *)
|
||||||
|
let () = Random.self_init ()
|
||||||
|
|
||||||
|
(* Generate random values. *)
|
||||||
|
let l = Iter.random_int 1000 |> Iter.take 3 |> Iter.to_list
|
||||||
|
]}
|
||||||
|
*)
|
||||||
|
|
||||||
(** {1 Infix functions} *)
|
(** {1 Infix functions} *)
|
||||||
|
|
||||||
module Infix : sig
|
module Infix : sig
|
||||||
|
|
@ -772,6 +806,22 @@ module Infix : sig
|
||||||
val ( <+> ) : 'a t -> 'a t -> 'a t
|
val ( <+> ) : 'a t -> 'a t -> 'a t
|
||||||
(** Concatenation of iterators
|
(** Concatenation of iterators
|
||||||
@since 0.5 *)
|
@since 0.5 *)
|
||||||
|
|
||||||
|
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
|
||||||
|
(** Alias for {!map}
|
||||||
|
@since 1.7 *)
|
||||||
|
|
||||||
|
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
|
||||||
|
(** Alias for {!product}
|
||||||
|
@since 1.7 *)
|
||||||
|
|
||||||
|
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
|
||||||
|
(** Alias for {!flat_map}
|
||||||
|
@since 1.7 *)
|
||||||
|
|
||||||
|
val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
|
||||||
|
(** Alias for {!product}
|
||||||
|
@since 1.7 *)
|
||||||
end
|
end
|
||||||
|
|
||||||
include module type of Infix
|
include module type of Infix
|
||||||
|
|
|
||||||
|
|
@ -227,11 +227,11 @@ val keep_some : 'a option t -> 'a t
|
||||||
Same as [filter_map (fun x->x)]
|
Same as [filter_map (fun x->x)]
|
||||||
@since 1.0 *)
|
@since 1.0 *)
|
||||||
|
|
||||||
val keep_ok : ('a, _) Result.result t -> 'a t
|
val keep_ok : ('a, _) result t -> 'a t
|
||||||
(** [keep_ok l] retains only elements of the form [Ok x].
|
(** [keep_ok l] retains only elements of the form [Ok x].
|
||||||
@since 1.0 *)
|
@since 1.0 *)
|
||||||
|
|
||||||
val keep_error : (_, 'e) Result.result t -> 'e t
|
val keep_error : (_, 'e) result t -> 'e t
|
||||||
(** [keep_error l] retains only elements of the form [Error x].
|
(** [keep_error l] retains only elements of the form [Error x].
|
||||||
@since 1.0 *)
|
@since 1.0 *)
|
||||||
|
|
||||||
|
|
@ -676,6 +676,8 @@ end
|
||||||
|
|
||||||
(** {2 Random iterators} *)
|
(** {2 Random iterators} *)
|
||||||
|
|
||||||
|
(** {3 Generating} *)
|
||||||
|
|
||||||
val random_int : int -> int t
|
val random_int : int -> int t
|
||||||
(** Infinite iterator of random integers between 0 and
|
(** Infinite iterator of random integers between 0 and
|
||||||
the given higher bound (see Random.int) *)
|
the given higher bound (see Random.int) *)
|
||||||
|
|
@ -714,6 +716,26 @@ val sample : n:int -> 'a t -> 'a array
|
||||||
It returns an array of size [min (length seq) n].
|
It returns an array of size [min (length seq) n].
|
||||||
@since 0.7 *)
|
@since 0.7 *)
|
||||||
|
|
||||||
|
(** {3 Seeding}
|
||||||
|
|
||||||
|
Random iterators use [Random.int], [Random.float], [Random.bool],
|
||||||
|
etc., under the hood, so they will respect seeding of the random
|
||||||
|
generator in the usual way. I.e., if you do not initialize the
|
||||||
|
random generator with one of [Random.init], [Random.full_init], or
|
||||||
|
[Random.self_init] before calling these functions, they will yield
|
||||||
|
the same values across seperate invocations of your program.
|
||||||
|
|
||||||
|
Example:
|
||||||
|
|
||||||
|
{[
|
||||||
|
(* Ensure a fresh random seed each time the program is executed. *)
|
||||||
|
let () = Random.self_init ()
|
||||||
|
|
||||||
|
(* Generate random values. *)
|
||||||
|
let l = Iter.random_int 1000 |> Iter.take 3 |> Iter.to_list
|
||||||
|
]}
|
||||||
|
*)
|
||||||
|
|
||||||
(** {2 Infix functions} *)
|
(** {2 Infix functions} *)
|
||||||
|
|
||||||
module Infix : sig
|
module Infix : sig
|
||||||
|
|
|
||||||
|
|
@ -2,7 +2,8 @@
|
||||||
|
|
||||||
(** {1 Interface and Helpers for bigarrays} *)
|
(** {1 Interface and Helpers for bigarrays} *)
|
||||||
|
|
||||||
open! IterBigarrayShims_
|
let bigarray_map_file fd ty lay b len =
|
||||||
|
Unix.map_file fd ty lay b [| len |] |> Bigarray.array1_of_genarray
|
||||||
|
|
||||||
let of_bigarray b yield =
|
let of_bigarray b yield =
|
||||||
let len = Bigarray.Array1.dim b in
|
let len = Bigarray.Array1.dim b in
|
||||||
|
|
@ -21,4 +22,4 @@ let mmap filename yield =
|
||||||
with e ->
|
with e ->
|
||||||
Unix.close fd;
|
Unix.close fd;
|
||||||
raise e
|
raise e
|
||||||
[@@ocaml.warning "-3"]
|
[@@ocaml.warning "-3"]
|
||||||
|
|
|
||||||
|
|
@ -2,19 +2,6 @@
|
||||||
(name iter_bigarray)
|
(name iter_bigarray)
|
||||||
(public_name iter.bigarray)
|
(public_name iter.bigarray)
|
||||||
(libraries iter bigarray unix)
|
(libraries iter bigarray unix)
|
||||||
(modules IterBigarray IterBigarrayShims_)
|
(modules IterBigarray)
|
||||||
(wrapped false)
|
(wrapped false)
|
||||||
(optional))
|
(optional))
|
||||||
|
|
||||||
(executable
|
|
||||||
(name mkshims)
|
|
||||||
(modules mkshims)
|
|
||||||
(libraries dune.configurator))
|
|
||||||
|
|
||||||
(rule
|
|
||||||
(targets IterBigarrayShims_.ml)
|
|
||||||
(deps mkshims.exe)
|
|
||||||
(action
|
|
||||||
(with-stdout-to
|
|
||||||
%{targets}
|
|
||||||
(run ./mkshims.exe))))
|
|
||||||
|
|
|
||||||
|
|
@ -1,21 +0,0 @@
|
||||||
module C = Configurator.V1
|
|
||||||
|
|
||||||
let shims_pre_408 =
|
|
||||||
"\nopen! Bigarray\nlet bigarray_map_file = Bigarray.Array1.map_file\n"
|
|
||||||
|
|
||||||
let shims_post_408 =
|
|
||||||
"\n\
|
|
||||||
let bigarray_map_file fd ty lay b len =\n\
|
|
||||||
\ Unix.map_file fd ty lay b [| len |] |> Bigarray.array1_of_genarray\n"
|
|
||||||
|
|
||||||
let () =
|
|
||||||
C.main ~name:"mkshims" (fun c ->
|
|
||||||
let version = C.ocaml_config_var_exn c "version" in
|
|
||||||
let major, minor =
|
|
||||||
Scanf.sscanf version "%u.%u" (fun maj min -> maj, min)
|
|
||||||
in
|
|
||||||
print_endline
|
|
||||||
(if (major, minor) >= (4, 8) then
|
|
||||||
shims_post_408
|
|
||||||
else
|
|
||||||
shims_pre_408))
|
|
||||||
18
src/dune
18
src/dune
|
|
@ -1,23 +1,9 @@
|
||||||
(executable
|
|
||||||
(name mkshims)
|
|
||||||
(modules mkshims)
|
|
||||||
(libraries dune.configurator))
|
|
||||||
|
|
||||||
(rule
|
|
||||||
(targets Iter_shims_.ml)
|
|
||||||
(deps mkshims.exe)
|
|
||||||
(action
|
|
||||||
(with-stdout-to
|
|
||||||
%{targets}
|
|
||||||
(run ./mkshims.exe))))
|
|
||||||
|
|
||||||
(library
|
(library
|
||||||
(name iter)
|
(name iter)
|
||||||
(public_name iter)
|
(public_name iter)
|
||||||
(wrapped false)
|
(wrapped false)
|
||||||
(modules Iter IterLabels Iter_shims_)
|
(modules Iter IterLabels)
|
||||||
(flags :standard -w +a -warn-error -a+8 -nolabels)
|
(flags :standard -w +a-4 -warn-error -a+8 -nolabels))
|
||||||
(libraries bytes result seq))
|
|
||||||
|
|
||||||
(env
|
(env
|
||||||
(_
|
(_
|
||||||
|
|
|
||||||
|
|
@ -1,16 +0,0 @@
|
||||||
module C = Configurator.V1
|
|
||||||
|
|
||||||
let shims_pre_408 = "module Stdlib = Pervasives"
|
|
||||||
let shims_post_408 = "module Stdlib = Stdlib"
|
|
||||||
|
|
||||||
let () =
|
|
||||||
C.main ~name:"mkshims" (fun c ->
|
|
||||||
let version = C.ocaml_config_var_exn c "version" in
|
|
||||||
let major, minor =
|
|
||||||
Scanf.sscanf version "%u.%u" (fun maj min -> maj, min)
|
|
||||||
in
|
|
||||||
print_endline
|
|
||||||
(if (major, minor) >= (4, 8) then
|
|
||||||
shims_post_408
|
|
||||||
else
|
|
||||||
shims_pre_408))
|
|
||||||
|
|
@ -1,4 +1,3 @@
|
||||||
|
|
||||||
(tests
|
(tests
|
||||||
(names t_iter)
|
(names t_iter)
|
||||||
(libraries iter qcheck-core qcheck-core.runner ounit2))
|
(libraries iter qcheck-core qcheck-core.runner ounit2))
|
||||||
|
|
|
||||||
|
|
@ -237,6 +237,31 @@ let () =
|
||||||
OUnit.assert_equal 2 n;
|
OUnit.assert_equal 2 n;
|
||||||
()
|
()
|
||||||
|
|
||||||
|
let list_equal eq l1 l2 =
|
||||||
|
List.length l1 = List.length l2 && List.for_all2 eq l1 l2
|
||||||
|
|
||||||
|
let () =
|
||||||
|
OUnit.assert_equal ~cmp:(list_equal Int.equal)
|
||||||
|
(1 -- 10
|
||||||
|
|> map_while (fun x ->
|
||||||
|
if x = 7 then
|
||||||
|
`Return (x + 1)
|
||||||
|
else
|
||||||
|
`Yield (x - 1))
|
||||||
|
|> to_list)
|
||||||
|
[ 0; 1; 2; 3; 4; 5; 8 ]
|
||||||
|
|
||||||
|
let () =
|
||||||
|
OUnit.assert_equal ~cmp:(list_equal Int.equal)
|
||||||
|
(1 -- 10
|
||||||
|
|> map_while (fun x ->
|
||||||
|
if x = 7 then
|
||||||
|
`Stop
|
||||||
|
else
|
||||||
|
`Yield (x - 1))
|
||||||
|
|> to_list)
|
||||||
|
[ 0; 1; 2; 3; 4; 5 ]
|
||||||
|
|
||||||
let () = 1 -- 5 |> drop 2 |> to_list |> OUnit.assert_equal [ 3; 4; 5 ]
|
let () = 1 -- 5 |> drop 2 |> to_list |> OUnit.assert_equal [ 3; 4; 5 ]
|
||||||
let () = 1 -- 5 |> rev |> to_list |> OUnit.assert_equal [ 5; 4; 3; 2; 1 ]
|
let () = 1 -- 5 |> rev |> to_list |> OUnit.assert_equal [ 5; 4; 3; 2; 1 ]
|
||||||
|
|
||||||
|
|
@ -328,6 +353,43 @@ let () =
|
||||||
OUnit.assert_bool "not empty" (not (is_empty s));
|
OUnit.assert_bool "not empty" (not (is_empty s));
|
||||||
()
|
()
|
||||||
|
|
||||||
|
let with_tmp_file f =
|
||||||
|
let path = Filename.temp_file "test_iter" "data" in
|
||||||
|
try
|
||||||
|
let x = f path in
|
||||||
|
(try Sys.remove path with _ -> ());
|
||||||
|
x
|
||||||
|
with e ->
|
||||||
|
(try Sys.remove path with _ -> ());
|
||||||
|
raise e
|
||||||
|
|
||||||
|
let () =
|
||||||
|
with_tmp_file @@ fun path ->
|
||||||
|
Iter.IO.write_lines path Iter.empty;
|
||||||
|
let l = Iter.IO.lines_of path |> Iter.to_list in
|
||||||
|
OUnit.assert_equal ~printer:Q.Print.(list @@ Printf.sprintf "%S") [] l
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
let errcode = QCheck_base_runner.run_tests ~colors:false !qchecks in
|
let errcode = QCheck_base_runner.run_tests ~colors:false !qchecks in
|
||||||
if errcode <> 0 then exit errcode
|
if errcode <> 0 then exit errcode
|
||||||
|
|
||||||
|
(* map_by_2 tests *)
|
||||||
|
let test = OUnit.assert_equal ~printer:Q.Print.(list int)
|
||||||
|
let () = test [] (map_by_2 (fun a _ -> a) (of_list []) |> to_list)
|
||||||
|
|
||||||
|
(* Test empty iterator *)
|
||||||
|
let () = test [ 1 ] (map_by_2 (fun _ b -> b) (of_list [ 1 ]) |> to_list)
|
||||||
|
let () = test [ 3 ] (map_by_2 (fun _ b -> b) (1 -- 3) |> drop 1 |> to_list)
|
||||||
|
let () = test [ 9 ] (map_by_2 (fun _ b -> b) (1 -- 9) |> drop 4 |> to_list)
|
||||||
|
|
||||||
|
(* Odd number of elements should leave the last element in the iterator.
|
||||||
|
For an increasing integer range [1,2k] (fun _ b -> b) returns only
|
||||||
|
even numbers so this is sufficient to test that this element is left
|
||||||
|
in the iterator. *)
|
||||||
|
let () = test [ 1 ] (map_by_2 (fun a _ -> a) (1 -- 2) |> to_list)
|
||||||
|
let () = test [ 2 ] (map_by_2 (fun _ b -> b) (1 -- 2) |> to_list)
|
||||||
|
|
||||||
|
(* Test two elements *)
|
||||||
|
let () = test [ 1; 3; 5; 7; 9 ] (map_by_2 (fun a _ -> a) (1 -- 10) |> to_list)
|
||||||
|
let () = test [ 2; 4; 6; 8; 10 ] (map_by_2 (fun _ b -> b) (1 -- 10) |> to_list)
|
||||||
|
(* Test more than two elements *)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue