Common LispでLALR(1)のparserを作る4
前回：Common LispでLALR(1)のparserを作る3 - nptclのブログ
1. 続きです
Common LispでLR(1)の表を作りました！
あとは実行してみて、そのあとでLALR(1)もやってみます。
2. 構文解析の実行
実行するためには、新たにスタックが必要になります。
すでに構文解析用のスタック*stack*がありますが、あれも使いますし別のやつがもう一つ必要です。
*transit*という名前で作ってみます。
(defvar *transit* nil) (defun push-transit (x) (declare (type unsigned-byte x)) (push x *transit*)) (defun pop-transit () (unless *transit* (error "pop-transit error.")) (pop *transit*)) (defun top-transit () (unless *transit* (error "top-transit error.")) (car *transit*)) (defun init-transit () (setq *transit* nil) (push-transit 0))
もうほとんど*stack*と同じですね。
何が違うのかというと、*stack*の方はshift/reduceで使いましたが、
*transit*の方は、状態の番号を格納して使います。
こちらのスタックは、init-transitで0をpushしています。
つまり初期状態が0だということです。
それでは実行するためのコードを作ります。
(defun execute-parse (x) (init-stack) (init-transit) (set-input x) (call-execute))
execute-parseは、*stack*と*transit*を初期化した後、
set-inputで入力を設定します。
つまり変数の初期化です。
そのあとcall-executeを実行します。
(defun call-execute () (output-stack-input) (let* ((index (top-transit)) (state (get-state index)) (ahead (top-input))) (multiple-value-bind (type next) (find-action-state ahead state) (ecase type (s (shift-execute next) (call-execute)) (r (reduce-execute next) (call-execute)) (a (accept-execute))))))
call-executeは、まず最初にoutput-stack-inputを実行して
*stack*と*input*の内容を出力します。
別に出力いらないや、っていうなら削除してください。
そのあと、top-transitとget-stateで現在の状態を取得。
top-inputで、入力をひとつ先読みします。
先読みしたaheadと状態を引数に、find-action-stateで遷移先の情報を取得します。
もしShiftなら、shift-executeを実行して再帰呼出でループ。
もしReduceなら、reduce-executeを実行して再帰呼出でループ。
もしAcceptなら、accept-executeを実行してcall-executeを終了。
find-action-stateから順番に見ていきましょう。
(defun find-action-state (v state) (dolist (x (state-action state)) (destructuring-bind (a b c) x (when (eql a v) (return (values b c))))))
これは、状態stateのactionから、記号vに対応するものを検索しています。
見つからなかったらnilが返却されますが、
呼び出し元のcall-executeのecaseに引っかかってエラーになります。
それでは、Shiftが実行されたときの関数を見ていきます。
(defun shift-execute (next) (shift-test) (push-transit next))
shift-test関数は、一番最初に確認として作った関数です。
やっていることは、inputからpopして、stackにpushするというもの。
そのあと、push-transitでnextをpushしています。
*transit*の先頭の値が現在の状態になるので、
状態が変化するということになります。
Reduceを見てみましょう。
(defun reduce-execute (rule) (let ((left (rule-left rule)) (right (rule-right rule))) (reduce-call left right) (dolist (ignore right) (pop-transit)) (goto-execute)))
こちらはShiftとは違い複雑です。
まず規則からleftとrightを取得し、reduce-callを呼び出します。
reduce-callも本当に最初の方に作った関数です。
*stack*から必要な分だけpopして、そのあとpushするというものです。
これはこれであっているのですが、同じ数だけ*transit*もpopする必要があります。
ということで、dolistでpopしています。
Reduceの難しいところは、この状態でgotoの遷移表を見る必要があるのです。
処理はgoto-executeに引き継がれます。
(defun find-goto-state (v state) (dolist (x (state-goto state)) (destructuring-bind (a b) x (when (eql a v) (return b))))) (defun goto-execute () (let* ((index (top-transit)) (state (get-state index)) (sym (top-stack))) (aif (find-goto-state sym state) (push-transit it) (error "find-goto-state error, ~S, ~S." index sym))))
goto-executeは、まず*transit*から現在の状態を取得します。
さらに、*stack*から一番上にある非終端記号を取得します。
取得した状態と、非終端記号をもとに、goto表から次の状態を取得してpush-transitで遷移します。
find-goto-state関数は、非終端記号vと状態stateからgoto表を検索するというものです。
これでReduceの動作は完了です。
最後のacceptを確認します。
(defun accept-execute () (format t "ACCEPT~%"))
ただ完了報告をしているだけです。
この状態で、*stack*にはたった一つの開始記号が格納されています。
構文ツリーなんかを作っていた場合は、
このタイミングで取り出して終了となります。
3. LR(1)の実行テスト
それでは早速やってみましょう。
(parse-terminal + * [ ] int) (parse-start expr) (parse-rule expr -> expr + term) (parse-rule expr -> term) (parse-rule term -> term * fact) (parse-rule term -> fact) (parse-rule fact -> [ expr ]) (parse-rule fact -> int) (make-table) (make-reduce) (output-table) (execute-parse '(int * [ int + int ]))
実行結果は下記の通り。
0 : INT:S:19 [:S:6 FACT:20 TERM:21 EXPR:1 1 : END:A:NIL +:S:2 2 : INT:S:19 [:S:6 FACT:20 TERM:3 3 : END:R:1 +:R:1 *:S:4 4 : INT:S:19 [:S:6 FACT:5 5 : END:R:3 +:R:3 *:R:3 6 : INT:S:17 [:S:12 FACT:16 TERM:15 EXPR:7 7 : ]:S:18 +:S:8 8 : INT:S:17 [:S:12 FACT:16 TERM:9 9 : ]:R:1 +:R:1 *:S:10 10 : INT:S:17 [:S:12 FACT:11 11 : ]:R:3 +:R:3 *:R:3 12 : INT:S:17 [:S:12 FACT:16 TERM:15 EXPR:13 13 : ]:S:14 +:S:8 14 : ]:R:5 +:R:5 *:R:5 15 : ]:R:2 +:R:2 *:S:10 16 : ]:R:4 +:R:4 *:R:4 17 : ]:R:6 +:R:6 *:R:6 18 : END:R:5 +:R:5 *:R:5 19 : END:R:6 +:R:6 *:R:6 20 : END:R:4 +:R:4 *:R:4 21 : END:R:2 +:R:2 *:S:4 NIL (INT * [ INT + INT ]) (INT) (* [ INT + INT ]) (FACT) (* [ INT + INT ]) (TERM) (* [ INT + INT ]) (TERM *) ([ INT + INT ]) (TERM * [) (INT + INT ]) (TERM * [ INT) (+ INT ]) (TERM * [ FACT) (+ INT ]) (TERM * [ TERM) (+ INT ]) (TERM * [ EXPR) (+ INT ]) (TERM * [ EXPR +) (INT ]) (TERM * [ EXPR + INT) (]) (TERM * [ EXPR + FACT) (]) (TERM * [ EXPR + TERM) (]) (TERM * [ EXPR) (]) (TERM * [ EXPR ]) NIL (TERM * FACT) NIL (TERM) NIL (EXPR) NIL ACCEPT
うまくいってる！
長かった！
4. LALR(1)の作成
さあどんどん行きましょう。
LALR(1)はどうやって作るのでしょうか。
もし同じコアの集合が複数あるなら、ひとつにまとめてしまうのです。
コアとは、left, alpha, betaのことであり、
コアが同じということはaheadだけが異なっているものです。
例えばこんな感じ。
([A -> B . C, a] [B -> . D, a/b] [B -> . E, c]) と ([A -> B . C, b] [B -> . D, b] [B -> . E, d/e]) が同じ
どうやってひとつにするかというと、aheadをunionします。
つまり次のようになります。
([A -> B . C, a/b] [B -> . D, a/b] [B -> . E, c/d/e])
いろんな方法があると思いますが、
ここでは新しい状態を作成しようと思います。
そのあと、マージ元の2つに向いている番号を、すべてマージ先に変更します。
マージと番号更新が終わったら、マージ元の全ての状態を削除します。
全然簡単じゃないですね。
書いてあることは難しくないのですが、
実際に作るとなれば結構な作業量になります。
でもやってみます。
もう飽きてきたので一気に説明します。
(defun make-lalr () (dolist (x *state*) (when (update-lalr x) (return (make-lalr)))))
make-lalrはLR(1)をLALR(1)に変換する関数です。
やっていることは、全ての状態をdolistで取得し、
ひとつずつupdate-lalrで更新していくのですが、
もし更新が行われた場合はmake-lalrを再帰呼出して最初からやり直します。
なにも更新が行われなくなった時点で完了です。
(defun update-lalr (x) (multiple-value-bind (merge remove) (split-lalr x *state*) (when merge (setq *state* remove) (let ((x (merge-lalr merge))) (replace-lalr x merge remove) t))))
update-lalrは、引数の状態xだけを見て、状態遷移表を更新する関数です。
split-lalrは、コアが同じもののリストmergeと、
それを除外したリストremoveを返却します。
merge-lalrは、コアが同じ状態をまとめて新規の状態を作ります。
replace-lalrは、全ての状態をたどって行き、遷移表の状態番号を更新します。
順番に見ていきます。
(defun split-lalr (x list) (when (find-others-lalr x list) (let (merge remove) (dolist (y list) (if (equal-state-lalr x y) (push y merge) (push y remove))) (values merge remove))))
split-lalrは、状態xと同じコアの集合と、違うコアの集合を返却します。
まず最初に、find-others-lalrで自分以外の同じコアがあるかどうかを判定します。
存在するのであれば、dolistを用いてmergeとremoveを返却します。
(defun find-others-lalr (x list) (dolist (y list) (and (not (eql x y)) (equal-state-lalr x y) (return t))))
find-others-lalrは、自分以外の同じコアを持つ状態を取得します。
同じコアかどうかの判定は、equal-state-lalrで行います。
(defun equal-grammar-lalr (x y) (and (equal (grammar-left x) (grammar-left y)) (equal (grammar-alpha x) (grammar-alpha y)) (equal (grammar-beta x) (grammar-beta y)))) (defun equal-state-lalr (x y) (let ((x (state-list x)) (y (state-list y))) (equalset x y :test #'equal-grammar-lalr)))
equal-state-lalrは、二つの集合に対して、equalsetで判定を行います。
同じコアかどうかは、equal-grammar-lalr関数にて行います。
これで、同じコアの集合mergeが取得できました。
次にマージする関数を見ていきます。
(defun merge-lalr (list) (aprog1 (reduce #'merge-state-lalr list) (setf (state-index it) *state-index*) (push it *state*) (incf *state-index*)))
マージ作業は難しく考えたくなかったので、
Common Lispのreduce関数に任せることにしました。
構文解析のreduceとは関係ないので注意。
merge-state-lalr関数とreduceにより、
全てをマージした状態がitに束縛されます。
返却された状態itは*state*に登録されていない一時的なものなので、
aprog1のbody部でちゃんと設定します。
通し番号の設定を行い、*state*にpushしています。
(defun merge-state-lalr (x y) (let ((list (merge-list-lalr x y)) (action (merge-action-lalr x y)) (goto (merge-goto-lalr x y))) (make-state :list list :action action :goto goto)))
これは単に集合listと、action, gotoをマージして、
新規の状態インスタンスを作成しているだけです。
(defun merge-grammar-lalr (x y) (grammar-instance (grammar-left x) (grammar-alpha x) (grammar-beta x) (union (grammar-ahead x) (grammar-ahead y)))) (defun merge-list-lalr (x y) (let ((listx (state-list x)) (listy (state-list y)) list) (dolist (v listx) (aif (find v listy :test #'equal-grammar-lalr) (push (merge-grammar-lalr v it) list) (error "Invalid state, ~S, ~S." x y))) list))
merge-list-lalrは集合と集合をマージします。
dolistで片方の集合をひとつずつ扱い、
findでマージするべきもうひとつの要素を探します。
merge-grammar-lalrは、aheadをunionで結合したインスタンスを返却します。
(defun merge-action-lalr (x y) (let ((x (state-action x)) (y (state-action y))) (union x y :test 'equal))) (defun merge-goto-lalr (x y) (let ((x (state-goto x)) (y (state-goto y))) (union x y :test 'equal)))
merge-action-lalrは、状態のaction表をマージします。
merge-goto-lalrは、状態のgoto表をマージします。
どちらもunionとequalだけで何とかなります。
マージ作業は以上です。
削除も完了していますので、あとは番号を置き換えるだけです。
(defun replace-lalr (x merge list) (let (a b) (setq b (state-index x)) (dolist (m merge) (setq a (state-index m)) (dolist (inst list) (replace-action-lalr inst a b) (replace-goto-lalr inst a b)))))
replace-lalrは、2つのdolistがあります。
まずは削除された集合mergeで繰り返しを行い、古い番号を取得します。
新しい番号は、引数xから取得します。
古い番号をa、新しい番号をbに代入しています。
2つめのdolistで、状態一つ一つに対してa -> bの置換を行っています。
(defun replace-action-lalr (inst a b) (let ((list (state-action inst))) (dolist (x list) (and (eq (cadr x) 's) (eql (caddr x) a) (setf (caddr x) b))) (setq list (delete-duplicates list :test 'equal)) (setf (state-action inst) list))) (defun replace-goto-lalr (inst a b) (let ((list (state-goto inst))) (dolist (x list) (when (eql (cadr x) a) (setf (cadr x) b))) (setq list (delete-duplicates list :test 'equal)) (setf (state-goto inst) list)))
replace-action-lalrは、actionテーブルを置き換えます。
replace-goto-lalrは、gotoテーブルを置き換えます。
どちらも遷移先を見つけては、setfで強引に置き換えています。
置換後は重複が出てきますので、delete-duplicatesでひとつにしています。
駆け足で説明してきましたが、これでLALR(1)の処理は完了です。
5. LALR(1)の実行テスト
テストの内容はLR(1)と同じにします。
(parse-terminal + * [ ] int) (parse-start expr) (parse-rule expr -> expr + term) (parse-rule expr -> term) (parse-rule term -> term * fact) (parse-rule term -> fact) (parse-rule fact -> [ expr ]) (parse-rule fact -> int) (make-table) (make-reduce) (make-lalr) (output-table) (execute-parse '(int * [ int + int ]))
実行結果は下記の通り。
0 : INT:S:26 [:S:31 FACT:24 TERM:22 EXPR:1 1 : END:A:NIL +:S:23 22 : ]:R:2 +:R:2 END:R:2 *:S:27 23 : INT:S:26 [:S:31 FACT:24 TERM:25 24 : ]:R:4 +:R:4 *:R:4 END:R:4 25 : ]:R:1 +:R:1 END:R:1 *:S:27 26 : ]:R:6 +:R:6 *:R:6 END:R:6 27 : INT:S:26 [:S:31 FACT:29 28 : ]:R:5 +:R:5 *:R:5 END:R:5 29 : ]:R:3 +:R:3 *:R:3 END:R:3 30 : ]:S:28 +:S:23 31 : INT:S:26 [:S:12 FACT:24 TERM:22 EXPR:30 NIL (INT * [ INT + INT ]) (INT) (* [ INT + INT ]) (FACT) (* [ INT + INT ]) (TERM) (* [ INT + INT ]) (TERM *) ([ INT + INT ]) (TERM * [) (INT + INT ]) (TERM * [ INT) (+ INT ]) (TERM * [ FACT) (+ INT ]) (TERM * [ TERM) (+ INT ]) (TERM * [ EXPR) (+ INT ]) (TERM * [ EXPR +) (INT ]) (TERM * [ EXPR + INT) (]) (TERM * [ EXPR + FACT) (]) (TERM * [ EXPR + TERM) (]) (TERM * [ EXPR) (]) (TERM * [ EXPR ]) NIL (TERM * FACT) NIL (TERM) NIL (EXPR) NIL ACCEPT
うまくいってます。
遷移表はだいぶ変わっているのが分かります。
しかも短くなっています。
実行結果は当然変わらずです。
