0.8.3.74:
[sbcl.git] / src / pcl / walk.lisp
index 2dbeb0c..ac68857 100644 (file)
   (let ((lexenv (sb!kernel::coerce-to-lexenv env)))
     (sb!c::make-lexenv
      :default lexenv
+     :vars (when (eql (caar macros) *key-to-walker-environment*)
+            (copy-tree (remove :lexical-var (fourth (cadar macros))
+                               :key #'cadr)))
      :funs (append (mapcar (lambda (f)
                             (cons (car f)
                                   (sb!c::make-functional :lexenv lexenv)))
 (defun walker-environment-bind-1 (env &key (walk-function nil wfnp)
                                           (walk-form nil wfop)
                                           (declarations nil decp)
-                                          (lexical-variables nil lexp))
-  (let ((lock (environment-macro env *key-to-walker-environment*)))
+                                          (lexical-vars nil lexp))
+  (let ((lock (env-lock env)))
     (list
       (list *key-to-walker-environment*
-           (list (if wfnp walk-function     (car lock))
-                 (if wfop walk-form         (cadr lock))
-                 (if decp declarations      (caddr lock))
-                 (if lexp lexical-variables (cadddr lock)))))))
+           (list (if wfnp walk-function (car lock))
+                 (if wfop walk-form     (cadr lock))
+                 (if decp declarations  (caddr lock))
+                 (if lexp lexical-vars  (cadddr lock)))))))
 
 (defun env-walk-function (env)
   (car (env-lock env)))
 
 ;;; SBCL-only special forms
 (define-walker-template sb!ext:truly-the     (nil quote eval))
+;;; FIXME: maybe we don't need this one any more, given that
+;;; NAMED-LAMBDA now expands into (FUNCTION (NAMED-LAMBDA ...))?
 (define-walker-template named-lambda         walk-named-lambda)
 \f
 (defvar *walk-form-expand-macros-p* nil)
     (relist*
      form locally walked-body)))
 
-(defun walk-let-if (form context env)
-  (let ((test (cadr form))
-       (bindings (caddr form))
-       (body (cdddr form)))
-    (walk-form-internal
-      `(let ()
-        (declare (special ,@(mapcar (lambda (x) (if (listp x) (car x) x))
-                                    bindings)))
-        (flet ((.let-if-dummy. () ,@body))
-          (if ,test
-              (let ,bindings (.let-if-dummy.))
-              (.let-if-dummy.))))
-      context
-      env)))
-
 (defun walk-multiple-value-setq (form context env)
   (let ((vars (cadr form)))
     (if (some (lambda (var)
         (body (cddr form)))
     (walker-environment-bind
        (new-env old-env
-                :lexical-variables
+                :lexical-vars
                 (append (mapcar (lambda (binding)
                                   `(,(car binding)
                                     sb!sys:macro . ,(cadr binding)))
 
 (defmacro with-rpush (&body body)
   `(with-lexical-macros ,(list (list 'rpush #'expand-rpush)) ,@body))
-|#
\ No newline at end of file
+|#