diff options
-rw-r--r-- | ext/B/B/Concise.pm | 1 | ||||
-rw-r--r-- | op.c | 61 | ||||
-rw-r--r-- | op.h | 3 | ||||
-rw-r--r-- | pp_ctl.c | 13 | ||||
-rw-r--r-- | pp_hot.c | 38 |
5 files changed, 106 insertions, 10 deletions
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index ebd5848e60..28545b98ed 100644 --- 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"; @@ -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; @@ -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' */ @@ -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; @@ -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"); |