timing.ml

(* ocamlfind opt -linkpkg -package lwt.ppx -package lwt.unix -package mtime.os timing.ml && ./a.out *)

open Lwt.Infix

let f1 dir =
  let s = Lwt_unix.files_of_directory dir in
  let s = Lwt_stream.filter (fun s -> s <> "." && s <> "..") s in
  let s = Lwt_stream.map (Filename.concat dir) s in
  Lwt_stream.to_list s

let f2 dir =
  let d = Sys.readdir dir in
  let d = Array.to_list d in
  let d = List.rev_map (Filename.concat dir) d in
  Lwt.return d

let f3 dir =
  let%lwt d = Lwt_unix.opendir dir in
  let%lwt entries = Lwt_unix.readdir_n d 10000 in
  let paths = Array.map (Filename.concat dir) entries in
  Lwt.return (Array.to_list paths)

let f4 dir =
  let d = Unix.opendir dir in
  let entries = ref [] in
  let rec read_all () =
    let entry = Unix.readdir d in
    entries := (Filename.concat dir entry)::!entries;
    read_all ()
  in
  let () =
    try read_all ()
    with End_of_file -> ()
  in
  Unix.closedir d;
  Lwt.return !entries

let f5 dir =
  let%lwt d = Lwt_unix.opendir dir in
  let entries = ref [] in
  let rec read_all () =
    Lwt_unix.readdir d >>= fun entry ->
    entries := (Filename.concat dir entry)::!entries;
    read_all ()
  in
  let%lwt () =
    try%lwt read_all ()
    with End_of_file -> Lwt.return_unit
  in
  let%lwt () = Lwt_unix.closedir d in
  Lwt.return !entries

let rec repeat n f x = match n with
  | 0 -> Lwt.return_unit
  | n -> f x >>= fun _ -> repeat (n-1) f x

let print_time msg c =
  Printf.printf "%s: %f.02s\n%!" msg (Mtime.to_s @@ Mtime.count c)

let random_letter () = Char.(chr @@ code 'a' + Random.int 26)

let random_filename () =
  Bytes.init (1 + Random.int 20) (fun _ -> random_letter ())
  |> Bytes.to_string

let (/) = Filename.concat

let tmpdir = Filename.get_temp_dir_name () / "readdir-bench"
let () = print_endline tmpdir

let mkdir d =
  let perm = 0o0700 in
  try Unix.mkdir d perm
  with
  | Unix.Unix_error (Unix.EEXIST, "mkdir", _) -> ()

let write f d =
  let f = tmpdir / f in
  mkdir (Filename.dirname f);
  let oc = open_out f in
  output_string oc d;
  close_out oc

let prepare_fs n =
  let fs = Array.init n (fun i -> random_filename (), string_of_int i) in
  Array.iter (fun (k, v) -> write k v) fs

let () =
  prepare_fs 5000;
  let c = Mtime.counter () in
  Lwt_main.run (repeat 500 f1 tmpdir);
  print_time "Lwt_unix.files_of_directory" c;
  let c = Mtime.counter () in
  Lwt_main.run (repeat 500 f2 tmpdir);
  print_time "Sys.readdir" c;
  let c = Mtime.counter () in
  Lwt_main.run (repeat 500 f3 tmpdir);
  print_time "Lwt_unix.readdir_n" c;
  let c = Mtime.counter () in
  Lwt_main.run (repeat 500 f4 tmpdir);
  print_time "Unix.readdir" c;
  let c = Mtime.counter () in
  Lwt_main.run (repeat 500 f5 tmpdir);
  print_time "Lwt_unix.readdir" c