Parse::RecDescent と Text::Hatena における文法の拡張

Higher-Order Lua [1] のサイトを作る上で一部に Text::Hatena [2] を使用しているのだけど Text::Hatena はドキュメント上はルールの拡張や改変をサポートしていなくて細かいことをやろうとしたら HTML 直打ちをしないといけないところが都合が悪い。

Text::Hatena は内部的には Parse::RecDescent [3] を使っているのだが、このパーサには Extend メソッドと Replace メソッドが定義されていて、既に作られているルールを後から変更することが可能である。

たとえば最初に次のような文法があったとする。

use Parse::RecDescent;

$grammar = q(
  expression : atom "+" expression
               { $return = $item[1] + $item[3]; }
  expression : atom
               { $return = $item[1]; }
  atom : /\d+/
         { $return = $item[1]; }
);

$parser = new Parse::RecDescent ($grammar) or die "Bad grammar!\n";

$text = "2 + 3 + 4";
$result = $parser->expression($text) or die "Bad text!\n";
print "$text = $result\n";

これは数値の足し算を行うパーサだが、これに続けて以下のように書くと文法の拡張ができる。

$parser->Extend(q(
  atom : /two/
         { $return = 2; }
));

$text = "two + 3 + 4";
$result = $parser->expression($text) or die "Bad text!\n";
print "$text = $result\n";

この Extend は atom の定義として /\d+/ のほかに /two/ を追加して "two + 3 + 4" のような式が解釈できるようになる。

一方で Replace は既存の定義を置き換えるのに使う。

$parser->Replace(q(
  atom : /two/   { $return = 2; }
  atom : /three/ { $return = 3; }
  atom : /four/  { $return = 4; }
));

$text = "two + three + four";

$result = $parser->expression($text) or die "Bad text!\n";
print "$text = $result\n";

$text = "two + 3 + 4";

$result = $parser->expression($text) or die "Bad text!\n";
print "$text = $result\n";

この場合 Replace は既存の atom の定義を削除して代わりに /two/, /three/, /four/ を追加する。したがって "two + three + four" という式は解釈できるようになるが "two + 3 + 4" は解釈できなくなる（正確には最初の一部分しか解釈できなくなる）。

これを踏まえて Text::Hatena だが、ソースを呼んでみると実は Replace を使って書き換えが可能な風な記述が見られる。

sub parser {
    my $class = shift;
    unless (defined $parser) {
         $::RD_AUTOACTION = q|my $method = shift @item;| .
             $class . q|->$method({items => \@item});|;
        $parser = Parse::RecDescent->new($syntax);
        if ($class->syntax) {
            $parser->Replace($class->syntax);
        }
    }
    return $parser;
}

察するに、これは多分 Text::Hatena を継承するクラスで syntax メソッドを定義してそのメソッドが置き換え版のルールを返すようにしておけばよいという意味と思われる。ドキュメントに書いていないので公式な仕様ではないのかもしれないが、これが使えそうだ。

というわけで Text::Hatena の拡張をしてみる。拡張したいのは以下のような変換を行うブロックルールだ。

元の記法:

<binary>
<factorial>
<hanoi>

変換後の HTML:

<ul>
<li><a href='binary'>binary</a></li>
<li><a href='factorial'>factorial</a></li>
<li><a href='hanoi'>hanoi</a></li>
</ul>

これは以下のように Text::Hatena を継承するとできた。

{
  package MyHatena;
  use base qw( Text::Hatena );
  sub syntax {
    return q(
      block      : h5
                 | h4
                 | blockquote
                 | dl
                 | list
                 | super_pre
                 | pre
                 | table
                 | linklist
                 | cdata
                 | p
      linklist   : link(s)
                 {
                   my $l = join("", @{$item[1]});
                   $return = "<ul>\n$l</ul>\n";
                 }
      link       : "\n<" /[\w\-\d]+/ ">"
                 {
                   $return = "<li><a href='$item[2]'>$item[2]</a></li>\n";
                 }
    );
  }
}

$html = MyHatena->parse($text);

block のサブルールとして linklist を追加したいだけなのだが、Replace メソッドは既存のルールを丸々置き換えてしまうので Text::Hatena の元の block ルールをコピーして持ってこざるを得なくなっている。これは汚い。

では Text::Hatena が Replace だけでなく Extend も使えるようになっていたらよかったかというとそう簡単な話でもなくて、元のルールに Extend で拡張を行っても block のサブルール内での優先順位が p より低くなってしまうため、思惑通りに linklist が使用されることがない。p より高い優先順位で linklist を追加するには丸々置き換えるしかないようだ。Camlp4 の EXTEND 文なんかではラベルつきのレベルについてはラベル指定をすることで任意のレベルに規則を挿入できるが、おそらく Parse::RecDescent にはそういう機能はないのだと思う。

[1] http://nul.jp/2007/hol/
[2] http://search.cpan.org/~jkondo/Text-Hatena-0.20/lib/Text/Hatena.pm
[3] http://blog.so-net.ne.jp/rainyday/2007-04-01