Reduced map

Как известно в Perl 6 имеются гипер- и редакшноператоры
(заметка о них http://laziness-impatience-hubris.blogspot.com/2009/01/perl6.html).

Но что же делать в Perl 5?

Для замены редакшноператоров можно воспользоваться подпрограммой reduce из модуля List::Util или
воспользоваться "reduced map" (rmap) из нижеприведенного модуля (List::Rmap).
Замена же гипероператоров осуществляется при помощи "hyper map" (hmap) того же модуля.

Рассмотрим примеры.

 use strict;
 use warnings;
 
 use List::Rmap qw(reduce rmap hmap);
 
 my @a = (1, 2, 3);
 my @b = (4, 5, 6);
 
 print           reduce { $a + $b } @a;
 # Бyдет напечатано 6
 # Это в Perl6 эквивалентно [+] @x
 print "\n";
 
 # reduced map
 print join " ", rmap   { $a + $b } @a;
 # Бyдет напечатано 1 3 6
 # Это в Perl6 эквивалентно [\+] @x
 print "\n";

 # hyper map
 print join " ", hmap   { $a + $b } @a, @b;
 # Бyдет напечатано 5 7 9
 # Это в Perl6 эквивалентно @x >>+<< @y

А вот содержимое вышеупомянутого модуля List::Rmap:

 # Reduced map
 
 package List::Rmap;
 
 use strict;
 use warnings;
 
 no strict qw(refs);
 
 use Exporter;
 our @EXPORT_OK = qw(reduce rmap hmap);
 
 
 sub import {
 
  # Avoid "Name "..." used only once" warnings for $a and $b.
  my $caller = caller;
  local *{"${caller}::a"};
  local *{"${caller}::b"};
 
  goto &Exporter::import
 }
 
 
 
 sub reduce (&@) {
  my $code = shift;
 
  my $caller = caller;
  local *{"${caller}::a"} = \ my $a;
  local *{"${caller}::b"} = \ my $b;
 
  $a = shift;
  foreach (@_) {
   $b = $_;
   $a = &{$code}();
  }
 
  return $a;
 }
 
 
 
 sub rmap (&@) {
  my $code = shift;
 
  my $caller = caller;
  local *{"${caller}::a"} = \ my $a;
  local *{"${caller}::b"} = \ my $b;
 
  my @r = ($a = shift);
  foreach (@_) {
   $b = $_;
   push @r, $a = &{$code}();
  }
 
  return @r;
 }
 
 
 
 sub hmap (&\@\@) {
  my $code = shift;
  my ($ra, $rb) = @_;
 
  @$ra == @$rb or die "Different length of lists.";
 
  my $caller = caller;
  local *{"${caller}::a"} = \ my $a;
  local *{"${caller}::b"} = \ my $b;
 
  my @r = ();
  foreach ($[ .. $#$ra) {
   $a = $$ra[$_];
   $b = $$rb[$_];
   push @r, &{$code}();
  }
 
  return @r;
 }
 
 
 1;