Permalink
Cannot retrieve contributors at this time
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?
functional-perl/intro/tailcalls
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
executable file
128 lines (103 sloc)
2.77 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/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; |