feat: add moonpool.sync with await-friendly abstractions

based on picos_sync

src/sync/dune

@@ -0,0 +1,5 @@
+(library
+ (name moonpool_sync)
+ (public_name moonpool.sync)
+ (synopsis "Cooperative synchronization primitives for Moonpool")
+ (libraries moonpool picos picos.sync))

src/sync/lock.ml

@@ -0,0 +1,38 @@
+module Mutex = Picos_sync.Mutex
+
+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/sync/lock.mli

@@ -0,0 +1,56 @@
+(** Mutex-protected resource.
+
+    This lock is a synchronous concurrency primitive, as a thin wrapper
+    around {!Mutex} that encourages proper management of the critical
+    section in RAII style:
+
+    {[
+      let (let@) = (@@)
+
+
+      …
+      let compute_foo =
+        (* enter critical section *)
+        let@ x = Lock.with_ protected_resource in
+        use_x;
+        return_foo ()
+        (* exit critical section *)
+      in
+      …
+    ]}
+
+    This lock is based on {!Picos_sync.Mutex} so it is [await]-safe.
+
+    @since NEXT_RELEASE *)
+
+type 'a t
+(** A value protected by a cooperative 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 -> Picos_sync.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/sync/moonpool_sync.ml

@@ -0,0 +1,9 @@
+module Mutex = Picos_sync.Mutex
+module Condition = Picos_sync.Condition
+module Lock = Lock
+module Event = Picos_sync.Event
+module Semaphore = Picos_sync.Semaphore
+module Lazy = Picos_sync.Lazy
+module Latch = Picos_sync.Latch
+module Ivar = Picos_sync.Ivar
+module Stream = Picos_sync.Stream