Record folded constants in the op tree

diff --git a/dump.c b/dump.c
index b5240fb..ad3b960 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -745,6 +745,7 @@ const struct flag_to_name op_const_names[] = {
     {OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"},
     {OPpCONST_STRICT, ",STRICT"},
     {OPpCONST_ENTERED, ",ENTERED"},
+    {OPpCONST_FOLDED, ",FOLDED"},
     {OPpCONST_BARE, ",BARE"}
 };
 
@@ -2923,6 +2924,8 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
                sv_catpv(tmpsv, ",STRICT");
            if (o->op_private & OPpCONST_ENTERED)
                sv_catpv(tmpsv, ",ENTERED");
+           if (o->op_private & OPpCONST_FOLDED)
+               sv_catpv(tmpsv, ",FOLDED");
        }
        else if (o->op_type == OP_FLIP) {
            if (o->op_private & OPpFLIP_LINENUM)

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 26fb34d..7e2c20f 100644 (file)
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -635,8 +635,8 @@ $priv{$_}{16} = "TARGMY"
        "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
        "setpriority", "time", "sleep");
 $priv{$_}{4} = "REVERSED" for ("enteriter", "iter");
-@{$priv{"const"}}{2,4,8,16,64} =
-    ("NOVER","SHORT","STRICT","ENTERED","BARE");
+@{$priv{"const"}}{2,4,8,16,64,128} =
+    ("NOVER","SHORT","STRICT","ENTERED","BARE","FOLD");
 $priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
 $priv{"list"}{64} = "GUESSED";
 $priv{"delete"}{64} = "SLICE";

diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t
index ebcf042..a986193 100644 (file)
--- a/ext/B/t/optree_constants.t
+++ b/ext/B/t/optree_constants.t
@@ -110,12 +110,12 @@ for $func (sort keys %$want) {
 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 -     <\@> lineseq KP ->3
 1        <;> dbstate(main 833 (eval 44):1) v ->2
-2        <\$> const[$want->{$func}[0] $want->{$func}[1]] s* ->3
+2        <\$> const[$want->{$func}[0] $want->{$func}[1]] s*/FOLD ->3
 EOT_EOT
 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 -     <\@> lineseq KP ->3
 1        <;> dbstate(main 833 (eval 44):1) v ->2
-2        <\$> const($want->{$func}[0] $want->{$func}[1]) s* ->3
+2        <\$> const($want->{$func}[0] $want->{$func}[1]) s*/FOLD ->3
 EONT_EONT
 
 }
@@ -143,14 +143,14 @@ checkOptree ( name        => 'myyes() as coderef',
 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
 # 5     <@> print vK ->6
 # 3        <0> pushmark s ->4
-# 4        <$> const[SPECIAL sv_yes] s* ->5
+# 4        <$> const[SPECIAL sv_yes] s*/FOLD ->5
 EOT_EOT
 # 6  <@> leave[1 ref] vKP/REFC ->(end)
 # 1     <0> enter ->2
 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
 # 5     <@> print vK ->6
 # 3        <0> pushmark s ->4
-# 4        <$> const(SPECIAL sv_yes) s* ->5
+# 4        <$> const(SPECIAL sv_yes) s*/FOLD ->5
 EONT_EONT
 
 
@@ -167,14 +167,14 @@ checkOptree ( name        => 'myno() as coderef',
 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
 # 5     <@> print vK ->6
 # 3        <0> pushmark s ->4
-# 4        <$> const[SPECIAL sv_no] s* ->5
+# 4        <$> const[SPECIAL sv_no] s*/FOLD ->5
 EOT_EOT
 # 6  <@> leave[1 ref] vKP/REFC ->(end)
 # 1     <0> enter ->2
 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
 # 5     <@> print vK ->6
 # 3        <0> pushmark s ->4
-# 4        <$> const(SPECIAL sv_no) s* ->5
+# 4        <$> const(SPECIAL sv_no) s*/FOLD ->5
 EONT_EONT
 
 
@@ -212,22 +212,22 @@ my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
 # 1        <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
 # 8        <@> prtf sK ->9
 # 2           <0> pushmark sM ->3
-# 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM ->4
-# 4           <$> const[IV 42] sM* ->5
-# 5           <$> const[PV "hithere"] sM* ->6
-# 6           <$> const[NV 1.414213] sM* ->7
-# 7           <$> const[NV 3.14159] sM* ->8
+# 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM/FOLD ->4
+# 4           <$> const[IV 42] sM*/FOLD ->5
+# 5           <$> const[PV "hithere"] sM*/FOLD ->6
+# 6           <$> const[NV 1.414213] sM*/FOLD ->7
+# 7           <$> const[NV 3.14159] sM*/FOLD ->8
 EOT_EOT
 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->9
 # 1        <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
 # 8        <@> prtf sK ->9
 # 2           <0> pushmark sM ->3
-# 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM ->4
-# 4           <$> const(IV 42) sM* ->5
-# 5           <$> const(PV "hithere") sM* ->6
-# 6           <$> const(NV 1.414213) sM* ->7
-# 7           <$> const(NV 3.14159) sM* ->8
+# 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM/FOLD ->4
+# 4           <$> const(IV 42) sM*/FOLD ->5
+# 5           <$> const(PV "hithere") sM*/FOLD ->6
+# 6           <$> const(NV 1.414213) sM*/FOLD ->7
+# 7           <$> const(NV 3.14159) sM*/FOLD ->8
 EONT_EONT
 
 if($] < 5.015) {
@@ -257,14 +257,14 @@ checkOptree ( name        => 'arithmetic constant folding in print',
 # 1        <;> nextstate(main 937 (eval 53):1) v ->2
 # 4        <@> print sK ->5
 # 2           <0> pushmark s ->3
-# 3           <$> const[IV 6] s ->4
+# 3           <$> const[IV 6] s/FOLD ->4
 EOT_EOT
 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->5
 # 1        <;> nextstate(main 937 (eval 53):1) v ->2
 # 4        <@> print sK ->5
 # 2           <0> pushmark s ->3
-# 3           <$> const(IV 6) s ->4
+# 3           <$> const(IV 6) s/FOLD ->4
 EONT_EONT
 
 checkOptree ( name     => 'string constant folding in print',
@@ -276,14 +276,14 @@ checkOptree ( name        => 'string constant folding in print',
 # 1        <;> nextstate(main 942 (eval 55):1) v ->2
 # 4        <@> print sK ->5
 # 2           <0> pushmark s ->3
-# 3           <$> const[PV "foobar"] s ->4
+# 3           <$> const[PV "foobar"] s/FOLD ->4
 EOT_EOT
 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->5
 # 1        <;> nextstate(main 942 (eval 55):1) v ->2
 # 4        <@> print sK ->5
 # 2           <0> pushmark s ->3
-# 3           <$> const(PV "foobar") s ->4
+# 3           <$> const(PV "foobar") s/FOLD ->4
 EONT_EONT
 
 checkOptree ( name     => 'boolean or folding',
@@ -321,7 +321,7 @@ checkOptree ( name  => 'lc*,uc*,gt,lt,ge,le,cmp',
 # -     <@> lineseq KP ->r
 # 1        <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
 # 4        <2> sassign vKS/2 ->5
-# 2           <$> const[PV "FOO.Bar.low.lOW"] s ->3
+# 2           <$> const[PV "FOO.Bar.low.lOW"] s/FOLD ->3
 # -           <1> ex-rv2sv sKRM*/1 ->4
 # 3              <#> gvsv[*s] s ->4
 # 5        <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
@@ -345,13 +345,13 @@ checkOptree ( name        => 'lc*,uc*,gt,lt,ge,le,cmp',
 # m           <0> pushmark s ->n
 # n           <$> const[PV "b-cmp-a"] s ->o
 # p        <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
-# q        <$> const[PVNV 0] s/SHORT ->r
+# q        <$> const[PVNV 0] s/FOLD,SHORT ->r
 EOT_EOT
 # r  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->r
 # 1        <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
 # 4        <2> sassign vKS/2 ->5
-# 2           <$> const(PV "FOO.Bar.low.lOW") s ->3
+# 2           <$> const(PV "FOO.Bar.low.lOW") s/FOLD ->3
 # -           <1> ex-rv2sv sKRM*/1 ->4
 # 3              <$> gvsv(*s) s ->4
 # 5        <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
@@ -375,7 +375,7 @@ EOT_EOT
 # m           <0> pushmark s ->n
 # n           <$> const(PV "b-cmp-a") s ->o
 # p        <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
-# q        <$> const(SPECIAL sv_no) s/SHORT ->r
+# q        <$> const(SPECIAL sv_no) s/FOLD,SHORT ->r
 EONT_EONT
 
 checkOptree ( name     => 'mixed constant folding, with explicit braces',
@@ -387,14 +387,14 @@ checkOptree ( name        => 'mixed constant folding, with explicit braces',
 # 1        <;> nextstate(main 977 (eval 28):1) v ->2
 # 4        <@> print sK ->5
 # 2           <0> pushmark s ->3
-# 3           <$> const[PV "foobar5"] s ->4
+# 3           <$> const[PV "foobar5"] s/FOLD ->4
 EOT_EOT
 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->5
 # 1        <;> nextstate(main 977 (eval 28):1) v ->2
 # 4        <@> print sK ->5
 # 2           <0> pushmark s ->3
-# 3           <$> const(PV "foobar5") s ->4
+# 3           <$> const(PV "foobar5") s/FOLD ->4
 EONT_EONT
 
 __END__

diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t
index 3e0b7f8..5db514c 100644 (file)
--- a/ext/B/t/optree_samples.t
+++ b/ext/B/t/optree_samples.t
@@ -617,14 +617,14 @@ checkOptree ( name        => '-e use constant j => qq{junk}; print j',
 # 1  <0> enter 
 # 2  <;> nextstate(main 71 -e:1) v:>,<,%,{
 # 3  <0> pushmark s
-# 4  <$> const[PV "junk"] s*
+# 4  <$> const[PV "junk"] s*/FOLD
 # 5  <@> print vK
 # 6  <@> leave[1 ref] vKP/REFC
 EOT_EOT
 # 1  <0> enter 
 # 2  <;> nextstate(main 71 -e:1) v:>,<,%,{
 # 3  <0> pushmark s
-# 4  <$> const(PV "junk") s*
+# 4  <$> const(PV "junk") s*/FOLD
 # 5  <@> print vK
 # 6  <@> leave[1 ref] vKP/REFC
 EONT_EONT

diff --git a/op.c b/op.c
index 311f5a0..e5707df 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3329,7 +3329,7 @@ S_fold_constants(pTHX_ register OP *o)
     if (type == OP_RV2GV)
        newop = newGVOP(OP_GV, 0, MUTABLE_GV(sv));
     else
-       newop = newSVOP(OP_CONST, 0, MUTABLE_SV(sv));
+       newop = newSVOP(OP_CONST, OPpCONST_FOLDED<<8, MUTABLE_SV(sv));
     op_getmad(o,newop,'f');
     return newop;
 
@@ -4849,6 +4849,7 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
     svop->op_sv = sv;
     svop->op_next = (OP*)svop;
     svop->op_flags = (U8)flags;
+    svop->op_private = (U8)(0 | (flags >> 8));
     if (PL_opargs[type] & OA_RETSCALAR)
        scalar((OP*)svop);
     if (PL_opargs[type] & OA_TARGET)
@@ -5850,6 +5851,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
                  || other->op_type == OP_TRANS)
                /* Mark the op as being unbindable with =~ */
                other->op_flags |= OPf_SPECIAL;
+           else if (other->op_type == OP_CONST)
+               other->op_private |= OPpCONST_FOLDED;
            return other;
        }
        else {
@@ -6007,6 +6010,8 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
              || live->op_type == OP_TRANS || live->op_type == OP_TRANSR)
            /* Mark the op as being unbindable with =~ */
            live->op_flags |= OPf_SPECIAL;
+       else if (live->op_type == OP_CONST)
+           live->op_private |= OPpCONST_FOLDED;
        return live;
     }
     NewOp(1101, logop, 1, LOGOP);

diff --git a/op.h b/op.h
index 6bc6c82..1d4f571 100644 (file)
--- a/op.h
+++ b/op.h
@@ -258,6 +258,7 @@ Deprecated.  Use C<GIMME_V> instead.
 #define        OPpCONST_STRICT         8       /* bareword subject to strict 'subs' */
 #define OPpCONST_ENTERED       16      /* Has been entered as symbol. */
 #define OPpCONST_BARE          64      /* Was a bare word (filehandle?). */
+#define OPpCONST_FOLDED                128     /* Result of constant folding */
 
 /* Private for OP_FLIP/FLOP */
 #define OPpFLIP_LINENUM                64      /* Range arg potentially a line num. */

diff --git a/toke.c b/toke.c
index ddd4319..1fa09d1 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -6912,7 +6912,7 @@ Perl_yylex(pTHX)
                        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 = 0;
+                       pl_yylval.opval->op_private = OPpCONST_FOLDED;
                        pl_yylval.opval->op_flags |= OPf_SPECIAL;
                        TOKEN(WORD);
                    }