PEG 手打ち用の小さなヘルパ

すっかり Parsing Expression Grammar (PEG) とバックトラック構文解析器および Packrat 解析器が手に馴染み、最近は、何であれ構文解析をしたいときは、とりあえず PEG の流儀で下向き解析することから手をつけるようになっています。そうしているうちに、だいたい、これさえあれば、楽に PEG 流で Perl再帰下降型の解析器ができるという基本セットが見えてきたので、小さなヘルパにまとめました。

https://gist.github.com/tociyuki/4743586 (うっかりして、プライベート Gist にしまっていたので、パブリックへ差し替えました)

PEG の終端記号 scan、sequence、alternate、ゼロ以上の繰り返し repeat_star をおこなうための 4 つの手続きにプラスして、良くある中置記法繰り返し手続き repeat_infix を合わせて 5 つ定義してあります。すべての手続きは第一引数で Derivs データを受けとります。これは配列リファレンスで、入力テキストへのスカラー・リファレンスとカーソルを順に格納したものです。Packrat 解析したいときはメモライズ用のハッシュを追加しておきます。なお、このヘルパはメモライズにはノータッチです。単に右から左へハッシュを受け渡していくだけです。

scan は正規表現か部分文字列を受け取り、一致したらその分を進めた新しいカーソル・データを生成して返します。同時に正規表現で一致している最後の括弧からキャプチャした値も返します。最後のものしか返さないので、複数同時にキャプチャするような正規表現は使えません。もっとも、PEG ではそのような使い方は不便なだけだということがわかってきたので、あえてキャプチャの最後のものだけを返すようにしています。一致しないときは偽を返します。

sequence と alternate は複数の解析手続きのコード・リファレンス正規表現を受け取り、順に実行または scan していきます。sequence はすべての実行が成功したときに、最後の解析手続きが返したカーソルと、それぞれの手続きが返した値を並べたリストを返します。alternate は最初に成功したときに処理を中段して、成功した手続きが返したカーソルと値を返します。両方共、すべてが失敗したときは偽を返します。sequence が返すのが配列リファレンスではなくリストなのは、成功した結果から値を拾い出して合成することが多いためです。

repeat_star は一個の解析手続きのコード・リファレンスか正規表現を受け取り、それが成功する間、ずっと繰り返します。一度も成功しなかったときでも戻り値を偽にせず、最初の Derivs データを返します。繰り返しながら受け取った値は配列リファレンスに順にプッシュして値として返します。一度も成功しなかったときは値の配列リファレンスは空になります。値が配列リファレンスなのは、そのまま一まとめで利用するケースが多いためです。

repeat_infix は二個の解析手続きのコード・リファレンスか正規表現を受け取ります。最初が中置記号用の解析手続きで、二番目が項記号の解析手続きです。項記号の解析手続きは最低でも1回は成功しないといけません。そうでないときは偽を返します。中置記号に成功した直後に項記号が成功しなければならず、そうでないときも偽を返します。項記号、中置記号、項記号、中置記号、項記号と順に成功していく限り繰り返します。中置記号が失敗したときに、繰り返しを止めて、それまで集めた項記号の結果をまとめた配列リファレンスを値に返します。

なお、PEG の他の表現、ゼロ回か 1 回のクエスチョンマークPerl だと or を使えば一発で記述できるのでヘルパーは作ってません。私の場合、1 回以上繰り返しも最初とそれ以外を別扱いするときがほとんどで、repeat_infix 以外では、sequence と repeat_star を組み合わせることが多いので、これまたヘルパーにいれてません。

最後に使い方の例です。簡単なテンプレートの例で、入れ子の if 〜 elsif 〜 end 連鎖を認識させて、入れ子リストへ変換します。

⇒ 続き PEG 手打ち用の小さなヘルパ Text-Derivs でも演算子優先順構文解析

2013年2月9日差し替え。無名関数を使って、記述をまとめました。

#!/usr/bin/env perl
use strict;
use warnings;
use Text::Derivs qw(scan alternate sequence repeat_star repeat_infix);
use Test::More;

my $text = <<'EOS';
<ul>
[% if h.hydrogen %]<li>hydrogen</li>
[% elsif he %]<li>helium</li>
[% elsif li %]<li>lithium
[%  if be %]<ul><li>beryllium</li>
[%  else %]<li>boron</li>
[%  end %]
[% else %]</ul></li>
[% end %]
</ul>
EOS
my($d1, $got) = block([\$text, 0]);
is_deeply $got,
   [["quote", "<ul>\n"],
    ["cond",
        [["get-var", "h.hydrogen"], ["quote", "<li>hydrogen</li>\n"]],
        [["get-var", "he"], ["quote", "<li>helium</li>\n"]],
        [["get-var", "li"],
            ["quote", "<li>lithium\n"],
            ["cond",
                [["get-var", "be"], ["quote", "<ul><li>beryllium</li>\n"]],
                ["else", ["quote", "<li>boron</li>\n"]]],
            ["quote", "\n"]],
        ["else", ["quote", "</ul></li>\n"]]],
    ["quote", "\n</ul>\n"] ];
done_testing;

sub block { return repeat_star($_[0], \&statement) }
sub statement { return alternate($_[0], \&if_statement, \&opaque) }
sub opaque {
    my($d0) = @_;
    my($d1, $v1) = scan($d0, qr/((?:\[(?!%)[^\[]*)+|[^\[]+(?:\[(?!%)[^\[]*)*)/msx) or return;
    return ($d1, ['quote', $v1]);
}
sub if_statement {
    my($d0) = @_;
    my($d1, @v) = sequence($d0, qr/\[%\s*if\s+/msx, \&elsif_clauses, \&else_clause, qr/\[%\s*end\s*%\]/msx) or return;
    return ($d1, ['cond', @{$v[1]}, $v[2] || ()]);
}
sub elsif_clauses { return repeat_infix($_[0], qr/\[%\s*elsif\s+/msx, \&then_clause) }
sub then_clause {
    my($d0) = @_;
    my($d1, @v) = sequence($d0, qr/(\w+(?:[.]\w+)*)\s*%\]/msx, \&block) or return;
    return ($d1, [['get-var', $v[0]], @{$v[1]}]);
}
sub else_clause {
    my($d0) = @_;
    my($d1, @v) = sequence($d0, qr/\[%\s*else\s*%\]/msx, \&block) or return ($d0);
    return ($d1, ['else', @{$v[1]}]);
}