(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*))
+ #-sb-xc-host
+ (declare (muffle-conditions sb!ext:code-deletion-note))
,@(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)
(aux-seen nil)
(optional-seen nil)
;; ANSI specifies that dotted lists are "treated exactly as if the
- ;; parameter name that ends the list had appeared preceded by &rest."
+ ;; parameter name that ends the list had appeared preceded by &REST."
;; We force this behavior by transforming dotted lists into ordinary
;; lists with explicit &REST elements.
(lambda-list (do ((in-pdll possibly-dotted-lambda-list (cdr in-pdll))
(error "&WHOLE may only appear first in ~S lambda-list." context))
;; Special case compiler-macros: if car of the form is FUNCALL,
;; skip over it for destructuring, pretending cdr of the form is
- ;; the actual form. Save original for &whole
- (when (eq context 'define-compiler-macro)
+ ;; the actual form. Save original for &WHOLE.
+ (when (and (not sublist) (eq context 'define-compiler-macro))
(push-let-binding compiler-macro-whole whole-var :system t)
(push compiler-macro-whole *ignorable-vars*)
(push-let-binding whole-var whole-var
:system t
:when `(not (eq 'funcall (car ,whole-var)))
- ;; do we need to SETF too?
+ ;; Do we need to SETF too?
:else `(setf ,whole-var (cdr ,whole-var))))
(do ((rest-of-lambda-list lambda-list (cdr rest-of-lambda-list)))
((null rest-of-lambda-list))
(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)))
(&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
(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