- (values `(let* (,@(when env-arg-used
- `((,*env-var* ,env-arg-name)))
- ,@(nreverse *system-lets*))
+ (values `(let* (,@(nreverse *system-lets*))
- (let* ,(nreverse *user-lets*)
+ (let* (,@(when env-arg-used
+ `((,*env-var* ,env-arg-name)))
+ ,@(nreverse *user-lets*))
;; 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))
;; 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
(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
(when (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)))
(when (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)))
:else `(setf ,whole-var (cdr ,whole-var))))
(do ((rest-of-lambda-list lambda-list (cdr rest-of-lambda-list)))
((null rest-of-lambda-list))
:else `(setf ,whole-var (cdr ,whole-var))))
(do ((rest-of-lambda-list lambda-list (cdr rest-of-lambda-list)))
((null rest-of-lambda-list))
- (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))