clocks: add real_clock and mono_clock

1. Makes Time.clock polymorphic
2. Rename clock to real_clock
3. Add mono_clock
4. Change benchmarks to use monotonic clock from realtime clock

bench/bench_cancel.ml

@@ -37,8 +37,8 @@ let run_bench ?domain_mgr ~clock () =
       )
   with Exit ->
     let t1 = Eio.Time.now clock in
-    let time_total = t1 -. t0 in
-    let time_per_iter = time_total /. float n_iters in
+    let time_total = Mtime.span t1 t0 in
+    let time_per_iter = Mtime.Span.to_s time_total /. float n_iters in
     let _minor1, prom1, _major1 = Gc.counters () in
     let prom = prom1 -. prom0 in
     Printf.printf "%11b, %7.2f, %13.4f\n%!" (domain_mgr <> None) (1e9 *. time_per_iter) (prom /. float n_iters)
@@ -52,4 +52,4 @@ let () =
   Eio_main.run @@ fun env ->
   main
     ~domain_mgr:(Eio.Stdenv.domain_mgr env)
-    ~clock:(Eio.Stdenv.clock env)
+    ~clock:(Eio.Stdenv.mono_clock env)

bench/bench_mutex.ml

@@ -32,9 +32,9 @@ let run_bench ~domain_mgr ~clock ~use_domains ~iters_per_thread ~threads =
     );
   assert (!v = 0);
   let t1 = Eio.Time.now clock in
-  let time_total = t1 -. t0 in
+  let time_total = Mtime.span t1 t0 in
   let n_iters = iters_per_thread * threads in
-  let time_per_iter = time_total /. float n_iters in
+  let time_per_iter = Mtime.Span.to_s time_total /. float n_iters in
   let _minor1, prom1, _major1 = Gc.counters () in
   let prom = prom1 -. prom0 in
   Printf.printf "%11b, %12d, %8d, %8.2f, %13.4f\n%!" use_domains n_iters threads (1e9 *. time_per_iter) (prom /. float n_iters)
@@ -55,4 +55,4 @@ let () =
   Eio_main.run @@ fun env ->
   main
     ~domain_mgr:(Eio.Stdenv.domain_mgr env)
-    ~clock:(Eio.Stdenv.clock env)
+    ~clock:(Eio.Stdenv.mono_clock env)

bench/bench_promise.ml

@@ -46,7 +46,8 @@ let bench_resolved ~clock ~n_iters =
     t := !t + Promise.await p;
   done;
   let t1 = Eio.Time.now clock in
-  Printf.printf "Reading a resolved promise: %.3f ns\n%!" (1e9 *. (t1 -. t0) /. float n_iters);
+  let total_time = Mtime.span t1 t0 in
+  Printf.printf "Reading a resolved promise: %.3f ns\n%!" (1e9 *. (Mtime.Span.to_s total_time) /. float n_iters);
   assert (!t = n_iters)
 
 let run_bench ~domain_mgr ~clock ~use_domains ~n_iters =
@@ -67,8 +68,8 @@ let run_bench ~domain_mgr ~clock ~use_domains ~n_iters =
        run_client ~n_iters ~i:0 init_p
     );
   let t1 = Eio.Time.now clock in
-  let time_total = t1 -. t0 in
-  let time_per_iter = time_total /. float n_iters in
+  let time_total = Mtime.span t1 t0 in
+  let time_per_iter = Mtime.Span.to_s time_total /. float n_iters in
   let _minor1, prom1, _major1 = Gc.counters () in
   let prom = prom1 -. prom0 in
   Printf.printf "%11b, %8d, %8.2f, %13.4f\n%!" use_domains n_iters (1e9 *. time_per_iter) (prom /. float n_iters)
@@ -86,4 +87,4 @@ let () =
   Eio_main.run @@ fun env ->
   main
     ~domain_mgr:(Eio.Stdenv.domain_mgr env)
-    ~clock:(Eio.Stdenv.clock env)
+    ~clock:(Eio.Stdenv.mono_clock env)

bench/bench_semaphore.ml

@@ -30,8 +30,8 @@ let run_bench ~domain_mgr ~clock ~use_domains ~n_iters ~batch_size =
        done
     );
   let t1 = Eio.Time.now clock in
-  let time_total = t1 -. t0 in
-  let time_per_iter = time_total /. float n_iters in
+  let time_total = Mtime.span t1 t0 in
+  let time_per_iter = Mtime.Span.to_s time_total /. float n_iters in
   let _minor1, prom1, _major1 = Gc.counters () in
   let prom = prom1 -. prom0 in
   Printf.printf "%11b, %8d, %3d, %8.2f, %13.4f\n%!" use_domains n_iters batch_size (1e9 *. time_per_iter) (prom /. float n_iters)
@@ -52,4 +52,4 @@ let () =
   Eio_main.run @@ fun env ->
   main
     ~domain_mgr:(Eio.Stdenv.domain_mgr env)
-    ~clock:(Eio.Stdenv.clock env)
+    ~clock:(Eio.Stdenv.mono_clock env)

bench/bench_stream.ml

@@ -26,8 +26,8 @@ let run_bench ~domain_mgr ~clock ~use_domains ~n_iters ~capacity =
          done
       );
     let t1 = Eio.Time.now clock in
-    let time_total = t1 -. t0 in
-    let time_per_iter = time_total /. float n_iters in
+    let time_total = Mtime.span t1 t0 in
+    let time_per_iter = Mtime.Span.to_s time_total /. float n_iters in
     let _minor1, prom1, _major1 = Gc.counters () in
     let prom = prom1 -. prom0 in
     Printf.printf "%11b, %8d, %8d, %7.2f, %13.4f\n%!" use_domains n_iters capacity (1e9 *. time_per_iter) (prom /. float n_iters)
@@ -46,4 +46,4 @@ let () =
   Eio_main.run @@ fun env ->
   main
     ~domain_mgr:(Eio.Stdenv.domain_mgr env)
-    ~clock:(Eio.Stdenv.clock env)
+    ~clock:(Eio.Stdenv.mono_clock env)

bench/bench_yield.ml

@@ -19,14 +19,14 @@ let main ~clock =
           done
         );
       let t1 = Eio.Time.now clock in
-      let time_total = t1 -. t0 in
+      let time_total = Mtime.span t1 t0 in
       let n_total = n_fibers * n_iters in
-      let time_per_iter = time_total /. float n_total in
+      let time_per_iter = Mtime.Span.to_s time_total /. float n_total in
       let _minor1, prom1, _major1 = Gc.counters () in
       let prom = prom1 -. prom0 in
       Printf.printf "%8d, % 7.2f, % 13.4f\n%!" n_fibers (1e9 *. time_per_iter) (prom /. float n_total)
     )
 
 let () =
   Eio_main.run @@ fun env ->
-  main ~clock:(Eio.Stdenv.clock env)
+  main ~clock:(Eio.Stdenv.mono_clock env)

dune-project

@@ -22,6 +22,7 @@
   (hmap (>= 0.8.1))
   (astring (and (>= 0.8.5) :with-test))
   (crowbar (and (>= 0.2) :with-test))
+  (ptime (>= 1.0.0))
   (mtime (>= 1.2.0))
   (alcotest (and (>= 1.4.0) :with-test))))
 (package

eio.opam

@@ -20,6 +20,7 @@ depends: [
   "hmap" {>= "0.8.1"}
   "astring" {>= "0.8.5" & with-test}
   "crowbar" {>= "0.2" & with-test}
+  "ptime" {>= "1.0.0"}
   "mtime" {>= "1.2.0"}
   "alcotest" {>= "1.4.0" & with-test}
   "odoc" {with-doc}

lib_eio/dune

@@ -1,5 +1,6 @@
 (library
-  (name eio)
-  (public_name eio)
-  (flags (:standard -open Eio__core -open Eio__core.Private))
-  (libraries eio__core cstruct lwt-dllist fmt bigstringaf optint))
+ (name eio)
+ (public_name eio)
+ (flags
+  (:standard -open Eio__core -open Eio__core.Private))
+ (libraries eio__core cstruct lwt-dllist fmt bigstringaf optint ptime mtime))

lib_eio/eio.ml

@@ -36,7 +36,8 @@ module Stdenv = struct
     stderr : Flow.sink;
     net : Net.t;
     domain_mgr : Domain_manager.t;
-    clock : Time.clock;
+    real_clock : Ptime.t Time.clock;
+    mono_clock : Mtime.t Time.clock;
     fs : Fs.dir Path.t;
     cwd : Fs.dir Path.t;
     secure_random : Flow.source;
@@ -48,7 +49,8 @@ module Stdenv = struct
   let stderr (t : <stderr : #Flow.sink;   ..>) = t#stderr
   let net (t : <net : #Net.t; ..>) = t#net
   let domain_mgr (t : <domain_mgr : #Domain_manager.t; ..>) = t#domain_mgr
-  let clock (t : <clock : #Time.clock; ..>) = t#clock
+  let real_clock (t : <real_clock : Ptime.t #Time.clock; ..>) = t#real_clock
+  let mono_clock (t : <mono_clock : Mtime.t #Time.clock; ..>) = t#mono_clock
   let secure_random (t: <secure_random : #Flow.source; ..>) = t#secure_random
   let fs (t : <fs : #Fs.dir Path.t; ..>) = t#fs
   let cwd (t : <cwd : #Fs.dir Path.t; ..>) = t#cwd

lib_eio/eio.mli

@@ -110,26 +110,31 @@ end
 
 (** Clocks, time, sleeping and timeouts. *)
 module Time : sig
-  class virtual clock : object
-    method virtual now : float
-    method virtual sleep_until : float -> unit
+  class virtual ['a] clock : object
+    method virtual now : 'a
+    method virtual sleep_until : 'a -> unit
+    method virtual add_seconds : 'a -> float -> 'a
+    method virtual to_seconds : 'a -> float
   end
 
-  val now : #clock -> float
+  val now : 'a #clock -> 'a
   (** [now t] is the current time according to [t]. *)
 
-  val sleep_until : #clock -> float -> unit
+  val sleep_until : 'a #clock -> 'a -> unit
   (** [sleep_until t time] waits until the given time is reached. *)
 
-  val sleep : #clock -> float -> unit
+  val sleep : 'a #clock -> float -> unit
   (** [sleep t d] waits for [d] seconds. *)
 
-  val with_timeout : #clock -> float -> (unit -> ('a, 'e) result) -> ('a, [> `Timeout] as 'e) result
+  val to_seconds : 'a #clock -> 'a -> float
+  (** [to_seconds clock time] converts [time] to fractional seconds using [clock]. *)
+
+  val with_timeout : 'a #clock -> float -> (unit -> ('a, 'e) result) -> ('a, [> `Timeout] as 'e) result
   (** [with_timeout clock d fn] runs [fn ()] but cancels it after [d] seconds. *)
 
   exception Timeout
 
-  val with_timeout_exn : #clock -> float -> (unit -> 'a) -> 'a
+  val with_timeout_exn : 'a #clock -> float -> (unit -> 'a) -> 'a
   (** [with_timeout_exn clock d fn] runs [fn ()] but cancels it after [d] seconds,
       raising exception [Timeout]. *)
 end
@@ -201,7 +206,8 @@ module Stdenv : sig
     stderr : Flow.sink;
     net : Net.t;
     domain_mgr : Domain_manager.t;
-    clock : Time.clock;
+    real_clock : Ptime.t Time.clock;
+    mono_clock : Mtime.t Time.clock;
     fs : Fs.dir Path.t;
     cwd : Fs.dir Path.t;
     secure_random : Flow.source;
@@ -254,8 +260,11 @@ module Stdenv : sig
       To use this, see {!Time}.
   *)
 
-  val clock : <clock : #Time.clock as 'a; ..> -> 'a
-  (** [clock t] is the system clock. *)
+  val real_clock : <real_clock : Ptime.t #Time.clock as 'a; ..> -> 'a
+  (** [real_clock t] is the realtime OS clock. *)
+
+  val mono_clock : <mono_clock : Mtime.t #Time.clock as 'a; ..> -> 'a
+  (** [mono_clock t] is the monotonic OS clock. *)
 
   (** {1 Randomness} *)
 

lib_eio/time.ml

@@ -1,15 +1,18 @@
 exception Timeout
 
-class virtual clock = object
-  method virtual now : float
-  method virtual sleep_until : float -> unit
+class virtual ['a] clock = object
+  method virtual now : 'a
+  method virtual sleep_until : 'a -> unit
+  method virtual add_seconds : 'a -> float -> 'a
+  method virtual to_seconds : 'a -> float
 end
 
-let now (t : #clock) = t#now
+let now (t: (_ #clock)) = t#now
 
-let sleep_until (t : #clock) time = t#sleep_until time
+let sleep_until (t : (_ #clock)) time = t#sleep_until time
 
-let sleep t d = sleep_until t (now t +. d)
+let sleep t d = sleep_until t (t#add_seconds t#now d)
 
+let to_seconds t time = t#to_seconds time
 let with_timeout t d = Fiber.first (fun () -> sleep t d; Error `Timeout)
 let with_timeout_exn t d = Fiber.first (fun () -> sleep t d; raise Timeout)

lib_eio/unix/dune

@@ -1,4 +1,4 @@
 (library
  (name eio_unix)
  (public_name eio.unix)
- (libraries eio unix threads mtime.clock.os))
+ (libraries eio unix threads mtime mtime.clock.os ptime ptime.clock.os))

lib_eio/unix/eio_unix.ml

@@ -14,16 +14,36 @@ module Private = struct
   type _ Effect.t += 
     | Await_readable : Unix.file_descr -> unit Effect.t
     | Await_writable : Unix.file_descr -> unit Effect.t
-    | Get_system_clock : Eio.Time.clock Effect.t
     | Socket_of_fd : Eio.Switch.t * bool * Unix.file_descr -> socket Effect.t
     | Socketpair : Eio.Switch.t * Unix.socket_domain * Unix.socket_type * int -> (socket * socket) Effect.t
 end
 
 let await_readable fd = Effect.perform (Private.Await_readable fd)
 let await_writable fd = Effect.perform (Private.Await_writable fd)
 
-let sleep d =
-  Eio.Time.sleep (Effect.perform Private.Get_system_clock) d
+let real_clock = object
+  inherit [Ptime.t] Eio.Time.clock
+
+  method now = Ptime_clock.now ()
+  method sleep_until = failwith "sleep_until not implemented"
+  method add_seconds t d =
+    let span = Ptime.Span.of_float_s d in
+    Option.bind span (Ptime.add_span t)
+    |> Option.get
+end
+
+let mono_clock = object
+  inherit [Mtime.t] Eio.Time.clock
+
+  method now = Mtime_clock.now ()
+  method sleep_until = failwith "sleep_until not implemented"
+  method add_seconds t d =
+    let span = (d *. 1e9) |> Int64.of_float |> Mtime.Span.of_uint64_ns in
+    Mtime.add_span t span
+    |> Option.get
+end
+
+let sleep d = Eio.Time.sleep mono_clock d
 
 let run_in_systhread fn =
   let f fiber enqueue =

lib_eio/unix/eio_unix.mli

@@ -60,7 +60,9 @@ val sleep : float -> unit
 (** [sleep d] sleeps for [d] seconds, allowing other fibers to run.
     This is can be useful for debugging (e.g. to introduce delays to trigger a race condition)
     without having to plumb {!Eio.Stdenv.clock} through your code.
-    It can also be used in programs that don't care about tracking determinism. *)
+    It can also be used in programs that don't care about tracking determinism.
+
+    The clock used is the monotonic system clock. See {!val:mono_clock}. *)
 
 val run_in_systhread : (unit -> 'a) -> 'a
 (** [run_in_systhread fn] runs the function [fn] in a newly created system thread (a {! Thread.t}).
@@ -85,7 +87,6 @@ module Private : sig
   type _ Effect.t += 
     | Await_readable : Unix.file_descr -> unit Effect.t      (** See {!await_readable} *)
     | Await_writable : Unix.file_descr -> unit Effect.t      (** See {!await_writable} *)
-    | Get_system_clock : Eio.Time.clock Effect.t             (** See {!sleep} *)
     | Socket_of_fd : Switch.t * bool * Unix.file_descr ->
         socket Effect.t                                      (** See {!FD.as_socket} *)
     | Socketpair : Eio.Switch.t * Unix.socket_domain * Unix.socket_type * int ->
@@ -96,3 +97,9 @@ module Ctf = Ctf_unix
 
 val getnameinfo : Eio.Net.Sockaddr.t -> (string * string)
 (** [getnameinfo sockaddr] returns domain name and service for [sockaddr]. *)
+
+val real_clock : Ptime.t Eio.Time.clock
+(** [real_clock] is the realtime OS clock. *)
+
+val mono_clock : Mtime.t Eio.Time.clock
+(** [mono_clock] is the monotonic OS clock. *)

lib_eio_linux/dune

@@ -6,4 +6,4 @@
   (language c)
   (flags :standard -D_LARGEFILE64_SOURCE)
   (names eio_stubs))
- (libraries eio eio.utils eio.unix uring logs fmt))
+  (libraries eio eio.utils eio.unix uring logs fmt ptime mtime))

lib_eio_linux/eio_linux.ml

@@ -1165,7 +1165,8 @@ type stdenv = <
   stderr : sink;
   net : Eio.Net.t;
   domain_mgr : Eio.Domain_manager.t;
-  clock : Eio.Time.clock;
+  real_clock : Ptime.t Eio.Time.clock;
+  mono_clock : Mtime.t Eio.Time.clock;
   fs : Eio.Fs.dir Eio.Path.t;
   cwd : Eio.Fs.dir Eio.Path.t;
   secure_random : Eio.Flow.source;
@@ -1190,13 +1191,6 @@ let domain_mgr ~run_event_loop = object (self)
       )
 end
 
-let clock = object
-  inherit Eio.Time.clock
-
-  method now = Unix.gettimeofday ()
-  method sleep_until = Low_level.sleep_until
-end
-
 class dir ~label (fd : dir_fd) = object
   inherit Eio.Fs.dir
 
@@ -1278,7 +1272,8 @@ let stdenv ~run_event_loop =
     method stderr = Lazy.force stderr
     method net = net
     method domain_mgr = domain_mgr ~run_event_loop
-    method clock = clock
+    method real_clock = Eio_unix.real_clock
+    method mono_clock = Eio_unix.mono_clock
     method fs = (fs :> Eio.Fs.dir Eio.Path.t)
     method cwd = (cwd :> Eio.Fs.dir Eio.Path.t)
     method secure_random = secure_random
@@ -1432,7 +1427,6 @@ let rec run : type a.
                   );
                 schedule st
             )
-          | Eio_unix.Private.Get_system_clock -> Some (fun k -> continue k clock)
           | Eio_unix.Private.Socket_of_fd (sw, close_unix, fd) -> Some (fun k ->
               let fd = FD.of_unix ~sw ~seekable:false ~close_unix fd in
               continue k (flow fd :> Eio_unix.socket)

lib_eio_linux/eio_linux.mli

@@ -64,7 +64,8 @@ type stdenv = <
   stderr : sink;
   net : Eio.Net.t;
   domain_mgr : Eio.Domain_manager.t;
-  clock : Eio.Time.clock;
+  real_clock : Ptime.t Eio.Time.clock;
+  mono_clock : Mtime.t Eio.Time.clock;
   fs : Eio.Fs.dir Eio.Path.t;
   cwd : Eio.Fs.dir Eio.Path.t;
   secure_random : Eio.Flow.source;