Use with-thunk in all my with- macrosHEADmain

2 files changed, 49 insertions, 28 deletions

diff --git a/src/db.lisp b/src/db.lisp
index ea18d16..db8f7c1 100644
--- a/src/db.lisp
+++ b/src/db.lisp
@@ -3,8 +3,8 @@
 (defpackage :ukkoclot/src/db
   (:use :c2cl :sqlite)
   (:import-from :log)
-  (:import-from :serapeum :-> :defunion)
-  (:export :inline-bot-type :blacklisted :whitelisted :get-inline-bot-type :set-inline-bot-type :with-db))
+  (:import-from :serapeum :-> :defunion :with-thunk)
+  (:export :inline-bot-type :blacklisted :whitelisted :get-inline-bot-type :set-inline-bot-type :call-with-db :with-db))
 (in-package :ukkoclot/src/db)
 
 (defconstant +target-version+ 1
@@ -13,10 +13,19 @@
 (deftype db ()
   'sqlite-handle)
 
+(-> call-with-db (pathname (function (db) t)) t)
+(defun call-with-db (path fn)
+  "Similar to `with-db', but instead of binding the database in a macro body,
+calls the function `fn' with it as an argument."
+  (let ((db (connect path)))
+    (unwind-protect (progn (upgrade db)
+                           (funcall fn db))
+      (disconnect db))))
+
 (defmacro with-db ((name path) &body body)
-  `(let ((,name (connect ,path)))
-     (unwind-protect (progn (upgrade ,name) ,@body)
-       (disconnect ,name))))
+  "Open database specified by `path' and bind it to `name' for the duration of the `body'."
+  (with-thunk (body name)
+    `(call-with-db ,path ,body)))
 
 (defunion inline-bot-type
   blacklisted
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)))