Yappo::タワシ

■RubyのFiberをPerlでも

package Fiber;
use strict;
use warnings;
use Carp ();

sub new (&@) {
    my $code = shift;

    bless {
        code  => $code,
        block => 0,
        now   => 0,
    }, __PACKAGE__;
}

sub run (&@) {
    Carp::croak q!Can't call Fiber::run {} outside Fiber::new {} block!;
}
sub yield (&@) {
    Carp::croak q!Can't call Fiber::yeild {} outside Fiber::new {} block!;
}

sub resume {
    my $self = shift;
    return if $self->{block} < 0;

    unless ($self->{block}) {
	my @blocks;
	{
            no warnings 'redefine';
            local *yield = sub { @_ };
            local *run   = sub { @blocks = @_ };
            use warnings;
            $self->{code}->();
	}
        $self->{blocks} = \@blocks;
	$self->{block}  = scalar(@blocks);
	$self->{block}  = -1 unless $self->{block};

	$self->{now} = 0;
    }
    Carp::croak 'dead fiber called (FiberError)' unless $self->{block} > $self->{now};

    $self->{blocks}->[$self->{now}++]->(@_);
}
1;

use strict;
use warnings;
use Fiber;

my $f = Fiber::new {
    my $i = 0;
    warn "init: " . $i++;
    Fiber::run {
        warn "1";
    } Fiber::yield {
        warn "2: ($_[0]) " . $i++;
    } Fiber::yield {
        warn "3";
        return $i;
    }
};

$f->resume;
$f->resume('args');
warn "LAST: " . $f->resume;

$ perl ./mock.pl 
init: 0 at ./mock.pl line 7.
1 at ./mock.pl line 9.
2: (args) 1 at ./mock.pl line 11.
3 at ./mock.pl line 13.
LAST: 2 at ./mock.pl line 20.

俺のつくりたいのはこんなんじゃなくて外部イテレータとかも出来るようにしたいの！！

Permalink | コメント(0) | トラックバック(1) | 22:08

■Scope::Upper

use strict;
use warnings;

{
    package Y;

    sub foo {
        warn "foo: start";
        bar();
        warn "foo: end";
    }

    sub bar {
        warn "bar: start";
        package X;
        use Scope::Upper qw( reap localize :words);
        reap sub {
            my $pkg = caller;
            warn "REAP: $pkg";
        } => HERE;

        sub {
            my $pkg = caller;
            warn "FUNC: $pkg";
        }->();
        warn "bar: end";
    }
}

warn "START";
Y::foo;
warn "END";

を実行すると

$ perl ./scopeupper.pl 
START at ./scopeupper.pl line 30.
foo: start at ./scopeupper.pl line 8.
bar: start at ./scopeupper.pl line 14.
FUNC: X at ./scopeupper.pl line 24.
bar: end at ./scopeupper.pl line 26.
REAP: Y at ./scopeupper.pl line 19.
foo: end at ./scopeupper.pl line 10.
END at ./scopeupper.pl line 32.

HERE を TOP に変えると

$ perl ./scopeupper.pl 
START at ./scopeupper.pl line 30.
foo: start at ./scopeupper.pl line 8.
bar: start at ./scopeupper.pl line 14.
FUNC: X at ./scopeupper.pl line 24.
bar: end at ./scopeupper.pl line 26.
foo: end at ./scopeupper.pl line 10.
END at ./scopeupper.pl line 32.
REAP: main at ./scopeupper.pl line 19.

HERE を SUB に変えると

$ perl ./scopeupper.pl 
START at ./scopeupper.pl line 30.
foo: start at ./scopeupper.pl line 8.
bar: start at ./scopeupper.pl line 14.
FUNC: X at ./scopeupper.pl line 24.
bar: end at ./scopeupper.pl line 26.
REAP: Y at ./scopeupper.pl line 19.
foo: end at ./scopeupper.pl line 10.
END at ./scopeupper.pl line 32.

HERE を UP に変えると

$ perl ./scopeupper.pl 
START at ./scopeupper.pl line 30.
foo: start at ./scopeupper.pl line 8.
bar: start at ./scopeupper.pl line 14.
FUNC: X at ./scopeupper.pl line 24.
bar: end at ./scopeupper.pl line 26.
foo: end at ./scopeupper.pl line 10.
REAP: main at ./scopeupper.pl line 19.
END at ./scopeupper.pl line 32.

HERE を UP 1 に変えると

$ perl ./scopeupper.pl 
START at ./scopeupper.pl line 30.
foo: start at ./scopeupper.pl line 8.
bar: start at ./scopeupper.pl line 14.
FUNC: X at ./scopeupper.pl line 24.
bar: end at ./scopeupper.pl line 26.
foo: end at ./scopeupper.pl line 10.
END at ./scopeupper.pl line 32.
REAP: main at ./scopeupper.pl line 19.

HERE を SCOPE に変えると

$ perl ./scopeupper.pl 
START at ./scopeupper.pl line 30.
foo: start at ./scopeupper.pl line 8.
bar: start at ./scopeupper.pl line 14.
FUNC: X at ./scopeupper.pl line 24.
bar: end at ./scopeupper.pl line 26.
REAP: Y at ./scopeupper.pl line 19.
foo: end at ./scopeupper.pl line 10.
END at ./scopeupper.pl line 32.

HERE を SCOPE 1 に変えると

$ perl ./scopeupper.pl 
START at ./scopeupper.pl line 30.
foo: start at ./scopeupper.pl line 8.
bar: start at ./scopeupper.pl line 14.
FUNC: X at ./scopeupper.pl line 24.
bar: end at ./scopeupper.pl line 26.
foo: end at ./scopeupper.pl line 10.
REAP: main at ./scopeupper.pl line 19.
END at ./scopeupper.pl line 32.

HERE を SCOPE 2 に変えると

$ perl ./scopeupper.pl 
START at ./scopeupper.pl line 30.
foo: start at ./scopeupper.pl line 8.
bar: start at ./scopeupper.pl line 14.
FUNC: X at ./scopeupper.pl line 24.
bar: end at ./scopeupper.pl line 26.
foo: end at ./scopeupper.pl line 10.
END at ./scopeupper.pl line 32.
REAP: main at ./scopeupper.pl line 19.

といった感じで指定したスコープの末尾にぶっ込む、同じスコープだとunshiftな感じで突っ込んでく。

他にも、特定のスコープの変数をlocalしたり要素のdeleteとしたりとかとか。

下位スコープで、上位スコープのlocal *subname = sub {}; なんてのも出来るから、その辺使って変態できそう。

return 文の前に return する値を先にセットしちうっぽい unwind と 特定のスコープの wantarray がとれる want_at ってやつがあるんだけど、解釈あってるかよくわからんちん。

Permalink | コメント(0) | トラックバック(1) | 13:29