Skip to content
Permalink
master
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
Go to file
 
 
Cannot retrieve contributors at this time
executable file 128 lines (103 sloc) 2.77 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 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;