Perl の正規表現リテラル中の変数展開を読む

Perl の正規表現リテラル中の変数展開では、文法上、 解釈にあいまいさが生じることがあります。

この文章では、Perl インタプリタのソースコードから、 実装上でどのようにあいまいさが解決されるのかを説明します。

更新履歴

2008-06-05: 公開

Perl の判断

Perl では、文字列リテラルや正規表現リテラルの中で変数展開を行えます。

use Test::More tests => 2; my $name = 'Alice'; $_ = "My name is $name"; is($_, 'My name is Alice', '$name として Alice が展開される'); s/$name/Bob/g; is($_, 'My name is Bob', 'Alice が Bob に置き換えられる');

しかし、正規表現リテラルのなかで配列の要素を展開する際には、 [ 〜 ] が配列の要素の参照にも、正規表現の文字クラスにも使われるため、 解釈に曖昧さが生じてしまいす。

use Test::More tests => 3; my @numbers= qw(zero one two); is($numbers[1], $numbers[001], '1 == 001'); $_ = 'one two three'; s/$numbers[1]/xxx/g; is($_, 'xxx two three', 'one が xxx に置き換えられる'); $_ = 'one two three'; s/$numbers[001]/xxx/g; is($_, 'xxx two three', 'one が xxx に置き換えられる');

結果、上記のテストは失敗します。

% perl 2.pl 1..3 ok 1 - 1 == 001 ok 2 - one が xxx に置き換えられる not ok 3 - one が xxx に置き換えられる # Failed test 'one が xxx に置き換えられる' # at 2.pl line 15. # got: 'one two three' # expected: 'xxx two three' # Looks like you failed 1 test of 3. %

つまり、Perl にとって s/$numbers[1]/xxx/g; と s/$numbers[001]/xxx/g; は等価ではないのです。

判断の設計

判断の根拠はどこにあるのでしょうか。

『プログラミング Perl』の「2.6.5 配列値を変数展開する」ではこの問題について

Perl は [bar] がどちらを表すかを推測するが、ほとんどのケースで適切な判断を下してくれる。

とあり、その注で

推測を行なうアルゴリズムを詳細に説明してみても、退屈なので割愛する。 基本的には、文字クラスらしく見えるもの (a-z、\w、先頭の ^) と、 式らしく見えるもの (変数や予約語) との加重平均をとって決定する。

としています。

判断の実装

それでは「退屈なので割愛」されたアルゴリズムを実際に読んでみましょう。 実装は toke.c の S_intuit_more という関数にあります。

/* S_intuit_more * Returns TRUE if there's more to the expression (e.g., a subscript), * FALSE otherwise. ... */ /* This is the one truly awful dwimmer necessary to conflate C and sed. */ STATIC int S_intuit_more(pTHX_ register char *s) {

関数の先頭のコードは省略しました。 文字クラスらしいか、式らしいかの判別は以下の部分からはじまります。

/* On the other hand, maybe we have a character class */ s++; if (*s == ']' || *s == '^') return FALSE; else { /* this is terrifying, and it works */ int weight = 2; /* let's weigh the evidence */ char seen[256]; unsigned char un_char = 255, last_un_char; const char * const send = strchr(s,']'); char tmpbuf[sizeof PL_tokenbuf * 4]; if (!send) /* has to be an expression */ return TRUE;

if 文でみているのは '[' の直後の文字です。 ']' や '^' がくれば、その時点で式ではないことが確実なので FALSE を返します。

send には s のなかで最初に ']' が出てくる位置を保持します。 (名前は s の end であって「送信」ではありません) ここで ']' が見つからない場合は文字クラスではないので、TRUE を返します。

変数 weight は「式らしさ」です。S_intuit_more の最後をみると

if (weight >= 0) /* probably a character class */ return FALSE; } return TRUE; }

weight >= 0 なら FALSE を、そうじゃなければ TRUE を返していることがわかります。

次に '[' 〜 ']' のなかの文字を順にみていくループがあります。 ループの中身を追う前に、前後を読んでおきましょう。

Zero(seen,256,char); if (*s == '$') weight -= 3; else if (isDIGIT(*s)) { if (s[1] != ']') { if (isDIGIT(s[1]) && s[2] == ']') weight -= 10; } else weight -= 100; } for (; s < send; s++) { last_un_char = un_char; un_char = (unsigned char)*s; switch (*s) { ... } seen[un_char]++; }

ループに入る前には '[' の直後の文字をみています。

[$ という並びなら weight -= 3

[数字2桁] なら weight -= 10

[数字1桁] なら weight -= 100

これらのパターンは式にありがち ($ary[$index], $ary[1], $ary[23] など) なため、どれも式側によせています。

ループの中では s, un_char が現在の文字、last_un_char が直前の文字で、 seen は文字ごとの出現回数を保持しています。

ここからは switch 文の個々の case について読んでいきます。

変数など

case '@': case '&': case '$': weight -= seen[un_char] * 10;

@, &, $ はそれぞれ、配列変数、サブルーチン呼び出し、 そしてスカラー変数の先頭につく記号です。 これらの文字が登場した時点で

weight -= いままでその文字が登場した回数 * 10

とします。 各文字の登場回数である seen をかけていて、 さらに seen は switch を抜けてからインクリメントしているので、 一回目のの登場では weight は変わりません。 二回目から式側によせています。

変数につく記号の後は、変数名があるかもしれません。

if (isALNUM_lazy_if(s+1,UTF)) { int len; scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE); len = (int)strlen(tmpbuf); if (len > 1 && gv_fetchpvn_flags(tmpbuf, len, 0, SVt_PV)) weight -= 100; else weight -= 10; }

記号に後続する文字列を識別子として読んで (scan_ident) から

変数が実際に存在する (gv_fetchpvn_flags) なら weight -= 100

変数が実際に存在しないなら weight -= 10

と、式側によせています。

else if (*s == '$' && s[1] && strchr("[#!%*<>()-=",s[1])) { if (/*{*/ strchr("])} =",s[2])) weight -= 10; else weight -= 1; } break;

ここはよくわかりませんでした。

$ の直後に [#!%*<>()-= がならび さらに ])} と続くようであれば weight -= 10

$ の直後に [#!%*<>()-= がならぶだけの場合も weight -= 1

バックスラッシュ

case '\\': un_char = 254; if (s[1]) { if (strchr("wds]",s[1])) weight += 100; else if (seen[(U8)'\''] || seen[(U8)'"']) weight += 1; else if (strchr("rnftbxcav",s[1])) weight += 40; else if (isDIGIT(s[1])) { weight += 40; while (s[1] && isDIGIT(s[1])) s++; } } else weight += 100; break;

ここでは weight への加算が続きます。大きく加算されるものと、 そうでもないものとの違いに注意してください。

'\' の後に 'w', 'd', 's', ']' のどれかが登場するのは、正規表現のメタ文字なので weight += 100

いままで ' か " が登場していれば、式のなかの文字列である可能性もあるので weight += 1

'\' の後の 'r', 'n', 'f', 't', 'b', 'x', 'c', 'a', 'v' はエスケープシーケンスなので weight += 40

'\' の後に数字が来るのは、8進数による指定なので weight += 40 して数字部分をスキップ

'\' で終わりならば weight += 100

ハイフン

case '-': if (s[1] == '\\') weight += 50; if (strchr("aA01! ",last_un_char)) weight += 30; if (strchr("zZ79~",s[1])) weight += 30; if (last_un_char == 255 && (isDIGIT(s[1]) || s[1] == '$')) weight -= 5; /* cope with negative subscript */ break;

ハイフンは正規表現の文字クラスを範囲で指定する場合に使われます。 文字クラスの範囲指定に使われがちなアルファベット ([a-z], [A-Z]) や数字 ([0-9])、ASCII の表示できる文字 ([!-~]) などが特別扱いされています。

ハイフンの後に '\' が来る場合 weight += 50

ハイフンの前が 'a', 'A', '0', '1', '!' のいずれかである場合、weight += 30

ハイフンの後が 'z', 'Z', '7', '9', '~' のいずれかである場合、weight += 30

最後の if は逆に、配列の添字として負数が指定されている場合を想定しています。

最初の [ の次に - さらに数字か $ が来た場合 weight -= 5

last_un_char == 255 は一回目のループか否かを判別しています。 関数のはじめで un_char = 255 して、 ループのはじめで last_un_char = un_char していることを思い出してください。

そのほか

default: if (!isALNUM(last_un_char) && !(last_un_char == '$' || last_un_char == '@' || last_un_char == '&') && isALPHA(*s) && s[1] && isALPHA(s[1])) { char *d = tmpbuf; while (isALPHA(*s)) *d++ = *s++; *d = '\0'; if (keyword(tmpbuf, d - tmpbuf, 0)) weight -= 150; } if (un_char == last_un_char + 1) weight += 5; weight -= seen[un_char]; break;

前の文字がアルファベットや数字でも $, @, & でもなく、 今の文字も次の文字もアルファベットなら、 アルファベットが続く限り読み、それがキーワードか否かをみています。

キーワードなら weight -= 50

反対に文字クラスらしさがあがる場合もあります。

今の文字が前の文字の次なら (a の後に b など) weight += 5

さらに、文字クラスの指定は集合なので [a] を [aa] とは書きません。 よって

weight -= いまの文字の出現回数

としています。同じ文字が複数回登場することは、文字クラスらしくないからです。

まとめ

Perl の判断基準はきわめて発見的です。迷ったらブレースでくくるのをお勧めします。

『プログラミング言語 Perl』の「2.6.5 配列値を変数展開する」から再び引用します。

あなたが (パラノイアではなく) 単に用心深い人物だったとしても、 ブレースを使うのは悪くない考えである。

以下のテストは成功します。

use Test::More tests => 3; my @numbers= qw(zero one two); is($numbers[1], $numbers[001], '1 == 001'); $_ = 'one two three'; s/${numbers[1]}/xxx/g; is($_, 'xxx two three', 'one が xxx に置き換えられる'); $_ = 'one two three'; s/${numbers[001]}/xxx/g; is($_, 'xxx two three', 'one が xxx に置き換えられる');