Initial hackery to create any/all keywords

Author: leonerd

ext/Opcode/Opcode.pm

@@ -1,4 +1,4 @@
-package Opcode 1.66;
+package Opcode 1.67;
 
 use strict;
 
@@ -377,6 +377,7 @@ used to implement a resource attack (e.g., consume all available CPU time).
 
     grepstart grepwhile
     mapstart mapwhile
+    anystart allstart anywhile
     enteriter iter
     enterloop leaveloop unstack
     last next redo

gv.c

@@ -610,7 +610,8 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     case KEY___DATA__: case KEY___END__ :
     case KEY_ADJUST  : case KEY_AUTOLOAD: case KEY_BEGIN : case KEY_CHECK :
     case KEY_DESTROY : case KEY_END     : case KEY_INIT  : case KEY_UNITCHECK:
-    case KEY_and     : case KEY_catch   : case KEY_class :
+    case KEY_all     : case KEY_and     : case KEY_any   :
+    case KEY_catch   : case KEY_class   :
     case KEY_continue: case KEY_cmp     : case KEY_defer :
     case KEY_do      : case KEY_dump   : case KEY_else  : case KEY_elsif  :
     case KEY_eq     : case KEY_eval  : case KEY_field  :

lib/B/Deparse-core.t

@@ -232,6 +232,9 @@ while (<DATA>) {
 
 # Special cases
 
+testit any      => 'CORE::any { $a } $b, $c',    'CORE::any({$a;} $b, $c);';
+testit all      => 'CORE::all { $a } $b, $c',    'CORE::all({$a;} $b, $c);';
+
 testit dbmopen  => 'CORE::dbmopen(%foo, $bar, $baz);';
 testit dbmclose => 'CORE::dbmclose %foo;';
 

lib/B/Deparse.pm

@@ -7,7 +7,7 @@
 # This is based on the module of the same name by Malcolm Beattie,
 # but essentially none of his code remains.
 
-package B::Deparse 1.80;
+package B::Deparse 1.81;
 use strict;
 use Carp;
 use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
@@ -2334,6 +2334,8 @@ my %feature_keywords = (
    finally  => 'try',
    defer    => 'defer',
    signatures => 'signatures',
+   any      => 'any_all',
+   all      => 'any_all',
 );
 
 # keywords that are strong and also have a prototype
@@ -3637,9 +3639,10 @@ sub pp_sort { indirop(@_, "sort") }
 
 sub mapop {
     my $self = shift;
-    my($op, $cx, $name) = @_;
+    my($op, $cx) = @_;
     my($expr, @exprs);
-    my $kid = $op->first; # this is the (map|grep)start
+    my $kid = $op->first; # this is the (map|grep\any|all)start
+    my ( $name ) = $kid->name =~ m/(.*)start/; # anystart and allstart share anywhile
     $kid = $kid->first->sibling; # skip a pushmark
     my $code = $kid->first; # skip a null
     if (is_scope $code) {
@@ -3657,8 +3660,9 @@ sub mapop {
 				    $code . join(", ", @exprs), $cx, 5);
 }
 
-sub pp_mapwhile { mapop(@_, "map") }
-sub pp_grepwhile { mapop(@_, "grep") }
+sub pp_mapwhile { mapop(@_) }
+sub pp_grepwhile { mapop(@_) }
+sub pp_anywhile { mapop(@_) }
 sub pp_mapstart { baseop(@_, "map") }
 sub pp_grepstart { baseop(@_, "grep") }
 

lib/B/Op_private.pm

@@ -12050,8 +12050,16 @@ Constructs, checks, and returns a glob reference op.
 OP *
 Perl_newGVREF(pTHX_ I32 type, OP *o)
 {
-    if (type == OP_MAPSTART || type == OP_GREPSTART || type == OP_SORT)
-        return newUNOP(OP_NULL, 0, o);
+    switch(type) {
+        /* The thing that looks like a GVREF at the start of these operators
+         * isn't really */
+        case OP_MAPSTART:
+        case OP_GREPSTART:
+        case OP_SORT:
+        case OP_ANYSTART:
+        case OP_ALLSTART:
+            return newUNOP(OP_NULL, 0, o);
+    }
 
     if (!FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED &&
         ((PL_opargs[type] >> OASHIFT) & 7) == OA_FILEREF &&
@@ -13192,7 +13200,10 @@ Perl_ck_grep(pTHX_ OP *o)
 {
     LOGOP *gwop;
     OP *kid;
-    const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
+    const OPCODE type =
+        o->op_type == OP_GREPSTART ? OP_GREPWHILE :
+        o->op_type == OP_MAPSTART  ? OP_MAPWHILE  :
+                                     OP_ANYWHILE;  /* any and all both share this */
 
     PERL_ARGS_ASSERT_CK_GREP;