Coro/Coro/Cont.pm

=head1 NAME

Coro::Cont - schmorp's faked continuations

=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;

use Carp qw(croak);

use Coro::State;
use Coro::Specific;

use base 'Exporter';

$VERSION = 0.5;
@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};
      no warnings;
      *{(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 {
      no warnings;
      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) {
         no warnings;
         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

our $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.13
Committed:	Sun Sep 16 01:34:36 2001 UTC (22 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.12:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Coro::Cont - schmorp's faked continuations
4
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	root	1.5	use Carp qw(croak);
33
34	root	1.1	use Coro::State;
35			use Coro::Specific;
36
37			use base 'Exporter';
38
39	root	1.13	$VERSION = 0.5;
40	root	1.8	@EXPORT = qw(csub yield);
41	root	1.4
42			{
43			my @csub;
44
45			# this way of handling attributes simply is NOT scalable ;()
46			sub import {
47			Coro::Cont->export_to_level(1, @_);
48			my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};
49			no warnings;
50			*{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"} = sub {
51			my ($package, $ref) = (shift, shift);
52			my @attrs;
53			for (@_) {
54			if ($_ eq "Cont") {
55	root	1.5	push @csub, [$package, $ref];
56	root	1.4	} else {
57			push @attrs, $_;
58			}
59			}
60			return $old ? $old->($package, $ref, @attrs) : @attrs;
61			};
62			}
63
64	root	1.5	sub findsym {
65			no warnings;
66			my ($pkg, $ref) = @_;
67			my $type = ref $ref;
68			for my $sym (values %{$pkg."::"}) {
69			return \$sym if *{$sym}{$type} == $ref;
70			}
71			();
72			}
73
74	root	1.4	sub INIT {
75	root	1.5	# prototypes are currently being ignored
76	root	1.4	for (@csub) {
77	root	1.5	no warnings;
78			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.5	our $return = new Coro::Specific;
94	root	1.1
95	root	1.4	sub csub(&) {
96	root	1.1	my $code = $_[0];
97			my $prev = new Coro::State;
98	root	1.5
99			my $coro = new Coro::State sub {
100			# we do this superfluous switch just to
101			# avoid the parameter passing problem
102			# on the first call
103	root	1.8	&yield;
104	root	1.5	&$code while 1;
105			};
106
107			# call it once
108			push @$$return, [$coro, $prev];
109			&Coro::State::transfer($prev, $coro, 0);
110
111	root	1.1	sub {
112	root	1.5	push @$$return, [$coro, $prev];
113	root	1.4	&Coro::State::transfer($prev, $coro, 0);
114	root	1.5	wantarray ? @_ : $_[0];
115	root	1.1	};
116			}
117
118	root	1.8	=item @_ = yield [list]
119	root	1.1
120	root	1.5	Return the given list/scalar as result of the continuation. Also returns
121			the new arguments given to the subroutine on the next call.
122	root	1.1
123			=cut
124
125	root	1.5	# implemented in Coro/State.xs
126	root	1.8	#sub yield(@) {
127	root	1.5	# &Coro::State::transfer(@{pop @$$return}, 0);
128			# wantarray ? @_ : $_[0];
129			#}
130	root	1.1
131			1;
132
133			=back
134
135			=head1 AUTHOR
136
137			Marc Lehmann <pcg@goof.com>
138			http://www.goof.com/pcg/marc/
139
140			=cut
141