projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
1.0.5.39: sb-sprof call counting
[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)
(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*
,@(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)
,@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))
(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)))
(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))
(&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 "&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
(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
(when aux-seen
(error "Multiple ~A in ~A lambda-list." '&aux context))
(setq now-processing :auxs