use warnings;
use strict;

use B::Deparse;
use PadWalker qw( closed_over );

sub dump_closure {
  my $f = shift;           # the closure
  my $conf = shift || ();  # hashref of options
  my $indent = exists $conf->{indent} ? $conf->{indent} :  '    ';
  my @deparse_opts =
    exists $conf->{deparse_opts} ? @{$conf->{deparse_opts}} : ('-sC');

  my ( $lexical_vars ) = closed_over( $f );
  my @lexical_vars = map {
    $indent . 'my '. $_. ' = '. ${$lexical_vars->{$_}}. ';'
  } sort keys %$lexical_vars;

  my $bd = B::Deparse->new( @deparse_opts );
  $bd->ambient_pragmas( strict => 'all', warnings => 'all' );
  my @body = split /\n/, $bd->coderef2text( $f );
  $body[0] = 'return sub ' . $body[0];
  @body = map { $indent . $_ } @body;

  return join "\n", 'sub {', @lexical_vars, @body, '} -> ()';
}

##############################################################################

# 2 * 3 * 4 = 24 = mult_n_n_n(2)->(3)->(4)
sub mult_n_n_n { # nested closure
  my $a = shift;
  return sub {
    my $b = shift;
    return sub {
      my $c = shift;
      return $a * $b * $c;
    }
  }
}

my $mult_2_n_n = mult_n_n_n( 2 );
my $mult_2_3_n = $mult_2_n_n->( 3 );

print dump_closure( $mult_2_n_n ), ";\n";
print dump_closure( $mult_2_3_n ), ";\n";

my $copy_2_3_n = eval( dump_closure( $mult_2_3_n ) );
print $@ if $@;
print $copy_2_3_n->( 4 ), "\n"; # clone works

my $copy_2_n_n = eval(  dump_closure( $mult_2_n_n ) );
print $@ if $@;
print $copy_2_n_n->( 3 )->( 4 ), "\n"; #clone works