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
# 1 "lib/picos/picos.common.ml"
module Trigger = struct
include Picos_bootstrap.Trigger
include Picos_ocaml.Trigger
end
module Computation = struct
include Picos_bootstrap.Computation
include Picos_ocaml.Computation
let block t =
let trigger = Trigger.create () in
if try_attach t trigger then begin
match Trigger.await trigger with
| None -> t
| Some (exn, bt) ->
detach t trigger;
Printexc.raise_with_backtrace exn bt
end
else t
let await t = get_or block t
let wait t = if is_running t then ignore (block t)
end
module Fiber = struct
include Picos_bootstrap.Fiber
include Picos_ocaml.Fiber
module Maybe = struct
let[@inline never] not_a_fiber () = invalid_arg "not a fiber"
type t = T : [< `Nothing | `Fiber ] tdt -> t [@@unboxed]
let[@inline] to_fiber_or_current = function
| T Nothing -> current ()
| T (Fiber _ as t) -> t
let[@inline] or_current t = T (to_fiber_or_current t)
let nothing = T Nothing
let[@inline] equal x y = x == y || x == nothing || y == nothing
let[@inline] unequal x y = x != y || x == nothing
let[@inline] of_fiber t = T t
let[@inline] current_if checked =
match checked with
| None | Some true -> of_fiber (current ())
| Some false -> nothing
let[@inline] current_and_check_if checked =
match checked with
| None | Some true ->
let fiber = current () in
check fiber;
of_fiber fiber
| Some false -> nothing
let[@inline] check = function
| T Nothing -> ()
| T (Fiber _ as t) -> check t
let[@inline] to_fiber = function
| T Nothing -> not_a_fiber ()
| T (Fiber _ as t) -> t
end
exception Done
let empty_bt = Printexc.get_callstack 0
let sleep ~seconds =
let sleep = Computation.create ~mode:`LIFO () in
Computation.cancel_after ~seconds sleep Done empty_bt;
let trigger = Trigger.create () in
if Computation.try_attach sleep trigger then
match Trigger.await trigger with
| None -> ()
| Some (exn, bt) ->
Computation.finish sleep;
Printexc.raise_with_backtrace exn bt
end
module Handler = struct
include Picos_bootstrap.Handler
include Picos_ocaml.Handler
end