- 6.1 An Interactive Interpreter Tool
- REPL構造をツール化
- 6.2 A Pattern-Matching Tool
- Elizaのpat-matchをツール化
- ツール化にあたってかなりの機能追加。こうなるとlistの正規表現マッチャという範囲をこえてるな。というのは、字面だけではなく、numberpだとかoddpだとか、objectとしての意味を問うているから。
- ここはちょっと丁寧にやりたい気分。ソースとコメントでやる。ソースはPeter Norvigのもの、日本語のコメントは私のもの。
- まずElizaのpat-matchを復習。
(defun pat-match (pattern input)
"Does pattern match input? Any variable can match anything."
(if (variable-p pattern)
t
(if (or (atom pattern) (atom input))
(eql pattern input)
(and (pat-match (first pattern) (first input))
(pat-match (rest pattern) (rest input))))))
;; pat-match ver.1
;; マッチしたかどうかをT/NILで返すだけ。
;; ツリー再帰的
(defun variable-p (x)
"Is x a variable (a symbol beginning with '?')?"
(and (symbolp x) (equal (char (symbol-name x) 0) #\?)))
#+test
(pat-match '(I need a ?X) '(I need a vacation)) ; => T
#+test
(pat-match '(I need a ?X) '(I really need a vacation)) ; => NIL
(sublis '((?X . vacation))
'(what would it mean to you if you got a ?X ?))
; => (WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?)
;; sublisは、パターンマッチとして得られた変数と値の
;; 組みをつかって別のリストを変換するのに使える。
(defun pat-match (pattern input)
"Does pattern match input? WARNING: buggy version."
(if (variable-p pattern)
(list (cons pattern input))
(if (or (atom pattern) (atom input))
(eql pattern input) ; =1=
(append (pat-match (first pattern) (first input))
(pat-match (rest pattern) (rest input))))))
;; pat-match ver.2 buggy version
;; '((?X . vacation))のような、マッチ結果のa-listを返すようにしようとしている。
;; しかし、
#+test
(pat-match '(I need a ?X) '(I need a vacation))
;; とするとエラーとなる。=1=のところTを返すだけで、それがappendの引数になるから。
(defconstant fail nil "Indicates pat-match failure")
(defconstant no-bindings '((t . t))
"Indicates pat-match success, with no variables.")
(defun get-binding (var bindings)
"Find a (variable . value) pair in a binding list."
(assoc var bindings))
(defun binding-val (binding)
"Get the value part of a single binding."
(cdr binding))
(defun lookup (var bindings)
"Get the value part (for var) from a binding list."
(binding-val (get-binding var bindings)))
(defun extend-bindings (var val bindings)
"Add a (var . value) pair to a binding list."
(cons (cons var val) bindings))
(defun pat-match (pattern input &optional (bindings no-bindings))
"Match pattern against input in the context of the bindings"
(cond ((eq bindings fail) fail) ; =1=
((variable-p pattern) ; =2=
(match-variable pattern input bindings))
((eql pattern input) bindings) ; =3=
((and (consp pattern) (consp input)) ; =4=
(pat-match (rest pattern) (rest input)
(pat-match (first pattern) (first input)
bindings)))
(t fail))) ; =5=
;; pat-match ver.3
;; bindingsを返す。
;; bindingsは、マッチした場合は、変数と値のalist。マッチに失敗した場合はFAIL。マッチしたけど変数がないときはNO-BINDINGS。
;;
;; =1= : bindingsがfail(nil) -> とにかくfailを返す。fail確定。
;; =2= : variable -> match-variableへ
;; =3= : variableじゃなくて、eqlで等価なもの -> それはそれでよくて継続していく。
;; =4= : 以上にあてはまらなく両者ともconsp -> 再帰。ただしfirstをさきにやって、そのbindingsをrestで使う。
;; =5= : ここまできたらもうfail。
(defun match-variable (var input bindings)
"Does VAR match input? Uses (or updates) and returns bindings."
(let ((binding (get-binding var bindings)))
(cond ((not binding) (extend-bindings var input bindings))
((equal input (binding-val binding)) bindings)
(t fail))))
;; pat-matchの副関数
;; manage-bindingsとかの名前の方がしっくりくるような？
(defun extend-bindings (var val bindings)
"Add a (var . value) pair to a binding list."
(cons (cons var val)
;; Once we add a "real" binding,
;; we can get rid of the dummy no-bindings
(if (eq bindings no-bindings)
nil
bindings)))
#+test
(pat-match '(i need a ?x) '(i need a vacation)) ; => ((?X . VACATION))
#+test
(sublis (pat-match '(i need a ?X) '(i need a vacation))
'(what would it mean to you if you got a ?X ?))
; => (WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?)
#+test
(pat-match '(i need a ?X) '(i really need a vacation)) ; => NIL
#+test
(pat-match '(this is easy) '(this is easy)) ; => ((T . T))
#+test
(pat-match '(?X is ?X) '((2 + 2) is 4)) ; => NIL
#+test
(pat-match '(?X is ?X) '((2 + 2) is (2 + 2))) ; => ((?X 2 + 2))
#+test
(pat-match '(?P need . ?X) '(i need a long vacation)) ; => ((?X A LONG VACATION) (?P . I))
;; これの動作分析。
;; pat-matchの=4=はfirst restなので、dotted-pairでももちろん動作する。
;; ただし、patternに関しては、それが最後の要素となる。
;; inputが同様のdotted-listなら、通常の動作と変わらない。
;; inputが通常のリストの場合、その要素のマッチ対象はリストになるのでその要素は変数じゃないとマッチしない。
;; 変数だった場合は、その変数の値はリストとなる。
;;; 5.3 Segment Pattern Matching
(defun pat-match (pattern input &optional (bindings no-bindings))
"Match pattern against input in the context of the bindings"
(cond ((eq bindings fail) fail) ; =1=
((variable-p pattern) ; =2=
(match-variable pattern input bindings))
((eql pattern input) bindings) ; =3=
((segment-pattern-p pattern) ; =6=
(segment-match pattern input bindings))
((and (consp pattern) (consp input)) ;= 4=
(pat-match (rest pattern) (rest input)
(pat-match (first pattern) (first input)
bindings)))
(t fail))) ; =5=
;; pat-match ver.4
;; ?*を導入して0を含む任意個の要素の連続とマッチすることを可能とする。
;; =1= : 無変更。
;; =2= : 無変更。
;; =3= : 無変更。
;; =6= : 新設。patternがsegment-patternの場合 -> segment-matchへ
;; =4= : 無変更。
;; =5= : 無変更。
#+test
(pat-match '((?* ?p) need (?* ?x))
'(Mr Hulot and I need a vacation)) ; => ((?P MR HULOT AND I) (?X A VACATION))
#+test
(pat-match '((?* ?p) need (?* ?x))
'(need a vacation)) ; => ((?P) (?X A VACATION))
#+test
(pat-match '((?* ?x) is a (?* ?y)) '(what he is is a fool)) ; => ((?X WHAT HE IS) (?Y FOOL))
#+test
(pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b)) ; => NIL
;; なぜこれがNILになるか。
;; pat-match :
;; まず第一のセグメントについて、=6=でsegment-matchに入る
;; segment-match :
;; ?x (1 2) でいけるか、となる。
;; そのとき、問題はsegment-matchの=5=によって、(pat-match pat (subseq input pos) bindings)となる。
;; すなわちpat (a b (?* ?x)) input (a b a b 1 2 a b)がマッチしますか？ということ。これはマッチする。
;; なので、=7=にいくが、しかしそのときの?Xのbindingsは(a b 1 2 a b)なので=7=がfailしておしまい。
;; 問題は=7=をどうするか、だ。
(defun segment-match (pattern input bindings &optional (start 0))
"Match the segment pattern ((?* var) . pat) against input."
(let ((var (second (first pattern)))
(pat (rest pattern)))
(if (null pat)
(match-variable var input bindings)
;; We assume that pat starts with a constant
;; In other words, a pattern can't have 2 consecutive vars
(let ((pos (position (first pat) input
:start start :test #'equal)))
(if (null pos)
fail
(let ((b2 (pat-match pat (subseq input pos)
(match-variable var (subseq input 0 pos)
bindings)))) ; =8=
;; If this match failed, try another longer one
(if (eq b2 fail)
(segment-match pattern input bindings (+ pos 1)) ; =9=
b2))))))) ; =10=
;; segment-match ver.2
;; 変更点のみ記載。
;; =8= : b2をしらべる際のbindingsに、varの現状のbinding案をいれてしまう。なので、先の例で=7=でunmatchしていたのはこの時点でfailする。
;; =9= : b2が失敗した場合。varのマッチ範囲を広げて再帰。
;; =10= : b2が成功した場合。これが答なので返すのみ。
#+test
(pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b)) ; => ((?X 1 2 A B)) - ここまではちゃんと理解できたと思う。
とりあえず一区切り。次は、6.2節を丁寧にやる。
こつこつ。
0 件のコメント:
コメントを投稿