(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)
(set
(walk-form-internal form :set env))
((lambda call)
- (cond ((or (symbolp form)
- (and (listp form)
- (= (length form) 2)
- (eq (car form) 'setf)))
+ (cond ((legal-fun-name-p form)
form)
(t (walk-form-internal form context env)))))
(case (car template)
(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)
walked-arglist
walked-body))))
+(defun walk-named-lambda (form context old-env)
+ (walker-environment-bind (new-env old-env)
+ (let* ((name (second form))
+ (arglist (third form))
+ (body (cdddr form))
+ (walked-arglist (walk-arglist arglist context new-env))
+ (walked-body
+ (walk-declarations body #'walk-repeat-eval new-env)))
+ (relist* form
+ (car form)
+ name
+ walked-arglist
+ walked-body))))
+
(defun walk-setq (form context env)
(if (cdddr form)
(let* ((expanded (let ((rforms nil)
(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
+|#