Re: How to get sort-like semantics?

Are you looking how to do "If the subroutine's prototype is ($$)"? prototype.

use strict;
use warnings;

sub reduce(&@) {
   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 prototyped($$) { $_[0] * $_[1] }
sub unprototyped   { $a * $b }


$\ = "\n";
print reduce { $a * $b }     1..6;  # 720
print reduce \&prototyped,   1..6;  # 720
print reduce \&unprototyped, 1..6;  # 720
[download]

Update: Adjusted to use the caller's package.

Comment on Re: How to get sort-like semantics? Select or Download Code

Replies are listed 'Best First'.
Re^2: How to get sort-like semantics? by ikegami (Patriarch) on Oct 25, 2007 at 20:54 UTC
What if we skipped checking the prototype and set up both `@_`, and `$a` and `$b`? `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; }` [download] Turns out it's negligeably faster for moderately long lists. `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;` [download] Full Results Benchmark code	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re^2: How to get sort-like semantics?
by ikegami (Patriarch) on Oct 25, 2007 at 20:54 UTC

What if we skipped checking the prototype and set up both @_, and $a and $b?

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;
}
[download]

Turns out it's negligeably faster for moderately long lists.

          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;
[download]

Full Results

Benchmark code

[reply]
[d/l]
[select]