(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)))
`(eval-when (:load-toplevel :execute)
(setf (get-walker-template-internal ',name) ',template)))
-(defun get-walker-template (x)
+(defun get-walker-template (x context)
(cond ((symbolp x)
(get-walker-template-internal x))
((and (listp x) (eq (car x) 'lambda))
'(lambda repeat (eval)))
(t
- (error "can't get template for ~S" x))))
+ ;; FIXME: In an ideal world we would do something similar to
+ ;; COMPILER-ERROR here, replacing the form within the walker
+ ;; with an error-signalling form. This is slightly less
+ ;; pretty, but informative non the less. Best is the enemy of
+ ;; good, etc.
+ (error "Illegal function call in method body:~% ~S"
+ context))))
\f
;;;; the actual templates
;;; 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)
newform)))
(t
(let* ((fn (car newform))
- (template (get-walker-template fn)))
+ (template (get-walker-template fn newform)))
(if template
(if (symbolp template)
(funcall template newform context env)
(defun walk-template-handle-repeat (form template stop-form context env)
(if (eq form stop-form)
(walk-template form (cdr template) context env)
- (walk-template-handle-repeat-1 form
- template
- (car template)
- stop-form
- context
- env)))
+ (walk-template-handle-repeat-1
+ form template (car template) stop-form context env)))
(defun walk-template-handle-repeat-1 (form template repeat-template
stop-form context env)
(if (null repeat-template)
(walk-template stop-form (cdr template) context env)
(error "while handling code walker REPEAT:
- ~%ran into STOP while still in REPEAT template")))
+ ~%ran into STOP while still in REPEAT template")))
((null repeat-template)
(walk-template-handle-repeat-1
form template (car template) stop-form context env))
(cdr body) fn env doc-string-p declarations)))
((and form
(listp form)
- (null (get-walker-template (car form)))
+ (null (get-walker-template (car form) form))
(progn
(multiple-value-setq (new-form macrop)
(sb-xc:macroexpand-1 form env))
(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
+|#