add CCMutex.{with_lock_as_ref,incr,decr}

src/threads/CCLock.ml

@@ -32,6 +32,8 @@ type 'a t = {
   mutable content : 'a;
 }
 
+type 'a lock = 'a t
+
 let create content = {
   mutex = Mutex.create();
   content;
@@ -47,6 +49,50 @@ let with_lock l f =
     Mutex.unlock l.mutex;
     raise e
 
+(*$R
+  let l = create 0 in
+  let try_incr l =
+    update l (fun x -> Thread.yield(); x+1)
+  in
+  for i = 1 to 10 do ignore (Thread.create try_incr l) done;
+  Thread.delay 0.10 ;
+  assert_equal 10 (get l)
+*)
+
+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
+
+(*$R
+  let l = create 0 in
+  let test_it l =
+    with_lock_as_ref l
+      (fun r ->
+        let x = LockRef.get r in
+        LockRef.set r (x+10);
+        Thread.yield ();
+        let y = LockRef.get r in
+        LockRef.set r (y - 10);
+      )
+  in
+  for i = 1 to 100 do ignore (Thread.create test_it l) done;
+  Thread.delay 0.10;
+  assert_equal 0 (get l)
+*)
+
 let mutex l = l.mutex
 
 let update l f =
@@ -58,4 +104,7 @@ let get l =
   Mutex.unlock l.mutex;
   x
 
+let incr l = update l (fun x -> x+1)
+
+let decr l = update l (fun x -> x-1)
 

src/threads/CCLock.mli

@@ -40,6 +40,24 @@ val with_lock : 'a t -> ('a -> 'b) -> 'b
     the lock [l], in a critical section. If [f x] fails, [with_lock l f]
     fails too but the lock is released *)
 
+(** Type allowing to manipulate the lock as a reference
+    @since NEXT_RELEASE *)
+module LockRef : sig
+  type 'a t
+
+  val get : 'a t -> 'a
+
+  val set : 'a t -> 'a -> unit
+
+  val update : 'a t -> ('a -> 'a) -> unit
+end
+
+val with_lock_as_ref : 'a t -> ('a LockRef.t -> 'b) -> 'b
+(** [with_lock_as_ref l f] calls [f] with a reference-like object
+    that allows to manipulate the value of [l] safely.
+    The object passed to [f] must not escape the function call
+    @since NEXT_RELEASE *)
+
 val update : 'a t -> ('a -> 'a) -> unit
 (** [update l f] replaces the content [x] of [l] with [f x], atomically *)
 
@@ -49,3 +67,11 @@ val mutex : _ t -> Mutex.t
 val get : 'a t -> 'a
 (** Get the value in the lock. The value that is returned isn't protected! *)
 
+val incr : int t -> unit
+(** Atomically increment the value
+    @since NEXT_RELEASE *)
+
+val decr : int t -> unit
+(** Atomically decrement the value
+    @since NEXT_RELEASE *)
+