Fri Jan 15 08:55:05 UTC 2010  pix@kepibu.org
  * Redefine MATCH-CASE in terms of MATCHING
  This both greatly simplifies the MATCH-CASE macro as well as its expansion.
  
  HOWEVER, this version is *NOT* 100% compatible with the previous version.
  Specifically, UNIFICATION-FAILUREs signalled from within clause-forms will /not/
  cause the next unification clause to be attempted, but will instead propogate
  outward as the -case name suggests they should.
  
  That is,
    (ignore-errors
      (match-case ("foo")
        ("foo" (error 'unification-failure ...))
        (t :default)))
    => :default                    ;; before patch
    => nil, #<unification-failure> ;; after patch
diff -rN -u old-cl-unification/match-block.lisp new-cl-unification/match-block.lisp
--- old-cl-unification/match-block.lisp	2013-09-20 18:22:47.000000000 +0000
+++ new-cl-unification/match-block.lisp	2013-09-20 18:22:47.000000000 +0000
@@ -209,16 +209,6 @@
     ))
 
 
-;;; match-case --
-;;; Implementation provided by Peter Scott.
-;;;
-;;; Notes:
-;;;
-;;; [MA 20071109]
-;;; The construction of the inner MATCH clauses could be done
-;;; more intelligently by supplying :ERRORP NIL, thus avoiding the
-;;; HANDLER-CASEs, which are quite expensive.  Any takers?
-
 (defmacro match-case ((object &key errorp default-substitution match-case-named)
                       &body clauses)
   "MATCH-CASE sets up a CASE-like environment for multiple template matching clauses.
@@ -248,33 +238,16 @@
 any default clause.  Otherwise, the default clause behaves as a
 standard CASE default clause.  The default value of ERRORP is NIL.
 "
-  (declare (ignore default-substitution)) ; For the time being.
-  (let* ((object-var (gensym "OBJECT-VAR-"))
-         (otherwise-clause-present-p
-          (member (caar (last clauses)) '(t otherwise)))
-	 (non-otherwise-clauses
-          (if otherwise-clause-present-p
-              (butlast clauses)
-              clauses))
-	 (otherwise-clause
-          (if otherwise-clause-present-p
-              (first (last clauses))
-              (when errorp
-                `(t (error 'unification-non-exhaustive
-                           :format-control "Non exhaustive matching.")))))
-         )
-    (labels ((generate-matchers (clauses)
-	       (if (null clauses)
-		   `(progn ,@(rest otherwise-clause))
-		   (destructuring-bind (pattern &rest body)
-		       (car clauses)
-		     `(handler-case (match (,pattern ,object-var)
-				      ,@body)
-		        (unification-failure ()
-			  ,(generate-matchers (cdr clauses))))))))
-      `(block ,match-case-named
-         (let ((,object-var ,object))
-           ,(generate-matchers non-otherwise-clauses))))))
+  (let ((object-var (gensym "OBJECT-VAR-")))
+    `(let ((,object-var ,object))
+       (matching (:errorp ,errorp :default-substitution ,default-substitution :matching-named ,match-case-named)
+         ,@(mapcar
+            (lambda (clause)
+              `(,(if (member (first clause) '(t otherwise))
+                     (first clause)
+                     (list (first clause) object-var))
+                 ,@(rest clause)))
+            clauses)))))
 
 
 (defmacro matchf-case ((object &key errorp default-substitution match-case-named)