(defun match-variable (p d bindings) (let ((binding (get-binding p bindings))) (cond ((null binding) (add-binding p d bindings)) ((equal d (binding-val binding)) bindings) (t 'fail))))まず,変数であった場合には,その変数(p)にすでに値がバインディングされ ているかどうかを調べ,その値がなければ,新しいバインディング情報を 追加したバインディング情報を返す. もし,値があった場合には,その値がデータ(d)と等しいかどうかを調べ, 等しいならば,バインディング情報をそのまま返し,等しくなければ失敗した ということで,failを返す.
(defun match-atom (a b bindings) (if (eql a b) bindings 'fail)) (defun match-list (pat data bindings) (let ((car-bindings (match (first pat) (first data) bindings))) (if (eq car-bindings 'fail) 'fail (match (rest pat) (rest data) car-bindings))))比較するデータのどちらかがアトムの場合には(match-atom),eqlで比較を行 ない,等しければバインディングを返し,等しくなければFAILである. 比較するデータの両方がリストならば(match-list),car部のマッチングを 行ない,そこで得られたバインディング情報が FAIL ならばcdrを調べずに FAILを返し,FAILでなければ,cdr部以下のマッチングへ引き渡す. このように引数でバインディング情報を受け渡すのではなく, これらの副手続きの中で動的バインディングによりバインディング情報が 参照できるようにするには,それぞれの第三引数のbindingsをなくして, (declare (special ...)) を使うことで可能となる.
(defun match (a b &aux bindings) (declare (special bindings)) (cond ((variable-p a) (match-variable a b)) ((or (atom a) (atom b)) (match-atom a b)) (t (match-list a b))))一方,Xlispでは,このdeclareがない.declare以外に,動的バインディ ングを行なう局所変数を宣言する方法としてprogvというのがある.これ はXlispにもある.以下のように,(progv 変数のリスト 初期値のリスト 本体)という具合に使う.letと違って,変数のリストも初期値のリスト も評価される.
(defun match (a b) (progv '(bindings) '(nil) (cond ((variable-p a) (match-variable a b)) ((or (atom a) (atom b)) (match-atom a b)) (t (match-list a b)))))以上まとめれば,
(defun match (a b &aux bindings) (declare (special bindings)) (match-aux a b)) (defun match (a b) (progv '(bindings) '(nil) (match-aux a b))) (defun match-aux (p d) (cond ((variable-p p) (match-variable p d)) ((or (atom p) (atom d)) (match-atom p d)) (t (match-list p d)))) (defun match-variable (p d) (let ((binding (get-binding p bindings))) (cond ((null binding) (add-binding p d bindings)) ((equal d (binding-val binding)) bindings) (t 'fail)))) (defun match-atom (a b) (if (eql a b) bindings 'fail)) (defun match-list (pat data) (setq bindings (match-aux (first pat) (first data))) (if (eq bindings 'fail) 'fail (match-aux (rest pat) (rest data))))