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 &$csub, &hash1;

 # dasselbe in grün (as we 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 Coro::Specific;

use vars qw($return);

use base 'Exporter';

$VERSION = 1.0;
@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

$return = new Coro::Specific;

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 @$$return, [$coro, $prev];
   &Coro::State::transfer($prev, $coro, 0);

   sub {
      push @$$return, [$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 <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

Revision:	1.33
Committed:	Tue Aug 10 01:56:30 2004 UTC (19 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	rel-1_0
Changes since 1.32:	+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.4	my %hash2 = map &$csub, &hash1;
15
16			# dasselbe in grün (as we germans say)
17			sub mul2 : Cont {
18	root	1.8	yield $_[0]*2;
19			yield $_[0];
20	root	1.4	}
21
22	root	1.5	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			use Coro::Specific;
38
39	pcg	1.27	use vars qw($return);
40
41	root	1.1	use base 'Exporter';
42
43	root	1.33	$VERSION = 1.0;
44	root	1.8	@EXPORT = qw(csub yield);
45	root	1.4
46			{
47			my @csub;
48
49			# this way of handling attributes simply is NOT scalable ;()
50			sub import {
51			Coro::Cont->export_to_level(1, @_);
52			my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};
53			*{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"} = sub {
54			my ($package, $ref) = (shift, shift);
55			my @attrs;
56			for (@_) {
57			if ($_ eq "Cont") {
58	root	1.5	push @csub, [$package, $ref];
59	root	1.4	} else {
60			push @attrs, $_;
61			}
62			}
63			return $old ? $old->($package, $ref, @attrs) : @attrs;
64			};
65			}
66
67	root	1.5	sub findsym {
68			my ($pkg, $ref) = @_;
69			my $type = ref $ref;
70			for my $sym (values %{$pkg."::"}) {
71			return \$sym if *{$sym}{$type} == $ref;
72			}
73			();
74			}
75
76	root	1.4	sub INIT {
77	root	1.5	# prototypes are currently being ignored
78	root	1.4	for (@csub) {
79	root	1.5	my $ref = findsym(@$_)
80			or croak "package $package: cannot declare non-global subs as 'Cont'";
81	root	1.7	*$ref = &csub($_->[1]);
82	root	1.4	}
83			@csub = ();
84			}
85			}
86	root	1.1
87	root	1.4	=item csub { ... }
88	root	1.1
89	root	1.4	Create a new "continuation" (when the sub falls of the end it is being
90			terminated).
91	root	1.1
92			=cut
93
94	pcg	1.27	$return = new Coro::Specific;
95	root	1.1
96	root	1.4	sub csub(&) {
97	root	1.1	my $code = $_[0];
98			my $prev = new Coro::State;
99	root	1.5
100			my $coro = new Coro::State sub {
101			# we do this superfluous switch just to
102			# avoid the parameter passing problem
103			# on the first call
104	root	1.8	&yield;
105	root	1.5	&$code while 1;
106			};
107
108			# call it once
109			push @$$return, [$coro, $prev];
110			&Coro::State::transfer($prev, $coro, 0);
111
112	root	1.1	sub {
113	root	1.5	push @$$return, [$coro, $prev];
114	root	1.4	&Coro::State::transfer($prev, $coro, 0);
115	root	1.5	wantarray ? @_ : $_[0];
116	root	1.1	};
117			}
118
119	root	1.8	=item @_ = yield [list]
120	root	1.1
121	root	1.5	Return the given list/scalar as result of the continuation. Also returns
122			the new arguments given to the subroutine on the next call.
123	root	1.1
124			=cut
125
126	root	1.5	# implemented in Coro/State.xs
127	root	1.8	#sub yield(@) {
128	root	1.5	# &Coro::State::transfer(@{pop @$$return}, 0);
129			# wantarray ? @_ : $_[0];
130			#}
131	root	1.1
132			1;
133
134			=back
135
136			=head1 AUTHOR
137
138			Marc Lehmann <pcg@goof.com>
139			http://www.goof.com/pcg/marc/
140
141			=cut
142