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 refs, not: '$_'");
	    }
	  }
	  my $i = 0;
	  # closure walks through list of subs
	  return sub{
	    if ($i==@subs) {
	      return undef;
	    }
	    $subs[$i++]->(@_);
	  }
	};
      }
    }
  }
}