1 files changed, 35 insertions, 23 deletions

diff --git a/src/rw-lock.lisp b/src/rw-lock.lisp
index 2a5e2c3..c0c545b 100644
--- a/src/rw-lock.lisp
+++ b/src/rw-lock.lisp
@@ -8,7 +8,7 @@
   ;; These imports make this SBCL-dependent, but technically speaking we could live without them.
   (:import-from :sb-sys
    :allow-with-interrupts :with-local-interrupts :without-interrupts)
-  (:import-from :serapeum :->)
+  (:import-from :serapeum :-> :with-thunk)
   (:import-from :ukkoclot/src/readtable :readtable)
   (:export
    #:rw-lock
@@ -16,9 +16,11 @@
    #:make-rw-lock
    #:acquire-read-lock
    #:release-read-lock
+   #:call-with-read-lock
    #:with-read-lock
    #:acquire-write-lock
    #:release-write-lock
+   #:call-with-write-lock
    #:with-write-lock))
 (in-package :ukkoclot/src/rw-lock)
 (in-readtable readtable)
@@ -100,19 +102,24 @@
         (wakeup-waiters rw-lock))))
   rw-lock)
 
+(-> call-with-read-lock (rw-lock (function () t)) t)
+(defun call-with-read-lock (rw-lock fn)
+  ;; TODO: timeout
+  "Similar to `with-read-lock', but instead of being a macro, it calls the function `fn'."
+  (let (lock-acquired)
+    (without-interrupts
+      (unwind-protect
+           (when (setf lock-acquired
+                       (allow-with-interrupts (acquire-read-lock rw-lock)))
+             (with-local-interrupts (funcall fn)))
+        (when lock-acquired
+          (release-read-lock rw-lock))))))
+
 (defmacro with-read-lock ((rw-lock) &body body)
   ;; TODO: timeout
-  (with-gensyms (lock-acquired lock-value)
-    `(let ((,lock-acquired)
-           (,lock-value ,rw-lock))
-       (without-interrupts
-         (unwind-protect
-              (when (setf ,lock-acquired
-                          (allow-with-interrupts
-                           (acquire-read-lock ,lock-value)))
-                (with-local-interrupts ,@body))
-           (when ,lock-acquired
-             (release-read-lock ,lock-value)))))))
+  "Hold the read lock for the duration of the `body'."
+  (with-thunk (body)
+    `(call-with-read-lock ,rw-lock ,body)))
 
 (-> acquire-write-lock (rw-lock &key (:wait boolean)) boolean)
 (defun acquire-write-lock (rw-lock &key (wait t))
@@ -149,16 +156,21 @@
       (wakeup-waiters rw-lock)))
   rw-lock)
 
+(-> call-with-write-lock (rw-lock (function () t)) t)
+(defun call-with-write-lock (rw-lock fn)
+  ;; TODO: timeout
+  "Similar to `with-write-lock', but instead of being a macro, it calls the function `fn'."
+  (let (lock-acquired)
+    (without-interrupts
+      (unwind-protect
+           (when (setf lock-acquired
+                       (allow-with-interrupts (acquire-write-lock rw-lock)))
+             (with-local-interrupts (funcall fn)))
+        (when lock-acquired
+          (release-write-lock rw-lock))))))
+
 (defmacro with-write-lock ((rw-lock) &body body)
   ;; TODO: timeout
-  (with-gensyms (lock-acquired lock-value)
-    `(let ((,lock-acquired)
-           (,lock-value ,rw-lock))
-       (without-interrupts
-         (unwind-protect
-              (when (setf ,lock-acquired
-                          (allow-with-interrupts
-                            (acquire-write-lock ,lock-value)))
-                (with-local-interrupts ,@body))
-           (when ,lock-acquired
-             (release-write-lock ,lock-value)))))))
+  "Hold the write lock for the duration of the `body'."
+  (with-thunk (body)
+    `(call-with-write-lock ,rw-lock ,body)))