#!/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 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();
};

