From 73f4c4fe76492cf68c8a57ccae33a9a3e5a87206 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 12 Oct 2014 08:10:41 -0700
Subject: [PATCH] Optimise "@_" to a single join

instead of stringify(join(...)).
---
 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       |  7 ++++++-
 8 files changed, 34 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 c95272a..892ec95 100644
--- a/t/op/opt.t
+++ b/t/op/opt.t
@@ -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(...)';
-- 
1.8.3.1