;;; So, now we hide our bits of interest in the walker-info slot in
;;; our new BOGO-FUN.
;;;
-;;; MACROEXPAND-1 is the only SBCL function that gets called with the
-;;; constructed environment argument.
+;;; MACROEXPAND-1 and SB-INT:EVAL-IN-LEXENV are the only SBCL
+;;; functions that get called with the constructed environment
+;;; argument.
(/show "walk.lisp 108")
(defun bogo-fun-to-walker-info (bogo-fun)
(declare (type function bogo-fun))
(funcall bogo-fun *bogo-fun-magic-tag*))
-
+
(defun with-augmented-environment-internal (env funs macros)
;; Note: In order to record the correct function definition, we
;; would have to create an interpreted closure, but the
(push (list (car mac)
(convert-macro-to-lambda (cadr mac)
(cddr mac)
+ ,old-env
(string (car mac))))
,macros))))
(with-augmented-environment
(,new-env ,old-env :functions ,functions :macros ,macros)
,@body))))
-(defun convert-macro-to-lambda (llist body &optional (name "dummy macro"))
+(defun convert-macro-to-lambda (llist body env &optional (name "dummy macro"))
(let ((gensym (make-symbol name)))
- (eval `(defmacro ,gensym ,llist ,@body))
+ (eval-in-lexenv `(defmacro ,gensym ,llist ,@body)
+ (sb-c::make-restricted-lexenv env))
(macro-function gensym)))
\f
;;;; the actual walker
(defun variable-symbol-macro-p (var env)
(let ((entry (member var (env-lexical-variables env) :key #'car)))
- (when (eq (cadar entry) :macro)
+ (when (eq (cadar entry) 'sb-sys:macro)
entry)))
(defvar *var-declarations* '(special))
(defun walk-unexpected-declare (form context env)
(declare (ignore context env))
- (warn "encountered DECLARE ~S in a place where a DECLARE was not expected"
+ (warn "encountered ~S ~_in a place where a DECLARE was not expected"
form)
form)
walked-arglist
walked-body))))
-(defun walk-named-lambda (form context old-env)
- (walker-environment-bind (new-env old-env)
- (let* ((name (cadr form))
- (arglist (caddr 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)
:lexical-variables
(append (mapcar (lambda (binding)
`(,(car binding)
- :macro . ,(cadr binding)))
+ sb-sys:macro . ,(cadr binding)))
bindings)
(env-lexical-variables old-env)))
(relist* form 'symbol-macrolet bindings