PerlでRecallの話

perl

Perl Coreだけで同様のことを実装できないかと考えたらあっさり出来たので。

sub recallable_sub(&) {
    use B::Deparse;
    my $coderef = shift;
    my $src     = B::Deparse->new->coderef2text($coderef);
    $src =~ s{\bRecall\s*\(}{\$coderef->\(}g;
    $coderef = eval qq"sub $src";
    die $@ if $@;
    $coderef;
}
404 Blog Not Found:perl - で(Recall()|arguments.callee()|&?BLOCK())

B::Deparse＆evalのコンボにワロタｗもはやなんでもアリじゃんコレｗ

もっとシンプルに書けないかと思って試してみた。

package Recall;

sub recall {
    shift->(@_);
}

sub recallable_sub(&;$) {
    my $coderef = shift;
    bless($coderef)->recall(@_);
}

local $\ = "\n";
print recallable_sub {
    my $recall = shift;
    $_[0] <= 1 ? 1 : $_[0] * $recall->recall( $_[0] - 1 );
}($_) for (1..9);

http://codepad.org/zFeSAYjP

こんな感じのほうがよくない？


追記

Devel::Caller が便利すぎる件について - IT戦記

用途から考えるとこっちの方がいいかな。

package Recall;

sub recall {
    $_[0]->(@_);
}

sub recallable_sub(&) {
    my $coderef = shift;
    my $obj = bless($coderef);
    sub { $obj->recall(@_) };
}

recallable_sub {
    my $recall = shift;
    my $c = shift;
    print "$c \n";
    $recall->recall($c) if ($c --);
}->(10);

http://codepad.org/g2L7KMQI

B::Deparse＆evalやDevel::Caller使わなくていい代わりに第一引数にRecallのオブジェクトが来るので微妙っちゃ微妙？んーどうだろう。