Easy coroutines?

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
[download]

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++]->(@_);
      }
    };
      }
    }
  }
}
[download]

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?

Back to Meditations