डीओ, प्रोग, आदि अपने शरीर के चारों ओर नामित एक निहित ब्लॉक स्थापित करते हैं। सीएलएचएस ऐसा करने वाले सभी मानक मैक्रोज़ की एक सूची प्रदान नहीं करता है। अब तक मुझे पता है:कौन सा मानक आम लिस्प मैक्रोज़/विशेष रूप शून्य नामक निहित ब्लॉक स्थापित करते हैं?
DO
DO*
PROG
PROG*
LOOP
DOLIST
DOTIMES
DO-SYMBOLS
DO-ALL-SYMBOLS
DO-EXTERNAL-SYMBOLS
क्या कोई अन्य मानक सीएल मैक्रोज़ या विशेष रूप हैं जो निहित ब्लॉक ब्लॉक स्थापित करते हैं?
मुझे विश्वास है कि प्रश्न में सूची पूरी हो गई है। इसके लिए मेरा सबूत प्रयोगात्मक है, सीएलएचएस के प्रत्येक पृष्ठ की जांच से नहीं लिया गया है; यहां मैंने जो किया है, उसके लिए जो भी जांचना चाहता है, उसके लिए मैंने कुछ भी महत्वपूर्ण नहीं छोड़ा। अंत में चेतावनी की एक सूची है।
सबसे पहले, एनआईएल नामक ब्लॉक रखने के लिए मैक्रो विस्तार की जांच करने के लिए एक सरल कार्य। यह एनआईएल ब्लॉक पाएगा जो शीर्ष स्तर पर नहीं हैं। इसमें झूठी सकारात्मक हो सकती है, इसलिए आउटपुट को हाथ से जांच की आवश्यकता होती है।
(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)))))
तब मैं सीएल कार्यान्वयन मैं हाथ है, जो 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, सीएलएचएस में उल्लेखित किए गए लोगों को हटा दिया गया, डुप्लिकेट हटा दिया गया, प्रत्येक के लिए एक सामान्य आमंत्रण पकाया गया (कुछ मामलों में से एक से अधिक), और फिर मैक्रोक्सपेन्ड -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 के माध्यम से) (ब्लॉक शून्य ...) में यह, और (2) यदि नहीं, तो क्या यह अप्रत्यक्ष रूप से विस्तारित है (मैक्रोक्सपैंड के माध्यम से) इसमें कुछ (ब्लॉक शून्य ...) के साथ कुछ है। यह मैक्रो विस्तार दिखाता है ताकि आप सुनिश्चित कर सकें कि वे झूठी सकारात्मक नहीं हैं।
यहाँ (मैं कुछ चेतावनी संदेश बाहर कतरना है) परिणाम है:
(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) मै मैक्रोज़ की सूची में कुछ आइटम याद कर सकते हैं। (मेरी उम्मीदवार सूची सीएलआईएसपी द्वारा ऑर्डर आउटपुट में थोड़े-क्रमबद्ध है, लेकिन मैंने इसे संबंधित मैक्रोज़ को एक साथ रखने के लिए थोड़ा सा पुन: व्यवस्थित किया।) (3) सीएलआईएसपी प्रासंगिक तरीकों से गैर-मानक हो सकता है।
मुझे पूरा भरोसा है कि उनमें से कोई वास्तव में उन तरीकों से मामला नहीं है जो मेरे परिणामों को अमान्य कर देते हैं। "बिल्कुल-बिल्कुल निश्चित" में "काफी आत्मविश्वास" को चालू करना संभवतः इस काम की मात्रा को दोगुना करना होगा :-)।
आप क्यों जानना चाहते हैं? – drdo
यह माता-पिता के लिए है।मुझे लगता है कि सीएल से कंपलर या अनुवादक पर काम करने वाले किसी और को यह जानकारी उपयोगी लगेगी (मैं CLiki पर एक आधिकारिक सूची प्रकाशित करने की योजना बना रहा हूं)। – vsedach