Detecting non-local exits in Common Lisp
Michał "phoe" Herda · Wednesday, 26 January, 2022 - 00:05 edit · 1 minute
Sometimes you need to do something only if control in your code zips by so fast that you cannot grab it... and you do not really care if goes by slowly. Like, you know, when you are suspicious that it would be doing something funky rather than going by and doing its business.
In other words, sometimes you are in need of detecting non-local exits from a block of code while ignoring normal returns.
There's an idiom for that - using
;;; © Michał "THEN PAY WITH YOUR BLOOD" Herda 2022 (defun oblivion (thunk) (let ((successfulp nil)) (unwind-protect (multiple-value-prog1 (funcall thunk) (setf successfulp t)) (unless successfulp (error "STOP RIGHT THERE CRIMINAL SCUM"))))) CL-USER> (oblivion (lambda () (+ 2 2))) 4 CL-USER> (block nil (oblivion (lambda () (return-from nil 42)))) ;;; Error: STOP RIGHT THERE CRIMINAL SCUM ;;; [Condition of type SIMPLE-ERROR]
The explanation is simple: we bind a variable with a default value which assumes that there was a non-local exit.
Then we execute our block of code in an
UNWIND-PROTECT, and only after it executes successfully we set that value again to denote that running our code succeeded and we are ready to return its values.
The cleanup forms of the
UNWIND-PROTECT are conditionalized on the same variable and will only trigger if the
SETF SUCCESSFULP T did not execute - and that only happens if there was a non-local exit that prevented it from occurring.
In fact, there's an Alexandria utility that does just that! The macro
ALEXANDRIA:UNWIND-PROTECT-CASE is capable of supporting this behavior.
;;; (ql:quickload :alexandria) (catch 'foo (alexandria:unwind-protect-case () (throw 'foo 1) (:abort (format t "ABORTED"))))
Thanks to Stelian Ionescu for the heads-up!