In
this node Limbic~Region talked about the challenge of writing coroutines in perl5. I decided to take up that challenge and try to create coroutines in perl5 without source filters and without obfuscated syntax. After finally figuring out how attributes.pm works I came up with the following (using Limbic~Region's example):
use strict;
use Coroutine;
sub create : coroutine {
my $foo = shift;
my @bar = @_;
yield{
print "$_\n" for @bar;
$foo++;
}
yield{
print "$foo\n";
rand() > .5 ? 'weird' : ++$foo;
}
yield{
print "The end is near - goodbye cruel ";
pop @bar;
}
}
my $wacky = create(42, 'hello', 'world');
print $wacky->(42, 'hello', 'world'), "\n";
print $wacky->(), "\n";
print $wacky->(), "\n";
print $wacky->(), "\n";
__END__
hello
world
42
43
44|weird
The end is near - goodbye cruel world
Here is the code for Coroutine.pm:
package Coroutine;
use base qw(Exporter);
our @EXPORT = qw(MODIFY_CODE_ATTRIBUTES yield);
our %classes;
sub MODIFY_CODE_ATTRIBUTES {
my ($class,$ref,$attr) = @_;
if ($attr ne "coroutine") {
return $attr;
}
bless $ref,"COROUTINE";
$classes{$class}=1;
no strict 'refs';
return ();
}
# allows for some syntatic sugar
sub yield(&@){
@_;
}
1;
CHECK{
no strict 'refs';
foreach my $caller (keys %classes) {
foreach my $sym (keys %{"${caller}::"}) {
my $glob = ${"${caller}::"}{$sym};
my $code = *$glob{CODE};
if ($code && ref($code) eq "COROUTINE" ) {
my $full_name = "${caller}::$sym";
*$full_name = sub{
my @subs = $code->(@_);
# verify that subs are subs
foreach (@subs) {
if (ref($_) ne "CODE") {
require Carp;
Carp::croak("a 'coroutine' sub must return a list of CODE re
+fs, not: '$_'");
}
}
my $i = 0;
# closure walks through list of subs
return sub{
if ($i==@subs) {
return undef;
}
$subs[$i++]->(@_);
}
};
}
}
}
}
All subroutines that are marked as "coroutine" must return a list of subs. When these subroutines are called their list is intercepted and wrapped in a closure that will call the next sub in the list each time it is called. This closure is returned as the the return value of the "coroutine". the "yield" function just provides some syntatic sugar so it looks like you have yield blocks. The code needs some cleaning up but it seems to allow the use of coroutines in a fairly easy to use fashion?
What do you think?
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.