In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/ef7999f1f1914f1a33743bbfa196e39f7f041445?hp=fd017c00b1282d493d81ce54d392bc0c3a3ae001>
- Log -----------------------------------------------------------------
commit ef7999f1f1914f1a33743bbfa196e39f7f041445
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Oct 12 00:20:26 2014 -0700
Optimise my(@array)=split
Even though we canât optimise away the array op for my(@array),
local(@array), and @{foo()}, we can still optimise away the assign-
ment. Just have split pop the array off the stack and Bobâs
your Uncle.
-----------------------------------------------------------------------
Summary of changes:
lib/B/Deparse.pm | 7 ++++++-
lib/B/Deparse.t | 3 +++
op.c | 23 ++++++++++++++++++++++-
pp.c | 6 +++---
4 files changed, 34 insertions(+), 5 deletions(-)
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 00a9a3c..ce86193 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -4972,12 +4972,15 @@ sub pp_split {
# figures out for us which it is.
my $replroot = $kid->pmreplroot;
my $gv = 0;
+ my $stacked = $op->flags & OPf_STACKED;
if (ref($replroot) eq "B::GV") {
$gv = $replroot;
} elsif (!ref($replroot) and $replroot > 0) {
$gv = $self->padval($replroot);
} elsif ($kid->targ) {
$ary = $self->padname($kid->targ)
+ } elsif ($stacked) {
+ $ary = $self->deparse($op->last, 7);
}
$ary = $self->maybe_local(@_,
$self->stash_variable('@',
@@ -4985,7 +4988,9 @@ sub pp_split {
$cx))
if $gv;
- for (; !null($kid); $kid = $kid->sibling) {
+ # Skip the last kid when OPf_STACKED is set, since it is the array
+ # on the left.
+ for (; !null($stacked ? $kid->sibling : $kid); $kid = $kid->sibling) {
push @exprs, $self->deparse($kid, 6);
}
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 21e6cdc..b51fe28 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -535,6 +535,9 @@ our @ary;
# Split to our array
our @array = split(//, 'foo', 0);
####
+# Split to my array
+my @array = split(//, 'foo', 0);
+####
# bug #40055
do { () };
####
diff --git a/op.c b/op.c
index 9f2db9c..9a8cfb6 100644
--- a/op.c
+++ b/op.c
@@ -1696,6 +1696,7 @@ Perl_scalarvoid(pTHX_ OP *o)
kid = cLISTOPo->op_first;
if (kid && kid->op_type == OP_PUSHRE
&& !kid->op_targ
+ && !(o->op_flags & OPf_STACKED)
#ifdef USE_ITHREADS
&& !((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff)
#else
@@ -6123,7 +6124,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
o->op_private |= OPpASSIGN_COMMON;
}
- if (right && right->op_type == OP_SPLIT) {
+ if (right && right->op_type == OP_SPLIT
+ && !(right->op_flags & OPf_STACKED)) {
OP* tmpop = ((LISTOP*)right)->op_first;
if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
PMOP * const pm = (PMOP*)tmpop;
@@ -6157,6 +6159,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
pm->op_targ = left->op_targ;
left->op_targ = 0; /* filch it */
}
+ detach_split:
tmpop = cUNOPo->op_first; /* to list (nulled) */
tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
/* detach rest of siblings from o subtree,
@@ -6167,6 +6170,24 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
/* "I don't know and I don't care." */
return right;
}
+ else if (left->op_type == OP_RV2AV
+ || left->op_type == OP_PADAV)
+ {
+ /* Detach the array. */
+#ifdef DEBUGGING
+ OP * const ary =
+#endif
+ op_sibling_splice(cBINOPo->op_last,
+ cUNOPx(cBINOPo->op_last)
+ ->op_first, 1, NULL);
+ assert(ary == left);
+ /* Attach it to the split. */
+ op_sibling_splice(right, cLISTOPx(right)->op_last,
+ 0, left);
+ right->op_flags |= OPf_STACKED;
+ /* Detach split and expunge aassign as above. */
+ goto detach_split;
+ }
else if (PL_modcount < RETURN_UNLIMITED_NUMBER &&
((LISTOP*)right)->op_last->op_type == OP_CONST)
{
diff --git a/pp.c b/pp.c
index 80dae1e..25e3ac4 100644
--- a/pp.c
+++ b/pp.c
@@ -5528,7 +5528,7 @@ PP(pp_reverse)
PP(pp_split)
{
dSP; dTARG;
- AV *ary;
+ AV *ary = PL_op->op_flags & OPf_STACKED ? (AV *)POPs : NULL;
IV limit = POPi; /* note, negative is forever */
SV * const sv = POPs;
STRLEN len;
@@ -5577,8 +5577,8 @@ PP(pp_split)
ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv);
}
#endif
- else
- ary = pm->op_targ ? (AV *)PAD_SVl(pm->op_targ) : NULL;
+ else if (pm->op_targ)
+ ary = (AV *)PAD_SVl(pm->op_targ);
if (ary) {
realarray = 1;
PUTBACK;
--
Perl5 Master Repository
