This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Optimise "@_" to a single join
authorFather Chrysostomos <sprout@cpan.org>
Sun, 12 Oct 2014 15:10:41 +0000 (08:10 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 12 Oct 2014 17:48:21 +0000 (10:48 -0700)
instead of stringify(join(...)).

embed.h
lib/B/Deparse.t
op.c
opcode.h
proto.h
regen/op_private
regen/opcodes
t/op/opt.t

diff --git a/embed.h b/embed.h
index b4176c7..8231b87 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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)
index b51fe28..0046ce1 100644 (file)
@@ -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 (file)
--- 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);
index 142c75e..f555e91 100644 (file)
--- 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 (file)
--- 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);
index 94f1a9a..8d82142 100644 (file)
@@ -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'),
                             ;
index d610d30..e0d3c9e 100644 (file)
@@ -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
index c95272a..892ec95 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-plan 17;
+plan 18;
 
 use B qw 'svref_2object OPpASSIGN_COMMON';
 
@@ -65,3 +65,8 @@ for(['@pkgary'      , '@_'       ],
     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(...)';