¿Qué macros/formas especiales Common Lisp establecen bloques implícitos llamados nil?

Question

DO, PROG, etc. establecen un bloque implícito llamado nil alrededor de sus cuerpos. CLHS no proporciona una lista de todas las macros estándar que hacen esto. Hasta el momento los que conozco sobre: ​​

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

¿Hay otras macros CL estándar o formas especiales que establecen bloques nulos implícitos?

Answer 1

creo que la lista en la pregunta es completa. Mi evidencia para esto es experimental, no derivada de verificar cada página de CLHS; esto es lo que hice, para el beneficio de cualquiera que quiera verificar, no me perdí nada importante. Hay una lista de advertencias justo al final.

En primer lugar, una función simple para verificar una expansión macro para tener un bloque llamado NIL. Encontrará bloques NIL que no están en el nivel superior. Puede tener falsos positivos, por lo que la salida necesita verificación a mano.

(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))))) 

Entonces recogió la implementación CL tuve más convenientemente a mano, que pasa a ser CLISP, e hizo esto:

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

que me dio la siguiente lista (que se encuentra en ningún orden en particular , incluye símbolos repetidos, e incluye algunos pero no todos los símbolos que se definen en CLHS como operadores especiales):

(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) 

Tomé entonces éstos, junto con los operadores de lis especiales en la sección 3.1.2.1.2.1 de CLHS, eliminó los que no se mencionan en CLHS, eliminó los duplicados, cocinó una invocación típica para cada uno (más de uno en algunos casos), y luego verificó el resultado de llamar a MACROEXPAND-1 y macroexpand en cada uno de los siguientes:

(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)))))) 

Este informa, para cualquiera de las invocaciones de macros candidatos, (1) si se expandió directamente (a través de macroexpand-1) a algo con una (BLOQUE NIL ...) en it, y (2) si no, si se expandió indirectamente (a través de MACROEXPAND) a algo con a (BLOCK NIL ...) en él. Muestra las macroexpansiones para que pueda asegurarse de que no sean falsos positivos.

Aquí está el resultado (He corté a cabo algunos mensajes de advertencia):

(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)))))))))))) 

que, como se puede ver, incluye todos los símbolos que figuran en la pregunta original y no otros.

maneras en que esto podría haber ido mal: (1) Si la invocación de una macro determinada produce un bloque nil podría depender de los detalles de la invocación. Deliberadamente elegí lindas invocaciones simples para todas las macros, y es posible que (por ejemplo) alguna instancia más barroca de DEFCLASS pueda hacer algo que cree un bloque nulo. (2) Pude haber omitido algunos elementos en la lista de macros. (Mi lista de candidatos está en cierto modo en el orden de salida de CLISP, pero la reordené un poco para juntar las macros relacionadas.) (3) CLISP podría no ser estándar en formas relevantes.

estoy bastante seguro de que ninguno de los que en realidad es el caso de las maneras que invalidan los resultados de mi. Convertir "bastante seguro" en "casi absolutamente cierto" probablemente signifique duplicar la cantidad de trabajo que esto requiere :-).