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

【変更】first-parseを修正しました。

1. 続きです

Common Lispでひたすらparserを作っていきます。

前回は、shift, reduceについて解説しました。
今回はLR(1)をひたすら作っていきます。

ここらへんから、本当にひたすら作るだけになります。
作って作って作る作業ばかりなので、プログラミング持久走みたいになります。
飽きますし疲れますので注意。

2. アナフォリックマクロ

すみません、アナフォリックマクロを使わせて下さい。
これ本当に便利なんです。
基本的にはCommon Lisp標準の機能しか使わないようにしてるんですが、こいつは使いたいです。

アナフォリックマクロってなんだよという前に、まずは定義を示します。

(defmacro aif (expr then &optional else)
  `(let ((it ,expr))
     (if it ,then ,else)))

(defmacro awhen (expr &body body)
  `(aif ,expr (progn ,@body)))

(defmacro aprog1 (expr &body body)
  `(let ((it ,expr))
     (prog1 it ,@body)))

(defmacro aif2 (expr then &optional else)
  (let ((g (gensym)))
    `(multiple-value-bind (it ,g) ,expr
       (if ,g ,then ,else))))

(defmacro awhen2 (expr &body body)
  `(aif2 ,expr (progn ,@body)))

aif, awhen, aprog1は、普通のアナフォリックマクロです。
if文で、条件判定に使われた値をitという変数で参照できるというもの。
つまり、

(if expr
  then)

みたいな文が

(let ((it expr))
  (if it
    then))

のように展開されます。

aif2とawhen2はちょっと複雑です。
if文がtrueと判定されるのは、条件式の第一返却値ではなく、第二返却値がtrueのときです。
これはいろんな流儀があります。
有名なものだと、ifの判定は、(or 第一返却第二返却)で行うものがあります。
今回は第二返却だけに注目しています。
そしてitに束縛されるのは、第一返却値です。
itの束縛については、多分どのaif2においても第一返却値で共通だと思います。

つまり、

(aif2 expr
  then)

という文は、

(multiple-value-bind (it #:check) expr
  (if #:check
    then))

になります。

ちょっとややこしいかもしれませんが、今後ずっと使っていきます。

3. CLOSURE

さあLR(1)を作りましょう！

まずはCLOSUREを作ります。
こいつが何なのか良くわかりませんが、難しいことは後で考えます。

;;  CLOSURE(I)
;;    repeat
;;      foreach ([A -> alpha . B beta, term-a] in I)
;;        foreach ([B -> gamma] in *rule*)
;;          foreach (term-b in FIRST(beta term-a))
;;            add [B -> . gamma, term-b] to I;
;;    until no more items are added to I;
;;    return I;

Common Lispで作ります。
結構大変ですががんばりましょう。

まず、繰り返しが4つもあることに注目します。
repeat, foreach, foreach, foreachの4つです。
repeatには、untilが対応しており、「Iに何も追加されなかったらループ終了」とのこと。

3つのforeachのあとにはaddという命令があるのですが、この処理は結構複雑です。
まずはrepeatを処理したいので、追加が生じたかどうかはaddの返却値によって判定したいと思います。

最初はこんな感じで作成してみます。

(defun closure-parse (list)
  (aif2 (closure-foreach list)
    (closure-parse it)
    list))

closure-parse関数がCLOSUREそのものになります。
CLOSUREのrepeat/untilを実現するために、再帰呼出のつくりになっています。
これから作成するclosure-foreachという関数の第二返却値がtならば、自分自身であるclosure-parse関数を呼び出すというものです。

closure-foreachを示します。

(defmacro dobind (bind expr &body body)
  (let ((g (gensym)))
    `(dolist (,g ,expr)
       (destructuring-bind ,bind ,g
         ,@body))))

(defun closure-foreach (list)
  (let (update)
    (dobind (b beta term-a) (closure-filter list)
      (dolist (gamma (closure-grammar b))
        (dolist (term-b (closure-first beta term-a))
          (awhen2 (closure-add b gamma term-b list)
            (setq list it update t)))))
    (values list update)))

元の文にあるforeach, foreach, foreachが、 dobind, dolist, dolistに対応します。
見た目をそろえるためだけに、dobindというマクロを作成しました。
ここで呼ばれている下記の関数を一つずつ説明していきます。

closure-filter
closure-grammar
closure-first
closure-add

やっていることは、とにかくlistに何かを追加しようとしています。
新しい要素が追加できたらupdateをtにして、呼び出し元であるclosure-parseにもう一度実行してほしいとお願いします。

それでは、最初に関数closure-filterから見ていきましょう。
元の文は次の個所に対応します。

;;      foreach ([A -> alpha . B beta, term-a] in I)
    (dobind (b beta term-a) (closure-filter list)
      ...)

ここはかなり丁寧に説明する必要があります。
まず引数のIというのは何らかの集合を表します。
集合とは、順不同の要素が集まったものです。
その集合Iの中に、

[A -> alpha . B beta, term-a]

に対応するような何かが入っているということです。
表記法に独特なルールがあります。
alpha, beta (あとgammaも)というのは0個以上の記号の列を意味します。
A, Bは、たった1つの非終端記号を意味します。

普通の規則であれば、

left -> right

みたいな形になりますが、LR(1)では、rightを二つの部分に分けます。
つまり、

left -> alpha . beta

みたいな感じになります。
alphaとbetaは記号の列なので、Common Lispではリストとして表現します。
ドット.は、現在処理中の場所を意味しています。

さらに、LR(1)の、(1)という部分は1つの先読みを意味しているわけですが、先読みした終端記号をaとした場合、

left -> alpha . beta, a

みたいな感じに表します。
この[left -> alpha . beta, a]みたいな形のやつが、集合Iにいっぱい入っているわけです。
上記のようにsymbolの列をそのまま格納してもいいのですが、構造体を作って管理しましょう。

(defstruct grammar left alpha beta ahead)

(defun grammar-instance (left alpha beta ahead)
  (make-grammar :left left :alpha alpha :beta beta :ahead ahead))

(defun grammar-instance-rest (left alpha beta &rest ahead)
  (grammar-instance left alpha beta ahead))

grammarが構造体です。
grammar-instanceとgrammar-instance-restは、構造体を作成するための関数です。

leftは左辺、alphaとbetaは右辺、そしてaheadは先読みの終端記号を格納した集合です。
つまりは次のようにあらわされます。

left -> alpha . beta, ahead

aheadは、本来たった1つの終端記号なのですが、例えば下記のように

left -> alpha . beta, a
left -> alpha . beta, b

left, alpha, betaが同じものの場合は、まとめて下記のようにあらわすと便利です。

left -> alpha . beta, a/b

ということで、aheadはリストで管理します。
例えば、

expr -> expr + . term, a/b

のような文を表す場合は、

(grammar-instance-rest 'expr '(expr +) '(term) 'a 'b)

のようになります。

ではforeach文に戻りましょう。

[A -> alpha . B beta, term-a]

つまりは、集合Iの中にある文のうち、ドット右側が、

(grammar-beta x) == (B . beta)

の形になっているものを全て抜き出せという意味です。
今回、A, alphaに該当する部分は使いませんので、 B, beta, term-aの3つの値を foreachで割り当ててループします。

それでは作成してみましょう。

(defun closure-filter (list)
  (let (root)
    (dolist (inst list)
      (awhen (grammar-beta inst)
        (destructuring-bind (b . beta) it
          (when (non-terminal-p b)
            (dolist (ahead (grammar-ahead inst))
              (push (list b beta ahead) root))))))
    root))

わりとそのまま作成しています。
まず集合Iであるlistをdolistで回します。
grammar-betaが(B . beta)の形なら、(B beta ahead)をpushします。
返却値は集合なので、順番は適当で問題ありません。

それでは2番目のforeachを見てみます。

;;        foreach ([B -> gamma] in *rule*)
      (dolist (gamma (closure-grammar b))
        ...)

これは全然難しくありません。
いまBは分かっているので、対応する規則の右辺rightを求めるだけです。

(defun closure-grammar (b)
  (let (root)
    (dolist (inst *rule*)
      (when (eql (rule-left inst) b)
        (push (rule-right inst) root)))
    root))

最後のforeachを見てみます。

;;          foreach (term-b in FIRST(beta term-a))
        (dolist (term-b (closure-first beta term-a))
          ...)

ただ単にFIRSTという関数を呼んでいるだけです。
FIRSTはちょっと難しかったので詳しく見ていきます。

FIRST(X)は、最初に遭遇する終端記号を返却します。
aが終端記号のとき、FIRST(a)はそのままaが返却されるわけですが、返却は集合であることを注意してください。
つまりFIRST(a) -> {a}です。
なぜ集合になるのかというと、

X -> a
X -> b

のようなときは、FIRST(X)に、aとbのどちらにも遭遇する可能性があるからです。

最初に遭遇した終端記号の集合ということなので、例えば下記のような場合、

X -> A B C

FIRST(X)は、もしFIRST(A)に返却値がある場合は

FIRST(X) -> FIRST(A)

です。
しかし、FIRST(A)が空の場合は、次にFIRST(B)を同様に調べます。
FIRST(B)に返却値があればそれが返却になりますが、無かったらFIRST(C)を調べるという動作になります。

これってどうやって作ればいいと思いますか。
普通に再帰で実装することを考えていたのですが、例えば

expr -> expr + term

みたいな場合って、FIRST(expr)を調べるとすぐにFIRST(expr)に遭遇するので無限ループになってしまうんですよね。

【変更】first-parseを修正しました。

もし自分自身に遭遇した場合は、その規則は無視して次の規則を調べることにします。
あと、今回の実装ではFIRSTの引数がリストなので、まずはリストの処理から見ていきましょう。

(defun first-parse (list)
  (when list
    (destructuring-bind (car . cdr) list
      (or (first-symbol car)
          (first-parse cdr)))))

引数のリストを順番に処理していき、もしfirst-symbol関数に返却値があったら全体を終了させます。

次にfirst-symbol関数を見てみます。

(defun first-symbol (x)
  (cond ((terminalp x) (list x))
        ((non-terminal-p x) (first-nonterm x))
        (t (error "Invalid symbol, ~S." x))))

もし引数が終端記号なら、それを返却して終わりです。
非終端記号なら、first-nontermを呼び出します。
余談ですが、ここのエラーは誤字脱字を指摘してくれるので便利です。

first-nontermを見てみます。

(defun first-nonterm (x)
  (let (root)
    (dolist (right (first-rule x))
      (dolist (y (first-right x right))
        (pushnew y root)))
    root))

二つのdolistがあります。
最初のfirst-ruleは、非終端記号xから該当する規則の集合を求めます。
二つ目のfirst-rightはFIRST(right)の結果を返却します。
yは終端記号であり、pushnewで重複がないように収集します。

first-ruleとfirst-rightを順番に見ていきます。

(defun first-rule (x)
  (let (list)
    (dolist (y *rule*)
      (when (eql x (rule-left y))
        (push (rule-right y) list)))
    list))

first-ruleは難しくありません。
引数の非終端記号xと、規則のleftが等しいものの rightをリストとして返却するだけです。

(declaim (ftype function first-symbol))

(defun first-right (x right)
  (dolist (y right)
    (when (eql x y)
      (return nil))
    (aif (first-symbol y)
      (return it))))

やっていることはFIRST(right)を求めるだけなのですが、もし自分自身の非終端記号に遭遇した場合はnilを返却します。
つまりは

expr -> expr + term

のような場合です。
nilを返却するため、次の規則を調べるように指示します。

これでfirst-parse関数は完成しましたので、元の文に戻ります。

;;         (dolist (term-b (closure-first beta term-a))
(defun closure-first (beta term)
  (or (first-parse beta)
      (list term)))

foreachで呼ばれていたclosure-firstです。
もともとの文はFIRST(beta term-a)なので、まずfirst-parseでFIRST(beta)を求め、もし値が無かったら(list term)を返却しています。

ここまでで、repeatと3つのforeachの説明は完了しました。
次はclosure-addです。

;;            add [B -> . gamma, term-b] to I;
          (awhen2 (closure-add b gamma term-b list)
            (setq list it update t))

もしclosure-add関数で値が追加された場合は、 listを更新し、updateにtを代入します。
第二返却値がnilの場合は何もしません。

closure-addはlistに追加するだけなのですが、無条件に追加するのではなく pushnewのように既に追加されているかどうかを調べる必要があります。
また、単にlistにpushするのではなく、 left, alpha, betaが同一の要素が存在する場合は、 aheadの集合にpushnewしなければなりません。
その辺を全部考慮して作っていきます。

(defun closure-add (left beta term list)
  (aif (closure-add-find left beta list)
    (closure-add-ahead it term list)
    (closure-add-list left beta term list)))

まずはclosure-add-findで要素が存在するかどうかを調べます。
存在する場合はclosure-add-aheadを呼びます。
存在しない場合はclosure-add-listを呼びます。

順番にclosure-add-findから見てきます。

(defun closure-add-find (left beta list)
  (dolist (inst list)
    (and (equal (grammar-left inst) left)
         (equal (grammar-alpha inst) nil)
         (equal (grammar-beta inst) beta)
         (return inst))))

ただ検索しているだけですが、 leftとbetaだけをequal判定し、alphaはnilかどうかを調べています。
どうしてかというと、追加する内容が次のようなものだからです。

[B -> . gamma, term-b]

alphaが存在しないのです。
aheadを無視しているのは次の処理で分岐させるためです。
ahead以外のleft, alpha, betaの3つが一致することを、「コアが等しい」というらしいです。
この辺の話はLALR(1)のときによく出てきます。

それでは、コアが等しい場合のclosure-add-aheadを見ていきます。

(defun closure-add-ahead (inst term list)
  (unless (member term (grammar-ahead inst))
    (push term (grammar-ahead inst))
    (values list t)))

やっていることはgrammar-aheadにpushnewするだけなのですが、もしpushに成功した場合は、 (values list t)を返却しないと正しく更新されません。
unlessやらmemberやらで存在確認しているのはそのためです。

次は等しいコアが見つからなかった場合のclosure-add-listです。

(defun closure-add-list (left beta term list)
  (let ((v (grammar-instance-rest left nil beta term)))
    (values (cons v list) t)))

こちらは単純にpushするだけです。

ずいぶん長くなりましたが、以上でCLOSUREの作成は終わりです。

4. 試しに実行する

そもそもCLOSUREってなんなのって話ですが、集合Iのドットの位置から非終端記号を経由して、たどれるところ全部たどって行った場合の新しい集合を返却する機能です。
正規表現をやったことある人なら NFAからDFAに変換するときに、 epsを全部たどるみたいなことをしたことがあるかもしれません。
つまりそれです。
これからCLOSUREを使って、構文解析のDFAを作ろうとしています。

試しに実行してみましょう。
まずは初期状態の集合を作ります。
最初の文は下記の通り。

#:start -> . expr, #:end

#:startは、開始を表す値*start-symbol*です。
#:endは、EOFを表す値*end*です。
exprは、parse-startで設定した値*start*です。
「. expr」で分かるように、初期状態なのでalphaはnilです。

実行してみましょう。

(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)

(let* ((left *start-symbol*)
       (beta (list *start*))
       (ahead *end*)
       (x (grammar-instance-rest left nil beta ahead)))
  (format t "~S~%" x)
  (format t "~S~%" (closure-parse (list x))))

結果は下記の通り。

#S(GRAMMAR :LEFT #:START :ALPHA NIL :BETA (EXPR) :AHEAD (#:END))
(#S(GRAMMAR :LEFT FACT :ALPHA NIL :BETA (INT) :AHEAD (* + #:END))
 #S(GRAMMAR :LEFT FACT :ALPHA NIL :BETA ([ EXPR ]) :AHEAD (* + #:END))
 #S(GRAMMAR :LEFT TERM :ALPHA NIL :BETA (FACT) :AHEAD (* + #:END))
 #S(GRAMMAR :LEFT TERM :ALPHA NIL :BETA (TERM * FACT) :AHEAD (* + #:END))
 #S(GRAMMAR :LEFT EXPR :ALPHA NIL :BETA (TERM) :AHEAD (+ #:END))
 #S(GRAMMAR :LEFT EXPR :ALPHA NIL :BETA (EXPR + TERM) :AHEAD (+ #:END))
 #S(GRAMMAR :LEFT #:START :ALPHA NIL :BETA (EXPR) :AHEAD (#:END)))

次は状態遷移表をつくります。

続きます

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

nptclのブログ

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

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

1. 続きです

2. アナフォリックマクロ

3. CLOSURE

4. 試しに実行する

続きます