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
open Eio.Std
type t = <
Eio.Time.clock;
advance : unit;
set_time : float -> unit;
>
module Key = struct
type t = < >
let compare = compare
end
module Job = struct
type t = {
time : float;
resolver : unit Promise.u;
}
let compare a b = Float.compare a.time b.time
end
module Q = Psq.Make(Key)(Job)
let make () =
object (self)
inherit Eio.Time.clock
val mutable now = 0.0
val mutable q = Q.empty
method now = now
method sleep_until time =
if time <= now 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 v.time <= time ->
Promise.resolve v.resolver ();
q <- Option.get (Q.rest q);
drain ()
| _ -> ()
in
drain ();
now <- time;
traceln "mock time is now %g" 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