diff --git a/src/sync/dune b/src/sync/dune new file mode 100644 index 00000000..d574642b --- /dev/null +++ b/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)) diff --git a/src/sync/lock.ml b/src/sync/lock.ml new file mode 100644 index 00000000..7a7af662 --- /dev/null +++ b/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 diff --git a/src/sync/lock.mli b/src/sync/lock.mli new file mode 100644 index 00000000..a50987a6 --- /dev/null +++ b/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. *) diff --git a/src/sync/moonpool_sync.ml b/src/sync/moonpool_sync.ml new file mode 100644 index 00000000..1c1d3716 --- /dev/null +++ b/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