How to use a nested closure as the first argument to List::Util::reduce?

Question

NB: the closure featured in this question is just a convenient example; the one I'm actually working with is substantially more complex than this. IOW, please disregard the details of this closure; all that matters, AFAICT, is that it refers to lexical variables in the parent scope.

---

I want to redefine the sub foo below so that the first argument in the call to List::Util::reduce is replaced with a reference to a nested closure.

use strict;
use warnings FATAL => 'all';
use List::Util;

sub foo {
  my ( $x, $y ) = @_;
  return List::Util::reduce { $y->[ $b ]{ $x } ? $a + ( 1 << $b ) : $a } 0, 0 .. $#$y;
}

My first attempt was this:

sub foo {
  my ( $x, $y ) = @_;
  sub z {
    our ( $a, $b );
    return exists $y->[ $b ]{ $x } ? $a | ( 1 << $b ) : $a;
  }
  return List::Util::reduce \&z, 0, 0 .. $#{ $y };
}

...but this results in a warning saying that Variable "$y" will not stay shared.

I've seen this sort of error before, and the only way I know around it is to replace the nested sub definition with an anonymous sub assigned to a variable. Therefore, I tried this instead:

sub foo {
  my ( $x, $y ) = @_;
  my $z = sub {
    our ( $a, $b );
    return exists $y->[ $b ]{ $x } ? $a | ( 1 << $b ) : $a;
  };
  return List::Util::reduce( $z, 0, 0 .. $#{ $y } );
}

Now the error says Type of arg 1 to List::Util::reduce must be block or sub {} (not private variable).

This I really don't understand. Why would passing a subref as the first argument to reduce not be supported?

---

PS: The following does work:

sub foo {
  my ( $x, $y ) = @_;
  my $z = sub {
    our ( $a, $b );
    return exists $y->[ $b ]{ $x } ? $a | ( 1 << $b ) : $a;
  };
  return List::Util::reduce { $z->( $a, $b ) } 0, 0 .. $#{ $y };
}

...but I really would like to know (a) what's wrong with using a subref as the first argument to List::Util::reduce (e.g. is there some technical impediment to supporting this variant?); and (b) is there a more direct approach (than { $z->( $a, $b ) }) to passing to List::Util::reduce a nested closure?

Answer 1

List::Util::reduce uses a Perl prototype which specifies a compile-time check on the parameters passed in a call. Passing a scalar variable that contains a subroutine reference cannot be verified at compile time so Perl disallows it

This is also the route to the the solution. It is usually considered bad practice to call a subroutine using an ampersand character & but in this case it will defeat the prototype checking, which is what is required

sub foo {

  my ( $x, $y ) = @_;

  my $z = sub {
    our ( $a, $b );
    return exists $y->[ $b ]{ $x } ? $a | ( 1 << $b ) : $a;
  };

  return &List::Util::reduce( $z, 0, 0 .. $#{ $y } ); # Defeat prototype
}

Note that this isn't possible in general, as a prototype can do such things as force an array or hash to be passed by reference, or force scalar context on an expression, and calling such a subroutine using & will disable these behaviours as well. But reduce has a prototype of &@ which means a block or sub { } (the sub part is optional here) followed by a list of scalars, which is the normal behaviour for a subroutine without a prototype, so the only effect is to allow $z to be passed for the subroutine reference

Answer 2

reduce has a prototype of &@. That means calls must use one of the following syntax:

reduce BLOCK LIST
reduce sub BLOCK, LIST  # The first form is short for this.
reduce \&NAME, LIST
reduce \&$NAME, LIST    # Same as third form, but via reference (short form)
reduce \&BLOCK, LIST    # Same as third form, but via reference (long form)

You could use any of the following equivalent statements:

return reduce { exists $y->[ $b ]{ $x } ? $a | ( 1 << $b ) : $a } 0, 0 .. $#$y;

# Long way of writing the first.
return reduce(sub { exists $y->[ $b ]{ $x } ? $a | ( 1 << $b ) : $a }, 0, 0 .. $#$y);

my $z = sub { exists $y->[ $b ]{ $x } ? $a | ( 1 << $b ) : $a };
return reduce(\&$z, 0, 0 .. $#$y);

You also have the option of overriding the prototype.

my $z = sub { exists $y->[ $b ]{ $x } ? $a | ( 1 << $b ) : $a };
return &reduce($z, 0, 0 .. $#$y);