[alexandria-devel] UNWIND-PROTECT-CASE

[Tobias C. Rittweiler]

Sometimes it's desired to only do a certain cleanup operating in an
UNWIND-PROTECT if a true transfer-of-control was issued in the
protected-form.

UNWIND-PROTECT-CASE can be used to conveniently control on what
circumstances cleanup operations are supposed to be performed.

(I think I've seen UNWIND-PROTECT-CASE on one of the Lisp machines, so
it's actually prior art.)

  -T.


(defmacro unwind-protect-case ((&optional abort-flag) protected-form &body clauses)
  "Like CL:UNWIND-PROTECT, but you can specify the circumstances that
the cleanup CLAUSES are run.

ABORT-FLAG is the name of a variable that will be bound to T in
CLAUSES if the PROTECTED-FORM aborted preemptively, and to NIL
otherwise.

Examples:

  (unwind-protect-case ()
       (protected-form)
     (:normal (format t \"This is only evaluated if PROTECTED-FORM executed normally.~%\"))
     (:abort  (format t \"This is only evaluated if PROTECTED-FORM aborted preemptively.~%\"))
     (:always (format t \"This is evaluated in either case.~%\")))

  (unwind-protect-case (aborted-p)
       (protected-form)
     (:always (perform-cleanup-if aborted-p)))
"
  (check-type abort-flag (or null symbol))
  (let ((gflag (gensym "FLAG+")))
    `(let ((,gflag t))
       (unwind-protect (multiple-value-prog1 ,protected-form (setf ,gflag nil))
	 (let ,(and abort-flag `((,abort-flag ,gflag)))
	   ,@(loop for (cleanup-kind . forms) in clauses
		   collect (ecase cleanup-kind
			     (:normal `(when (not ,gflag) , at forms))
			     (:abort  `(when ,gflag , at forms))
			     (:always `(progn , at forms)))))))))