Which standard Common Lisp macros/special forms establish implicit blocks named nil?

Question

DO, PROG, etc. establish an implicit block named nil around their bodies. The CLHS doesn't provide a list of all standard macros that do this. So far the ones I know about:

DO
DO*
PROG
PROG*
LOOP
DOLIST
DOTIMES
DO-SYMBOLS
DO-ALL-SYMBOLS
DO-EXTERNAL-SYMBOLS

Are there any other standard CL macros or special forms that establish implicit nil blocks?

Answer 1

I believe the list in the question is complete. My evidence for this is experimental, not derived from checking every page of CLHS; here's what I did, for the benefit of anyone who wants to check I didn't miss anything important. There's a list of caveats right at the end.

First, a simple function to check a macro expansion for having a block called NIL. It will find NIL blocks that aren't at the top level. It may have false positives, so the output needs checking by hand.

(defun has-nil-block (x)
  (labels ((helper (items)
             (and (consp items) (or (has-nil-block (first items)) (helper (rest items))))))
    (and (consp x) (or (and (eq (first x) 'block) (eq (second x) nil))
                       (helper x)))))

Then I picked the CL implementation I had most conveniently to hand, which happens to be CLISP, and did this:

(let ((syms nil))
  (do-symbols (sym (find-package "COMMON-LISP"))
    (when (macro-function sym) (push sym syms)))
  syms)

which gave me the following list (which is in no particular order, includes repeated symbols, and includes some but not all symbols that are defined in CLHS as special operators):

(CALL-METHOD GENERIC-FLET WITH-SLOTS GENERIC-LABELS CLOS-WARNING DEFGENERIC
 DEFINE-METHOD-COMBINATION MAKE-METHOD DEFMETHOD DEFCLASS WITH-ACCESSORS
 DO-EXTERNAL-SYMBOLS DOTIMES ROTATEF ETYPECASE IGNORE-ERRORS CHECK-TYPE
 TYPECASE MAKE-METHOD DEFMETHOD CTYPECASE WITH-SLOTS WITH-PACKAGE-ITERATOR
 HANDLER-BIND LAMBDA ECASE DEFINE-MODIFY-MACRO DECF DEFCLASS DEFPARAMETER
 DESTRUCTURING-BIND WITH-SIMPLE-RESTART POP WITH-OUTPUT-TO-STRING
 DEFINE-CONDITION DEFUN STEP WITH-OPEN-FILE AND MULTIPLE-VALUE-SETQ COND
 CALL-METHOD DEFCONSTANT DEFMACRO WHEN MULTIPLE-VALUE-LIST UNTRACE PROG2
 DEFGENERIC PROG1 PUSHNEW PROG* DEFTYPE DEFINE-METHOD-COMBINATION
 WITH-OPEN-STREAM OR WITH-ACCESSORS SHIFTF INCF PUSH HANDLER-CASE NTH-VALUE
 DEFSTRUCT RESTART-CASE PSETQ WITH-INPUT-FROM-STRING ASSERT SETF PSETF
 DEFPACKAGE LOOP-FINISH WITH-STANDARD-IO-SYNTAX DEFINE-SYMBOL-MACRO TIME
 IN-PACKAGE FORMATTER DO-SYMBOLS CASE LOCALLY DO REMF DO* WITH-COMPILATION-UNIT
 LOOP RETURN WITH-CONDITION-RESTARTS PPRINT-LOGICAL-BLOCK CCASE TRACE DEFVAR
 PRINT-UNREADABLE-OBJECT DEFINE-COMPILER-MACRO PROG RESTART-BIND DO-ALL-SYMBOLS
 UNLESS DECLAIM DEFINE-SETF-EXPANDER MULTIPLE-VALUE-BIND DEFSETF
 WITH-HASH-TABLE-ITERATOR DOLIST DECLARE)

Then I took these, together with the special operators listed in CLHS section 3.1.2.1.2.1, removed the ones that aren't mentioned in CLHS, removed duplicates, cooked up a typical invocation for each (more than one in some cases), and then checked the result of calling MACROEXPAND-1 and MACROEXPAND on each of these:

(let ((candidates '(
  ;; special operators as defined in CLHS 3.1.2.1.2.1
  (block wombat)
  (catch a-tag t)
  (eval-when (:compile-toplevel :load-toplevel :execute) t)
  (flet ((f (x) x)) (f t))
  (function (x) t)
  (go bananas)
  (if (some-function) 123 234)
  (labels ((f (x) x) (g (x) (1+ (f x)))) (g (banana)))
  (let ((x 1) (y 2)) (+ x y))
  (let* ((x 1) (y 2)) (+ x y))
  (load-time-value 123)
  (load-time-value 123 t)
  (locally (declare (special x)) x)
  (macrolet ((zog (x) x)) (zog 123))
  (multiple-value-call #'list 1 (values 2 3) 4)
  (multiple-value-prog1 (values 1 2) (values 2 3))
  (progn (f) (g) (h))
  (progv '(*x* *y* *z*) '(1 2 3) (+ *x* *y* *z*))
  (quote 123)
  (return-from some-name 123)
  (setq x 1 y 2 z 3)
  (symbol-macrolet ((x '(foo x))) (list x))
  (tagbody (foo) x (bar) (go x))
  (the double-float 1.234d0)
  (throw 'ouch 123)
  (unwind-protect (foo) (bar))
  ;; symbols in COMMON-LISP package for which MACRO-FUNCTION evaluates to true in CLISP
  ;(call-method (make-method t)) ;; this is kinda illegal
  (with-slots ((xx x) (yy y)) an-object (list xx yy))
  (defgeneric f (a b) (:method ((a integer) (b integer)) 123))
  (define-method-combination fnord :identity-with-one-argument t)
  (define-method-combination zorg () ((around (:around)) (primary (zorg) :required t)) t)
  (defmethod foo ((a double-float) b) (+ a b))
  (with-accessors ((xx x) (yy y)) an-object (list xx yy))
  (do-symbols (sym :COMMON-LISP) nil)
  (do-all-symbols (sym :COMMON-LISP) nil)
  (do-external-symbols (sym :COMMON-LISP) nil)
  (do (x (y 1 2)) ((ended) (final x y)) (foo x y))
  (do* (x (y 1 2)) ((ended) (final x y)) (foo x y))
  (dotimes (i 3) (foo i))
  (dolist (x (get-list)) (foo x))
  (rotatef a b c)
  (shiftf a b c)
  (typecase an-object ((integer 1) (otherwise 2)))
  (ctypecase an-object ((integer 1) (otherwise 2)))
  (etypecase an-object ((integer 1) (otherwise 2)))
  (ignore-errors (foo))
  (check-type x integer)
  (handler-bind ((unbound-variable #'(lambda (x) x))) (foo))
  (handler-case (foo) (unbound-variable (c) (bar c)))
  (lambda (x) x)
  (case x ((1) t) (otherwise 'zog))
  (ccase x ((1) t) (otherwise 'zog))
  (ecase x ((1) t) (otherwise 'zog))
  (decf x)
  (incf x)
  (defconstant +x+ 123)
  (defparameter *x* 123)
  (defvar *x* 123)
  (deftype zoo () `(and (array) (satisfies (lambda (a) (eql (array-rank a) 1)))))
  (defstruct boo slot1 slot2)
  (defstruct (boo :constructor :copier :predicate (:print-object pfun)) slot1 slot2)
  (defclass trivclass () ())
  (defpackage :SOME-PACKAGE)
  (in-package :SOME-PACKAGE (foo))
  (with-package-iterator (iter :COMMON-LISP :internal :external :inherited) 123)
  (with-package-iterator (iter :COMMON-LISP :internal :external :inherited) (foo (iter)))
  (with-hash-table-iterator (iter (get-hash-table)) (foo (iter)))
  (destructuring-bind (x y) (foo) (list y x))
  (with-simple-restart (abort "Exit") (foo))
  (restart-bind ((my-restart (get-restart-function))) (foo))
  (restart-case (foo) (my-restart (x) x))
  (with-condition-restarts (get-condition) (get-restarts) (foo))
  (push (foo) some-list)
  (pushnew (foo) some-list)
  (pop some-list)
  (with-input-from-string (ss (get-string)) (foo ss))
  (with-output-to-string (ss) (foo ss))
  (define-condition my-condition () ())
  (defun foo () 123)
  (defmacro foo (&rest body) body)
  (define-symbol-macro foo (call-foo))
  (define-modify-macro appendf (&rest args) append "Append onto list")
  (define-compiler-macro foo (&rest body) `(call-foo . ,body))
  (defsetf accessor updater)
  (defsetf accessor (x spong) (result) result)
  (step (foo))
  (with-open-file (ss (get-filespec) :direction :input) (foo ss))
  (with-open-stream (st (get-stream)) (foo st))
  (and (foo) (bar) (baz))
  (or (foo) (bar) (baz))
  (multiple-value-setq (x y z) (foo))
  (multiple-value-list (foo))
  (psetq x 1 y 2 z 3)
  (psetf x 1 y 2 z 3)
  (setf x 1 y 2 z 3)
  (remf (car x) 'property)
  (cond ((foo) 123) ((bar) 321) (t 999))
  (when (foo) (bar) (baz))
  (unless (foo) (bar) (baz))
  (trace banana)
  (untrace banana)
  (prog1 (foo) (bar) (baz))
  (prog2 (foo) (bar) (baz))
  (prog (x y z) (foo x) aaa (foo y) (go aaa) (foo z))
  (prog* (x y z) (foo x) aaa (foo y) (go aaa) (foo z))
  (nth-value (get-index) (get-values))
  (assert (foo))
  (with-standard-io-syntax (foo))
  (time (foo))
  (formatter "~&~A~%")
  (with-compilation-unit () (foo))
  (loop (foo))
  (loop for x in (foo) do (bar x))
  (return 123)
  (pprint-logical-block (stream thing) (foo))
  (print-unreadable-object (obj stream) (foo))
  (declare ((optimize (space 0))))
  )))
  (loop for candidate in candidates do
    (let ((one (macroexpand-1 candidate))
          (two (macroexpand candidate)))
      (cond ((has-nil-block one)
             (format t "~&~%~A~%  ==> ~A~%" candidate one))
            ((has-nil-block two)
             (format t "~&~%~A~%  ==> ~A~%  ...--> ~A~%" candidate one two))))))

This reports, for any of the candidate macro invocations, (1) whether it expanded directly (via MACROEXPAND-1) to something with a (BLOCK NIL ...) in it, and (2) if not, whether it expanded indirectlY (via MACROEXPAND) to something with a (BLOCK NIL ...) in it. It shows the macro expansions so that you can make sure they aren't false positives.

Here's the result (I've snipped out a few warning messages):

(DO-SYMBOLS (SYM COMMON-LISP) NIL)
  ==>
(BLOCK NIL
 (LET ((PACKAGE-4169 COMMON-LISP))
  (LET ((SYM NIL)) (DECLARE (IGNORABLE SYM))
   (MAP-SYMBOLS #'(LAMBDA (SYM) (TAGBODY NIL)) PACKAGE-4169) NIL)))

(DO-ALL-SYMBOLS (SYM COMMON-LISP) NIL)
  ==>
(BLOCK NIL
 (LET ((SYM NIL)) (DECLARE (IGNORABLE SYM)) (MAP-ALL-SYMBOLS #'(LAMBDA (SYM) (TAGBODY NIL)))
  COMMON-LISP))

(DO-EXTERNAL-SYMBOLS (SYM COMMON-LISP) NIL)
  ==>
(BLOCK NIL
 (LET ((PACKAGE-4171 COMMON-LISP))
  (LET ((SYM NIL)) (DECLARE (IGNORABLE SYM))
   (MAP-EXTERNAL-SYMBOLS #'(LAMBDA (SYM) (TAGBODY NIL)) PACKAGE-4171) NIL)))

(DO (X (Y 1 2)) ((ENDED) (FINAL X Y)) (FOO X Y))
  ==>
(BLOCK NIL
 (LET (X (Y 1))
  (TAGBODY LOOP-4173 (IF (ENDED) (GO END-4174)) (FOO X Y) (PSETQ Y 2) (GO LOOP-4173) END-4174
   (RETURN-FROM NIL (PROGN (FINAL X Y))))))

(DO* (X (Y 1 2)) ((ENDED) (FINAL X Y)) (FOO X Y))
  ==>
(BLOCK NIL
 (LET* (X (Y 1))
  (TAGBODY LOOP-4177 (IF (ENDED) (GO END-4178)) (FOO X Y) (SETQ Y 2) (GO LOOP-4177) END-4178
   (RETURN-FROM NIL (PROGN (FINAL X Y))))))

(DOTIMES (I 3) (FOO I))
  ==> (DO ((I 0 (1+ I))) ((>= I 3) NIL) (FOO I))
  ...-->
(BLOCK NIL
 (LET ((I 0))
  (TAGBODY LOOP-4181 (IF (>= I 3) (GO END-4182)) (FOO I) (PSETQ I (1+ I)) (GO LOOP-4181) END-418
   (RETURN-FROM NIL (PROGN NIL)))))

(DOLIST (X (GET-LIST)) (FOO X))
  ==>
(DO* ((LIST-4183 (GET-LIST) (CDR LIST-4183)) (X NIL)) ((ENDP LIST-4183) NIL)
 (DECLARE (LIST LIST-4183)) (SETQ X (CAR LIST-4183)) (FOO X))
  ...-->
(BLOCK NIL
 (LET* ((LIST-4184 (GET-LIST)) (X NIL)) (DECLARE (LIST LIST-4184))
  (TAGBODY LOOP-4185 (IF (ENDP LIST-4184) (GO END-4186)) (SETQ X (CAR LIST-4184)) (FOO X)
   (SETQ LIST-4184 (CDR LIST-4184)) (GO LOOP-4185) END-4186 (RETURN-FROM NIL (PROGN NIL)))))

(PROG (X Y Z) (FOO X) AAA (FOO Y) (GO AAA) (FOO Z))
  ==> (BLOCK NIL (LET (X Y Z) (TAGBODY (FOO X) AAA (FOO Y) (GO AAA) (FOO Z))))

(PROG* (X Y Z) (FOO X) AAA (FOO Y) (GO AAA) (FOO Z))
  ==> (BLOCK NIL (LET* (X Y Z) (TAGBODY (FOO X) AAA (FOO Y) (GO AAA) (FOO Z))))

(LOOP (FOO))
  ==> (BLOCK NIL (TAGBODY LOOP-4350 (FOO) (GO LOOP-4350)))

(LOOP FOR X IN (FOO) DO (BAR X))
  ==>
(MACROLET ((LOOP-FINISH NIL (LOOP-FINISH-ERROR)))
 (BLOCK NIL
  (LET ((LIST-4352 (FOO)))
   (PROGN
    (LET ((X NIL))
     (LET NIL
      (MACROLET ((LOOP-FINISH NIL '(GO END-LOOP)))
       (TAGBODY BEGIN-LOOP (WHEN (ENDP LIST-4352) (LOOP-FINISH)) (SETQ X (CAR LIST-4352))
        (PROGN (PROGN (BAR X))) (PSETQ LIST-4352 (CDR LIST-4352)) (GO BEGIN-LOOP) END-LOOP
        (MACROLET ((LOOP-FINISH NIL (LOOP-FINISH-WARN) '(GO END-LOOP))))))))))))

which, as you can see, includes all the symbols listed in the original question and no others.

Ways in which this could have gone wrong: (1) Whether invoking a given macro produces a nil block might depend on the details of the invocation. I deliberately chose nice simple invocations for all the macros, and it's possible that (e.g.) some more baroque instance of DEFCLASS might do something that creates a nil block. (2) I might have missed some items in the list of macros. (My candidate list is kinda-sorta in the order output by CLISP, but I rearranged it a bit to put related macros together.) (3) CLISP might be non-standard in relevant ways.

I'm fairly confident that none of those is actually the case in ways that invalidate my results. Turning "fairly confident" into "near-absolutely certain" would probably mean doubling the amount of work this required :-).