* SB-MOP:DIRECT-SLOT-DEFINITION-CLASS and
SB-MOP:EFFECTIVE-SLOT-DEFINITION-CLASS now have the
specified-by-AMOP lambda list of (CLASS &REST INITARGS).
+ * compiler checks for duplicated variables in macro lambda lists.
* fixed some bugs revealed by Paul Dietz' test suite:
** the GENERIC-FUNCTION type is no longer disjoint from FUNCTION
types.
+ ** &ENVIRONMENT parameter in macro lambda list is bound first.
planned incompatible changes in 0.8.x:
(declaim (type list *system-lets*))
(defvar *user-lets* nil) ; LET bindings that the user has explicitly supplied
(declaim (type list *user-lets*))
+(defvar *env-var* nil) ; &ENVIRONMENT variable name
;; the default default for unsupplied &OPTIONAL and &KEY args
(defvar *default-default* nil)
(let ((*arg-tests* ())
(*user-lets* ())
(*system-lets* ())
- (*ignorable-vars* ()))
+ (*ignorable-vars* ())
+ (*env-var* nil))
(multiple-value-bind (env-arg-used minimum maximum)
(parse-defmacro-lambda-list lambda-list arg-list-name name
error-kind error-fun (not anonymousp)
- nil env-arg-name)
- (values `(let* ,(nreverse *system-lets*)
+ nil)
+ (values `(let* (,@(when env-arg-used
+ `((,*env-var* ,env-arg-name)))
+ ,@(nreverse *system-lets*))
,@(when *ignorable-vars*
`((declare (ignorable ,@*ignorable-vars*))))
,@*arg-tests*
,@declarations
,@forms))
`(,@(when (and env-arg-name (not env-arg-used))
- `((declare (ignore ,env-arg-name)))))
+ `((declare (ignore ,env-arg-name)))))
documentation
minimum
maximum)))))
error-fun
&optional
toplevel
- env-illegal
- env-arg-name)
+ env-illegal)
(let* (;; PATH is a sort of pointer into the part of the lambda list we're
;; considering at this point in the code. PATH-0 is the root of the
;; lambda list, which is the initial value of PATH.
(error "&ENVIRONMENT is not valid with ~S." error-kind))
((not toplevel)
(error "&ENVIRONMENT is only valid at top level of ~
- lambda-list.")))
+ lambda-list."))
+ (env-arg-used
+ (error "Repeated &ENVIRONMENT.")))
(cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args)))
(setq rest-of-args (cdr rest-of-args))
- (push-let-binding (car rest-of-args) env-arg-name nil)
+ (check-defmacro-arg (car rest-of-args))
+ (setq *env-var* (car rest-of-args))
(setq env-arg-used t))
(t
(defmacro-error "&ENVIRONMENT" error-kind name))))
:maximum maximum)))
(defun push-sub-list-binding (variable path object name error-kind error-fun)
+ (check-defmacro-arg variable)
(let ((var (gensym "TEMP-")))
(push `(,variable
(let ((,var ,path))
(defun push-let-binding (variable path systemp &optional condition
(init-form *default-default*))
+ (check-defmacro-arg variable)
(let ((let-form (if condition
`(,variable (if ,condition ,path ,init-form))
`(,variable ,path))))
(error "illegal or ill-formed ~A argument in ~A~@[ ~S~]"
problem kind name))
+(defun check-defmacro-arg (arg)
+ (when (or (and *env-var* (eq arg *env-var*))
+ (member arg *system-lets* :key #'car)
+ (member arg *user-lets* :key #'car))
+ (error "variable ~S occurs more than once" arg)))
+
;;; Determine whether KEY-LIST is a valid list of keyword/value pairs.
;;; Do not signal the error directly, 'cause we don't know how it
;;; should be signaled.
((:lossage-fun *lossage-fun*))
((:unwinnage-fun *unwinnage-fun*)))
(declare (type function result-test) (type combination call)
- ;; FIXME: Could FUN-TYPE here actually be something like
+ ;; FIXME: Could TYPE here actually be something like
;; (AND GENERIC-FUNCTION (FUNCTION (T) T))? How
;; horrible... -- CSR, 2003-05-03
- (type (or fun-type classoid) type))
+ (type ctype type))
(let* ((*lossage-detected* nil)
(*unwinnage-detected* nil)
(*compiler-error-context* call)
(args (combination-args call))
(nargs (length args)))
- (if (typep type 'classoid)
- (do ((i 1 (1+ i))
- (arg args (cdr arg)))
- ((null arg))
- (check-arg-type (car arg) *wild-type* i))
+ (if (fun-type-p type)
(let* ((required (fun-type-required type))
(min-args (length required))
(optional (fun-type-optional type))
(check-fixed-and-rest args (append required optional) rest)
(when keyp
(check-key-args args max-args type))))
-
+
(let* ((dtype (node-derived-type call))
(return-type (fun-type-returns type))
(cont (node-cont call))
((not int)
(note-lossage "The result is a ~S, not a ~S."
(type-specifier out-type)
- (type-specifier return-type))))))))
+ (type-specifier return-type)))))))
+ (loop for arg in args
+ and i from 1
+ do (check-arg-type arg *wild-type* i)))
(cond (*lossage-detected* (values nil t))
(*unwinnage-detected* (values nil nil))
(t (values t t)))))
;;; Bug reported by Paul Dietz on cmucl-imp and fixed by Gerd
;;; Moellmann: CONVERT-MORE-CALL failed on the following call
(assert (eq (eval '((lambda (&key) 'u) :allow-other-keys nil)) 'u))
+
+;;; &ENVIRONMENT parameter should be bound first (from Paul Dietz'
+;;; test suit)
+(assert (eql (macrolet ((foo () 1))
+ (macrolet ((%f (&optional (x (macroexpand '(foo) env)) &environment env)
+ x))
+ (%f)))
+ 1))
+
+;;; MACROLET should check for duplicated names
+(dolist (ll '((x (z x))
+ (x y &optional z x w)
+ (x y &optional z z)
+ (x &rest x)
+ (x &rest (y x))
+ (x &optional (y nil x))
+ (x &optional (y nil y))
+ (x &key x)
+ (x &key (y nil x))
+ (&key (y nil z) (z nil w))
+ (&whole x &optional x)
+ (&environment x &whole x)))
+ (assert (nth-value 2
+ (handler-case
+ (compile nil
+ `(lambda ()
+ (macrolet ((foo ,ll nil)
+ (bar (&environment env)
+ `',(macro-function 'foo env)))
+ (bar))))
+ (error (c)
+ (values nil t t))))))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8alpha.0.9"
+"0.8alpha.0.10"
projects / sbcl.git / commitdiff