X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fmacros.lisp;h=935fe5b6cc05242c1fd4462ff2a4b90ed0021315;hb=eac461c1f1ca91cfe282c779291d582ed6b336cb;hp=731d81fb957046213ecd9d7d649579e154fa45aa;hpb=c8eb86a40a6542b978ef34299ac5ab2601163ff4;p=sbcl.git diff --git a/src/code/macros.lisp b/src/code/macros.lisp index 731d81f..935fe5b 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -73,7 +73,7 @@ invoked. In that case it will store into PLACE and start over." ;; variable to work around Python's blind spot in type derivation. ;; For more complex places getting the type derived should not ;; matter so much anyhow. - (let ((expanded (sb!xc:macroexpand place env))) + (let ((expanded (%macroexpand place env))) (if (symbolp expanded) `(do () ((typep ,place ',type)) @@ -165,7 +165,8 @@ invoked. In that case it will store into PLACE and start over." (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) -(define-condition duplicate-case-key-warning (style-warning) +;;; Make this a full warning during SBCL build. +(define-condition duplicate-case-key-warning (#-sb-xc-host style-warning #+sb-xc-host warning) ((key :initarg :key :reader case-warning-key) (case-kind :initarg :case-kind @@ -260,6 +261,17 @@ invoked. In that case it will store into PLACE and start over." ,@forms) clauses)) (t + (when (and (eq name 'case) + (cdr cases) + (memq keyoid '(t otherwise))) + (error 'simple-reference-error + :format-control + "~@<~IBad ~S clause:~:@_ ~S~:@_~S allowed as the key ~ + designator only in the final otherwise-clause, not in a ~ + normal-clause. Use (~S) instead, or move the clause the ~ + correct position.~:@>" + :format-arguments (list 'case case keyoid keyoid) + :references `((:ansi-cl :macro case)))) (push keyoid keys) (check-clause (list keyoid)) (push `((,test ,keyform-value ',keyoid) @@ -303,11 +315,7 @@ invoked. In that case it will store into PLACE and start over." (cond ,@(nreverse clauses) ,@(if errorp - `((t (error 'case-failure - :name ',name - :datum ,keyform-value - :expected-type ',expected-type - :possibilities ',keys)))))))) + `((t (case-failure ',name ,keyform-value ',keys)))))))) ) ; EVAL-WHEN (defmacro-mundanely case (keyform &body cases)