Skip to content

Commit aaf314b

Browse files
art-wart-w
committed
Add eio backend
1 parent a8dd53d commit aaf314b

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

47 files changed

+3043
-2017
lines changed

‎CHANGES.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,10 @@
66
- Update to cmdliner.1.1.0 (#382, @MisterDA)
77
- Mirage support: optional dependency to unix (#396, @art-w)
88

9+
## Added
10+
11+
- Add `index.eio` with Eio backend (#397, @art-w)
12+
913
# 1.6.2 (2023-06-06)
1014

1115
## Changed

‎bench/bench.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -214,7 +214,7 @@ module Index = struct
214214

215215
let run ~with_metrics ~nb_entries ~log_size ~root ~name ~fresh ~readonly b =
216216
let index =
217-
Index.v ~cache:(Index.empty_cache ()) ~fresh ~readonly ~log_size
217+
Index.v ~io:() ~cache:(Index.empty_cache ()) ~fresh ~readonly ~log_size
218218
(root // name)
219219
in
220220
let result = Benchmark.run ~nb_entries (b ~with_metrics index) in

‎bench/replay.ml‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -164,7 +164,10 @@ module Index = struct
164164
include Index
165165

166166
let cache = Index.empty_cache ()
167-
let v root = Index.v ~cache ~readonly:false ~fresh:true ~log_size:500_000 root
167+
168+
let v root =
169+
Index.v ~io:() ~cache ~readonly:false ~fresh:true ~log_size:500_000 root
170+
168171
let close t = Index.close t
169172
end
170173

‎src/checks.ml‎

Lines changed: 19 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,8 @@ module Make (K : Data.Key) (V : Data.Value) (Platform : Platform_args) = struct
4242
@@ pos 0 (some string) None
4343
@@ info ~doc:"Path to the Index store on disk" ~docv:"PATH" []
4444

45+
type io = Platform.IO.io
46+
4547
module Stat = struct
4648
type io = {
4749
size : size;
@@ -62,16 +64,17 @@ module Make (K : Data.Key) (V : Data.Value) (Platform : Platform_args) = struct
6264

6365
type t = { entry_size : size; files : files } [@@deriving repr]
6466

65-
let with_io : type a. string -> (IO.t -> a) -> a option =
66-
fun path f ->
67-
match IO.v path with
67+
let with_io : type a. io:Platform.IO.io -> string -> (IO.t -> a) -> a option
68+
=
69+
fun ~io path f ->
70+
match IO.v ~io path with
6871
| Error `No_file_on_disk -> None
6972
| Ok io ->
7073
let a = f io in
7174
IO.close io;
7275
Some a
7376

74-
let io path =
77+
let run_io path =
7578
with_io path @@ fun io ->
7679
let IO.Header.{ offset; generation } = IO.Header.get io in
7780
let fanout_size = Bytes (IO.get_fanout_size io) in
@@ -80,12 +83,12 @@ module Make (K : Data.Key) (V : Data.Value) (Platform : Platform_args) = struct
8083
let generation = Int63.to_int64 generation in
8184
{ size; offset; generation; fanout_size }
8285

83-
let run ~root =
86+
let run ~io ~root =
8487
Logs.app (fun f -> f "Getting statistics for store: `%s'@," root);
85-
let data = io (Layout.data ~root) in
86-
let log = io (Layout.log ~root) in
87-
let log_async = io (Layout.log_async ~root) in
88-
let merge = io (Layout.merge ~root) in
88+
let data = run_io ~io (Layout.data ~root) in
89+
let log = run_io ~io (Layout.log ~root) in
90+
let log_async = run_io ~io (Layout.log_async ~root) in
91+
let merge = run_io ~io (Layout.merge ~root) in
8992
let lock =
9093
IO.Lock.pp_dump (Layout.lock ~root)
9194
|> Option.map (fun f ->
@@ -99,7 +102,7 @@ module Make (K : Data.Key) (V : Data.Value) (Platform : Platform_args) = struct
99102
}
100103
|> Repr.pp_json ~minify:false t Fmt.stdout
101104

102-
let term = Cmdliner.Term.(const (fun root () -> run ~root) $ path)
105+
let term ~io = Cmdliner.Term.(const (fun root () -> run ~io ~root) $ path)
103106
end
104107

105108
module Integrity_check = struct
@@ -120,9 +123,9 @@ module Make (K : Data.Key) (V : Data.Value) (Platform : Platform_args) = struct
120123
highlight (fun ppf () -> (Repr.pp Entry.t) ppf entry))
121124
|> Fmt.(concat ~sep:cut)
122125

123-
let run ~root =
126+
let run ~io ~root =
124127
let context = 2 in
125-
match IO.v (Layout.data ~root) with
128+
match IO.v ~io (Layout.data ~root) with
126129
| Error `No_file_on_disk -> Fmt.failwith "No data file in %s" root
127130
| Ok io ->
128131
let io_offset = IO.offset io in
@@ -151,7 +154,7 @@ module Make (K : Data.Key) (V : Data.Value) (Platform : Platform_args) = struct
151154
());
152155
previous := e)
153156

154-
let term = Cmdliner.Term.(const (fun root () -> run ~root) $ path)
157+
let term ~io = Cmdliner.Term.(const (fun root () -> run ~io ~root) $ path)
155158
end
156159

157160
module Cli = struct
@@ -166,7 +169,7 @@ module Make (K : Data.Key) (V : Data.Value) (Platform : Platform_args) = struct
166169
in
167170
Logs_fmt.reporter ~pp_header ()
168171

169-
let main () : empty =
172+
let main ~io () : empty =
170173
let default = Term.(ret (const (`Help (`Auto, None)))) in
171174
let info =
172175
let doc = "Check and repair Index data-stores." in
@@ -175,12 +178,12 @@ module Make (K : Data.Key) (V : Data.Value) (Platform : Platform_args) = struct
175178
let commands =
176179
[
177180
( Term.(
178-
Stat.term
181+
Stat.term ~io
179182
$ Log.setup_term ~reporter (module Clock) (module Fmt_tty)),
180183
Cmd.info ~doc:"Print high-level statistics about the store." "stat"
181184
);
182185
( Term.(
183-
Integrity_check.term
186+
Integrity_check.term ~io
184187
$ Log.setup_term ~reporter (module Clock) (module Fmt_tty)),
185188
Cmd.info
186189
~doc:"Search the store for integrity faults and corruption."

‎src/checks_intf.ml‎

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -3,24 +3,26 @@ open! Import
33
type empty = |
44

55
module type S = sig
6+
type io
7+
68
module Stat : sig
7-
val run : root:string -> unit
9+
val run : io:io -> root:string -> unit
810
(** Read basic metrics from an existing store. *)
911

10-
val term : (unit -> unit) Cmdliner.Term.t
12+
val term : io:io -> (unit -> unit) Cmdliner.Term.t
1113
(** A pre-packaged [Cmdliner] term for executing {!run}. *)
1214
end
1315

1416
module Integrity_check : sig
15-
val run : root:string -> unit
17+
val run : io:io -> root:string -> unit
1618
(** Check that the integrity invariants of a store are preserved, and
1719
display any broken invariants. *)
1820

19-
val term : (unit -> unit) Cmdliner.Term.t
21+
val term : io:io -> (unit -> unit) Cmdliner.Term.t
2022
(** A pre-packaged [Cmdliner] term for executing {!run}. *)
2123
end
2224

23-
val cli : unit -> empty
25+
val cli : io:io -> unit -> empty
2426
(** Run a [Cmdliner] binary containing tools for running offline integrity
2527
checks. *)
2628
end
@@ -38,5 +40,6 @@ module type Checks = sig
3840
module type S = S
3941
module type Platform_args = Platform_args
4042

41-
module Make (K : Data.Key) (V : Data.Value) (_ : Platform_args) : S
43+
module Make (K : Data.Key) (V : Data.Value) (P : Platform_args) :
44+
S with type io = P.IO.io
4245
end

‎src/eio/buffer.ml‎

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,54 @@
1+
(* The MIT License
2+
3+
Copyright (c) 2021 Clément Pascutto <clement@tarides.com>
4+
5+
Permission is hereby granted, free of charge, to any person obtaining a copy
6+
of this software and associated documentation files (the "Software"), to deal
7+
in the Software without restriction, including without limitation the rights
8+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9+
copies of the Software, and to permit persons to whom the Software is
10+
furnished to do so, subject to the following conditions:
11+
12+
The above copyright notice and this permission notice shall be included in
13+
all copies or substantial portions of the Software. *)
14+
15+
open! Import
16+
17+
type t = { mutable buffer : bytes; mutable position : int }
18+
19+
external unsafe_blit_string : string -> int -> bytes -> int -> int -> unit
20+
= "caml_blit_string"
21+
[@@noalloc]
22+
(** Bytes.unsafe_blit_string not available in OCaml 4.08. *)
23+
24+
let create n = { buffer = Bytes.create n; position = 0 }
25+
26+
let write_with (write : string -> int -> int -> unit) b =
27+
write (Bytes.unsafe_to_string b.buffer) 0 b.position
28+
29+
let length b = b.position
30+
let is_empty b = b.position = 0
31+
let clear b = b.position <- 0
32+
33+
let resize b more =
34+
let old_pos = b.position in
35+
let old_len = Bytes.length b.buffer in
36+
let new_len = ref old_len in
37+
while old_pos + more > !new_len do
38+
new_len := 2 * !new_len
39+
done;
40+
let new_buffer = Bytes.create !new_len in
41+
Bytes.blit b.buffer 0 new_buffer 0 b.position;
42+
b.buffer <- new_buffer
43+
44+
let add_substring b s ~off ~len =
45+
let new_position = b.position + len in
46+
if new_position > Bytes.length b.buffer then resize b len;
47+
unsafe_blit_string s off b.buffer b.position len;
48+
b.position <- new_position
49+
50+
let blit ~src ~src_off ~dst ~dst_off ~len =
51+
assert (src_off + len <= src.position);
52+
Bytes.blit src.buffer src_off dst dst_off len
53+
54+
let add_string b s = add_substring b s ~off:0 ~len:(String.length s)

‎src/eio/buffer.mli‎

Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
(* The MIT License
2+
3+
Copyright (c) 2021 Clément Pascutto <clement@tarides.com>
4+
5+
Permission is hereby granted, free of charge, to any person obtaining a copy
6+
of this software and associated documentation files (the "Software"), to deal
7+
in the Software without restriction, including without limitation the rights
8+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9+
copies of the Software, and to permit persons to whom the Software is
10+
furnished to do so, subject to the following conditions:
11+
12+
The above copyright notice and this permission notice shall be included in
13+
all copies or substantial portions of the Software. *)
14+
15+
(** Extensible buffers with non-allocating access to the buffer's contents. *)
16+
17+
type t
18+
(** The type of buffers. *)
19+
20+
val create : int -> t
21+
(** [create n] is a fresh buffer with initial size [n]. *)
22+
23+
val length : t -> int
24+
(** [length b] is the number of bytes contained in the buffer. *)
25+
26+
val is_empty : t -> bool
27+
(** [is_empty t] iff [t] contains 0 characters. *)
28+
29+
val clear : t -> unit
30+
(** [clear t] clears the data contained in [t]. It does not reset the buffer to
31+
its initial size. *)
32+
33+
val add_substring : t -> string -> off:int -> len:int -> unit
34+
(** [add_substring t s ~off ~len] appends the substring
35+
[s.(off) .. s.(off + len - 1)] at the end of [t], resizing [t] if necessary. *)
36+
37+
val add_string : t -> string -> unit
38+
(** [add_string t s] appends [s] at the end of [t], resizing [t] if necessary. *)
39+
40+
val write_with : (string -> int -> int -> unit) -> t -> unit
41+
(** [write_with writer t] uses [writer] to write the contents of [t]. [writer]
42+
takes a string to write, an offset and a length. *)
43+
44+
val blit : src:t -> src_off:int -> dst:bytes -> dst_off:int -> len:int -> unit
45+
(** [blit] copies [len] bytes from the buffer [src], starting at offset
46+
[src_off], into the supplied bytes [dst], starting at offset [dst_off]. *)

‎src/eio/dune‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
(library
2+
(public_name index.eio)
3+
(name index_eio)
4+
(optional)
5+
(libraries fmt fmt.tty index logs logs.threaded threads.posix unix eio
6+
eio.core cstruct mtime mtime.clock.os optint progress))

‎src/eio/import.ml‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
module Int63 = Optint.Int63
2+
3+
type int63 = Int63.t
4+
5+
module Mtime = struct
6+
include Mtime
7+
8+
let span_to_s span = Mtime.Span.to_float_ns span *. 1e-9
9+
let span_to_us span = Mtime.Span.to_float_ns span *. 1e-3
10+
end

0 commit comments

Comments
 (0)