Optimise foreach my $i (reverse ...)

foreach without a lexical iterator not yet optimised

p4raw-id: //depot/perl@23108

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index ebd5848..28545b9 100644 (file)
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -546,6 +546,7 @@ $priv{$_}{16} = "TARGMY"
        "link", "symlink", "mkdir", "rmdir", "wait", "waitpid", "system",
        "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
        "setpriority", "time", "sleep");
+$priv{$_}{4} = "REVERSED" for ("enteriter", "iter");
 @{$priv{"const"}}{8,16,32,64,128} = ("STRICT","ENTERED", '$[', "BARE", "WARN");
 $priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
 $priv{"list"}{64} = "GUESSED";

diff --git a/op.c b/op.c
index 4f819c3..d4c2887 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6717,6 +6717,67 @@ Perl_peep(pTHX_ register OP *o)
 
            break;
        }
+
+       case OP_REVERSE: {
+           OP *ourmark, *theirmark, *ourlast, *iter;
+           LISTOP *enter, *exlist;
+           o->op_opt = 1;
+
+           enter = (LISTOP *) o->op_next;
+           if (!enter)
+               break;
+           if (enter->op_type == OP_NULL) {
+               enter = (LISTOP *) enter->op_next;
+               if (!enter)
+                   break;
+           }
+           if (enter->op_type != OP_ENTERITER)
+               break;
+
+           iter = enter->op_next;
+           if (!iter || iter->op_type != OP_ITER)
+               break;
+           
+           exlist = (LISTOP *) enter->op_last;
+           if (!exlist || exlist->op_type != OP_NULL
+               || exlist->op_targ != OP_LIST)
+               break;
+
+           if (exlist->op_last != o) {
+               /* Mmm. Was expecting to point back to this op.  */
+               break;
+           }
+           theirmark = exlist->op_first;
+           if (!theirmark || theirmark->op_type != OP_PUSHMARK)
+               break;
+
+           ourmark = ((LISTOP *)o)->op_first;
+           if (!ourmark || ourmark->op_type != OP_PUSHMARK)
+               break;
+
+           if (ourmark->op_next != o) {
+               /* There's something between the mark and the reverse, eg
+                  for (1, reverse (...))
+                  so no go.  */
+               break;
+           }
+
+           ourlast = ((LISTOP *)o)->op_last;
+           if (!ourlast || ourlast->op_next != o)
+               break;
+
+           /* We don't have control over who points to theirmark, so sacrifice
+              ours.  */
+           theirmark->op_next = ourmark->op_next;
+           theirmark->op_flags = ourmark->op_flags;
+           ourlast->op_next = (OP *) enter;
+           op_null(ourmark);
+           op_null(o);
+           enter->op_private |= OPpITER_REVERSED;
+           iter->op_private |= OPpITER_REVERSED;
+           
+           break;
+       }
        
        default:
            o->op_opt = 1;

diff --git a/op.h b/op.h
index 6c02a1c..d72c52e 100644 (file)
--- a/op.h
+++ b/op.h
@@ -180,6 +180,9 @@ Deprecated.  Use C<GIMME_V> instead.
   /* (lower bits may carry MAXARG) */
 #define OPpTARGET_MY           16      /* Target is PADMY. */
 
+/* Private for OP_ENTERITER and OP_ITER */
+#define OPpITER_REVERSED       4       /* for (reverse ...) */
+
 /* Private for OP_CONST */
 #define        OPpCONST_SHORTCIRCUIT   4       /* eg the constant 5 in (5 || foo) */
 #define        OPpCONST_STRICT         8       /* bearword subject to strict 'subs' */

diff --git a/pp_ctl.c b/pp_ctl.c
index a9bc3e5..1107ad9 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1810,11 +1810,22 @@ PP(pp_enteriter)
                (void) SvPV(right,n_a);
            }
        }
+       else if (PL_op->op_private & OPpITER_REVERSED) {
+           cx->blk_loop.itermax = 0;
+           cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary);
+
+       }
     }
     else {
        cx->blk_loop.iterary = PL_curstack;
        AvFILLp(PL_curstack) = SP - PL_stack_base;
-       cx->blk_loop.iterix = MARK - PL_stack_base;
+       if (PL_op->op_private & OPpITER_REVERSED) {
+           cx->blk_loop.itermax = MARK - PL_stack_base;
+           cx->blk_loop.iterix = cx->blk_oldsp;
+       }
+       else {
+           cx->blk_loop.iterix = MARK - PL_stack_base;
+       }
     }
 
     RETURN;

diff --git a/pp_hot.c b/pp_hot.c
index 382030d..4157736 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1886,19 +1886,39 @@ PP(pp_iter)
     }
 
     /* iterate array */
-    if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av)))
-       RETPUSHNO;
+    if (PL_op->op_private & OPpITER_REVERSED) {
+       /* In reverse, use itermax as the min :-)  */
+       if (cx->blk_loop.iterix <= 0)
+           RETPUSHNO;
 
-    if (SvMAGICAL(av) || AvREIFY(av)) {
-       SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
-       if (svp)
-           sv = *svp;
-       else
-           sv = Nullsv;
+       if (SvMAGICAL(av) || AvREIFY(av)) {
+           SV **svp = av_fetch(av, cx->blk_loop.iterix--, FALSE);
+           if (svp)
+               sv = *svp;
+           else
+               sv = Nullsv;
+       }
+       else {
+           sv = AvARRAY(av)[cx->blk_loop.iterix--];
+       }
     }
     else {
-       sv = AvARRAY(av)[++cx->blk_loop.iterix];
+       if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp :
+                                   AvFILL(av)))
+           RETPUSHNO;
+
+       if (SvMAGICAL(av) || AvREIFY(av)) {
+           SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
+           if (svp)
+               sv = *svp;
+           else
+               sv = Nullsv;
+       }
+       else {
+           sv = AvARRAY(av)[++cx->blk_loop.iterix];
+       }
     }
+
     if (sv && SvREFCNT(sv) == 0) {
        *itersvp = Nullsv;
        Perl_croak(aTHX_ "Use of freed value in iteration");