X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fwalk.lisp;h=7430d6fc8f6f4d368f61218c4b18236bf632d060;hb=ec735ab75335c1744b39190314142a7e6f1ecdb3;hp=0589bd1725fc8f082fedb0df0ab3c068e439851b;hpb=b0b168c08b31a748150f404398af754f26fd4813;p=sbcl.git

diff --git a/src/pcl/walk.lisp b/src/pcl/walk.lisp
index 0589bd1..7430d6f 100644
--- a/src/pcl/walk.lisp
+++ b/src/pcl/walk.lisp
@@ -101,8 +101,9 @@
 ;;; 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")
 
@@ -136,7 +137,7 @@
 (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
@@ -195,15 +196,17 @@
 	    (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)))
 
 ;;;; the actual walker
@@ -263,7 +266,7 @@
 
 (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))
@@ -632,7 +635,7 @@
 
 (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)
 
@@ -811,20 +814,6 @@
 	       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)
@@ -858,7 +847,7 @@
 		 :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