Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

Obfu Coroutines

by Limbic~Region (Chancellor)
on Aug 22, 2004 at 04:59 UTC ( #384885=perlmeditation: print w/replies, xml ) Need Help??

How many of you have ever thought about how to implement coroutines in Perl?

Wow, I hadn't expected any. How many of you with your hands raised have thought about how you might avoid source filters and evil gotos?

Ok, with the exception of perhaps TheDamian, how many actually tried it? It seemed simple enough and I had a working solution in about 10 minutes:

  • Break the code between the yields into code refs
  • Create a dispatch table that knew about all the sections
  • Create a tied variable that knows how to cycle through the dispatch table
  • Return a closure calling the dispatch table

The problem was that it was fugly and no longer resembled a coroutine. I figured if I put it inside a module (see below), it would hide all the nasty stuff and maybe even make it more useable.

package Iterator; sub TIESCALAR { bless $_[1], $_[0] } sub STORE {} sub FETCH { $_[0]->[1] = 0 if ! $_[0]->[1] || $_[0]->[1] == @{ $_[0]-> +[2] }; $_[0]->[1]++ } package Coroutine; sub new { my $self = bless [[[]]], $_[0]; tie $self->[0][0], 'Iterator', $self->[0]; return $self; } sub add_section { push @{ $_[0]->[0][2] } , $_[1] } sub create { my $s = shift; return sub { $s->[0][2][ $s->[0][0] ]->($s +, @_) } } 42;

Boy was I wrong! It came out horrendous. What, you don't believe me? Just look:

#!/usr/bin/perl use strict; use warnings; use Coroutine; my $coroutine = Coroutine->new(); $coroutine->add_section( sub { my $self = shift; $self->[3] = shift; $self->[4] = \@_; print "$_\n" for @{ $self->[4] }; return $self->[3]++; } ); $coroutine->add_section( sub { my $self = shift; print "$self->[3]\n"; return rand() > .5 ? 'weird' : ++$self->[3]; } ); $coroutine->add_section( sub { my $self = shift; print "The end is near - goodbye cruel "; return pop @{ $self->[4] }; } ); my $wacky = $coroutine->create(42, 'hello', 'world'); print $wacky->(42, 'hello', 'world'), "\n"; print $wacky->(), "\n"; print $wacky->(), "\n"; print $wacky->(), "\n";

All of that to do the following if Perl natively supported coroutines:

coroutine create { my $foo = shift; my @bar = @_; print "$_\n" for @bar; yield $foo++; print "$foo\n"; yield rand() > .5 ? 'weird' : ++$foo; print "The end is near - goodbye cruel "; yield pop @bar; } my $wacky = create(42, 'hello', 'world'); print $wacky->(42, 'hello', 'world'), "\n"; print $wacky->(), "\n"; print $wacky->(), "\n"; print $wacky->(), "\n"; __END__ hello world 42 43 44|weird The end is near - goodbye cruel world 0

Incidently, revdiablo and I came up with a solution using evil gotos and source filters about a week ago that was elegant.

So why post? Well even with the explanation, it isn't easy to see what is going on inside the module - especially with the bless/tie combo. I really didn't intend it to come out obfu. Sometimes obfu just happens

Cheers - L~R

I originally posted this under Obfuscation, but didn't argue with Enlil when he asked to move it here. The real meditation, "Sometimes obfu just happens" along with "sometimes breaking the rules is the best way to do things" is there though - along with an attempt at some humor ;-)

Replies are listed 'Best First'.
Re: Coroutines
by tilly (Archbishop) on Aug 22, 2004 at 05:18 UTC
    Sometimes obfu just happens. But unexpected obfuscation is most likely to happen when trying to play interesting games with control of flow.

    I still remember with my shock reading an early version of Switch and encountering the line, goto $__;. After discussion with TheDamian I realized that he was right, there was no other way to achieve the promised control of flow. (One of two necessary uses of the traditional goto that I know of in Perl! Bonus points to anyone who can guess the other.)

    In fact that line is still there, but thankfully $__ has a better name.

    For another view of how one might implement goto in a language which doesn't support it, see Coroutines in C. The technique presented there is actually used in a popular piece of software. (PuTTY. If you're on Windows and need a decent ssh client, get it.) That article is aimed at C, and uses the pre-processor to work its magic.

    He also accidentally wound up obfuscating his code. So much so that he felt compelled to write an article explaining why his approach really was natural and obvious, despite the obvious things which people can object to in it.

Re: Coroutines
by Zaxo (Archbishop) on Aug 22, 2004 at 05:11 UTC

    Have you seen Coro? Its docs don't come close to showing what to use it for, or how, but it's for real.

    After Compline,

      Yep. Saw it along with coroutine0. I really don't need to use coroutines. It is a fascination of another unamed monk that likes to hang out in #perl - they didn't want to try it. I got hooked on the problem (i.e. couldn't get it out of my head) and just let it follow its natural progression.

      Cheers - L~R

(non-)Obfu Coroutines
by Roy Johnson (Monsignor) on Nov 16, 2005 at 19:32 UTC
    Here's a version that approximates your desired usage without gotos or source filters, and it's not obfuscated, IMO. Each yield section gets its own sub, and they're all wrapped in a sub that sets up the variables for the coroutine scope.
    use warnings; use strict; package Coroutine; sub prototype { my $class = shift; bless shift(), $class; } sub instance { my $self = shift; my @sections = $self->(@_); return sub { return () unless @sections; (shift @sections)->(@_); } } package main; my $coroutine = Coroutine->prototype( sub { my $foo = shift; my @bar = @_; ( sub { print "1st section:\n"; print " $_\n" for @bar; return $foo++; }, sub { print "2nd section:\n"; print " $foo\n"; return rand() > .5 ? 'weird' : ++$foo; }, sub { print "3rd section:\n"; print " The end is near - goodbye cruel "; return pop @bar; } ) } ); my $wacky = $coroutine->instance(42, 'hello', 'world'); print "returned($_)\n" while ($_ = $wacky->()); print "Resetting...\n"; $wacky = $coroutine->instance('another', 'time', 'through'); print "returned($_)\n" while ($_ = $wacky->()); __END__ 1st section: hello world returned(42) 2nd section: 43 returned(44) 3rd section: The end is near - goodbye cruel returned(world) Resetting... 1st section: time through returned(another) 2nd section: anothes returned(anothet) 3rd section: The end is near - goodbye cruel returned(through)

    Caution: Contents may have been coded under pressure.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://384885]
Approved by adrianh
Front-paged by broquaint
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (4)
As of 2023-12-04 09:27 GMT
Find Nodes?
    Voting Booth?
    What's your preferred 'use VERSION' for new CPAN modules in 2023?

    Results (23 votes). Check out past polls.