From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

#!/usr/bin/env perl
# Copyright (c) 2015-2020 Christian Jaeger, copying@christianjaeger.ch
# This is free software. See the file COPYING.md that came bundled
# with this file.
use strict;
use warnings FATAL => 'uninitialized';
@ARGV == 2 or die "usage: $0 n m";
our ($n, $m) = @ARGV;
# a lazily nested data structure to work on:
sub naturals {
my ($n) = @_;
sub {
if ($n > 0) { [$n, naturals($n - 1)] }
else {
undef
}
}
}
# -----------------------------------------------------------
# variant tail-calling itself, showing the problem
sub stream_sum_LEAK {
my ($s, $tot) = @_;
if (my $fs = &$s) {
@_ = ($$fs[1], $$fs[0] + $tot);
goto \&stream_sum_LEAK;
} else {
$tot
}
}
# -----------------------------------------------------------
# variant using a label instead of coderef, showing that the algorithm
# is sane and it's in fact a problem with perl's handling of `goto
# $coderef`.
sub stream_sum_OK {
stream_sum_OK: {
my ($s, $tot) = @_;
if (my $fs = &$s) {
@_ = ($$fs[1], $$fs[0] + $tot);
goto stream_sum_OK;
} else {
$tot
}
}
}
# -----------------------------------------------------------
# variant using trampolines to implement tail call optimization, also
# confirming that the algorithm is sane and that it's got something to
# do with how perl handles goto &$coderef / stack memory or so.
sub T (&) {
bless $_[0], "TrampolineContinuation"
}
sub trampoline {
@_ == 1 or fp_croak_arity 1;
my ($v) = @_;
while (ref($v) eq "TrampolineContinuation") {
$v = &$v()
}
$v
}
sub _stream_sum_TRAMPOLINE {
my ($s, $tot) = @_;
if (my $fs = &$s) {
T { _stream_sum_TRAMPOLINE($$fs[1], $$fs[0] + $tot) }
} else {
$tot
}
}
sub stream_sum_TRAMPOLINE {
trampoline _stream_sum_TRAMPOLINE(@_)
}
# -----------------------------------------------------------
# choose variant:
*stream_sum = \&stream_sum_LEAK;
my $res;
for (1 .. $m) {
warn "build up..\n";
my $ns = naturals $n;
warn "summing..\n";
$res = stream_sum($ns, 0);
}
print $res, "\n";