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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
module Cmd = B0__cmd
module Fmt = B0__fmt
module Fpath = B0__fpath
module Log = B0__log
module Mtime = B0__mtime
module Os = B0__os
module Char = B0__char
module List = B0__list
module Result = B0__result
module String = B0__string
module Type = B0__type
module Fut = struct
type 'a state = Det of 'a | Undet of { mutable awaits : ('a -> unit) list }
type 'a t = 'a state ref
let rec kontinue ks v =
let todo = ref ks in
while match !todo with [] -> false | _ -> true do
match !todo with k :: ks -> todo := ks; k v | [] -> ()
done
let set f v = match !f with
| Det _ -> invalid_arg "The future is already set"
| Undet u -> f := Det v; kontinue u.awaits v
let _make () = ref (Undet { awaits = [] })
let make () = let f = _make () in f, set f
let value f = match !f with Det v -> Some v | _ -> None
let await f k = match !f with
| Det v -> k v | Undet u -> u.awaits <- k :: u.awaits
let rec sync f = match !f with
| Det v -> v
| Undet _ -> Os.relax (); sync f
let return v = ref (Det v)
let map fn f =
let r = _make () in
await f (fun v -> set r (fn v)); r
let bind f fn =
let r = _make () in
await f (fun v -> await (fn v) (set r)); r
let pair f0 f1 =
let r = _make () in
await f0 (fun v0 -> await f1 (fun v1 -> set r (v0, v1))); r
let of_list fs = match fs with
| [] -> return []
| fs ->
let r = _make () in
let rec loop acc = function
| [] -> set r (List.rev acc)
| f :: fs -> await f (fun v -> loop (v :: acc) fs)
in
loop [] fs; r
module Syntax = struct
let ( let* ) = bind
let ( and* ) = pair
end
end
module Bval = struct
let already_set () = invalid_arg "already set"
type 'a t =
| V of 'a
| Lazy of 'a Fut.t * (unit -> unit)
| Fut of ('a Fut.t * ('a -> unit))
type 'a setter = 'a t
let make () = let bv = Fut (Fut.make ()) in bv, bv
let of_val v = V v
let of_lazy_fun f =
let value, set = Fut.make () in
let run = ref true in
let stir () = if !run then (run := true; set (f ())) else () in
Lazy (value, stir)
let of_setter = Fun.id
let is_lazy = function Lazy _ -> true | _ -> false
let set s v = match s with
| Fut (fut, set) -> set v
| _ -> assert false
let try_set s v = match s with
| Fut (fut, set) ->
(match Fut.value fut with None -> set v; true | Some _ -> false)
| _ -> assert false
let try_set' s f = match s with
| Fut (fut, set) ->
begin match Fut.value fut with
| Some _ -> false
| None ->
let v = f () in
match Fut.value fut with
| Some _ -> false
| None -> set v; true
end
| _ -> assert false
let get = function
| V v -> Fut.return v
| Lazy (fut, stir) -> stir (); fut
| Fut (fut, _) -> fut
let poll = function
| V v -> Some v
| Lazy (fut, stir) -> stir (); Fut.value fut
| Fut (fut, _) -> Fut.value fut
let stir = function Lazy (_, stir) -> stir () | _ -> ()
let pp pp_v ppf = function
| V v -> pp_v ppf v
| Lazy (fut, _) | Fut (fut, _) ->
match Fut.value fut with
| None -> Fmt.string ppf "<pending>" | Some v -> pp_v ppf v
end