スキップしてメイン コンテンツに移動

Perl 5 to 6 - (似非)XMLのグラマー

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 20 - A grammer for (pseudo) XMLの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

Original text: Copyright© 2008-2010 Moritz Lenz

Japanese translation: Copyright© 2011 SATOH Koichi

注記: XMLに関する用語の誤用(「整形式」と「妥当」を混同しているなど)がありますが、あくまで例なので原文通りに残しています。

NAME

"Perl 5 to 6" Lesson 20 - (似非)XMLのグラマー

SYNOPSIS

grammar XML {
    token TOP   { ^ <xml> $ };
    token xml   { <text> [ <tag> <text> ]* };
    token text {  <-[<>&]>* };
    rule tag   {
        '<'(\w+) <attributes>*
        [
            | '/>'                 # 空タグ
            | '>'<xml>'</' $0 '>'  # 開始タグと終了タグ
        ]
    };
    token attributes { \w+ '="' <-["<>]>* '"' };
};

DESCRIPTION

これまでの連載記事の焦点はPerl6言語であり、実装状況は気にしていませんでした。 これが空想上の言語でないことを示すため、またグラマーの能力を証明するために、このレッスンでは基本的なXMLを解析する、Rakudoで実行できるグラマーの開発をお見せします。

Rakudoの入手とビルドはhttp://rakudo.org/how-to-get-rakudoの指示にしたがって自分で行って下さい。

XMLの概念

私たちの用途の範囲ではXMLは非常に単純です: プレーンテキストと入れ子になったタグから成り、タグは属性を持つことがあります。 妥当なXMLであると(あるいはそうでないと)解析させたいテストケースをちょっとだけ用意しました:

my @tests = (
    [1, 'abc'                       ],      # 1
    [1, '<a></a>'                   ],      # 2
    [1, '..<ab>foo</ab>dd'          ],      # 3
    [1, '<a><b>c</b></a>'           ],      # 4
    [1, '<a href="foo"><b>c</b></a>'],      # 5
    [1, '<a empty="" ><b>c</b></a>' ],      # 6
    [1, '<a><b>c</b><c></c></a>'    ],      # 7
    [0, '<'                         ],      # 8
    [0, '<a>b</b>'                  ],      # 9
    [0, '<a>b</a'                   ],      # 10
    [0, '<a>b</a href="">'          ],      # 11
    [1, '<a/>'                      ],      # 12
    [1, '<a />'                     ],      # 13
);

my $count = 1;
for @tests -> $t {
    my $s = $t[1];
    my $M = XML.parse($s);
    if !($M  xor $t[0]) {
        say "ok $count - '$s'";
    } else {
        say "not ok $count - '$s'";
    }
    $count++;
}

これは「良い」XMLと「悪い」XMLのリスト、そしてXML.parse($string)を呼び出してテストを走らせる小さなスクリプトです。 言語全体にマッチするルールはTOPという名前にする約束になっています。

(テスト1で分かるように単一のルートタグを必須にしていませんが、この制限を追加するのは些細なことです)

グラマーの開発

XMLのキモは当然タグの入れ子構造ですから、まず2番目のテストに着目することにしましょう。 テストスクリプトの先頭に以下のコードを置いて下さい:

grammar XML {
    token TOP   { ^ <tag> $ }
    token tag   {
        '<' (\w+) '>'
        '</' $0   '>'
    }
};

それからスクリプトを実行します:

$ ./perl6 xml-01.pl
not ok 1 - 'abc'
ok 2 - '<a></a>'
not ok 3 - '..<ab>foo</ab>dd'
not ok 4 - '<a><b>c</b></a>'
not ok 5 - '<a href="foo"><b>c</b></a>'
not ok 6 - '<a empty="" ><b>c</b></a>'
not ok 7 - '<a><b>c</b><c></c></a>'
ok 8 - '<'
ok 9 - '<a>b</b>'
ok 10 - '<a>b</a'
ok 11 - '<a>b</a href="">'
not ok 12 - '<a/>'
not ok 13 - '<a />'

つまりこれは一対の開始タグと終了タグのペアを解析する単純なルールであり、妥当でない4つのXMLをきちんと排除できています。

1番目のテストも同様に簡単に通るように、次のコードを試して下さい:

grammar XML {
    token TOP   { ^ <xml> $ };
    token xml   { <text> | <tag> };
    token text  { <-[<>&]>*  };
    token tag   {
        '<' (\w+) '>'
        '</' $0   '>'
    }
};

(<-[...]>は否定形の文字クラスだったことを思い出して下さい)

それから実行します:

$ ./perl6 xml-03.pl
ok 1 - 'abc'
not ok 2 - '<a></a>'
(残りはさっきと同じ)

どうして2番目のテストは動かなくなったのでしょう? その理由はRakudoが最長トークンマッチをまだ実装しておらず、順番にマッチングを行っているからです。 <text>は空文字列に(つまりいつでも)マッチするので、<text> | <tag><tag>とのマッチングを試しません。選択肢の順番を入れ替えると動きます。

しかし我々はプレーンテキストかタグだけを適当にマッチさせたいのではなく、両者のランダムな組合わせをマッチさせたいのでした:

token xml   { <text> [ <tag> <text> ]*  };

([...]はキャプチャしないグループであり、Perl5の(?: ...)と同様です)

いやはや驚くことに、これは最初の2つのテストを両方とも通過します。

3番目のテスト.<ab>foo</ab>ddは開始タグと終了タグの間にテキストがあるので、次はこれを受理しなければいけません。 しかしタグの間に出現できるのはテキストに限らず任意のXMLで在り得るので、<xml>を単に呼ぶことにしましょう:

token tag   {
    '<' (\w+) '>'
    <xml>
    '</' $0   '>'
}

./perl6 xml-05.pl
ok 1 - 'abc'
ok 2 - '<a></a>'
ok 3 - '..<ab>foo</ab>dd'
ok 4 - '<a><b>c</b></a>'
not ok 5 - '<a href="foo"><b>c</b></a>'
(残りはさっきと同じ)

これで属性(href="foo"のやつ)に集中することができます:

token tag   {
    '<' (\w+) <attribute>* '>'
    <xml>
    '</' $0   '>'
};
token attribute {
    \w+ '="' <-["<>]>* \"
};

しかしこれでは新しいテストを通過できるようにはなりません。その原因はタグ名と属性の間にある空白です。 \s+\s*を色んな場所に加える代わりに、tokenrule(:sigspace修飾子を暗黙的にセットします)に切り替えることにします:

rule tag   {
    '<'(\w+) <attribute>* '>'
    <xml>
    '</'$0'>'
};
token attribute {
    \w+ '="' <-["<>]>* \"
};

これで残るテストは最後の2つになりました:

ok 1 - 'abc'
ok 2 - '<a></a>'
ok 3 - '..<ab>foo</ab>dd'
ok 4 - '<a><b>c</b></a>'
ok 5 - '<a href="foo"><b>c</b></a>'
ok 6 - '<a empty="" ><b>c</b></a>'
ok 7 - '<a><b>c</b><c></c></a>'
ok 8 - '<'
ok 9 - '<a>b</b>'
ok 10 - '<a>b</a'
ok 11 - '<a>b</a href="">'
not ok 12 - '<a/>'
not ok 13 - '<a />'

これらは/で閉じられた入れ子になっていないタグを含んでいます。rule tagにこれを追加するのは何の問題もありません:

rule tag   {
    '<'(\w+) <attribute>* [
        | '/>'
        | '>' <xml> '</'$0'>'
    ]
};

全テストが通るようになりました。やった、はじめて作ったグラマーはちゃんと動きます。

さらなるハッキング

グラマーで遊ぶのは遊び方を読むよりずっと楽しいので、これから実装できるものの例を挙げておきます:

  • &amp;のような実体参照を含むことができるプレーンテキスト
  • XMLタグ名が数字で開始して良いのかどうか分かりませんが、現在のグラマーはこれを許しています。必要ならXMLの仕様書を調べてグラマーを改造するのも良いでしょう
  • <![CDATA[ ... ]]>を含むことができるプレーンテキスト。このXML風タグは無視され、<のような文字はエスケープする必要がありません
  • <?xml version="0.9" encoding="utf-8"?>のようなXML宣言を許容し、すべてを包含する単一のルートタグを要求する本物のXML(テストケースをいくつか修正する必要があります)
  • マッチオブジェクト$/を再帰的に走査することでXML用のプリティプリンタを実装できます(これは生半可にはいきません; いくつかRakudoのバグを回避しなければいけないかも知れませんし、キャプチャも新しく導入する必要があるかも知れません)

(解答をこのブログのコメント欄に書かないで下さい; 他の人にも楽しませてあげましょう;-)

ハッキングを楽しんで下さい。

MOTIVATION

強力だし、楽しい

SEE ALSO

正規表現はS05で詳細に規定されています: http://perlcabal.org/syn/S05.html

正規表現とグラマーの動作している(!)例を、Perl6で書かれたWikiエンジンであるNovember projectでもっと見つけることができます。http://github.com/viklund/november/をご覧下さい。

コメント

このブログの人気の投稿

js_of_ocaml の使い方

js_of_ocaml (jsoo) は Ocsigen が提供しているコンパイラである。その名の通り OCaml バイトコードから JavaScript コードを生成する。 これを使うことで OCaml で書いたプログラムを Web ブラウザや node.js で実行することができる。 インストール 単に OPAM を使えば良い: $ opam install js_of_ocaml js_of_ocaml-ocamlbuild js_of_ocaml-ppx バージョン 3.0 から OPAM パッケージが分割されたので、必要なライブラリやプリプロセッサは個別にインストールする必要がある。 とりあえず使うだけなら js_of_ocaml と js_of_ocaml-ppx の二つで十分。後述するように OCamlBuild でアプリケーションをビルドするなら js_of_ocaml-ocamlbuild も入れると良い。 これで js_of_ocaml コマンドがインストールされ、OCamlFind に js_of_ocaml 及びサブパッケージが登録される。 コンパイルの仕方 以下ソースファイル名は app.ml とし、ワーキングディレクトリにあるものとする。 手動でやる場合 一番安直な方法は、直接 js_of_ocaml コマンドを実行することである: $ # バイトコードにコンパイルする。js_of_ocaml.ppx は JavaScript オブジェクトの作成や操作の構文糖衣を使う場合に必要 $ ocamlfind ocamlc -package js_of_ocaml,js_of_ocaml.ppx -linkpkg -o app.byte app.ml $ # 得られたバイトコードを JavaScript にコンパイルする $ js_of_ocaml -o app.js app.byte OCamlBuild を使う場合 OCamlBuild を使う場合、.js 用のビルドルールを定義したディスパッチャが付属しているので myocamlbuild.ml でこれを使う: let () = Ocamlbuild_plugin . dispatch Ocamlbuild_js_of_ocaml . dispatcher $ # app.ml -...

救急外来にかかったときの記録

子どもの頃にかかった記憶はあるが自分で行ったことはなかったのでメモしておく。 先日怪我をした。より具体的に云うとランニング中に転倒し顎を地面に叩きつけた。深夜の12時ごろの話である。 その時点ては両手の擦傷が痛いとか下顎の間接が痛いとか奥歯のセラミックが割れなくて幸いだったといった程度だが、マスクを外して見るとなにやら下部に血がついている。 顎にも擦傷があるのかとうんざりしながら歩いて帰り、血の滲んだマスクを捨てて傷口を洗おうとしたところで皮膚が割けて肉が見えているのに気付いた。 一瞬顔が青くなったが単身なので倒れるわけにはいかない。幸い血は固まっていてそれほど出血していないし、先程まで運動していたからかあまり痛みもない。 この時点で明白な選択肢は3つあった。即ち: 救急車を呼ぶ 自力で病院へ行き救急外来を受診する 応急処置して朝になったら近場の医院を受診する である。まず 3 は精神的に無理だと悟った。血も完全には止まっていないし、痛みだしたら冷静に行動できなくなるだろう。 1 はいつでも可能だったが、意識明瞭で移動にも支障がない状態では憚られた。救急車が受け入れ先病院を探すのにも時間がかかると聞く。 結局とりあえず 1 をバックアップ案とし、2 の自分で連絡して病院へ向かうことにした。まずは病院探しである。このときだいたい 00:30 AM。 最初に連絡したのは最寄りの都立病院の ER だった。ここならタクシーで10分もかからない、のだが、なんと ER が現在休止しているとの回答だった。そんなことがあるのかと驚愕したがどうしようもない。 近場に形成外科の救急外来の開いている病院はないか尋ねたところ 消防庁の相談センター の電話番号を案内された。 ここで4つの病院を紹介された。余談だが相談の対応は人間だが番号の案内は自動音声に切り替わるので録音の用意をした方が良い (一応2回くり返してくれる。) いずれも若干遠くタクシーで2、30分かかるが仕方がない。最初に連絡した最寄りの病院はその日形成外科の当直医師がいなかった。二件目でトリアージの質問をされ、受け入れ可能とのことだったので受診先が決定。このとき 00:45 AM。 診察時に脱ぎ易い服に着替え (このときまでランニングウェアだった)、健康保険証を持って病院へ向かう。ガーゼがないのでマス...

Project Euler - Problem 35

問題 原文 How many circular primes are there below one million? 日本語訳 100万未満の巡回素数は何個か? 解答 回転させた数値がすべて素数ということは、すべての桁が奇数でなければいけません(ただし2を除く)。 追記 匿名氏にコメントでご指摘頂いたのでコードを一部修正しました。 いずれかの桁に5がある場合も、回転させると必ず5の倍数が現れるので除外できます。 もっと追記 前の修正に間違いが入っているのをご指摘頂いたので修正しました。 5自体は素数なので、巻き添えで除外してはいけません。 #!/usr/bin/env perl use strict; use warnings; use feature qw/say state/; use List::MoreUtils qw/all none/; sub is_prime($) { state %memos; my $n = shift; return 0 if $n < 2; return 1 if $n == 2; return 1 if $n == 3; return $memos{$n} if exists $memos{$n}; $memos{$n} = none { $n % $_ == 0 } 2 .. sqrt $n; } sub rotate($) { my $n = shift; substr($n, 1) . substr($n, 0, 1); } sub rotations($) { my $n = shift; my %seen = ($n => 1); $seen{$n} = 1 until exists $seen{$n = rotate $n}; keys %seen; } sub is_circular_prime($) { state %memos; my $n = shift; return 0 if $n =~ /[024568]/ and $n != 2 and $n != 5; return $memos{$n} if exists $memos{$n}; my ...

Perl の新 class 構文を使ってみる

Perl 5 のオブジェクト指向機能は基本的には Python の影響を受けたものだが、データを名前空間 (package) に bless する機構だけで Perl 4 以来の名前空間とサブルーチンをそのままクラスとメソッドに転換し第一級のオブジェクト指向システムとした言語設計は驚嘆に価する。 実際この言語のオブジェクトシステムは動的型付言語のオブジェクト指向プログラミングに要求されるおよそあらゆる機能を暗にサポートしており、CPAN には Moose を筆頭とした屋下屋オブジェクトシステムが複数存在しているがその多くは Pure Perl ライブラリである。つまり「やろうと思えば全部手書きで実現できる」わけである。 そういうわけで Perl のオブジェクト指向プログラミングサポートは機能面では (静的型検査の不在という現代的には極めて重大な欠如を除けば) 申し分ないのだが、しかし Moose その他の存在が示しているように一つ明らかな欠点がある。記述の冗長さだ。 コンストラクタを含むあらゆるメソッドは第一引数としてレシーバを受ける単なるサブルーチンとして明示的に書く必要があるし、オブジェクトのインスタンス変数 (a.k.a. プロパティ / データメンバ) は bless されたデータに直接的ないし間接的に プログラマ定義の方法 で格納されるためアクセス手段は実装依存である。これはカプセル化の観点からは望ましい性質だが、他者の書いたクラスを継承するときに問題となる。ある日データ表現を変更した親クラスがリリースされると突然自分の書いた子クラスが実行時エラーを起こすようになるわけだ。 そうならないためにはインスタンス変数へのアクセスに (protected な) アクセサを使う必要があるのだが、そのためには親クラスが明示的にそれらを提供している必要があるし、そもそも Perl にはメソッドのアクセス修飾子というものがないので完全な制御を与えるならばオブジェクトの内部状態がすべて public になってしまう。 そのような事情もあり、特にパフォーマンスが問題にならないようなアプリケーションコードでは Moose のようなリッチな語彙を提供するオブジェクトシステムを使うことが 公式のチュートリアルでも推奨 されてきた。Perl コアのオブジェクトシステムの改良は...

Project Euler - Problem 18

問題 原文 Find the maximum total from top to bottom of the triangle 日本語訳 三角形を頂点から下まで移動するとき、その最大の合計値を求めよ。 解答 動的計画法 を使ってボトムアップで簡単に解くことができる問題です。 簡単のため、小さい三角形で考えることにします: 0: j 1: h i 2: e f g 3: a b c d 2行目の各点を頂点として、2行の小さい三角形が作れることが分かります。 上の例で言えば、(e, a, b)と(f, b, c)、(g, c, d)の3つです。 (e, a, b)の頂点eから末端(a、b、c、dのいずれか)に移動したとき、その数値の合計は最大でe + max(a, b)となります(maxは最大値を選ぶ関数)。同様に他の2つもf + max(b, c)、g + max(c, d)と表せます。 これらをE、F、Gとおくことにして、例を次のように書き換えます: 0: j 1: h i 2: E F G (h, E, F)からなる三角形の最大値はH = h + max(E, F)、(i, F, G)からなる三角形のそれはI = i + max(F, G)です。 Eは「頂点eから末端に至る経路の最大値」で、FやGも同様ですから、HとIは「頂点h(やi)から末端に至る経路の最大値」となります。 これを先ほどと同様に置き換えて: 0: j 1: H I 頂点jから末端に至る経路の最大値はJ = j + max(H, I)となり、これが解です。 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; use List::Util qw/max/; my @rows = map { [ split /\s+/ ] } <DATA>; until (@rows == 1) { my $curr_row = $rows[-2]; my $bigger_branch; for (my $i = 0; $i < @$curr_row; $i++) { $bigger_branch = ma...