#!/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 warnings FATAL => 'uninitialized';

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);
}

print $res, "\n";

