root/lang/perl/Attribute-Generator/trunk/lib/Attribute/Generator.pm @ 22898

Revision 22898, 4.3 kB (checked in by rintaro, 5 years ago)
  • $generator->send(EXPR) を実装
Line 
1package Attribute::Generator;
2
3use strict;
4use warnings;
5our $VERSION = '0.01';
6
7use Attribute::Handlers;
8use Coro::State;
9#use Scalar::Util ();
10
11use base qw(Exporter);
12
13our @EXPORT = qw(yield);
14
15sub UNIVERSAL::Generator : ATTR(CODE) {
16    my($package, $symbol, $refent) = @_;
17    no warnings 'redefine';
18    *{$symbol} = sub { Generator::State->new($refent, @_); };
19}
20
21my @stack = (Coro::State->new()); # Generator stack;
22
23sub yield {
24    my $cur = pop @stack;
25    $cur->{_sent} = $_[0];
26    $cur->transfer($stack[-1]); # back
27    delete $cur->{_sent}; # from send()
28}
29
30{
31    package Generator::State;
32    use base qw(Coro::State);
33
34    use overload (
35        '@{}' => '__list__',
36        '<>'  => 'next',
37    );
38
39    sub _run_generator {
40        eval {
41            &{+shift}; #execute the code
42        };
43
44        $stack[-1]{_throw} = $@ if $@;
45        while() {
46            my $cur = pop @stack;
47            $cur->transfer($stack[-1]); # back
48            delete $cur->{_sent};
49        }
50    }
51
52    sub new {
53        shift->SUPER::new(\&_run_generator, @_)
54    }
55
56    sub next {
57        my($self) = @_;
58        push @stack, $self;
59        $stack[-2]->transfer($self); # resume
60        return delete $self->{_sent} if exists $self->{_sent}; # from yield
61
62        # finished
63        die delete $self->{_throw} if exists $self->{_throw}; # dead.
64        return;
65    }
66
67    sub send { $_[0]{_sent} = $_[1] };
68
69    sub __list__ {
70        my($self) = @_;
71        my @ret;
72        while(defined($_ = $self->next)) {
73            push @ret, $_;
74        }
75        \@ret;
76    }
77}
78
79#sub iter {
80#    my($obj) = @_;
81#
82#    if(ref $obj eq 'ARRAY') {
83#        return Generator::State->new(sub { yield $_ for @{+shift} }, $obj);
84#    }
85#    if(ref $obj eq 'GLOB') {
86#        return Generator::State->new(sub { my $o = shift; yield $_ while <$o> }, $obj);
87#    }
88#    if(Scalar::Util::blessed $obj) {
89#        if($obj->can('next')) { # next method is a good thing :)
90#            return $obj;
91#        }
92#        if(my $m = $obj->can('__iter__')) {
93#            return iter($m->($obj)); # re-iter() to ensure returned object is a generator;
94#        }
95#        if(my $m = $obj->can('__list__')) {
96#            return iter($m->($obj)); # re-iter() to convert listref to generator;
97#        }
98#    }
99#    die "Could not convert to iterator";
100#}
101
102#sub list {
103#    my($obj) = @_;
104#    if(ref $obj eq 'ARRAY') {
105#        return $obj;
106#    }
107#    if(ref $obj eq 'GLOB') {
108#        return [<$obj>];
109#    }
110#    if(Scalar::Util::blessed $obj) {
111#        if(my $m =(overload::Method($obj, '@{}') || $obj->can('__list__'))) {
112#            return list($m->($obj)); # re-list() to ensure
113#        }
114#    }
115#    die "Could not convert to list";
116#}
117
1181;
119__END__
120
121=head1 NAME
122
123Attribute::Generator - Python like generator powered by Coro
124
125=head1 SYNOPSIS
126
127  use Attribute::Generator;
128 
129  sub fizzbuzz :Generator {
130    my($i, $end) = @_;
131    do {
132      yield (($i % 3 ? '':'Fizz').($i % 5 ? '':'Buzz') || $i)
133    } while $i++ < $end;
134  }
135 
136  my $generator = fizzbuzz(1, 100);
137 
138  while(<$generator>) {
139    print "$_\n";
140  }
141
142=head1 DESCRIPTION
143
144Attribute::Generator realizes Python like generators using the power of L<Coro>
145module. This module exports C<yield> function which is like C<yield> in Python.
146
147=head1 FUNCTIONS
148
149=over 4
150
151=item :Generator attribute
152
153This CODE attribute declares generator. When generator subroutines are called,
154returns an iterator object that has next() method.
155
156=item $generator->next()
157
158Advances generator until next yield called.
159
160=item $generator->send(EXPR)
161
162Send a value to the generator. In generator subroutine, sent value can be
163received as return value of yield(): e.g.
164
165  sub foo:Generator {
166    my $i = 0;
167    while() {
168      if(defined yield $i++) {
169        $i=0;
170      }
171    }
172  }
173
174This generator, yields 0, 1, 2, 3.. , can be reset by calling $gen->send(1).
175
176Returns the generator itself.
177
178Note: Unlike Python, send() does *NOT* advances iterator.
179
180=item yield EXPR
181
182When you call yield in generator, current status of the generator are frozen
183and EXPR is returned to the caller of $generator->next().
184
185Note that calling yield() outside of :Generator subroutines are strictly
186prohibited.
187
188=back
189
190=head1 AUTHOR
191
192Rintaro Ishizaki E<lt>rintaro@cpan.orgE<gt>
193
194=head1 SEE ALSO
195
196L<Coro::State>
197
198=head1 LICENSE
199
200This library is free software; you can redistribute it and/or modify
201it under the same terms as Perl itself.
202
203=cut
Note: See TracBrowser for help on using the browser.