X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcode%2Fmacros.lisp;h=2574cacd4b64dbb437dd96c2f16684c600b6515a;hb=a260738d7a71680079d972b102b4e4db4e8dc3ae;hp=32cc184a60de32ca40d14273b8fd859d0efb4a6b;hpb=41ed816c7915806abca6b09ecd2136458f27adcc;p=sbcl.git

diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index 32cc184..2574cac 100644
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -122,7 +122,7 @@
     ;; (DEFINE-COMPILER-MACRO (SETF FOO) ...) could easily be surprised
     ;; by this way of complying with a rather screwy aspect of the ANSI
     ;; spec, so at least we can warn him...
-    (compiler-style-warn
+    (sb!c::compiler-style-warn
      "defining compiler macro of (SETF ...), which will not be expanded"))
   (let ((whole (gensym "WHOLE-"))
 	(environment (gensym "ENV-")))
@@ -173,10 +173,13 @@
       (destructuring-bind (keyoid &rest forms) case
 	(cond ((memq keyoid '(t otherwise))
 	       (if errorp
-		   (error 'simple-program-error
-			  :format-control
-			  "No default clause is allowed in ~S: ~S"
-			  :format-arguments (list name case))
+		   (progn
+		     ;; FIXME: this message could probably do with
+		     ;; some loving pretty-printer format controls.
+		     (style-warn "Treating bare ~A in ~A as introducing a normal-clause, not an otherwise-clause" keyoid name)
+		     (push keyoid keys)
+		     (push `((,test ,keyform-value ',keyoid) nil ,@forms)
+			   clauses))
 		   (push `(t nil ,@forms) clauses)))
 	      ((and multi-p (listp keyoid))
 	       (setf keys (append keyoid keys))