feat: add a Lock module

src/lock.ml

@@ -0,0 +1,36 @@
+type 'a t = {
+  mutex: Mutex.t;
+  mutable content: 'a;
+}
+
+let create content : _ t = { mutex = Mutex.create (); content }
+
+let with_ (self : _ t) f =
+  Mutex.lock self.mutex;
+  try
+    let x = f self.content in
+    Mutex.unlock self.mutex;
+    x
+  with e ->
+    Mutex.unlock self.mutex;
+    raise e
+
+let[@inline] mutex self = self.mutex
+let[@inline] update self f = with_ self (fun x -> self.content <- f x)
+
+let[@inline] update_map l f =
+  with_ 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

src/lock.mli

@@ -0,0 +1,35 @@
+(** Mutex-protected resource.
+
+    @since NEXT_RELEASE *)
+
+type 'a t
+(** A value protected by a mutex *)
+
+val create : 'a -> 'a t
+(** Create a new protected value. *)
+
+val with_ : 'a t -> ('a -> 'b) -> 'b
+(** [with_ l f] runs [f x] where [x] is the value protected with
+    the lock [l], in a critical section. If [f x] fails, [with_lock l f]
+    fails too but the lock is released. *)
+
+val update : 'a t -> ('a -> 'a) -> unit
+(** [update l f] replaces the content [x] of [l] with [f x], while protected
+    by the mutex. *)
+
+val update_map : 'a t -> ('a -> 'a * 'b) -> 'b
+(** [update_map l f] computes [x', y = f (get l)], then puts [x'] in [l]
+    and returns [y], while protected by the mutex. *)
+
+val mutex : _ t -> Mutex.t
+(** Underlying mutex. *)
+
+val get : 'a t -> 'a
+(** Atomically get the value in the lock. The value that is returned
+    isn't protected! *)
+
+val set : 'a t -> 'a -> unit
+(** Atomically set the value.
+
+    {b NOTE} caution: using {!get} and {!set} as if this were a {!ref}
+    is an anti pattern and will not protect data against some race conditions. *)

src/moonpool.ml

@@ -5,6 +5,7 @@ let start_thread_on_some_domain f x =
 module Atomic = Atomic_
 module Blocking_queue = Bb_queue
 module Chan = Chan
+module Lock = Lock
 module Fork_join = Fork_join
 module Fut = Fut
 module Pool = Pool

src/moonpool.mli

@@ -11,6 +11,7 @@ val start_thread_on_some_domain : ('a -> unit) -> 'a -> Thread.t
     to run the thread. This ensures that we don't always pick the same domain
     to run all the various threads needed in an application (timers, event loops, etc.) *)
 
+module Lock = Lock
 module Fut = Fut
 module Chan = Chan
 module Fork_join = Fork_join