sub reduce(&@) {
   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;
}

##</code><code>##

          Rate ike1_p ike1_n ike2_p ike1_i ike2_i ike2_n
ike1_p 6.34/ms     --    -2%    -2%    -4%    -6%     -7%
ike1_n 6.46/ms     2%     --    -1%    -3%    -4%     -5%
ike2_p 6.50/ms     3%     1%     --    -2%    -3%     -4%
ike1_i 6.63/ms     5%     3%     2%     --    -1%     -2%
ike2_i 6.72/ms     6%     4%     3%     1%     --     -1%
ike2_n 6.79/ms     7%     5%     4%     2%     1%      --

(I)nline:        reduce { $a * $b }     1..100;
(P)rototype:     reduce \&prototyped,   1..100;
(N)o prototype:  reduce \&unprototyped, 1..100;

##</code><code>##

ikegami1_i  1  ok
ikegami1_n  1  ok
ikegami1_p  1  ok
ikegami2_i  1  ok
ikegami2_n  1  ok
ikegami2_p  1  ok

ikegami1_i  6  ok
ikegami1_n  6  ok
ikegami1_p  6  ok
ikegami2_i  6  ok
ikegami2_n  6  ok
ikegami2_p  6  ok


----------------------------------------
Tiny (3 args)

             Rate ikegami2_p ikegami2_n ikegami2_i ikegami1_i ikegami1_n ikegami1_p
ikegami2_p 67.8/s         --        -0%        -1%       -38%       -39%       -56%
ikegami2_n 68.0/s         0%         --        -1%       -38%       -39%       -56%
ikegami2_i 68.6/s         1%         1%         --       -38%       -38%       -56%
ikegami1_i  110/s        63%        62%        61%         --        -1%       -29%
ikegami1_n  111/s        64%        63%        61%         1%         --       -29%
ikegami1_p  155/s       129%       128%       126%        41%        40%         --

Multiply by 1000 to get real rate.

----------------------------------------
Short (6 args)

             Rate ikegami2_p ikegami2_n ikegami2_i ikegami1_n ikegami1_i ikegami1_p
ikegami2_p 52.6/s         --        -2%        -3%       -31%       -32%       -45%
ikegami2_n 53.7/s         2%         --        -1%       -30%       -31%       -43%
ikegami2_i 54.2/s         3%         1%         --       -29%       -30%       -43%
ikegami1_n 76.4/s        45%        42%        41%         --        -1%       -20%
ikegami1_i 77.5/s        47%        44%        43%         1%         --       -18%
ikegami1_p 95.0/s        80%        77%        75%        24%        23%         --

Multiply by 1000 to get real rate.

----------------------------------------
Medium (20 args)

             Rate ikegami2_p ikegami2_n ikegami2_i ikegami1_i ikegami1_n ikegami1_p
ikegami2_p 25.4/s         --        -2%        -4%       -11%       -12%       -20%
ikegami2_n 26.0/s         2%         --        -1%        -9%       -10%       -18%
ikegami2_i 26.4/s         4%         2%         --        -8%        -9%       -17%
ikegami1_i 28.6/s        13%        10%         8%         --        -1%       -10%
ikegami1_n 29.0/s        14%        11%        10%         1%         --        -9%
ikegami1_p 31.8/s        25%        22%        21%        11%        10%         --

Multiply by 1000 to get real rate.

----------------------------------------
Long (100 args)

             Rate ikegami1_p ikegami1_n ikegami2_p ikegami1_i ikegami2_i ikegami2_n
ikegami1_p 6.34/s         --        -2%        -2%        -4%        -6%        -7%
ikegami1_n 6.46/s         2%         --        -1%        -3%        -4%        -5%
ikegami2_p 6.50/s         3%         1%         --        -2%        -3%        -4%
ikegami1_i 6.63/s         5%         3%         2%         --        -1%        -2%
ikegami2_i 6.72/s         6%         4%         3%         1%         --        -1%
ikegami2_n 6.79/s         7%         5%         4%         2%         1%         --

Multiply by 1000 to get real rate.

##</code><code>##

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