if, elsif, elsif, ... なコードをどう書き直せばわかりやすいか悩む修行、その２

Perl

WEB から取ってきた文字列を標準化するコードを書いている。前回エントリを書いたところ、コメントで Regexp::Assemble (R::A) を教えてもらった。R::A オブジェクトに複数の正規表現を入れておいて、文字列をマッチさせ、どれがマッチしたか、を知ることができる。ので、やりたいことにかなり近い。しかし、456 にマッチする正規表現を見つけろ - 昨日知ったことで見たように (今のところ、私の理解では) どの正規表現を優先的にマッチさせるか、が制御できない。やりたいことはまさに if, elsif, elsif であり、lisp で言えば cond であり、マッチさせる順序が重要である。

あんまり前回から進展がないが、次のような特徴を持つように書き直してみた。

  • 正規表現を順にマッチするか調べ、マッチしたらクロージャを実行という処理をひとつの関数 cond として抜き出す
    • その関数に実際のルールを渡すようにする
  • アクションに「パターンにマッチしたもの」だけでなく、任意の変数を渡せるようにする

まず、cond 関数。とりあえず Unau::Regexp パッケージに入れてみた。

use strict;
use warnings;

package Unau::Regexp;

sub cond {
    my ($str, $rules_ref) = @_;
    foreach my $rule_ref (@{$rules_ref}) {
        my ($reg, $action) = @{$rule_ref};
        if (my @args = $str =~ $reg) {
            return $action->($@args);
        }
    }
    return;
}

第一引数の $obj は、アクションの第一引数に渡されるもの。第二引数がマッチングの対象となる文字列、第三二引数にアクションテーブルがくる。アクションテーブルは正規表現とそれにマッチしたときに実行するアクションの対が入った配列への参照。引数の順序はちょっと悩んだが、とりあえずこの順で。

cond を使っているところ。Unau::Obj オブジェクトを想定。

package Unau::Obj;
*cond = *Unau::Regexp::cond;

sub new {
    my ($class, $string) = @_;
    my $obj = {};
    bless $obj, $class;
    $obj->_init($string);
    $obj;
}

sub _init {
    my ($self, $str) = @_;
    my $ret = cond $str, [
       [qr{\A (\S+) \s* (are) \s* (.+) \z}xms =>
        sub {
            my ($n, $v, $p) = @_;
            $self->{are} = 1;
            $self->{subject} = $n;
            $self->{rest} = $p;
            return 1;
        }],
       [qr{\A (\S+) \s* (is) \s* (.+) \z}xms =>  # ... (1)
        sub {
            my ($n, $v, $p) = @_;
            $self->{is} = 1;
            $self->{subject} = $n;
            $self->{rest} = $p;
            return 1;
        }],
       [qr{\A (.*) \z}xms =>
        sub {
            my ($x) = @_;
            $self->{else} = 1;
            $self->{rest} = $x;
            return;
        }],
                             ];
    return if ! $ret;
    cond $self->{rest}, [
       [qr{\A (.*\S) \s* (which) \s* (.+) \z}xms =>
        sub {
            my ($n, $r, $p) = @_;
            $self->{relative} = 1;
        }],
      [qr{\A (a|an|the) \s* (.+) \z}xms =>  # ... (2)
       sub {
           my ($a, $n) = @_;
           $self->{article} = 1;
           $self->{object} = $n;
       }],
     [qr{\A (.*) \z}xms =>
      sub {
          my ($x) = @_;
          $self->{else} = 1;
          $self->{rest} = $x;
          return;
      }],
                   ];
}

sub stringify {
    use Data::Dumper;
    Dumper(shift);
}

package main;

my $obj = new Unau::Obj 'this is a test.';
print $obj->stringify."\n";

ここでは、アクションテーブルとして無名配列を渡している。つまり、cond の引数に直接アクションテーブルを渡している。別の配列、たとえば @rules にアクションテーブルを作っておき、cond には \@rules で渡すことも可能。ここはAnyEvent::Introで

There is also an abstraction penalty to pay as one has to name the callback, which often is unnecessary and leads to nonsensical or duplicated names.

とあるのに引きずられている。アクションテーブルを別に持ったり、関数を別に持ったりすると、そういう abstraction penalty があるよね、みたいな。

実行すると次のようになる。

[takeyuki@sunya ~]$ perl d3.pl
$VAR1 = bless( {
                 'object' => 'test.',
                 'rest' => 'a test.',
                 'subject' => 'this',
                 'article' => 1,
                 'is' => 1
               }, 'Unau::Obj' );

最初の cond では (1) にマッチし、対応するクロージャが実行され、1 (すなわち true）が $ret に返る。そして次の cond では (2) にマッチし、対応するクロージャが実行される。

追記

やっぱり cond に $self を渡す必要はないなあ、と書き換えた。ついでにパターンとアクションの間のコンマをファットコンマにしてみた。