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;

no warnings qw(uninitialized);

use Carp qw(croak);

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

use base 'Exporter';

$VERSION = 0.53;
@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.18
Committed:	Mon Dec 3 05:52:36 2001 UTC (22 years, 6 months ago) by root
Branch:	MAIN
Changes since 1.17:	+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.15	no warnings qw(uninitialized);
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			use base 'Exporter';
40
41	root	1.18	$VERSION = 0.53;
42	root	1.8	@EXPORT = qw(csub yield);
43	root	1.4
44			{
45			my @csub;
46
47			# this way of handling attributes simply is NOT scalable ;()
48			sub import {
49			Coro::Cont->export_to_level(1, @_);
50			my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};
51			no warnings;
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			no warnings;
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	no warnings;
80			my $ref = findsym(@$_)
81			or croak "package $package: cannot declare non-global subs as 'Cont'";
82	root	1.7	*$ref = &csub($_->[1]);
83	root	1.4	}
84			@csub = ();
85			}
86			}
87	root	1.1
88	root	1.4	=item csub { ... }
89	root	1.1
90	root	1.4	Create a new "continuation" (when the sub falls of the end it is being
91			terminated).
92	root	1.1
93			=cut
94
95	root	1.5	our $return = new Coro::Specific;
96	root	1.1
97	root	1.4	sub csub(&) {
98	root	1.1	my $code = $_[0];
99			my $prev = new Coro::State;
100	root	1.5
101			my $coro = new Coro::State sub {
102			# we do this superfluous switch just to
103			# avoid the parameter passing problem
104			# on the first call
105	root	1.8	&yield;
106	root	1.5	&$code while 1;
107			};
108
109			# call it once
110			push @$$return, [$coro, $prev];
111			&Coro::State::transfer($prev, $coro, 0);
112
113	root	1.1	sub {
114	root	1.5	push @$$return, [$coro, $prev];
115	root	1.4	&Coro::State::transfer($prev, $coro, 0);
116	root	1.5	wantarray ? @_ : $_[0];
117	root	1.1	};
118			}
119
120	root	1.8	=item @_ = yield [list]
121	root	1.1
122	root	1.5	Return the given list/scalar as result of the continuation. Also returns
123			the new arguments given to the subroutine on the next call.
124	root	1.1
125			=cut
126
127	root	1.5	# implemented in Coro/State.xs
128	root	1.8	#sub yield(@) {
129	root	1.5	# &Coro::State::transfer(@{pop @$$return}, 0);
130			# wantarray ? @_ : $_[0];
131			#}
132	root	1.1
133			1;
134
135			=back
136
137			=head1 AUTHOR
138
139			Marc Lehmann <pcg@goof.com>
140			http://www.goof.com/pcg/marc/
141
142			=cut
143