From: Alexey Dejneka Date: Sun, 4 May 2003 16:52:32 +0000 (+0000) Subject: 0.8alpha.0.10: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=21083e7372a447498dacd3f92427c1e9da7e074a;p=sbcl.git 0.8alpha.0.10: * &ENVIRONMENT argument in macro lambda list is bound first (found by Paul Dietz); * Added checking for duplicate variables in macro lambda lists. --- diff --git a/NEWS b/NEWS index f3db1f4..92d3a42 100644 --- a/NEWS +++ b/NEWS @@ -1716,9 +1716,11 @@ changes in sbcl-0.8.0 relative to sbcl-0.8alpha.0 * 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: diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp index edd9323..dada4f5 100644 --- a/src/code/parse-defmacro.lisp +++ b/src/code/parse-defmacro.lisp @@ -19,6 +19,7 @@ (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) @@ -42,12 +43,15 @@ (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* @@ -55,7 +59,7 @@ ,@declarations ,@forms)) `(,@(when (and env-arg-name (not env-arg-used)) - `((declare (ignore ,env-arg-name))))) + `((declare (ignore ,env-arg-name))))) documentation minimum maximum))))) @@ -71,8 +75,7 @@ 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. @@ -161,10 +164,13 @@ (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)))) @@ -266,6 +272,7 @@ :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)) @@ -280,6 +287,7 @@ (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)))) @@ -308,6 +316,12 @@ (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. diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp index 6b62565..288bad7 100644 --- a/src/compiler/ctype.lisp +++ b/src/compiler/ctype.lisp @@ -109,20 +109,16 @@ ((: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)) @@ -158,7 +154,7 @@ (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)) @@ -175,7 +171,10 @@ ((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))))) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index fb5d3e4..6c9dfb8 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -341,3 +341,35 @@ ;;; 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)))))) diff --git a/version.lisp-expr b/version.lisp-expr index 5f00874..9d5d83b 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; 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"