examples to loop CPS functions in Perl

cps_perl.pl

#!/usr/bin/env perl

=pod

=head1 NAME

cps_loop.pl - examples to loop CPS functions

=head1 SYNOPSIS

    $ ./cps_loop.pl


=head1 DESCRIPTION

This script demonstrates some examples to use modules for looping CPS
functions.

As I understand it, a CPS (continuation-passing style) function is a
function whose result is NOT returned but given to a callback
function, which is supplied by the user.

Looping (repeating) a CPS function is tricky, usually involving
recursive calls to the function. It is even trickier when the CPS
function is actually implemented in a synchronous way. This can lead
to very deep recursive calls.

There are modules to ease programming loop of CPS functions. This
script tries the following modules and finds out their features.


=head2 CPS::kloop

C<kloop> function from L<CPS> module implements CPS-version of while
loop with arbitrary loop condition.

Its implementation uses tail-calls to callback functions, so it can
prevent deep recursive calls even if the CPS function is synchronous.


=head2 Async::Defer

L<Async::Defer>'s C<while> method implements loop of CPS functions.

This module is meant to be used with asynchronous functions.  If the
CPS function is synchronous, C<while> method can lead to deep
recursive calls.


=head2 AnyEvent::Tools::async_repeat

C<async_repeat> function from L<AnyEvent::Tools> module repeats a CPS
function by predefined times.

As the name suggests, it depends on L<AnyEvent> to handle callbacks.
This is why the user has to call C<recv()> method on some condition
variable to run the CPS function.

It seems that the CPS function cannot use C<< AnyEvent->idle >> to
delay the callback execution, in which case the callback is never
executed.


=head1 AUTHOR

Toshio Ito C<< <toshioito [at] cpan.org> >>


=cut

use strict;
use warnings;

use Devel::StackTrace;
use CPS;
use AnyEvent::Tools;
use Async::Defer;
use AE;

sub sync_cps_add {
    my ($a, $b, $callback) = @_;
    $callback->($a + $b);
}

sub async_cps_add {
    my ($a, $b, $callback) = @_;
    ## my $w; $w = AE::idle sub {
    my $w; $w = AE::timer 0, undef, sub {
        undef $w;
        $callback->($a + $b);
    };
}

my $cv;

sub print_result {
    my ($number) = @_;
    printf STDERR (
        "number: %d, stack_num: %d\n", $number,
        Devel::StackTrace->new->frame_count
    );
    $cv->send;
}

my $loop_count = 1000;

foreach my $cps_type (qw(sync async)) {
    my $cps_func = do {
        no strict "refs";
        \&{ "${cps_type}_cps_add" }
    };
    
    {
        print STDERR "--- $cps_type, CPS::kloop\n";
        $cv = AE::cv;
        my $iter = 0;
        CPS::kloop(sub {
            my ($knext, $klast) = @_;
            if($iter < $loop_count) {
                $cps_func->($iter, 1, sub {
                    $iter = shift;
                    $knext->();
                });
                return;
            }
            $klast->();
        }, sub {
            print_result($iter);
        });
        $cv->recv;
    }

    {
        print STDERR "--- $cps_type, Async::Defer\n";
        $cv = AE::cv;
        my $iter = 0;
        Async::Defer->new->while(sub { $iter < $loop_count })->do(sub {
            my $d = shift;
            $cps_func->($iter, 1, sub {
                $iter = shift;
                $d->done();
            });
        })->end_while->do(sub {
            my $d = shift;
            print_result($iter);
            $d->done();
        })->run;
        $cv->recv;
    }

    {
        print STDERR "--- $cps_type, AnyEvent::Tools::async_repeat\n";
        $cv = AE::cv;
        my $iter = 0;
        AnyEvent::Tools::async_repeat($loop_count, sub {
            my ($guard, $local_iter) = @_;
            $cps_func->($iter, 1, sub {
                $iter = shift;
                undef $guard;
            });
        }, sub {
            print_result($iter);
        });
        $cv->recv;
    }
}