X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fwalk.lisp;h=30906c755e5604b1361c50927945fd1ebf573a03;hb=4ec46046e59ce00abe3e53bce16fdfb2c4c57362;hp=5f4495387bdceebd1503e3906a55f4f2f09a9d4d;hpb=4f8f4b25cb564509437d8fc26038143150077f14;p=sbcl.git

diff --git a/src/pcl/walk.lisp b/src/pcl/walk.lisp
index 5f44953..30906c7 100644
--- a/src/pcl/walk.lisp
+++ b/src/pcl/walk.lisp
@@ -276,20 +276,35 @@
     (when (eq (cadar entry) 'sb!sys:macro)
       entry)))
 
-(defvar *var-declarations* '(special))
+(defun walked-var-declaration-p (declaration)
+  (member declaration '(sb!pcl::%class sb!pcl::%variable-rebinding special)))
+
+(defun %var-declaration (declaration var env)
+  (let ((id (or (var-lexical-p var env) var)))
+    (dolist (decl (env-declarations env))
+      (when (and (eq (car decl) declaration)
+                 (eq (cadr decl) id))
+        (return decl)))))
 
 (defun var-declaration (declaration var env)
-  (if (not (member declaration *var-declarations*))
-      (error "~S is not a recognized variable declaration." declaration)
-      (let ((id (or (var-lexical-p var env) var)))
-        (dolist (decl (env-declarations env))
-          (when (and (eq (car decl) declaration)
-                     (eq (cadr decl) id))
-            (return decl))))))
+  (if (walked-var-declaration-p declaration)
+      (%var-declaration declaration var env)
+      (error "Not a variable declaration the walker cares about: ~S" declaration)))
+
+#-sb-xc-host
+(define-compiler-macro var-declaration (&whole form declaration var env
+                                        &environment lexenv)
+  (if (sb!xc:constantp declaration lexenv)
+      (let ((decl (constant-form-value declaration lexenv)))
+        (if (walked-var-declaration-p decl)
+            `(%var-declaration ,declaration ,var ,env)
+            form))
+      form))
 
 (defun var-special-p (var env)
-  (or (not (null (var-declaration 'special var env)))
-      (var-globally-special-p var)))
+  (and (or (var-declaration 'special var env)
+           (var-globally-special-p var))
+       t))
 
 (defun var-globally-special-p (symbol)
   (eq (info :variable :kind symbol) :special))
@@ -613,7 +628,7 @@
            (let ((type (car declaration))
                  (name (cadr declaration))
                  (args (cddr declaration)))
-             (if (member type *var-declarations*)
+             (if (walked-var-declaration-p type)
                  (note-declaration `(,type
                                      ,(or (var-lexical-p name env) name)
                                      ,.args)