nptclのブログ

Common Lisp処理系nptの開発メモです。https://github.com/nptcl/npt

Common LispでLALR(1)のparserを作る3

前回:Common LispでLALR(1)のparserを作る2 - nptclのブログ

1. 続きです

Common LispでひたすらLR(1)を作成するコーナーです。
CLOSUREまで作ったので、状態遷移表の作成に入ります。

2. GOTO

CLOSUREができたら、次はGOTOを作りましょう。
まずは定義から。

;;  GOTO(I, X)
;;    J = ();
;;    foreach ([A -> alpha . X beta, a] in I)
;;        add  [A -> alpha X . beta, a] to J;
;;    return CLOSURE(J);

GOTOは、集合Iから記号Xで遷移した新たな集合を取得します。
Xは、終端記号でも非終端記号でもどちらでもかまいません。
定義を見てもらえば分かる通り、

[A -> alpha . X beta, a]
が
[A -> alpha X . beta, a]

になっています。
ドットを前進させた集合を作り、 それをCLOSUREに渡したものが返却値です。

コードは難しくはありません。

(defun goto-parse (list x)
  (let (root)
    (dolist (g list)
      (awhen (goto-next g x)
        (push it root)))
    (closure-parse root)))

GOTO(I, X)が、(goto-parse list x)になります。
listをひとつずつ見ていき、goto-nextが返却した場合にpushします。
最終的に得られた集合をclosure-parseに渡して終了です。

(defun goto-next (g x)
  (awhen (grammar-beta g)
    (destructuring-bind (y . beta) it
      (when (eql x y)
        (let ((left (grammar-left g))
              (alpha (grammar-alpha g))
              (ahead (grammar-ahead g)))
          (setq alpha (append alpha (list y)))
          (grammar-instance left alpha beta ahead))))))

goto-nextは、grammar-beta(x . beta)の形になっているものを探します。
見つかったらドットを前進させ、新しいinstanceを作って返却です。

4. 集合の確認

ここからは、集合Iの内容に応じた状態遷移表を作っていきます。
まず考えなければいけないのは、集合が等しいという判定です。
集合とは、順不同のリストだと思ってください。

例えば、次の二つの集合は等しいです。

(a b c)
(c a b)

集合が等しいかどうかの判定を行う関数equalsetを作ります。

(defun equalset-find (x right test)
  (dolist (y right)
    (when (funcall test x y)
      (return t))))

(defun equalset-call (left right test)
  (dolist (x left t)
    (unless (equalset-find x right test)
      (return nil))))

(defun equalset (left right &key (test #'eql))
  (and (listp left)
       (listp right)
       (= (length left) (length right))
       (equalset-call left right test)))

何をしているのかというと、下記の実行が行われた場合、

(equalset left right)

まずleftrightの長さが等しいかどうかを見ます。
そのあとにleftの要素一つずつ取り出して、 全部rightに含まれるかどうかを確認します。

5. 状態の作成

次に状態を作っていきましょう。
状態は、整数の番号であらわされるものとします。
集合Iの内容に応じて状態が作成されます。

まずは構造体と変数から見ていきます。

(defstruct state index list action goto)
(defvar *state-index* 0)
(defvar *state* nil)

state構造体は、通し番号indexと集合listを持ちます。
actiongotoは、状態遷移の矢印を意味します。
actionにはshiftreduceの動作が入り、 gotoにはreduce後の遷移先が入ります。

変数である*state-index*は、indexの通し番号に使います。
*state*は、状態を格納するリストです。

状態の番号から、state構造体を取得する関数を作成します。

(defun get-state (index &optional (errorp t))
  (or (find index *state* :key #'state-index)
      (when errorp
        (error "Index error, ~S." index))))

get-stateは、単にfindしてるだけなので簡単です。

次に、集合listから状態を取得する関数を示します。

(defun intern-make-state (list)
  (aprog1 (make-state :index *state-index* :list list)
    (push it *state*)
    (incf *state-index*)))

(defun intern-state (list)
  (or (intern-find-state list)
      (values (intern-make-state list) t)))

intern-stateは、まずintern-find-stateで検索を行います。
既に存在しているならその構造体を返却します。
存在しないならintern-make-stateで構造体を作成して返却します。
もし構造体が作成された場合は、(values instance t)のように、 第二返却値がtになります。

次にintern-find-stateを見てみます。

(defun intern-find-state (list)
  (dolist (y *state*)
    (when (equalset list (state-list y) :test #'grammar-equal)
      (return y))))

この関数は、リスト*state*から集合listに対応する構造体をfindしています。
keyが集合listで、valueが状態というhash-tableの索引みたいなものです。
注意点としては、集合listは順不同なのでequalsetを使う必要があるということ。
equalset:testには、grammar-equalが指定されています。

(defun grammar-equal (x y)
  (and (equal (grammar-left x) (grammar-left y))
       (equal (grammar-alpha x) (grammar-alpha y))
       (equal (grammar-beta x) (grammar-beta y))
       (equalset (grammar-ahead x) (grammar-ahead y))))

grammar-equal関数は、引数xyが等しいかどうかを調べます。
left, alpha, betaは普通にequalで確認しますが、 aheadだけは集合なので、equalsetを用いています。

6. 状態遷移表の作成

それでは開始記号をもとに、状態遷移表を作成します。
まずは開始記号から初期状態を作りましょう。

(defun start-table ()
  (let* ((left *start-symbol*)
         (beta (list *start*))
         (ahead *end*)
         (x (grammar-instance-rest left nil beta ahead)))
    (intern-state
      (closure-parse (list x)))))

初期状態の集合については前回解説しました。
もう一度書くと、

#:start -> . expr, #:end

というたったひとつの集合をCLOSUREに渡しています。
前回と違うのは、CLOSUREの返却値をintern-stateに渡して状態を作成している所です。

start-tableは、開始記号の集合に対応する初期状態が返却されます。
ついでに、一度実行したら全部同じ状態が返却されるのを確認してみましょう。

(format t "~S~%" (start-table))
(format t "~S~%" (start-table))
(format t "~S~%" (start-table))

実行結果は下記の通り。

#S(STATE :INDEX 0 ...)
#S(STATE :INDEX 0 ...)
#S(STATE :INDEX 0 ...)

indexがインクリメントされずに全部0になっているのが分かります。

それではGOTOを使って次々に遷移していきましょう。
まずは開始の関数を制定します。

(defun make-table ()
  (make-table-loop
    (start-table)))

make-tableは、初期状態を作成してから すぐmake-table-loopを呼んでるだけです。

(defun make-table-loop (x)
  (dolist (s (symbols-table x))
    (multiple-value-bind (y make) (goto-table x s)
      (arrow-table s x y)
      (when make
        (make-table-loop y)))))

make-table-loopは短いにしては色々やっています。
まず状態xから遷移できる記号を全部集めます。
終端記号・非終端記号どちらも全部取得します。
次に状態xと記号sを引数に、GOTOで遷移させて状態yを取得します。
遷移元xと遷移先yを、記号sと一緒に状態遷移表に追加します。
もし遷移先yが新しく作成されたものであったなら、 make-table-loop再帰呼出します。

関数がいくつかあります。

  • symbols-table
    状態から遷移する記号をリストで全部取得する
  • goto-table
    GOTOを実行して状態を取得する
  • arrow-table
    元の状態と新たな状態を、記号で遷移させる

順番に見ていきましょう。

(defun symbols-table (x)
  (let (root)
    (dolist (g (state-list x))
      (awhen (grammar-beta g)
        (pushnew (car it) root)))
    root))

symbols-tableは、状態x保有する集合を全部見て、遷移先の記号をすべて取得します。
どういうことかというと、集合の中のbetacarを集めます。
文法っぽく書くならば、

[left -> alpha . X beta, ahead] in I

Xを集めます。

(defun goto-table (x s)
  (intern-state
    (goto-parse (state-list x) s)))

goto-tableは簡単ですね。
状態が保有する集合をGOTOに渡して、intern-stateで状態を取得しています。
goto-tableの返却値は、intern-stateの第二返却値も必要なことに注意してください。
状態は必ず作成されるのではなく、 すでに同じ集合があるならそれが返却されます。

(defun arrow-table (s x y)
  (let ((next (state-index y)))
    (cond ((terminalp s) (add-shift-table s x next))
          ((non-terminal-p s) (add-goto-table s x next))
          (t (error "Invalid symbol, ~S." s)))))

arrow-tableは状態xに遷移先を登録します。
これは少し説明が必要です。

状態xから記号sで遷移するとき、 記号sが終端記号か非終端記号かのどちらかで動作が変わります。
終端記号の場合は、状態のactionshiftとして登録します。
非終端記号の場合は、状態のgotoに遷移先を登録します。
reduceはどうしたんだという話ですが、まだ出てきません。
ということで、arrow-tableは呼び出す関数を変えているのです。

(defun state-action-check-p (y z b c)
  (and (eq b y)
       (or (eql c z)
           (and (rule-p c)
                (rule-p z)
                (eql (rule-index c)
                     (rule-index z))))))

(defun state-action-check (list a b c)
  (destructuring-bind (y z) (cdr list)
    (unless (state-action-check-p y z b c)
      (error "~S/~S error, ~S, ~S." y b list (list a b c)))))

(defun add-shift-table (s x next)
  (aif (find s (state-action x) :key #'car)
    (state-action-check it s 's next)
    (push (list s 's next) (state-action x))))

add-shift-tableは終端記号を登録するための関数です。
まずはactionテーブルに同じ記号が登録されているかどうかを確認します。
登録されていた場合、state-action-checkで確認を行います。
もし全く同じものが登録されていた場合は問題ありません(state-action-check-pで確認)。
しかし違うのならエラーの可能性があります。
今の段階では、無条件にエラーにしてしまっています。
後で話題に出すかもしれませんが、Shift/Reduce衝突と呼ばれるものは 無視したりする場合もあります。
そういう時はstate-action-checkをいろいろいじって下さい。

もし登録されていないのであれば、状態のactionにShift操作として登録します。
pushする内容が

(list s 's next)

となっていますが、二番目の'sがShiftを意味しています。
他にも'rがReduce、'aがAcceptになります。

それでは非終端記号の方を示します。

(defun state-goto-check (list a b)
  (destructuring-bind (y) (cdr list)
    (unless (eql b y)
      (error "goto error, ~S /= ~S." list (list a b)))))

(defun add-goto-table (s x next)
  (aif (find s (state-goto x) :key #'car)
    (state-goto-check it s next)
    (push (list s next) (state-goto x))))

こちらはShiftやReduceなど種類がありません。
たんに記号と遷移先の2つの情報をpushしています。
もちろん衝突チェックは入れています。

7. 状態遷移表の確認

ここまででshiftの遷移表までは完成しました。
Reduceをやる前にちょっと動作確認をしてみましょう。

状態の確認に使う出力関数です。

(defun output-action-table (x)
  (destructuring-bind (a b c) x
    (if (rule-p c)
      (format nil "~A:~A:~A" a b (rule-index c))
      (format nil "~A:~A:~A" a b c))))

(defun output-goto-table (x)
  (destructuring-bind (a b) x
    (format nil "~A:~A" a b)))

(defun output-table ()
  (dotimes (index *state-index*)
    (awhen (get-state index nil)
      (let ((a (mapcar #'output-action-table (state-action it)))
            (g (mapcar #'output-goto-table (state-goto it))))
        (format t "~3A:~{ ~A~}~40T~{ ~A~}~%" index a g)))))

それではoutput-tableを実行してみます。

0  : INT:S:19 [:S:6                      FACT:20 TERM:21 EXPR:1
1  : +:S:2
2  : INT:S:19 [:S:6                      FACT:20 TERM:3
3  : *:S:4
4  : INT:S:19 [:S:6                      FACT:5
5  :
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  : *:S:10
10 : INT:S:17 [:S:12                     FACT:11
11 :
12 : INT:S:17 [:S:12                     FACT:16 TERM:15 EXPR:13
13 : ]:S:14 +:S:8
14 :
15 : *:S:10
16 :
17 :
18 :
19 :
20 :
21 : *:S:4

大きく左の列がactionで、右の列がgotoです。
状態0actionにあるINT:S:19というのは、 終端記号がint,種類がshift,遷移先が19という意味です。
gotoは非終端記号に対して、遷移先の番号が対応しているのが分かります。
例えばFACT:20というのは、非終端記号FACT, 遷移先20という意味です。
goto表がいったい何者なのかは、実際に動かしてみるときに説明します。

8. Reduce表の作成

続けてReduceの遷移を作成します。
Shiftはもう作成してあるので、Reduceが終わればLR(1)が完成ということになります。

Reduceの遷移は、全ての状態を個別に見ていく必要があります。
さらに状態の中の集合を一つずつ見ていきます。
集合内の要素と全ての規則を比べて、どれかに一致しているかを見ていきます。
とにかく地道に一つずつ見ていきます。
何をどう見ていくかというと、

[expr -> expr + term . A B C, +/int]

みたいな文を含む集合を持った状態があったとします。
この文は、次の規則を適用できます。

(parse-rule expr -> expr + term)

つまり、文のleftalphaを見て、 それが規則のleftrightと一致するものを探すのです。
もし一致するのであれば、その規則でReduceする遷移をactionに追加します。
遷移記号は終端記号であり、その文が保有するaheadになります。
つまり今回の場合は+intです。
遷移先は登録しませんが、後でgotoをもとに遷移する方法を説明します。

それではやっていきましょう。

(defun make-reduce ()
  (dolist (x *state*)
    (dolist (g (state-list x))
      (awhen (find-reduce g)
        (add-reduce x g it)))))

この関数は2つのdolistがあります。
最初のdolistは全ての状態に対して行います。
次のdolistは、状態の全ての集合に対して行います。
もしfind-reduceでReduceする規則が見つかったら、add-reduceactionに追加します。

(defun find-reduce (g)
  (let ((left (grammar-left g))
        (alpha (grammar-alpha g)))
    (dolist (rule *rule*)
      (and (equal (rule-left rule) left)
           (equal (rule-right rule) alpha)
           (return rule)))))

dolistを用いて、全ての*rule*findをしています。
条件は、文のleftalphaがそれぞれ規則のleftrightに等しいことです。

(defun add-reduce (x g rule)
  (dolist (s (grammar-ahead g))
    (if (rule-accept rule)
      (add-final-table s x)
      (add-reduce-table s x rule))))

もしReduceできる規則があった場合は、 add-reduceaheadの分だけactionに追加されます。
ただし、見つかった規則がacceptかどうかで分岐します。
acceptとは、開始記号かどうかです。
もし開始記号の場合は、構文解析が「受理」しますので、また別の処理となります。

まずは普通のreduceの場合を見ていきます。

(defun add-reduce-table (s x rule)
  (aif (find s (state-action x) :key #'car)
    (state-action-check it s 'r rule)
    (push (list s 'r rule) (state-action x))))

追加はshiftのときのadd-shift-tableと同じです。
追加する記号が既に存在する場合は、 内容が全く同じなら問題ありませんが、違う場合は衝突です。
存在しない場合は、(list s 'r rule)を追加します。

Shiftの場合とは違い、'rruleそのものが格納されます。
遷移先の番号ではないので注意。

続いてaccpetの場合です。

(defun add-final-table (s x)
  (aif (find s (state-action x) :key #'car)
    (state-action-check it s 'a nil)
    (push (list s 'a nil) (state-action x))))

追加する内容は、(list s 'a nil)です。

以上で、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)

実行結果は下記の通り。

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

注意してほしいことがあり、Reduceの出力はEND:R:1みたいになっていますが、 番号の1は遷移先ではなく、規則の通し番号です。

続きます

Common LispでLALR(1)のparserを作る4 - nptclのブログ