マッチオブジェクト超入門 #Perl6

Perl 6 におけるマッチオブジェクトの改善は、地味ですが重要なものです。

Perl 5 の正規表現はとても成功したので、今では主要なプログラミング言語はこれを取り込んでいますが、制限もそのまま移植されています。Python (2~3) の場合を見てみましょう。以下では、Python での正規表現マッチをテストケースの形でデモしています。

a.match-obj.py

#!/usr/bin/env python

from unittest import TestCase, TestProgram
from re import compile as regex

class T(TestCase):
    def test0(self):
        re = regex(r'\A((.)(.))(.)\Z')
        mo = re.search('abc') # match object
        expected = '_sre.SRE_Match', str, str
        got = type_string(mo), type(mo.group()), type(mo.group(1))
        self.assertEquals(expected, got)

def type_string(obj):
    return str(type(obj)).split()[1][1:-2]

if __name__ == '__main__':
    TestProgram()

$ ./a.match-obj.py
.
----------------------------------------------------------------------
Ran 1 test in 0.001s

OK

何が言いたいかというと、たとえパターンが再帰的な構造をしていても、マッチオブジェクトはたかだか文字列の配列のようなものに平坦化されてしまうということです。

同じ正規表現 --- ( ( . ) ( . ) ) ( . ) --- でも、Perl 6 の場合は事情が違ってきます。正規表現の入れ子構造が、マッチオブジェクトにそのまま反映されます。

b.match-obj.t6

#!/usr/bin/env perl6

use v6;
use Test;
plan *;

# match object.
my $mo = 'abc' ~~ /^ ( ( . ) ( . ) ) ( . ) $/;
my $expected = $mo.WHAT.gist; # Str は、正しく機能しない。

test :$mo;
$mo = $mo[0];
test :$mo;
$mo = $mo[0];
test :$mo;

sub test(:$mo!)
{
    my $got = $mo.WHAT.gist;
    is $expected, $got;
}

$ ./b.match-obj.t6
ok 1 - 
ok 2 - 
ok 3 -

外側のマッチオブジェクト ($mo) は 2 個の子マッチオブジェクトを含んでおり、特に $mo[0] は、その内側に孫マッチオブジェクトをやはり 2 個含んでいます。

今回の残りでは、いくつかのパターンについて、どのようなマッチオブジェクトが得られるか調べてみます。この目的のため dump-any-match-obj() という関数を定義しました。また 3 日に定義した Appendable、MemOut も使います。

c.dump-any-match-obj.t6

#!/usr/bin/env perl6

# 念のため Unix 版の rakudo-star-2012.11 を使ってください。

use v6;
use MemOut;
use Test;
plan *;

my $text = '0ab123c';

grammar G0 { ... }
grammar G1 { ... }
grammar G2 { ... }
grammar G3 { ... }

my $expected0 = q :to '!';
"TOP":
  0:
    0:
      0
    1:
      a
    2:
      b
!

my $expected1 = q :to '!';
"TOP":
  0ab123c
!

my $expected2 = q :to '!';
"TOP":
  "x":
    0:
      0
    1:
      1
    2:
      2
    3:
      3
  "y":
    0:
      a
    1:
      b
    2:
      c
!

my $expected3 = q :to '!';
"TOP":
  "z":
    0:
      "x":
        0
    1:
      "y":
        a
    2:
      "y":
        b
    3:
      "x":
        1
    4:
      "x":
        2
    5:
      "x":
        3
    6:
      "y":
        c
!

test G0, $expected0;
test G1, $expected1;
test G2, $expected2;
test G3, $expected3;

sub test($grammar, $expected)
{
    $grammar.parse($text);
    my $a = MemOut.new();
    dump-any-match-obj :index<TOP>, :$a, :obj($/);
    is $a.Str, $expected;
}

grammar G0
{
    token TOP { ^ ( ( . ) ( . ) ( . ) ) .* $ }
}

grammar G1
{
    token TOP { ^ [ \d | \D ]* $ }
}

grammar G2
{
    token TOP { ^ [ <x> | <y> ]* $ }
    token x { \d }
    token y { \D }
}

grammar G3
{
    token TOP { ^ <z>* $ }
    token z { <x> | <y> }
    token x { \d }
    token y { \D }
}

sub dump-any-match-obj(:$index!, :$obj!, Appendable :$a!, :$indent = '')
{
    my &recurse := &?ROUTINE;
    $a.s($indent).s($index.perl).g(':');
    my @keys := $obj.keys;
    my $deeper = $indent ~ '  ';
    if @keys.elems == 0 && $obj.elems == 0 {
        $a.s($deeper).g($obj.Str);
        return;
    }
    for @keys -> $key {
        next if $key ~~ / \d+ /; # avoid infinite recursion.
        next if $key eq ''; # noise.
        &recurse(:index($key), :obj($obj{$key}), :$a, :indent($deeper));
    }
    loop (my $i = 0; $i < $obj.elems; $i++) {
        &recurse(:index($i), :obj($obj[$i]), :$a, :indent($deeper))
    }
}

$ perl6 -I../a.streams c.dump-any-match-obj.t6
ok 1 - 
ok 2 - 
ok 3 - 
ok 4 -