X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fmacros.lisp;h=f14e8e28bc0481eba5c53aa2e53a1478f68535e8;hb=3d9d3088982414ca5617caf62bd37b4fecac29b6;hp=b4453d12f3fac6b5e86206820fe9b8701ecfc7da;hpb=dc84ceb894fdbe315f82dd8336f3ba894435a669;p=sbcl.git diff --git a/src/code/macros.lisp b/src/code/macros.lisp index b4453d1..f14e8e2 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -197,16 +197,19 @@ (let ((keyform-value (gensym)) (clauses ()) (keys ())) - (dolist (case cases) + (do* ((cases cases (cdr cases)) + (case (car cases) (car cases))) + ((null cases) nil) (unless (list-of-length-at-least-p case 1) (error "~S -- bad clause in ~S" case name)) (destructuring-bind (keyoid &rest forms) case - (cond ((memq keyoid '(t otherwise)) + (cond ((and (memq keyoid '(t otherwise)) + (null (cdr cases))) (if errorp (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) + (style-warn "~@" + keyoid name) (push keyoid keys) (push `((,test ,keyform-value ',keyoid) nil ,@forms) clauses))