Tue Jun 15 03:21:37 UTC 2010  pix@kepibu.org
  * Pull variable binding out of %match-expander
  I'd like to tell you this is part of a plan to simplify %match-expander, but in
  all honesty, the only reason I'm doing it is because I found myself thinking
  with-unification-variables would be a handy macro while working on a private
  extension to cl-unification, and I didn't want to duplicate the code.
diff -rN -u old-cl-unification/match-block.lisp new-cl-unification/match-block.lisp
--- old-cl-unification/match-block.lisp	2014-09-11 07:34:34.000000000 +0000
+++ new-cl-unification/match-block.lisp	2014-09-11 07:34:34.000000000 +0000
@@ -10,6 +10,15 @@
   (intern (subseq (symbol-name v) 1)
           (symbol-package v)))
 
+(defmacro with-unification-variables ((&rest variables) environment &body body)
+  "Execute body with variables bound to their values in environment."
+  (flet ((variable-bindings (v)
+           `((,v (find-variable-value ',v ,environment))
+             (,(clean-unify-var-name v) ,v))))
+    `(let* ,(mapcan #'variable-bindings variables)
+       (declare (ignorable ,@(mapcar #'clean-unify-var-name variables)))
+       ,@body)))
+
 (defun %match-expander (template-munger clause-munger clauses
                         &key default named environment errorp error-form keyform)
   "A rather hairy internal function which handles expansion for all the MATCH* macros.
@@ -81,9 +90,6 @@
                         (make-instance 'list-template
                                        :spec (cons 'list template)))
                        (t template)))
-               (bind-variable (v)
-                 `((,v (find-variable-value ',v ,match-environment))
-                   (,(clean-unify-var-name v) ,v)))
                (expand-clause (clause)
                  (destructuring-bind (template object &rest body)
                      (munge-clause clause)
@@ -91,8 +97,7 @@
                           (variables (collect-template-vars template)))
                      `((setf (values ,match-environment ,match-error)
                              (unify* ,template ,object (make-expanded-environment ,base-environment)))
-                       (let* ,(mapcan #'bind-variable variables)
-                         (declare (ignorable ,@variables ,@(mapcar #'clean-unify-var-name variables)))
+                       (with-unification-variables ,variables ,match-environment
                          ,@body)))))
                (munge-clause (clause)
                  (ecase clause-munger