Coro/Coro/Cont.pm

=head1 NAME

Coro::Cont - continuations in perl

=head1 SYNOPSIS

 use Coro::Cont;

 # multiply all hash keys by 2
 my $cont = csub {
    yield $_*2;
    yield $_;
 };
 my %hash2 = map &$cont, %hash1;

 # dasselbe in grün (as the germans say)
 sub mul2 : Cont {
    yield $_[0]*2;
    yield $_[0];
 }

 my %hash2 = map mul2($_), %hash1;

=head1 DESCRIPTION

=over 4

=cut

package Coro::Cont;

BEGIN { eval { require warnings } && warnings->unimport }

use Carp qw(croak);

use Coro::State;

use vars qw($return);

use base 'Exporter';

$VERSION = 1.8;
@EXPORT = qw(csub yield);

{
   my @csub;

   # this way of handling attributes simply is NOT scalable ;()
   sub import {
      Coro::Cont->export_to_level(1, @_);
      my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};
      *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"} = sub {
         my ($package, $ref) = (shift, shift);
         my @attrs;
         for (@_) {
            if ($_ eq "Cont") {
               push @csub, [$package, $ref];
            } else {
               push @attrs, $_;
            }
         }
         return $old ? $old->($package, $ref, @attrs) : @attrs;
      };
   }

   sub findsym {
      my ($pkg, $ref) = @_;
      my $type = ref $ref;
      for my $sym (values %{$pkg."::"}) {
         return \$sym if *{$sym}{$type} == $ref;
      }
      ();
   }

   sub INIT {
      # prototypes are currently being ignored
      for (@csub) {
         my $ref = findsym(@$_)
            or croak "package $package: cannot declare non-global subs as 'Cont'";
         *$ref = &csub($_->[1]);
      }
      @csub = ();
   }
}

=item csub { ... }

Create a new "continuation" (when the sub falls of the end it is being
terminated).

=cut

sub csub(&) {
   my $code = $_[0];
   my $prev = new Coro::State;

   my $coro = new Coro::State sub {
      # we do this superfluous switch just to
      # avoid the parameter passing problem
      # on the first call
      &yield;
      &$code while 1;
   };

   # call it once
   push @{ $Coro::current->{yieldstack} }, [$coro, $prev];
   &Coro::State::transfer($prev, $coro, 0);

   sub {
      push @{ $Coro::current->{yieldstack} }, [$coro, $prev];
      &Coro::State::transfer($prev, $coro, 0);
      wantarray ? @_ : $_[0];
   };
}

=item @_ = yield [list]

Return the given list/scalar as result of the continuation. Also returns
the new arguments given to the subroutine on the next call.

=cut

# implemented in Coro/State.xs
#sub yield(@) {
#   &Coro::State::transfer(@{pop @$$return}, 0);
#   wantarray ? @_ : $_[0];
#}

1;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.46
Committed:	Wed Jan 25 21:43:58 2006 UTC (18 years, 4 months ago) by root
Branch:	MAIN
Changes since 1.45:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.32	Coro::Cont - continuations in perl
4	root	1.1
5			=head1 SYNOPSIS
6
7			use Coro::Cont;
8
9			# multiply all hash keys by 2
10	root	1.4	my $cont = csub {
11	root	1.8	yield $_*2;
12			yield $_;
13	root	1.1	};
14	root	1.40	my %hash2 = map &$cont, %hash1;
15	root	1.4
16	root	1.37	# dasselbe in grün (as the germans say)
17	root	1.4	sub mul2 : Cont {
18	root	1.8	yield $_[0]*2;
19			yield $_[0];
20	root	1.4	}
21
22	root	1.40	my %hash2 = map mul2($_), %hash1;
23	root	1.1
24			=head1 DESCRIPTION
25
26			=over 4
27
28			=cut
29
30			package Coro::Cont;
31
32	pcg	1.27	BEGIN { eval { require warnings } && warnings->unimport }
33	root	1.14
34	root	1.5	use Carp qw(croak);
35
36	root	1.1	use Coro::State;
37
38	pcg	1.27	use vars qw($return);
39
40	root	1.1	use base 'Exporter';
41
42	root	1.46	$VERSION = 1.8;
43	root	1.8	@EXPORT = qw(csub yield);
44	root	1.4
45			{
46			my @csub;
47
48			# this way of handling attributes simply is NOT scalable ;()
49			sub import {
50			Coro::Cont->export_to_level(1, @_);
51			my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};
52			*{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"} = sub {
53			my ($package, $ref) = (shift, shift);
54			my @attrs;
55			for (@_) {
56			if ($_ eq "Cont") {
57	root	1.5	push @csub, [$package, $ref];
58	root	1.4	} else {
59			push @attrs, $_;
60			}
61			}
62			return $old ? $old->($package, $ref, @attrs) : @attrs;
63			};
64			}
65
66	root	1.5	sub findsym {
67			my ($pkg, $ref) = @_;
68			my $type = ref $ref;
69			for my $sym (values %{$pkg."::"}) {
70			return \$sym if *{$sym}{$type} == $ref;
71			}
72			();
73			}
74
75	root	1.4	sub INIT {
76	root	1.5	# prototypes are currently being ignored
77	root	1.4	for (@csub) {
78	root	1.5	my $ref = findsym(@$_)
79			or croak "package $package: cannot declare non-global subs as 'Cont'";
80	root	1.7	*$ref = &csub($_->[1]);
81	root	1.4	}
82			@csub = ();
83			}
84			}
85	root	1.1
86	root	1.4	=item csub { ... }
87	root	1.1
88	root	1.4	Create a new "continuation" (when the sub falls of the end it is being
89			terminated).
90	root	1.1
91			=cut
92
93	root	1.4	sub csub(&) {
94	root	1.1	my $code = $_[0];
95			my $prev = new Coro::State;
96	root	1.5
97			my $coro = new Coro::State sub {
98			# we do this superfluous switch just to
99			# avoid the parameter passing problem
100			# on the first call
101	root	1.8	&yield;
102	root	1.5	&$code while 1;
103			};
104
105			# call it once
106	root	1.37	push @{ $Coro::current->{yieldstack} }, [$coro, $prev];
107	root	1.5	&Coro::State::transfer($prev, $coro, 0);
108
109	root	1.1	sub {
110	root	1.37	push @{ $Coro::current->{yieldstack} }, [$coro, $prev];
111	root	1.4	&Coro::State::transfer($prev, $coro, 0);
112	root	1.5	wantarray ? @_ : $_[0];
113	root	1.1	};
114			}
115
116	root	1.8	=item @_ = yield [list]
117	root	1.1
118	root	1.5	Return the given list/scalar as result of the continuation. Also returns
119			the new arguments given to the subroutine on the next call.
120	root	1.1
121			=cut
122
123	root	1.5	# implemented in Coro/State.xs
124	root	1.8	#sub yield(@) {
125	root	1.5	# &Coro::State::transfer(@{pop @$$return}, 0);
126			# wantarray ? @_ : $_[0];
127			#}
128	root	1.1
129			1;
130
131			=back
132
133			=head1 AUTHOR
134
135	root	1.36	Marc Lehmann <schmorp@schmorp.de>
136	root	1.34	http://home.schmorp.de/
137	root	1.1
138			=cut
139