Permalink
Fetching contributors…
Cannot retrieve contributors at this time
executable file 131 lines (102 sloc) 2.61 KB
#!/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 Chj::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;