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.

--- old-cl-unification-1/match-block.lisp 2013-07-21 19:26:43.000000000 +0000

+++ new-cl-unification-1/match-block.lisp 2013-07-21 19:26:43.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