Merge pull request #630 from talex5/bench-stat

Add Path.stat benchmark

.github/workflows/main.yml

@@ -12,7 +12,7 @@ jobs:
         os:
           - macos-latest
         ocaml-compiler:
-          - 5.0.x
+          - 5.1.x
         local-packages:
           - eio eio_posix eio_main
 
@@ -44,7 +44,7 @@ jobs:
         with:
           opam-pin: false
           opam-depext: false
-          ocaml-compiler: ocaml.5.0.0,ocaml-option-mingw
+          ocaml-compiler: ocaml.5.1.0,ocaml-option-mingw
           opam-repositories: |
             dra27: https://github.com/dra27/opam-repository.git#windows-5.0
             normal: https://github.com/ocaml/opam-repository.git

Dockerfile

@@ -1,8 +1,8 @@
-FROM ocaml/opam:debian-11-ocaml-5.0
+FROM ocaml/opam:debian-11-ocaml-5.1
 # Make sure we're using opam-2.1:
 RUN sudo ln -sf /usr/bin/opam-2.1 /usr/bin/opam
 # Ensure opam-repository is up-to-date:
-RUN cd opam-repository && git pull -q origin 24ff26d7dbf5de564035bbb7d39414bc7f7262d3 && opam update
+RUN cd opam-repository && git pull -q origin 0ac3fc79fd11ee365dd46119d43e9763cf57da52 && opam update
 # Install utop for interactive use:
 RUN opam install utop fmt
 # Install Eio's dependencies (adding just the opam files first to help with caching):

bench.Dockerfile

@@ -0,0 +1,14 @@
+FROM ocaml/opam:debian-11-ocaml-5.1
+# Make sure we're using opam-2.1:
+RUN sudo ln -sf /usr/bin/opam-2.1 /usr/bin/opam
+# Ensure opam-repository is up-to-date:
+RUN cd opam-repository && git pull -q origin 0ac3fc79fd11ee365dd46119d43e9763cf57da52 && opam update
+# Install Eio's dependencies (adding just the opam files first to help with caching):
+RUN mkdir eio
+WORKDIR eio
+COPY *.opam ./
+RUN opam pin --with-version=dev . -yn
+RUN opam install eio_main yojson
+# Build the benchmarks:
+COPY . ./
+RUN opam exec -- dune build ./bench

bench/bench_stat.ml

@@ -0,0 +1,151 @@
+open Eio.Std
+
+module Path = Eio.Path
+
+let () = Random.init 3
+
+let ( / ) = Eio.Path.( / )
+
+module Bench_dir = struct
+  type t = 
+    | Dir of { name : string; perm : int; children : t list }
+    | File of { name : string; size : int64; perm : int; }
+
+  let get_name = function Dir { name; _ } | File { name; _ } -> name
+
+  let get_children = function
+    | Dir { children; _ } -> children
+    | File _ -> invalid_arg "Files don't have children"
+
+  let compare a b = String.compare (get_name a) (get_name b)
+
+  let rec sort = function
+    | Dir ({ children; _ } as v) ->
+      let c = List.map sort children in
+      let c = List.stable_sort compare c in
+      Dir { v with children = c }
+    | File _ as f -> f
+
+  let rec size = function
+    | Dir { children; _ } ->
+      List.fold_left (fun acc v -> acc + size v) 0 children
+    | File _ -> 1
+
+  let rec pp ppf = function
+    | Dir { name; perm; children } ->
+      if children = [] then Fmt.pf ppf "dir %s (0o%o)" name perm else
+        Fmt.pf ppf "@[<v2>dir %s (0o%o)@ %a@]" name perm Fmt.(list ~sep:Fmt.cut pp) children
+    | File { name; size; perm } ->
+      Fmt.pf ppf "file %s (0o%o) %Lu" name perm size
+
+  let make random fs t =
+    let limit = Eio.Semaphore.make 32 in        (* Prevent FD exhaustion *)
+    let rec aux fs = function
+      | Dir { name; perm; children } ->
+        let dir = fs / name in
+        Eio.Semaphore.acquire limit;
+        Path.mkdir ~perm dir;
+        Eio.Semaphore.release limit;
+        Fiber.List.iter (aux dir) children
+      | File { name; size; perm } ->
+        Eio.Semaphore.acquire limit;
+        let buf = Cstruct.create (Int64.to_int size) in
+        Eio.Flow.read_exact random buf;
+        Path.with_open_out ~create:(`If_missing perm) (fs / name) (fun oc ->
+            Eio.Flow.write oc [ buf ]
+          );
+        Eio.Semaphore.release limit
+    in
+    aux fs t
+end
+
+let with_tmp_dir ~fs prefix suffix fn =
+  Switch.run @@ fun sw ->
+  let dir = fs / Filename.temp_dir prefix suffix in
+  Switch.on_release sw (fun () -> Path.rmtree dir);
+  fn dir
+
+let bench_stat root =
+  let limit = Eio.Semaphore.make 32 in        (* Prevent FD exhaustion *)
+  let rec aux dir =
+    Eio.Semaphore.acquire limit;
+    let { Eio.File.Stat.kind; perm; size; _ } = Path.stat ~follow:false dir in
+    match kind with
+    | `Directory ->
+      let items = Path.read_dir dir in
+      Eio.Semaphore.release limit;
+      let children = items |> Fiber.List.map (fun f -> aux (dir / f)) in
+      let name = Path.native_exn dir |> Filename.basename in
+      Bench_dir.Dir { name; perm; children }
+    | `Regular_file ->
+      Eio.Semaphore.release limit;
+      let name = Path.native_exn dir |> Filename.basename in
+      File { name; perm; size = Optint.Int63.to_int64 size }
+    | _ -> assert false
+  in
+  aux root
+
+let file name = Bench_dir.File { name; perm = 0o644; size = 128L }
+let dir name children = Bench_dir.Dir { name; perm = 0o700; children }
+
+let random_bench_dir ~n ~levels =
+  if levels < 0 then invalid_arg "Levels should be > 0";
+  let rec loop root = function
+    | 1 -> (
+        match root with
+        | Bench_dir.Dir d ->
+          let leaf_files = List.init n (fun i -> file (Fmt.str "test-file-%i-%i" 1 i)) in
+          Bench_dir.Dir { d with children = leaf_files }
+        | _ -> failwith "Root is always expected to be a directory"
+      )
+    | level ->
+      match root with
+      | Bench_dir.Dir d ->
+        let files = List.init n (fun i -> file (Fmt.str "test-file-%i-%i" level i)) in
+        let dirs = List.init n (fun i -> dir (Fmt.str "test-dir-%i-%i" level i) []) in 
+        let dirs = List.map (fun dir -> loop dir (level - 1)) dirs in
+        Bench_dir.Dir { d with children = dirs @ files }
+      | _ -> failwith "Root is always expected to be directory"
+  in
+  loop (dir "root" []) levels
+
+let run_bench ~n ~levels ~random ~root ~clock =
+  let dir = random_bench_dir ~levels ~n |> Bench_dir.sort in
+  traceln "Going to create %i files and directories" (Bench_dir.size dir);
+  let create_time =
+    let t0 = Eio.Time.now clock in
+    Bench_dir.make random root dir;
+    let t1 = Eio.Time.now clock in
+    t1 -. t0
+  in
+  traceln "Created %i files and directories in %.2f s" (Bench_dir.size dir) create_time;
+  let bench () =
+    Gc.full_major ();
+    let stat0 = Gc.stat () in
+    let t0 = Eio.Time.now clock in
+    let res = bench_stat root in
+    let t1 = Eio.Time.now clock in
+    let stat1 = Gc.stat () in
+    match Bench_dir.sort res with
+    | Dir { children = [ dir' ]; _ } ->
+      assert (dir = dir');
+      let time_total = t1 -. t0 in
+      let minor_total = stat1.minor_words -. stat0.minor_words in
+      let major_total = stat1.major_words -. stat0.major_words in
+      time_total, minor_total, major_total
+    | _ -> failwith "Stat not the same as the spec"
+  in
+  let time, minor, major = bench () in
+  [ 
+    Metric.create "create-time" (`Float (1e3 *. create_time)) "ms" (Fmt.str "Time to create %i files and directories" (Bench_dir.size dir));
+    Metric.create "stat-time" (`Float (1e3 *. time)) "ms" (Fmt.str "Time to stat %i files and directories" (Bench_dir.size dir));
+    Metric.create "stat-minor" (`Float (1e-3 *. minor)) "kwords" (Fmt.str "Minor words allocated to stat %i files and directories" (Bench_dir.size dir));
+    Metric.create "stat-major" (`Float (1e-3 *. major)) "kwords" (Fmt.str "Major words allocated  %i files and directories" (Bench_dir.size dir))
+  ]
+
+let run env =
+  let fs = Eio.Stdenv.fs env in
+  let random = Eio.Stdenv.secure_random env in
+  let clock = Eio.Stdenv.clock env in
+  with_tmp_dir ~fs "eio-bench-" "-stat" @@ fun root ->
+  run_bench ~n:20 ~levels:4 ~root ~random ~clock

bench/main.ml

@@ -10,6 +10,7 @@ let benchmarks = [
   "HTTP", Bench_http.run;
   "Eio_unix.Fd", Bench_fd.run;
   "File.stat", Bench_fstat.run;
+  "Path.stat", Bench_stat.run;
 ]
 
 let usage_error () =

dune-project

@@ -11,13 +11,9 @@
  (name eio)
  (synopsis "Effect-based direct-style IO API for OCaml")
  (description "An effect-based IO API for multicore OCaml with fibers.")
- (conflicts
+ (conflicts (seq (< 0.3)))
-  (ocaml-base-compiler (< 5.0.0~beta1))
-  (ocaml-variants (< 5.0.0~beta1))
-  (ocaml-system (< 5.0.0~beta1))
-  (seq (< 0.3)))
  (depends
-  (ocaml (>= 5.0.0))
+  (ocaml (>= 5.1.0))
   (bigstringaf (>= 0.9.0))
   (cstruct (>= 6.0.1))
   lwt-dllist

eio.opam

@@ -10,7 +10,7 @@ doc: "https://ocaml-multicore.github.io/eio/"
 bug-reports: "https://github.com/ocaml-multicore/eio/issues"
 depends: [
   "dune" {>= "3.9"}
-  "ocaml" {>= "5.0.0"}
+  "ocaml" {>= "5.1.0"}
   "bigstringaf" {>= "0.9.0"}
   "cstruct" {>= "6.0.1"}
   "lwt-dllist"
@@ -26,9 +26,6 @@ depends: [
   "odoc" {with-doc}
 ]
 conflicts: [
-  "ocaml-base-compiler" {< "5.0.0~beta1"}
-  "ocaml-variants" {< "5.0.0~beta1"}
-  "ocaml-system" {< "5.0.0~beta1"}
   "seq" {< "0.3"}
 ]
 build: [