Tail call Recursion “Optimising”

Question

I have a weird problem I can't figure out. I created a simple sequence in Perl with anonymous functions.

sub{($data, sub{($data, sub{($data, sub{($data, empty)})})})};

And it works but I tired to implement tail optimizing and got some weird behaviour. Example. The iter function below works.

sub iter {
    my ($func, $seq) = @_;
    my ($data, $next) = $seq->();

    if (defined $data) {
        $func->($data);
        @_ = ($func, $next);#This @_ update works fine
        goto &iter;
    }
}

while this implementation of iter fails.

sub iter {
    my ($func, $seq) = @_;
    my ($data, $next) = $seq->();

    if (defined $data) {
        $func->($data);
        $_[1] = $next; #This @_ update fails
        goto &iter;
    }
}

Both updates of @_ yield the same values for @_ but the code behaves differently when it continues.. To see what I'm talking about try running the complete code below.

#! /usr/bin/env perl

package Seq;

use 5.006;
use strict;
use warnings;

sub empty {
    sub{undef};
}

sub add {
    my ($data, $seq) = @_;
    sub{($data, $seq)};
}

sub iter {
    my ($func, $seq) = @_;
    my ($data, $next) = $seq->();

    if (defined $data) {
        $func->($data);
        @_ = ($func, $next);#This works fine
        #$_[1] = $next; #This fails
        goto &iter;
    }
}

sub smap {
    my ($func, $seq) = @_;
    my ($data, $next) = $seq->();
    if (defined $data) {
        sub{($func->($data), Seq::smap($func, $next))};
    }else {
        empty();
    }
}

sub fold {
    my ($func, $acc, $seq) = @_;
    my ($data, $next) = $seq->();
    if (defined $data) {
        @_ = ($func, $func->($acc, $data), $next);
        goto &Seq::fold;
    }else {
        $acc;
    }
}

1;

package main;

use warnings;
use strict;
use utf8;

use List::Util qw(reduce);

my $seq =
    reduce
    {Seq::add($b, $a)}
    Seq::empty,
    (4143, 1234, 4321, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10);

Seq::iter(sub{my ($data) = @_; STDOUT->print("$data\n")}, $seq);

my $seq2 = Seq::smap(sub{my ($data) = @_; $data * 2}, $seq);

STDOUT->print("\n\n");

Seq::iter(sub{my ($data) = @_; STDOUT->print("$data\n")}, $seq2);

STDOUT->print("\n\n");

my $ans = Seq::fold(sub{my ($acc, $data) = @_; $acc + $data}, 0, $seq);
my $ans2 = Seq::fold(sub{my ($acc, $data) = @_; $acc + $data}, 0, $seq2);

STDOUT->print("$ans\n");
STDOUT->print("$ans2\n");

exit (0);

The code should work for both examples of iter but it doesn't.. Any pointers why?

Answer 1

Writing to $_[1] writes to the second scalar passed to the sub.

$ perl -E'$x = "abc"; say $x; sub { $_[0] = "def"; say $_[0]; }->($x); say $x;'
abc
def
def

So you are clobbering the caller's variables. Assigning to @_ replaces the scalars it contains rather than writing to them.

$ perl -E'$x = "abc"; say $x; sub { @_ = "def"; say $_[0]; }->($x); say $x;'
abc
def
abc

You can replace a specific element using splice .

$ perl -E'$x = "abc"; say $x; sub { splice(@_, 0, 1, "def"); say $_[0]; }->($x); say $x;'
abc
def
abc

---

It's far more convenient for iterators to return an empty list when they are exhausted. For starters, it allows them to return undef .

Furthermore, I'd remove the expensive recursive calls with quicker loops. These loops can be made particularly simple because of the change mentioned above.

The module becomes:

package Seq;

use strict;
use warnings;

sub empty { sub { } }

sub add {
    my ($data, $seq) = @_;
    return sub { $data, $seq };
}

sub iter {
    my ($func, $seq) = @_;
    while ( (my $data, $seq) = $seq->() ) {
        $func->($data);
    }
}

sub smap {
    my ($func, $seq) = @_;
    if ( (my $data, $seq) = $seq->() ) {
        return sub { $func->($data), smap($func, $seq) };
    } else {
        return sub { };
    }
}

sub fold {
    my ($func, $acc, $seq) = @_;
    while ( (my $data, $seq) = $seq->() ) {
        $acc = $func->($acc, $data);
    }

    return $acc;
}

1;

Also, for speed reasons, replace

sub { my ($data) = @_; $data * 2 }
sub { my ($acc, $data) = @_; $acc + $data }

with

sub { $_[0] * 2 }
sub { $_[0] + $_[1] }