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):
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?
Here is the code for Coroutine.pm: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
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++]->(@_); } }; } } } }
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Easy coroutines?
by tilly (Archbishop) on Aug 27, 2004 at 20:11 UTC | |
by perlfan (Vicar) on Aug 30, 2004 at 16:29 UTC | |
by tilly (Archbishop) on Aug 30, 2004 at 18:18 UTC | |
by lidden (Curate) on Aug 30, 2004 at 17:37 UTC |
Back to
Meditations