How about if the core perl plumbing were reworked to implement C<grep>,
C<map>, etc with something that from the outside would appeared identical to
the god awful kludge I've banged together below? It is based on the idea for
ACCEPT and REJECT labels for last (where REJECT would be the default).

#!/usr/bin/perl
sub mygrep (&@) {
  my ($coderef, @list) = @_;
  my ($once, $last, @results) = 1;
  ACCEPT: for my $redo ($once) {
    if ($redo++ > 1 and defined $last) {
      push(@results, $last);
      unshift(@list, $_);
    }
    REJECT: while($_ = shift(@list)) {
      $last = $_;
      push(@results, $_)  if &$coderef;
    } continue { $_ = undef }
    $last = undef;
    last ACCEPT;
  } continue {
    if (defined($last)) {
      push @results, $last;
      undef $last;
    }
    $_ = $last = undef;
    @list and goto ACCEPT;
  }
  $_ = undef;
  push(@results, $last)  if defined $last;
  print "\n";
  @results;
}

$a=2;
@list = (1,2,3,2,1);
@a = mygrep { $_ <= $a or last REJECT } @list;
@b = mygrep { $_ <= $a or last ACCEPT } @list;
@c = mygrep { $_ <= $a or next REJECT } @list;
@d = mygrep { $_ <= $a or next ACCEPT } @list;
@e = mygrep { $_ <= $a or $_-- and redo REJECT } @list;
@f = mygrep { $_ <= $a or $_-- and redo ACCEPT } @list;

print "last REJECT: (@a)\n";
print "last ACCEPT: (@b)\n";
print "next REJECT: (@c)\n";
print "next ACCEPT: (@d)\n";
print "redo REJECT: (@e)\n";
print "redo ACCEPT: (@f)\n";

-->Results in:

last REJECT: (1 2)
last ACCEPT: (1 2 3)
next REJECT: (1 2 2 1)
next ACCEPT: (1 2 3 2 1)
redo REJECT: (1 2 2 2 1)
redo ACCEPT: (1 2 3 2 2 1)

Garrett

Reply via email to