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
(** {1 Utils around Mutex} *)
type 'a t = { mutex: Mutex.t; mutable content: 'a }
type 'a lock = 'a t
let create content = { mutex = Mutex.create (); content }
let with_lock l f =
Mutex.lock l.mutex;
try
let x = f l.content in
Mutex.unlock l.mutex;
x
with e ->
Mutex.unlock l.mutex;
raise e
let try_with_lock l f =
if Mutex.try_lock l.mutex then (
try
let x = f l.content in
Mutex.unlock l.mutex;
Some x
with e ->
Mutex.unlock l.mutex;
raise e
) else
None
module LockRef = struct
type 'a t = 'a lock
let get t = t.content
let set t x = t.content <- x
let update t f = t.content <- f t.content
end
let with_lock_as_ref l ~f =
Mutex.lock l.mutex;
try
let x = f l in
Mutex.unlock l.mutex;
x
with e ->
Mutex.unlock l.mutex;
raise e
let mutex l = l.mutex
let update l f = with_lock l (fun x -> l.content <- f x)
let update_map l f =
with_lock l (fun x ->
let x', y = f x in
l.content <- x';
y)
let get l =
Mutex.lock l.mutex;
let x = l.content in
Mutex.unlock l.mutex;
x
let set l x =
Mutex.lock l.mutex;
l.content <- x;
Mutex.unlock l.mutex
let incr l = update l Stdlib.succ
let decr l = update l Stdlib.pred
let incr_then_get l =
Mutex.lock l.mutex;
l.content <- l.content + 1;
let x = l.content in
Mutex.unlock l.mutex;
x
let get_then_incr l =
Mutex.lock l.mutex;
let x = l.content in
l.content <- l.content + 1;
Mutex.unlock l.mutex;
x
let decr_then_get l =
Mutex.lock l.mutex;
l.content <- l.content - 1;
let x = l.content in
Mutex.unlock l.mutex;
x
let get_then_decr l =
Mutex.lock l.mutex;
let x = l.content in
l.content <- l.content - 1;
Mutex.unlock l.mutex;
x
let get_then_set l =
Mutex.lock l.mutex;
let x = l.content in
l.content <- true;
Mutex.unlock l.mutex;
x
let get_then_clear l =
Mutex.lock l.mutex;
let x = l.content in
l.content <- false;
Mutex.unlock l.mutex;
x