#!/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.
# This file shows how to use syntactical sugar additions to Perl to
# make the code from the file `tailcalls` look better.
# Also, there's some added material towards the end.
# ------------------------------------------------------------------
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::TEST;
use Chj::Backtrace;
# This needs `Method::Signatures`, which is likely packaged
# (libmethod-signatures-perl in Debian), and `Sub::Call::Tail` which
# you'll probably have to install from CPAN:
# run `cpan`, then (perhaps after configuration, just say `yes`):
# [`install Method::Signatures` and] `install Sub::Call::Tail`
# This gives the 'func' keyword, to avoid having to pick up arguments
# explicitely from @_
use Method::Signatures;
# This gives the 'tail' keyword, to avoid having to use 'goto' and @_
# assignments
use Sub::Call::Tail;
# ------------------------------------------------------------------
# again, see (4b) in `basics` for basic explanations
func functional_fact($x) {
    functional_fact_iter($x, 1)
}
our @functional_inspect;
func functional_fact_iter($x, $res) {
    push @functional_inspect, func { ($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 could be making use of Perl's goto &$subroutine feature (see
        # `perldoc -f goto`):
        #
        # @_ = ($x - 1,  $x * $res);
        # goto \&functional_fact_iter
        #
        # or, with nicer looks, by using Sub::Call::Tail:
        tail functional_fact_iter($x - 1, $x * $res)
    }
}
# To really see the difference, here's a function that we can usefully
# test for higher numbers of iterations:
func odd($n) {
    if ($n == 0) {
        0
    } else {
        even($n - 1)
    }
}
func even($n) {
    if ($n == 0) {
        1
    } else {
        odd($n - 1)
    }
}
# $ ulimit -S -v 20000; ./more_tailcalls
# main> even 4
# $VAR1 = 1;
# main> even 5
# $VAR1 = 0;
# main> even 500
# Deep recursion on subroutine "main::even" at ./more_tailcalls line 65.
# Deep recursion on subroutine "main::odd" at ./more_tailcalls line 74.
# $VAR1 = 1;
# main> even 50000
# Deep recursion on subroutine "main::even" at ./more_tailcalls line 65.
# Deep recursion on subroutine "main::odd" at ./more_tailcalls line 74.
# Out of memory!
# You can see that Perl ran out of space for the stack.
func opt_odd($n) {
    if ($n == 0) {
        0
    } else {
        tail opt_even($n - 1);
    }
}
func opt_even($n) {
    if ($n == 0) {
        1
    } else {
        tail opt_odd($n - 1);
    }
}
# $ ulimit -S -v 20000; ./more_tailcalls
# main> opt_even 500000
# $VAR1 = 1;
# Now it runs with little (and constant) memory usage.
# ------------------------------------------------------------------
# Note: there's also trampolining as a potential solution:
use FP::Trampoline;
use Chj::time_this;
func tramp_odd($n) {
    if ($n == 0) {
        0
    } else {
        T { tramp_even($n - 1) }
    }
}
func tramp_even($n) {
    if ($n == 0) {
        1
    } else {
        T { tramp_odd($n - 1) }
    }
}
TEST {
    time_this { trampoline tramp_even 60000 } "T"
}
1;
# or
func tramp2_odd($n) {
    if ($n == 0) {
        0
    } else {
        TC \&tramp2_even, $n - 1
    }
}
func tramp2_even($n) {
    if ($n == 0) {
        1
    } else {
        TC \&tramp2_odd, $n - 1
    }
}
TEST {
    time_this { trampoline tramp2_even 60000 } "TC"
}
1;
# ------------------------------------------------------------------
# Also note: all of the above example are defining functions as
# package globals, which makes it trivial to call themselves
# recursively. If you need to define them as lexicals, then you need
# to heed the advice given in [[README]] with regards to self
# calls (recursive function definitions), either by way of weaken:
use Scalar::Util 'weaken';
use FP::Stream 'Weakened';    # XX should probably move to non-lazyness
                              # related place
func weakened_even($n) {
    my ($odd, $even);
    $odd = func($n) {
        if ($n == 0) {
            0
        } else {
            tail &$even($n - 1)
        }
    };
    $even = func($n) {
        if ($n == 0) {
            1
        } else {
            tail &$odd($n - 1)
        }
    };
    # do *not* make this a tail call or $even will become undef on
    # bleadperl at some point (not so on v5.14.2):
    # (XXX Perl issue, or what are the rules here?)
    Weakened($even)->($n)
}
TEST {
    ($^V->{version}[1] > 20)
        ? weakened_even 60000
        : warn "skipping test on older perl"
}
1;
# XXX this actually fails both on v5.14.2 and bleadperl for undefined
# subroutine call. Submit bug report?
# or by using the n-ary fixpoint combinator:
use FP::fix;
func fix_even($n) {
    my ($odd, $even) = fixn(
        func($odd, $even, $n)
        {
            if ($n == 0) {
                0
            } else {
                tail &$even($n - 1)
            }
        },
        func($odd, $even, $n)
        {
            if ($n == 0) {
                1
            } else {
                tail &$odd($n - 1)
            }
        }
    );
    tail &$even($n)
}
TEST { fix_even 60000 }
1;
# ------------------------------------------------------------------
# run tests if called as part of the test suite, or
# enter the repl for your experiments, see (0) in `basics`
perhaps_run_tests "main" or do {
    require FP::Repl;
    FP::Repl::repl();
};