Rintaro日記

Coroっていうモジュールがあります。Coroutine っていう概念を理解してないのもあり、 dmakiさんの記事で、なんとなく、 非同期でいろいろ出来るようになるモジュールなんだろうな、っていうくらいにしか考えて 無かったんですが、本質的にはちょっとイメージが違ったっぽいっす。

全然間違っているかもだけど、現在の僕の理解を書いてみます。

Coro.pm のソースを見てると、Coro::Stateをベースクラスにしてます。 このCoro::State、ドキュメント読んでても英語が不得意なせいもあり、よく分からなかったんですが、 いろいろいじってるうちに、なんとなく、「現在の実行状態（レキシカル変数や、関数スタック）を保存 しておける箱」っていうのが見えてきました。

といっても意味分からないっすね。

とりあえずサンプルコード

use Coro::State;

$::main = Coro::State->new();

$::sub = Coro::State->new(sub{
  print "in sub.\n";
  $::sub->transfer($::main);
  print "in sub again.\n";
  $::sub->transfer($::main);
});

print "in main.\n";
$::main->transfer($::sub);
print "back to main.\n";
$::main->transfer($::sub);
print "back to main again.\n";
__END__

こんな感じ。実行すると、

in main.
in sub.
back to main.
in sub again.
back to main again.

と表示されました。

順を追って説明します。まず

$::main = Coro::State->new();

で空の箱を作ります。 この中に実行状態を保存するわけですが、Coro::Stateでは、状態の保存と同時に別の Coro::State に処理を移す必要があります。というわけで、別のCoro::Stateを作ります。 空のCoro::Stateには飛ばせないので、作成時に実行状態を与えてあげます。

$::sub = Coro::State->new(sub{ ... });

こうすることで、「引数の sub{ ... } 実行直前」という状態を持ったCoro::Stateが作成されます。 一個目のprint文を実行した後:

$::main->transfer($::sub);

これで、$::main に現在の実行状態を保存しつつ、$::sub に処理が移り、 $::subが実行開始されます。

"in sub." を表示した後：

$::sub->transfer($::main);

$::sub に現在の実行状態、つまり「無名関数の一つ目のprint文の後まで進んだ」 という状態が保存されつつ、 $::main に処理が戻り、transfer した直後から処理が再開され、 "back to main." を表示、以下続く。

とかそんな感じです。

Stateを複数作って、処理を途中で投げ出してあらぬところに飛んでいったり、またあらぬところから 処理が戻ってきたりできちゃいます。goto でも似たようなことが出来そうだけど、レキシカル変数や スタックが保存されているのが大きな違い。変数が共有されるPerlインタプリタを複数作って、その 間を行ったり来たりする感じに近いっぽい。

Coro.pm は Coro::State を隠蔽して、Coro::State オブジェクトの管理を自動化しているです。

ところで、スレッド等と違って同時実行されるわけではなくて、あくまで一つが動いている間は、 他は止まっているってドキュメントに書いてあるのに、なんで非同期処理が出来るんだ？ って 思ったら、これとイベント系のモジュール(see Coro::AnyEvent）を組み合わせると非同期プログラミングが楽に出来るぜって話なのかと。 それにはイベント系のモジュールを理解しないと分からないっぽいので勉強する時間があったら。

なんでCoroに手を出したかって言うと、use Perl; の記事 見て、Generator は、 Coro で出来るよんって書いてあって、何ですかそれ？ってな具合です。

CPANに Coro::Generator っていうのが上がってて、 なるほどねーって感じだったんだけど、バグっぽかったので、一から書き直してAttribute::Generator を 作ってみたのでした。

けど遅くては意味ないのです＞＜

Pythonにジェネレータって仕組みがありますね。 簡単に言うと、「値を返しつつ、途中から再開出来る関数」。 ジェネレータを実行すると、イテレータを返して、それに対してnextメソッドを呼ぶ度に 次の yield まで進んで、yieldの引数を nextの返値として返してくれます。

そういうのをPerlでやりたくて、 Iterator::Simple とかを作ってたのですが、 実行状態の保存をクロージャで自前実装しなきゃいけなかったりで、結構めんどう でした。

なんとなく解決出来そうな気がしたので、勢いで実装して Attribute::Generator というモジュールをCodeReposに上げました。

使い方は簡単。適当な関数にGeneratorアトリビュートつけて、 その中で yield 呼ぶだけです。

use Attribute::Generator;

sub fib:Generator {
  my($x, $y) = (0, 1);
  while(1) {
    yield $y;
    ($x, $y) = ($y, $x+$y);
  }
}

まず。fib() を実行してイテレータを得ます。

my $iter = fib();

あとは $iter->next する度に、1, 1, 2, 3, 5, 8, 13, 21, 34, ... と値を返してきます。 Iterator::Simpleと違って、yieldの直後から再開します。whileの途中からでも問題ありません。 クロージャでごにょごにょする必要もありません。

しかし・・・

遅いです（泣）。うちの環境で 50 万回 next 呼ぶのに 7秒くらいかかります。 こういうのって、メモリに乗り切らないくらい大量のデータを一つ一つ処理したい時に 使うことが多いのに、これでは使いものになりません（泣）

バックエンドに Coro::State というモジュール使って、関数の実行状態を保存しつつ メインロジックと行ったり来たりして実装してるのですが、そのスイッチに時間がかかるみたい。

どうしようもないかなー。誰か助けてください><

Coro::State については、また今度書けたら書きます。

以前 、「クラスメソッドのエクスポート」っていう記事を書きましたけど、やっぱりインポートする側が自由にやりたいよね、ってことで、

use Import qw(FormValidator::Simple#check as Validate);

とすると、FormValidator::Simple->check() を呼び出す Validate関数 を定義してくれる Import.pm ってのを考えてみました。

つまり、

$result = FormValidator::Simple->check($query => $profile);

と書く代わりに、

$result = Validate($query => $profile);

と書けるようになります。

package Import;

use strict;
use warnings;

sub import {
    my($self, $class_method, %op) = @_;
    return if not $class_method;

    my($class, $method) = split /#/, $class_method, 2;
    my($importer, $call_file, $call_line) = caller;

    my $as = exists $op{as} ? $op{as} : $class;
    if($as !~ /^[_a-zA-Z][_a-zA-Z0-9]*$/) {
        require Carp;
        Carp::croak qq{Invalid function name '$as'}
    }

    # require
    {
        my $module = (exists $op{from} ? $op{from} : $class) . '.pm';
        $module =~ s{::}{/};
        if(not $INC{$module}) {
            eval qq{#line $call_line "$call_file"\n require(\$module); };
            if($@ && (exists $op{from} || $@ !~ /^Can't locate .*? at/)) {
                die $@;
            }
        }
    }

    $method ||= 'new';
    my $func = $class->can($method);
    if(not $func) {
        require Carp;
        Carp::croak qq{Can't locate '$method' method in package '$class'}
    }

    my $f = sub { unshift @_, $class; goto &$func };
    no strict 'refs';
    *{"${importer}::$as"} = $f;
}

1;
__END__

=head1 NAME

Import - Import class method

=head1 SYNOPSIS

  use Import qw(URI#new as URI);

  $uri = URI('http://www.fs-output.com/');

使い方としては

use Import qw(クラス名#メソッド名 as 関数名 from モジュール名);

です。

モジュール名はオプションで、目的のクラスが、そのクラス名とは違うモジュール内で定義されている場合に使用します。具体的には、 fromで指定されたモジュールをrequireします。

メソッド名もオプションで、デフォルトは'new'です。

また、関数名もオプションで、省略された場合はクラス名を使用します。ただし、クラス名が '::' を含む場合はエラーになるので、必ず as で関数名を指定する必要があります。

というわけで、次の二つの使い方は同等です。

use Import qw(URI);
use Import qw(URI#new as URI from URI);

ちなみに、これで作った関数は普通に Class->method(args) と呼び出すよりかなり遅いです。目的のクラスメソッドが何もしないメソッドの場合、3.5倍くらいの時間がかかります。もちろん、普通にそれなりの処理をするメソッドの場合はその差は縮まるのですが。。

悩ましいのがここ:

    my $f = sub { unshift @_, $class; goto &$func };

ここを、

    my $f = sub { $func->($class, @_) };

に変えると、ネイティブの場合とたいして変わらないスピードになるのですが、内部でcroakされた場合に、Import.pm内でのエラーとなってしまって、デバッグが面倒に。

ま、ループで何万回も廻すでもない限り、大きな差は出ないだろうから、このままでいいっすわ。

前のエントリを考えてるときに、CORE::GLOBAL::caller をlocalで定義してやればいいんでないかと:

sub UNIVERSAL::base {
    my $class = shift;
    local *CORE::GLOBAL::caller = sub(;$) {
        my $height = $_[0] || 0;
        CORE::caller(1) eq __PACKAGE__ ? $class : CORE::caller($height+1);
    };
    base->import(@_);
}

こんなコードを書いてみたものの、うまく行かなかった（base.pmのcallerでCORE::GLOBAL::callerが呼び出されない）。

なんでー？と思っていろいろ漁ってたら、perlmonksに答えがありました。 callerが呼ばれるコードがコンパイルされる前にCORE::GLOBAL::callerを定義しておかなければいけないんですね。

ってことはSub::Uplevelなんかも同じなはず。ソース見ると

# We must override *CORE::GLOBAL::caller if it hasn't already been 
# overridden or else Perl won't see our local override later.

if ( not defined *CORE::GLOBAL::caller{CODE} ) {
    *CORE::GLOBAL::caller = \&_normal_caller;
}

と、一応その対策はされているんだけど、useされるのが遅れたらだめじゃないの? と思って

sub foo { warn join ' - ', caller;}
use Sub::Uplevel;
sub bar { warn join ' - ', caller;}

sub baz {
    uplevel 1, \&foo;
    uplevel 1, \&bar;
}

#line 123
baz();

こんなコードを実行してみたら、案の定、

Sub::Uplevel - /usr/lib/perl5/site_perl/5.8.8/Sub/Uplevel.pm - 93 at uplevel.pl line 1.
main - uplevel_test.pl - 123 at uplevel.pl line 3.

だそうで。

ということは base.pmがコンパイルされる前に確実にUNIVERSAL::baseがコンパイルされないと実現 不可能。そんなのは無理な相談なので、CORE::GLOBAL::callerの案は却下になったのでした。

やっぱCORE::GLOBAL:: いじるのはよっぽどの時にしか使えないなーと実感。

http://d.hatena.ne.jp/fbis/20070816/1187247587

いろいろ試してみたのですが、結局この程度。

sub UNIVERSAL::base {
    my $class = shift;
    local $" = ' '; # ensure 
    eval qq{
        package $class;
        use base qw(@_);
    };
    Carp::croak $@ if $@;
}

evalするのは変わらないのだけど、既に@ISAに入っているののスキップ処理はbase.pmもやってくれてるので不必要ですよ、と。それだけっす＞＜。

どうせならってことで、もっと凶悪に、インスタンスで呼び出したら、そのインスタンスでのみ継承するようなUNIVERSAL::baseを。

package UNIVERSAL::base;
use strict;
use warnings;

sub UNIVERSAL::base {
    ref($_[0]) ? goto &_ref_base : goto &_class_base;
}

sub _class_base {
    my $class = shift;
    local $" = ' '; # ensure 
    eval qq{
        package $class;
        use base qw(@_);
    };
    if($@) {
        require Carp;
        Carp::croak $@;
    }
}

sub _ref_base {
    require Symbol;
    require Scalar::Util;
    my $obj = shift;
    my $class = ref($obj);
    my $pkg = $class . '::_' . Scalar::Util::refaddr($obj);

    _class_base($pkg, $class, @_); # private package inherits original and ...
    no strict 'refs';
    *{$pkg . '::DESTROY'} = sub {
        my $self = shift;
        bless $self, $class; # rebless to original class.
        Symbol::delete_package($pkg);
    };

    bless $obj, $pkg; # rebless to private package.
}

1;

専用の名前空間作って、そこで元クラスと目的のクラス継承しておき、インスタンスをreblessするっていうかなり強引なことに。

一応、

use UNIVERSAL::base;
use Hoge;

my $obj = Hoge->new();
$obj->base('Foo');

ってやると、Hogeクラス自体はFooを継承してないけど、$obj は isa('Hoge')でありつつ、 Fooも継承してます、ってな具合で。

使い道あるんでしょーか・・・

たまにはPerlから離れて。

友人と下位互換、上位互換、前方互換、後方互換の話をしていて、間違えやすいといえば昇順、降順も間違えている人多いよねー。ってな話の中で:

俺: 正順 逆順 とかの方が、間違えるひとは少ないかもね。
俺: 正ってなんだよ、って議論は置いておいて。
友: 困る単位がありそうだなあ
友: 二酸化炭素の量とか、空気中の。
友: 戦争の数とか

はて？ 単純に%やら数で表せるし、別に問題ないんじゃね？

友: ネガティブなものだと正順だと違和感あるかも

その発想はなかったよ。

理系だとか文系だとかじゃない、なにか大切なものが僕から抜け落ちてるんではないかと思った。

ところで、アルファベットのソートとか、日付や角度だとかを「昇降」で考えるのって違和感ありません？

http://d.hatena.ne.jp/tokuhirom/20070727/1185553138

より一般化するとこんな感じっすかね。

perl -MUNIVERSAL::require -e'$t=shift;$t->require;die join " ",grep{defined&{"${t}::$_"}}keys%{"${t}::"}' モジュール名

ただ、これで親クラスから継承しているメソッドも含めて取れると誤解する人が居るかもしれないので補足。

これで取れるのはそのクラスで直接定義されているメソッドだけで、親クラス(@ISA)で定義されているメソッドは取れない。継承しているものも含め全部取るなら@ISAを再帰的にたどってそれぞれ調べていかなければならないのでけっこう面倒。やっぱClass::Inspector使うのが楽ですね。

perl -MUNIVERSAL::require -MClass::Inspector -e'$t=shift;$t->require;die "@{Class::Inspector->methods($t)}"' モジュール名

ちなみに最初のとほぼ等価なのは Class::Inspector->functions($t) でOK。

Perlモジュールの慣例として、最後に 1; を書くというのがありますよね。 perldoc perlmodやperldoc -f require にも書いてある由緒正しい慣例。

これは、require時に初期化が正常に実行されたことを示すためにtrue値を返さなければならないからだけど、 これを __PACKAGE__; (クラス名）にしようよ！っていう提案です。

なぜなら

use UNIVERSAL::require;
SomeClass->require->new();

って出来るから。

それだけです。それだけだけど、何の意味もない1を返すよりはマシじゃないっすか？

ってこんな誰も見てないブログで書いてもしょうがないけど ＞＜

ふと思いついて、CPAN検索したらいくつか既存モジュールあったけど、 英語読むのがめんどくさくてソースも長くて読むのがめんどくさかったので、 試しもせずに車輪の再発明をしてみました。

要はYet Another な Object::Realize::Later や Class::LazyObject です。

コンストラクタのコストが高いオブジェクトってありますよね、それらに対して、 使うかどうか分からないけど、一応newしておきたい。 アプリの初期化時にnewしたいけど、初期化でもたつきたくないので、実際に使う時までコンストラクタを遅延したい。 なんていう時に使います。

使い方は簡単

use Class::Lazy;
my $foo = YourHeavyClass->lazy::new(@args);

これだけ。つまりコンストラクタメソッドの前に lazy:: をつけるだけです。

あとは、この $foo に対してメソッドを呼び出した時点でフックされてコンストラクタ実行され、 その返値に対してメソッドが実行されます。 それ以降は $foo自体がすでにきちんと初期化されたオブジェクト（コンストラクタの返値）になっているので、 通常通りの動作をします。

package Class::Lazy;

use strict;
use warnings;
our $VERSION = '0.01';

sub AUTOLOAD {
    if(@{$_[0]} > 1) {
        my($caller, $constructor, $class, @args) = @{$_[0]};
        my $thing = $class->$constructor(@args)
            or die qq{Can't construct "$class" object with "$constructor"}
                . qq{at $caller->[1] line $caller->[2].\n};
        @{$_[0]} = $thing;
    }
    $_[0] = $_[0][0]; # realize it!

    our $AUTOLOAD =~ s/^.*:://o;
    my $method = $_[0]->can($AUTOLOAD);
    goto $method if $method;

    # method not found!
    shift->$AUTOLOAD(@_); # die?
}

# Override UNIVERSAL methods.
sub isa { $_[0][2]->isa($_[1]) };
sub can { $_[0][2]->can($_[1]) };

# Do not have to AUTOLOAD this.
sub DESTROY { undef; }

###########################################################################
package lazy;

sub AUTOLOAD {
    my $constructor = substr(our($AUTOLOAD), 6); # 6 == length('lazy::')
    bless [[caller()], $constructor, @_], 'Class::Lazy';
}

__END__

一度初期化されるまで、ref()の値が本来のものと違うとか、 overload されたオブジェクトでoverloadが有効にならないとか、 いろいろ制限はありますが、素直なメソッドによるオブジェクト操作だけなら有用なんではないかと思います。

2007/07/27追記

オーバーロードに対応して、もうちょっときちんとしたものをTracのプロジェクトページ に置きました。

今回は一般的なオブジェクトとしても、またハッシュリファレンスとしても使用できるオブジェクトのインターフェイスと その実装方法について考えてみよう。つまり:

$obj->foo();
$obj->{foo};

両方のインターフェイスを正式にサポートするオブジェクトだ。

Perlでは一般的にオブジェクトをハッシュリファレンスとして扱うことは良くないこととされている。 それは、普通オブジェクトはblessされたハッシュリファレンスとして実装され、そのハッシュに直接アクセスする ことはカプセル化を壊すことになるからだ。

しかし、ハッシュとしてアクセスした方が自然なオブジェクトもある。そんな時に使われるのがtied hash、最近は あまり使われていないようだが、*DBM_File 系のモジュールでおなじみのアレ。

また、別の話としてPerlではオブジェクトに存在しないメソッドが呼ばれたときに呼び出されるAUTOLOADという 仕組みが用意されている。その使い方については 弾さんの説明 を読んでいただくとして、この仕組みを 利用してメソッドを仮想的または動的に作ることができる。

という前振りをしつつ、、、