This commit is contained in:
Simon Cruanes 2024-01-09 17:39:18 -05:00
parent 92d0022079
commit 399e95b50f
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
5 changed files with 30 additions and 26 deletions

View file

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

View file

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

View file

@ -189,7 +189,9 @@ 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 : 'a array; mutable n : int; mutable tl : 'a node } 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 =
@ -202,9 +204,9 @@ module MList = struct
match !acc with match !acc with
| Nil -> acc := !cur | Nil -> acc := !cur
| _ -> | _ ->
match !tail with (match !tail with
| Nil -> () | Nil -> ()
| Cons r -> r.tl <- !cur | Cons r -> r.tl <- !cur)
in in
seq (fun x -> seq (fun x ->
@ -214,7 +216,7 @@ module MList = struct
| Nil -> | Nil ->
let n = !chunk_size in let n = !chunk_size in
if n < 4096 then chunk_size := 2 * n; if n < 4096 then chunk_size := 2 * n;
cur := Cons {a=Array.make n x; n = 1; tl = Nil} cur := Cons { a = Array.make n x; n = 1; tl = Nil }
| Cons r -> | Cons r ->
assert (r.n < Array.length r.a); assert (r.n < Array.length r.a);
r.a.(r.n) <- x; r.a.(r.n) <- x;
@ -232,7 +234,7 @@ module MList = struct
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;
@ -242,7 +244,7 @@ module MList = struct
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;
@ -253,7 +255,7 @@ module MList = struct
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)
@ -263,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
@ -271,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
@ -283,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
@ -300,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
@ -673,7 +675,9 @@ let map_while f seq k =
let consume x = let consume x =
match f x with match f x with
| `Yield y -> k y | `Yield y -> k y
| `Return y -> k y; raise_notrace ExitMapWhile | `Return y ->
k y;
raise_notrace ExitMapWhile
| `Stop -> raise_notrace ExitMapWhile | `Stop -> raise_notrace ExitMapWhile
in in
try seq consume with ExitMapWhile -> () try seq consume with ExitMapWhile -> ()

View file

@ -1,4 +1,3 @@
(library (library
(name iter) (name iter)
(public_name iter) (public_name iter)

View file

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