tailcalls

#!/usr/bin/env perl

# Copyright (c) 2015 Christian Jaeger, copying@christianjaeger.ch
# This is free software. See the file COPYING.md that came bundled
# with this file.


# This file shows how to do optimized tail-calls in Perl; see point
# (4b) in the file `basics` for the version without optimized
# tail-calls.

# ------------------------------------------------------------------
use strict; use warnings; use warnings FATAL => 'uninitialized';

use Cwd 'abs_path';
our ($mydir, $myname); BEGIN {
    my $location= (-l $0) ? abs_path ($0) : $0;
    $location=~ /(.*?)([^\/]+?)_?\z/s or die "?";
    ($mydir, $myname)=($1,$2);
}
use lib "$mydir/../lib";

use Chj::Backtrace;
use FP::Repl;


# ------------------------------------------------------------------

# again, see (4b) in `basics` for basic explanations

sub functional_fact {
    my ($x)= @_;
    functional_fact_iter($x, 1)
}

our @functional_inspect;

sub functional_fact_iter {
    my ($x, $res) = @_;
    push @functional_inspect, sub {
        ($x,$res)
    };
    if ($x < 2) {
        return $res;
    } else {
        # This is a tail call. Instead of doing it unoptimized like:
        #
        #  functional_fact_iter($x - 1,  $x * $res)
        #
        # we're making use of Perl's goto &$subroutine feature (see
        # `perldoc -f goto`):

        @_=($x - 1,  $x * $res);
        goto \&functional_fact_iter

        # Yes that's rather ugly; see the file `more_tailcalls`
        # for a better-looking way.
    }
}


# To really see the difference, here's a function that we can usefully
# test for higher numbers of iterations:

sub odd {
    my ($n)=@_;
    if ($n == 0) {
        0
    } else {
        even ($n - 1)
    }
}

sub even {
    my ($n)=@_;
    if ($n == 0) {
        1
    } else {
        odd ($n - 1)
    }
}

# $ ulimit -S -v 200000; ./tailcalls
# main> even 4
# $VAR1 = 1;
# main> even 5
# $VAR1 = 0;
# main> even 500
# Deep recursion on subroutine "main::even" at ./tailcalls line 65.
# Deep recursion on subroutine "main::odd" at ./tailcalls line 74.
# $VAR1 = 1;
# main> even 500000
# Deep recursion on subroutine "main::even" at ./tailcalls line 65.
# Deep recursion on subroutine "main::odd" at ./tailcalls line 74.
# Out of memory!

# You can see that Perl ran out of space for the stack.


sub opt_odd {
    my ($n)=@_;
    if ($n == 0) {
        0
    } else {
        @_=($n - 1);
        goto \&opt_even
    }
}

sub opt_even {
    my ($n)=@_;
    if ($n == 0) {
        1
    } else {
        @_=($n - 1);
        goto \&opt_odd
    }
}

# $ ulimit -S -v 200000; ./tailcalls
# main> opt_even 5000000
# $VAR1 = 1;

# Now it runs with little (and constant) memory usage.


# ------------------------------------------------------------------
# enter the repl for your experiments, see (0) in `basics`

repl;