[Sbcl-commits] CVS: sbcl/src/code early-setf.lisp, 1.30, 1.31 parse-defmacro.lisp, 1.24, 1.25

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv7329/src/code

Modified Files:
	early-setf.lisp parse-defmacro.lisp 
Log Message:
1.0.5.5: &ENVIRONMENT fixes

 * Place the binding for &ENVIRONMENT in the correct scope for
   ignore declarations.

 * Place the local-decls return value from PARSE-DEFMACRO in the
   right scope in DEFSETF.

 * Tests.


Index: early-setf.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-setf.lisp,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- early-setf.lisp	8 Apr 2007 13:12:31 -0000	1.30
+++ early-setf.lisp	29 Apr 2007 16:19:29 -0000	1.31
@@ -405,10 +405,9 @@
                   (assign-setf-macro
                    ',access-fn
                    (lambda (,access-form-var ,env-var)
-                     (declare (ignorable ,env-var))
+                     ,@local-decs
                      (%defsetf ,access-form-var ,(length store-variables)
                                (lambda (,whole-var)
-                                 ,@local-decs
                                  ,body)))
                    nil
                    ',doc))))))

Index: parse-defmacro.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/parse-defmacro.lisp,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -d -r1.24 -r1.25
--- parse-defmacro.lisp	8 Apr 2007 12:51:36 -0000	1.24
+++ parse-defmacro.lisp	29 Apr 2007 16:19:29 -0000	1.25
@@ -50,13 +50,13 @@
           (parse-defmacro-lambda-list lambda-list whole-var name context
                                       :error-fun error-fun
                                       :anonymousp anonymousp)
-        (values `(let* (,@(when env-arg-used
-                            `((,*env-var* ,env-arg-name)))
-                        ,@(nreverse *system-lets*))
+        (values `(let* (,@(nreverse *system-lets*))
                    ,@(when *ignorable-vars*
                        `((declare (ignorable ,@*ignorable-vars*))))
                    ,@*arg-tests*
-                   (let* ,(nreverse *user-lets*)
+                   (let* (,@(when env-arg-used
+                            `((,*env-var* ,env-arg-name)))
+                          ,@(nreverse *user-lets*))
                      ,@declarations
                      ,@(if wrap-block
                            `((block ,(fun-name-block-name name)