Tue Jan 12 09:08:23 UTC 2010 pix@kepibu.org
* Extract the bits that wrap forms with bindings for template variables
In some cases, this patch swaps the order of execution of
%TEMPLATE-FOR-MATCH and COLLECT-TEMPLATE-VARS. I'm pretty sure this
doesn't have any noticable effect, but thorough testing is probably
wise.
hunk ./match-block.lisp 18
+(defun %wrap-var-bindings (template environment-var forms)[_^M_][_$_]
+ (let* ((template-vars (collect-template-vars template))[_^M_][_$_]
+ (bindings (loop for v in template-vars[_^M_][_$_]
+ nconc (list `(,v (find-variable-value ',v[_^M_][_$_]
+ ,environment-var))[_^M_][_$_]
+ `(,(clean-unify-var-name v) ,v)))))[_^M_][_$_]
+ `(let* ,bindings[_^M_][_$_]
+ (declare (ignorable ,@(mapcar #'first bindings)))[_^M_][_$_]
+ ,@forms)))[_^M_][_$_]
+[_^M_][_$_]
hunk ./match-block.lisp 54
- (let ((template-vars (collect-template-vars template))[_^M_][_$_]
- (env-var (gensym "UNIFICATION-ENV-"))[_^M_][_$_]
+ (let ((env-var (gensym "UNIFICATION-ENV-"))[_^M_][_$_]
hunk ./match-block.lisp 57
- (flet ((generate-var-bindings ()[_^M_][_$_]
- (loop for v in template-vars[_^M_][_$_]
- nconc (list `(,v (find-variable-value ',v[_^M_][_$_]
- ,env-var))[_^M_][_$_]
- `(,(clean-unify-var-name v) ,v))))[_^M_][_$_]
- )[_^M_][_$_]
- `(block ,match-named[_^M_][_$_]
- (handler-case[_^M_][_$_]
- (let* ((,env-var (unify ,template ,object ,substitution))[_^M_][_$_]
- ,@(generate-var-bindings)[_^M_][_$_]
- )[_^M_][_$_]
- (declare (ignorable ,@(mapcar #'first[_^M_][_$_]
- (generate-var-bindings))))[_^M_][_$_]
- ,@forms)[_^M_][_$_]
+ `(block ,match-named[_^M_][_$_]
+ (handler-case[_^M_][_$_]
+ (let* ((,env-var (unify ,template ,object ,substitution))[_^M_][_$_]
+ )[_^M_][_$_]
+ ,(%wrap-var-bindings template env-var forms))[_^M_][_$_]
hunk ./match-block.lisp 63
- ;; Yes. The above is sligthly wasteful.[_^M_][_$_]
+ ;; Yes. The above is sligthly wasteful.[_^M_][_$_]
hunk ./match-block.lisp 65
- (unification-failure (uf)[_^M_][_$_]
- (if ,errorp[_^M_][_$_]
- (error uf)[_^M_][_$_]
- ,error-value))[_^M_][_$_]
- )))))[_^M_][_$_]
+ (unification-failure (uf)[_^M_][_$_]
+ (if ,errorp[_^M_][_$_]
+ (error uf)[_^M_][_$_]
+ ,error-value))[_^M_][_$_]
+ ))))[_^M_][_$_]
hunk ./match-block.lisp 101
- (let ((template-vars (collect-template-vars template))[_^M_][_$_]
- (env-var (gensym "UNIFICATION-ENV-"))[_^M_][_$_]
+ (let ((env-var (gensym "UNIFICATION-ENV-"))[_^M_][_$_]
hunk ./match-block.lisp 113
- (flet ((generate-var-bindings ()[_^M_][_$_]
- (loop for v in template-vars[_^M_][_$_]
- nconc (list `(,v (find-variable-value ',v[_^M_][_$_]
- ,env-var))[_^M_][_$_]
- `(,(clean-unify-var-name v) ,v))))[_^M_][_$_]
- )[_^M_][_$_]
- `(block ,match-named[_^M_][_$_]
- (handler-case[_^M_][_$_]
- (let* ((,env-var (unify ,template ,object ,substitution))[_^M_][_$_]
- ,@(generate-var-bindings)[_^M_][_$_]
- )[_^M_][_$_]
- (declare (ignorable ,@(mapcar #'first[_^M_][_$_]
- (generate-var-bindings))))[_^M_][_$_]
- ,@forms)[_^M_][_$_]
+ `(block ,match-named[_^M_][_$_]
+ (handler-case[_^M_][_$_]
+ (let* ((,env-var (unify ,template ,object ,substitution))[_^M_][_$_]
+ )[_^M_][_$_]
+ ,(%wrap-var-bindings template env-var forms))[_^M_][_$_]
hunk ./match-block.lisp 119
- ;; Yes. The above is sligthly wasteful.[_^M_][_$_]
+ ;; Yes. The above is sligthly wasteful.[_^M_][_$_]
hunk ./match-block.lisp 121
- (unification-failure (uf)[_^M_][_$_]
- (if ,errorp[_^M_][_$_]
- (error uf)[_^M_][_$_]
- ,error-value))[_^M_][_$_]
- )))))[_^M_][_$_]
+ (unification-failure (uf)[_^M_][_$_]
+ (if ,errorp[_^M_][_$_]
+ (error uf)[_^M_][_$_]
+ ,error-value))[_^M_][_$_]
+ ))))[_^M_][_$_]
hunk ./match-block.lisp 167
- (let ((template-vars (collect-template-vars template))[_^M_][_$_]
- (template (%template-for-match template))[_^M_][_$_]
+ (let ((template (%template-for-match template))[_^M_][_$_]
hunk ./match-block.lisp 169
- (flet ((generate-var-bindings ()[_^M_][_$_]
- (loop for v in template-vars[_^M_][_$_]
- nconc (list `(,v (find-variable-value[_^M_][_$_]
- ',v[_^M_][_$_]
- ,clause-var))[_^M_][_$_]
- `(,(clean-unify-var-name v) ,v))))[_^M_][_$_]
- )[_^M_][_$_]
- `((setf ,clause-var[_^M_][_$_]
- (unify* ,template ,object ,substitution))[_^M_][_$_]
- (let* (,@(generate-var-bindings))[_^M_][_$_]
- ,@forms))[_^M_][_$_]
- )))[_^M_][_$_]
+ `((setf ,clause-var[_^M_][_$_]
+ (unify* ,template ,object ,substitution))[_^M_][_$_]
+ ,(%wrap-var-bindings template clause-var forms))[_^M_][_$_]
+ ))[_^M_][_$_]