#!/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;
use
FP::Carp;
@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);
}
$res
,
"\n"
;