use strict;
use warnings;

use Benchmark qw( cmpthese );

my $OUTER = $ARGV[0] || -3;
my $INNER = $ARGV[1] || 1000;

$a=$b;  # Avoid warning.


sub ikegami1(&@) {
   my $f = shift;
   my $a = shift;

   if (prototype($f)||'' eq '$$') {
      $a = $f->($a, shift) while @_;
   } else {
      my $b;
      no strict 'refs';
      my $caller = caller();
      local *{$caller."::a"} = \$a;
      local *{$caller."::b"} = \$b;
      $b = shift, $a = $f->() while @_;
   }

   return $a;
}


sub ikegami2(&@) {
   my $f = shift;
   my $a = shift;
   my $b;

   our @args;
   (local *_, local *args) = (sub { \@_ }->($a, $b), \@_);

   no strict 'refs';
   my $caller = caller();
   local *{$caller."::a"} = \$a;
   local *{$caller."::b"} = \$b;

   $b = shift(@args), $a = &$f while @args;
   return $a;
}


sub prototyped($$) { $_[0] * $_[1] }
sub unprototyped   { $a * $b }

sub test {
   my ($name, $code, $expect) = @_;
   my $rv = eval($code);
   my $ok = ($expect == $rv);
   printf("%-10s  %d  %s\n", $name, $_, $ok?'ok':'XXX');
}

my %tests = map +(
   "${_}_i" => "${_} { \$a * \$b }    1..\$_;",  # inline
   "${_}_p" => "${_} \\&prototyped,   1..\$_;",  # proto
   "${_}_n" => "${_} \\&unprototyped, 1..\$_;",  # no proto
), qw(
   ikegami1
   ikegami2
);

for my $data (1, 6) {
   my $expect = do { local $_ = $data; eval($tests{ikegami1_i}) };
   for my $name (sort keys %tests) {
      my $code = $tests{$name};
      test($name, $code, $expect) for $data;
   }
   print("\n");
}

print("\n");

my %bench_code = map +( $_ => "use strict; use warnings; for (1..$INNER) { my \$rv = $tests{$_}; }" ), keys %tests;

for (
   [ 'Tiny',     3, ],
   [ 'Short',    6, ],
   [ 'Medium',  20, ],
   [ 'Long',   100, ],
) {
   my ($name, $data) = @$_;
   print("$name ($data args)\n\n");
   cmpthese($OUTER, \%bench_code) for $data;
   print("\n\n");
}

print("Multiply by $INNER to get real rate.\n");