2010-12-09 8 views
13

DO, PROG, etc. établissent un bloc implicite nommé nul autour de leur corps. Le CLHS ne fournit pas une liste de toutes les macros standard qui le font. Jusqu'à présent, ceux que je connais:Quelles macros Common Lisp/formes spéciales standard établissent des blocs implicites nommés nil?

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

Y a-t-il des autres macros standard CL ou formes spéciales implicites qui établissent des blocs nuls?

+0

Pourquoi voulez-vous savoir? – drdo

+3

Ceci est pour Parenscript.J'imagine que quelqu'un d'autre travaillant sur des compilateurs ou des traducteurs vers/depuis CL trouvera cette information utile (j'ai l'intention de publier une liste faisant autorité sur CLiki). – vsedach

Répondre

8

Je crois que la liste dans la question est complète. Mon témoignage à cet égard est expérimental, pas dérivé de vérifier chaque page de CLHS; Voici ce que j'ai fait, pour le bénéfice de tous ceux qui veulent vérifier, je n'ai rien manqué d'important. Il y a une liste de mises en garde juste à la fin. Tout d'abord, une fonction simple pour vérifier une expansion de macro pour avoir un bloc appelé NIL. Il trouvera les blocs NIL qui ne sont pas au niveau supérieur. Il peut avoir des faux positifs, donc la sortie doit être vérifiée à la main.

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

Puis j'ai choisi la mise en œuvre CL j'avais le plus commodément à la main, qui se trouve être CLISP, et a fait ceci:

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

qui m'a donné la liste suivante (ce qui est sans ordre particulier , comprend des symboles répétés, et comprend certains, mais pas tous les symboles qui sont définis dans CLHS comme opérateurs spéciaux):

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

et je pris ces derniers, ainsi que les opérateurs spéciaux lis Dans la section 3.1.2.1.2.1 de la section CLHS, on a enlevé ceux qui ne sont pas mentionnés dans le CLHS, supprimé les doublons, créé une invocation typique pour chacun (plus d'un dans certains cas), puis vérifié le résultat de l'appel de MACROEXPAND-1 et MACROEXPAND sur chacun d'entre eux:

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

Cette fonction rend compte, pour l'un des candidats macro invocations, (1) si elle a élargi directement (via MACROEXPAND-1) à quelque chose avec un (BLOC NIL ...) en et (2) si ce n'est pas le cas, si elle s'est étendue indirectement (via MACROEXPAND) vers quelque chose avec (BLOC NIL ...) dedans. Il montre les expansions de macro afin que vous puissiez vous assurer qu'ils ne sont pas des faux positifs.

est ici le résultat (je l'ai Snipped sur quelques messages d'avertissement):

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

qui, comme vous pouvez le voir, comprend tous les symboles figurant dans la question initiale et pas d'autres.

Les façons dont cela pourrait avoir mal tourné: (1) Le fait d'invoquer une macro donnée produit un bloc nul peut dépendre des détails de l'invocation. J'ai délibérément choisi de belles invocations simples pour toutes les macros, et il est possible que (par exemple) une instance plus baroque de DEFCLASS fasse quelque chose qui crée un bloc nul. (2) J'ai peut-être manqué certains éléments dans la liste des macros. (Ma liste de candidats est un peu triée dans l'ordre produit par CLISP, mais je l'ai réarrangé un peu pour mettre les macros liées ensemble.) (3) CLISP pourrait être non standard de manière pertinente.

Je suis assez confiant que rien de tout cela n'est réellement le cas de manière à invalider mes résultats. Transformer «assez confiant» en «quasi-certain» signifierait probablement doubler la quantité de travail nécessaire :-).

Questions connexes