1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
open Eio.Std
module type S = sig
type time
type t = <
time Eio.Time.clock_base;
advance : unit;
set_time : time -> unit;
>
val make : unit -> t
val advance : t -> unit
val set_time : t -> time -> unit
end
module type TIME = sig
type t
val zero : t
val compare : t -> t -> int
val pp : t Fmt.t
end
module Make(T : TIME) : S with type time := T.t = struct
type t = <
T.t Eio.Time.clock_base;
advance : unit;
set_time : T.t -> unit;
>
module Key = struct
type t = < >
let compare = compare
end
module Job = struct
type t = {
time : T.t;
resolver : unit Promise.u;
}
let compare a b = T.compare a.time b.time
end
module Q = Psq.Make(Key)(Job)
let make () =
object (self)
inherit [T.t] Eio.Time.clock_base
val mutable now = T.zero
val mutable q = Q.empty
method now = now
method sleep_until time =
if T.compare time now <= 0 then Fiber.yield ()
else (
let p, r = Promise.create () in
let k = object end in
q <- Q.add k { time; resolver = r } q;
try
Promise.await p
with Eio.Cancel.Cancelled _ as ex ->
q <- Q.remove k q;
raise ex
)
method set_time time =
let rec drain () =
match Q.min q with
| Some (_, v) when T.compare v.time time <= 0 ->
Promise.resolve v.resolver ();
q <- Option.get (Q.rest q);
drain ()
| _ -> ()
in
drain ();
now <- time;
traceln "mock time is now %a" T.pp now
method advance =
match Q.min q with
| None -> invalid_arg "No further events scheduled on mock clock"
| Some (_, v) -> self#set_time v.time
end
let set_time (t:t) time = t#set_time time
let advance (t:t) = t#advance
end
module Old_time = struct
type t = float
let compare = Float.compare
let pp f x = Fmt.pf f "%g" x
let zero = 0.0
end
module Mono_time = struct
type t = Mtime.t
let compare = Mtime.compare
let zero = Mtime.of_uint64_ns 0L
let pp f t =
let s = Int64.to_float (Mtime.to_uint64_ns t) /. 1e9 in
Fmt.pf f "%g" s
end
module Mono = Make(Mono_time)
include Make(Old_time)