Какие стандартные макросы / специальные формы Common Lisp устанавливают неявные блоки с именем nil? - PullRequest
14 голосов
/ 09 декабря 2010

DO, PROG и т. Д. Устанавливают неявный блок с именем nil вокруг их тел. CLHS не предоставляет список всех стандартных макросов, которые делают это. Пока что те, о которых я знаю:

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

Существуют ли другие стандартные макросы CL или специальные формы, которые устанавливают неявные нулевые блоки?

1 Ответ

10 голосов
/ 04 февраля 2011

Я считаю, что список в вопросе завершен. Мои доказательства этого являются экспериментальными, а не получены из проверки каждой страницы CLHS; вот что я сделал, для тех, кто хочет проверить, я не пропустил ничего важного. В конце есть список предостережений.

Во-первых, простая функция для проверки раскрытия макроса на наличие блока с именем NIL. Он найдет блоки NIL, которые не находятся на верхнем уровне. У него могут быть ложные срабатывания, поэтому вывод нужно проверить вручную.

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

Затем я выбрал наиболее удобную для меня реализацию CL, которая оказалась CLISP, и сделал следующее:

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

, который дал мне следующий список (который не в определенном порядке, включает повторяющиеся символы и включает некоторые, но не все символы, которые определены в CLHS как специальные операторы):

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

Затем я взял их вместе со специальными операторами, перечисленными в разделе 3.1.2.1.2.1 CLHS, удалил те, которые не упомянуты в CLHS, удалил дубликаты, приготовил типичный вызов для каждого (более одного в некоторых случаев), а затем проверил результат вызова MACROEXPAND-1 и MACROEXPAND для каждого из них:

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

Это сообщает, для любого из возможных вызовов макросов, (1) было ли оно расширено (через MACROEXPAND-1) до чего-либо с (BLOCK NIL ...) в нем, и (2) если нет, то ли оно расширен косвенно (через MACROEXPAND) до чего-то с (BLOCK NIL ...) в нем. Он показывает расширения макросов, чтобы вы могли убедиться, что они не являются ложными срабатываниями.

Вот результат (я вырвал несколько предупреждений):

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

, который, как вы видите, включает в себя все символы, перечисленные в исходном вопросе, и никаких других.

Пути, в которых это могло бы пойти не так: (1) То, вызовет ли данный макрос макрос с нулевым блоком, может зависеть от деталей вызова. Я сознательно выбрал хорошие простые вызовы для всех макросов, и вполне возможно, что (например) какой-нибудь более барочный экземпляр DEFCLASS может сделать что-то, что создаст нулевой блок. (2) Я мог пропустить некоторые элементы в списке макросов. (Мой список кандидатов является своего рода сортировкой в ​​порядке вывода CLISP, но я немного перестроил его, чтобы связать связанные макросы.) (3) CLISP может быть нестандартным в соответствующих отношениях.

Я вполне уверен, что ни один из них на самом деле не относится к таким способам, которые сводят на нет мои результаты. Превращение «довольно уверенного» в «почти абсолютно уверенный», вероятно, будет означать удвоение объема работ, которые для этого требуются:

...