Macro: WITH-TRANSACTION

Source

(defmacro with-transaction ((&rest args
                             &key
                             (rucksack '(current-rucksack))
                             (inhibit-gc nil inhibit-gc-supplied-p)
                             &allow-other-keys)
                            &body body)
  (let ((committed (gensym "COMMITTED"))
        (transaction (gensym "TRANSACTION"))
        (result (gensym "RESULT")))
    `(let ((,transaction nil)
           (*collect-garbage-on-commit* (if ,inhibit-gc-supplied-p
                                            ,(not inhibit-gc)
                                            *collect-garbage-on-commit*)))
       (loop named ,transaction do         
          (with-simple-restart (retry "Retry ~S" ,transaction)
            (let ((,committed nil)
                  (,result nil))
              (unwind-protect
                   (progn
                     ;; Use a local variable for the transaction so that nothing
                     ;; can replace it from underneath us, and only then bind
                     ;; it to *TRANSACTION*. 
                     (setf ,transaction (transaction-start :rucksack ,rucksack
                                                           ,@(sans args :rucksack)))
                     (let ((*transaction* ,transaction))
                       (with-simple-restart (abort "Abort ~S" ,transaction)
                         (setf ,result (progn ,@body))
                         (transaction-commit ,transaction)
                         (setf ,committed t)))
                     ;; Normal exit from the WITH-SIMPLE-RESTART above -- either
                     ;; everything went well or we aborted -- the ,COMMITTED will tell
                     ;; us. In either case we jump out of the RETRY loop.
                     (return-from ,transaction (values ,result ,committed)))
                (unless ,committed
                  (transaction-rollback ,transaction)))))
            ;; Normal exit from the above block -- we selected the RETRY restart.
            ))))
Source Context