In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/73f4c4fe76492cf68c8a57ccae33a9a3e5a87206?hp=c1bd5aaaae0e00fe17b9337100f4941bed955561>
- Log -----------------------------------------------------------------
commit 73f4c4fe76492cf68c8a57ccae33a9a3e5a87206
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Oct 12 08:10:41 2014 -0700
Optimise "@_" to a single join
instead of stringify(join(...)).
M embed.h
M lib/B/Deparse.t
M op.c
M opcode.h
M proto.h
M regen/op_private
M regen/opcodes
M t/op/opt.t
commit 457427054efbb32a4c1e4298aa72a5221d72628f
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Oct 12 06:58:11 2014 -0700
opt.t: Test split-to-array optimisation
M t/op/opt.t
-----------------------------------------------------------------------
Summary of changes:
embed.h | 1 +
lib/B/Deparse.t | 8 ++++----
op.c | 14 ++++++++++++++
opcode.h | 2 +-
proto.h | 6 ++++++
regen/op_private | 1 +
regen/opcodes | 2 +-
t/op/opt.t | 22 +++++++++++++++++++++-
8 files changed, 49 insertions(+), 7 deletions(-)
diff --git a/embed.h b/embed.h
index b4176c7..8231b87 100644
--- a/embed.h
+++ b/embed.h
@@ -1121,6 +1121,7 @@
#define ck_sort(a) Perl_ck_sort(aTHX_ a)
#define ck_spair(a) Perl_ck_spair(aTHX_ a)
#define ck_split(a) Perl_ck_split(aTHX_ a)
+#define ck_stringify(a) Perl_ck_stringify(aTHX_ a)
#define ck_subr(a) Perl_ck_subr(aTHX_ a)
#define ck_substr(a) Perl_ck_substr(aTHX_ a)
#define ck_svconst(a) Perl_ck_svconst(aTHX_ a)
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index b51fe28..0046ce1 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -243,13 +243,13 @@ like($a, qr/-e syntax OK/,
# [perl #93990]
@] = ();
-is($deparse->coderef2text(sub{ print "@{]}" }),
+is($deparse->coderef2text(sub{ print "foo@{]}" }),
q<{
- print "@{]}";
+ print "foo@{]}";
}>, 'curly around to interpolate "@{]}"');
-is($deparse->coderef2text(sub{ print "@{-}" }),
+is($deparse->coderef2text(sub{ print "foo@{-}" }),
q<{
- print "@-";
+ print "foo@-";
}>, 'no need to curly around to interpolate "@-"');
# Strict hints in %^H are mercilessly suppressed
diff --git a/op.c b/op.c
index f1cdc0a..1de26ae 100644
--- a/op.c
+++ b/op.c
@@ -10610,6 +10610,20 @@ Perl_ck_split(pTHX_ OP *o)
}
OP *
+Perl_ck_stringify(pTHX_ OP *o)
+{
+ OP * const kid = OP_SIBLING(cUNOPo->op_first);
+ PERL_ARGS_ASSERT_CK_STRINGIFY;
+ if (kid->op_type == OP_JOIN) {
+ assert(!OP_HAS_SIBLING(kid));
+ op_sibling_splice(o, cUNOPo->op_first, -1, NULL);
+ op_free(o);
+ return kid;
+ }
+ return ck_fun(o);
+}
+
+OP *
Perl_ck_join(pTHX_ OP *o)
{
OP * const kid = OP_SIBLING(cLISTOPo->op_first);
diff --git a/opcode.h b/opcode.h
index 142c75e..f555e91 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1413,7 +1413,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
Perl_ck_null, /* subtract */
Perl_ck_null, /* i_subtract */
Perl_ck_concat, /* concat */
- Perl_ck_fun, /* stringify */
+ Perl_ck_stringify, /* stringify */
Perl_ck_bitop, /* left_shift */
Perl_ck_bitop, /* right_shift */
Perl_ck_cmp, /* lt */
diff --git a/proto.h b/proto.h
index 8844932..0423160 100644
--- a/proto.h
+++ b/proto.h
@@ -651,6 +651,12 @@ PERL_CALLCONV OP * Perl_ck_split(pTHX_ OP *o)
#define PERL_ARGS_ASSERT_CK_SPLIT \
assert(o)
+PERL_CALLCONV OP * Perl_ck_stringify(pTHX_ OP *o)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_CK_STRINGIFY \
+ assert(o)
+
PERL_CALLCONV OP * Perl_ck_subr(pTHX_ OP *o)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
diff --git a/regen/op_private b/regen/op_private
index 94f1a9a..8d82142 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -239,6 +239,7 @@ use strict;
ops_with_check('ck_lfun'),
ops_with_check('ck_open'),
ops_with_check('ck_select'),
+ ops_with_check('ck_stringify'),
ops_with_check('ck_tell'),
ops_with_check('ck_trunc'),
;
diff --git a/regen/opcodes b/regen/opcodes
index d610d30..e0d3c9e 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -133,7 +133,7 @@ i_add integer addition (+) ck_null
ifsT2 S S
subtract subtraction (-) ck_null IfsT2 S S
i_subtract integer subtraction (-) ck_null ifsT2 S S
concat concatenation (.) or string ck_concat fsT2 S S
-stringify string ck_fun fsT@ S
+stringify string ck_stringify fsT@ S
left_shift left bitshift (<<) ck_bitop fsT2 S S
right_shift right bitshift (>>) ck_bitop fsT2 S S
diff --git a/t/op/opt.t b/t/op/opt.t
index 3090e35..892ec95 100644
--- a/t/op/opt.t
+++ b/t/op/opt.t
@@ -9,7 +9,7 @@ BEGIN {
@INC = '../lib';
}
-plan 12;
+plan 18;
use B qw 'svref_2object OPpASSIGN_COMMON';
@@ -50,3 +50,23 @@ for (['CONSTANT', sub { join "foo", "bar" }, 0,
"bar" ],
is $last_expr->name, 'const', "$tn optimised to constant";
is $sub->(), $expect, "$tn folded correctly";
}
+
+
+# split to array
+
+for(['@pkgary' , '@_' ],
+ ['@lexary' , 'my @a; @a'],
+ ['my(@array)' , 'my(@a)' ],
+ ['local(@array)', 'local(@_)'],
+ ['@{...}' , '@{\@_}' ],
+){
+ my($tn,$code) = @$_;
+ my $sub = eval "sub { $code = split }";
+ my $split = svref_2object($sub)->ROOT->first->last;
+ is $split->name, 'split', "$tn = split swallows up the assignment";
+}
+
+
+# stringify with join kid --> join
+is svref_2object(sub { "@_" })->ROOT->first->last->name, 'join',
+ 'qq"@_" optimised from stringify(join(...)) to join(...)';
--
Perl5 Master Repository
