This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Inline list constants
authorFather Chrysostomos <sprout@cpan.org>
Sun, 30 Jun 2013 07:20:33 +0000 (00:20 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 26 Jul 2013 06:48:02 +0000 (23:48 -0700)
These are inlined the same way as 1..5.  We have two ops:

  rv2av
    |
    `-- const

The const op returns an AV, which is stored in the op tree, and then
rv2av flattens it.

embed.fnc
embed.h
op.c
proto.h
toke.c

index 8aed92a..1426d57 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -300,6 +300,7 @@ p   |void   |cv_ckproto_len_flags   |NN const CV* cv|NULLOK const GV* gv\
 : Used in pp.c and pp_sys.c
 ApdR   |SV*    |gv_const_sv    |NN GV* gv
 ApdR   |SV*    |cv_const_sv    |NULLOK const CV *const cv
+pR     |SV*    |cv_const_sv_or_av|NULLOK const CV *const cv
 : Used in pad.c
 pR     |SV*    |op_const_sv    |NULLOK const OP* o|NULLOK CV* cv
 Apd    |void   |cv_undef       |NN CV* cv
diff --git a/embed.h b/embed.h
index 353357b..039cde4 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define croak_popstack         Perl_croak_popstack
 #define cv_ckproto_len_flags(a,b,c,d,e)        Perl_cv_ckproto_len_flags(aTHX_ a,b,c,d,e)
 #define cv_clone_into(a,b)     Perl_cv_clone_into(aTHX_ a,b)
+#define cv_const_sv_or_av(a)   Perl_cv_const_sv_or_av(aTHX_ a)
 #define cv_forget_slab(a)      Perl_cv_forget_slab(aTHX_ a)
 #define cvgv_set(a,b)          Perl_cvgv_set(aTHX_ a,b)
 #define cvstash_set(a,b)       Perl_cvstash_set(aTHX_ a,b)
diff --git a/op.c b/op.c
index f9ca03f..a6312d3 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6875,6 +6875,16 @@ Perl_cv_const_sv(pTHX_ const CV *const cv)
     return sv;
 }
 
+SV *
+Perl_cv_const_sv_or_av(pTHX_ const CV * const cv)
+{
+    PERL_UNUSED_CONTEXT;
+    if (!cv)
+       return NULL;
+    assert (SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM);
+    return CvCONST(cv) ? MUTABLE_SV(CvXSUBANY(cv).any_ptr) : NULL;
+}
+
 /* op_const_sv:  examine an optree to determine whether it's in-lineable.
  * Can be called in 3 ways:
  *
@@ -8582,6 +8592,7 @@ Perl_ck_rvconst(pTHX_ OP *o)
                Perl_croak(aTHX_ "Constant is not %s reference", badtype);
            return o;
        }
+       if (SvTYPE(kidsv) == SVt_PVAV) return o;
        if ((o->op_private & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
            const char *badthing;
            switch (o->op_type) {
diff --git a/proto.h b/proto.h
index 89c7316..aca7030 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -746,6 +746,9 @@ PERL_CALLCONV CV*   Perl_cv_clone_into(pTHX_ CV* proto, CV *target)
 PERL_CALLCONV SV*      Perl_cv_const_sv(pTHX_ const CV *const cv)
                        __attribute__warn_unused_result__;
 
+PERL_CALLCONV SV*      Perl_cv_const_sv_or_av(pTHX_ const CV *const cv)
+                       __attribute__warn_unused_result__;
+
 PERL_CALLCONV void     Perl_cv_forget_slab(pTHX_ CV *cv)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_CV_FORGET_SLAB        \
diff --git a/toke.c b/toke.c
index 1781899..c030aec 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -7323,7 +7323,7 @@ Perl_yylex(pTHX)
                        d = s + 1;
                        while (SPACE_OR_TAB(*d))
                            d++;
-                       if (*d == ')' && (sv = cv_const_sv(cv))) {
+                       if (*d == ')' && (sv = cv_const_sv_or_av(cv))) {
                            s = d + 1;
                            goto its_constant;
                        }
@@ -7387,14 +7387,19 @@ Perl_yylex(pTHX)
                             UTF8fARG(UTF, l, PL_tokenbuf));
                     }
                    /* Check for a constant sub */
-                   if ((sv = cv_const_sv(cv))) {
+                   if ((sv = cv_const_sv_or_av(cv))) {
                  its_constant:
                        op_free(rv2cv_op);
                        SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
                        ((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
-                       pl_yylval.opval->op_private = OPpCONST_FOLDED;
-                       pl_yylval.opval->op_folded = 1;
-                       pl_yylval.opval->op_flags |= OPf_SPECIAL;
+                       if (SvTYPE(sv) == SVt_PVAV)
+                           pl_yylval.opval = newUNOP(OP_RV2AV, OPf_PARENS,
+                                                     pl_yylval.opval);
+                       else {
+                           pl_yylval.opval->op_private = OPpCONST_FOLDED;
+                           pl_yylval.opval->op_folded = 1;
+                           pl_yylval.opval->op_flags |= OPf_SPECIAL;
+                       }
                        TOKEN(WORD);
                    }