1.0.5.5: &ENVIRONMENT fixes

[sbcl.git] / src / code / parse-defmacro.lisp

diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp
index 225c2f7..fe30d12 100644 (file)
--- a/src/code/parse-defmacro.lisp
+++ b/src/code/parse-defmacro.lisp
@@ -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)
@@ -140,7 +140,10 @@
                   (defmacro-error (format nil "required argument after ~A"
                                           restp)
                       context name))
-                (process-sublist var "REQUIRED-" `(car ,path))
+                (when (process-sublist var "REQUIRED-" `(car ,path))
+                  ;; Note &ENVIRONMENT from DEFSETF sublist
+                  (aver (eq context 'defsetf))
+                  (setf env-arg-used t))
                 (setq path `(cdr ,path)
                       minimum (1+ minimum)
                       maximum (1+ maximum)))
@@ -195,7 +198,9 @@
                (&environment
                 (cond (env-illegal
                        (error "&ENVIRONMENT is not valid with ~S." context))
-                      (sublist
+                      ;; DEFSETF explicitly allows &ENVIRONMENT, and we get
+                      ;; it here in a sublist.
+                      ((and sublist (neq context 'defsetf))
                        (error "&ENVIRONMENT is only valid at top level of ~
                              lambda-list."))
                       (env-arg-used
@@ -246,6 +251,8 @@
                   (error "Multiple ~A in ~A lambda-list." var context))
                 (setq allow-other-keys-p t))
                (&aux
+                (when (eq context 'defsetf)
+                  (error "~A not allowed in a ~A lambda-list." var context))
                 (when aux-seen
                   (error "Multiple ~A in ~A lambda-list." '&aux context))
                 (setq now-processing :auxs