This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #123286] Lone C-style for in a block
[perl5.git] / perly.y
diff --git a/perly.y b/perly.y
index e3df831..6ba61ae 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -71,7 +71,8 @@
 %type <opval> sliceme kvslice gelem
 %type <opval> listexpr nexpr texpr iexpr mexpr mnexpr miexpr
 %type <opval> optlistexpr optexpr indirob listop method
-%type <opval> formname subname proto optsubbody cont my_scalar formblock
+%type <opval> formname subname proto optsubbody cont my_scalar my_var
+%type <opval> refgen_topic formblock
 %type <opval> subattrlist myattrlist myattrterm myterm
 %type <opval> realsubbody subsignature termbinop termunop anonymous termdo
 %type <opval> formstmtseq formline formarg
 /* Top-level choice of what kind of thing yyparse was called to parse */
 grammar        :       GRAMPROG
                        {
-                         PL_parser->expect = XSTATE;
+                         parser->expect = XSTATE;
                        }
                remember stmtseq
                        {
                          newPROG(block_end($3,$4));
+                         PL_compiling.cop_seq = 0;
                          $$ = 0;
                        }
        |       GRAMEXPR
@@ -177,33 +179,35 @@ grammar   :       GRAMPROG
 
 /* An ordinary block */
 block  :       '{' remember stmtseq '}'
-                       { if (PL_parser->copline > (line_t)$1)
-                             PL_parser->copline = (line_t)$1;
+                       { if (parser->copline > (line_t)$1)
+                             parser->copline = (line_t)$1;
                          $$ = block_end($2, $3);
                        }
        ;
 
 /* format body */
 formblock:     '=' remember ';' FORMRBRACK formstmtseq ';' '.'
-                       { if (PL_parser->copline > (line_t)$1)
-                             PL_parser->copline = (line_t)$1;
+                       { if (parser->copline > (line_t)$1)
+                             parser->copline = (line_t)$1;
                          $$ = block_end($2, $5);
                        }
        ;
 
 remember:      /* NULL */      /* start a full lexical scope */
-                       { $$ = block_start(TRUE); }
+                       { $$ = block_start(TRUE);
+                         parser->parsed_sub = 0; }
        ;
 
 mblock :       '{' mremember stmtseq '}'
-                       { if (PL_parser->copline > (line_t)$1)
-                             PL_parser->copline = (line_t)$1;
+                       { if (parser->copline > (line_t)$1)
+                             parser->copline = (line_t)$1;
                          $$ = block_end($2, $3);
                        }
        ;
 
 mremember:     /* NULL */      /* start a partial lexical scope */
-                       { $$ = block_start(FALSE); }
+                       { $$ = block_start(FALSE);
+                         parser->parsed_sub = 0; }
        ;
 
 /* A sequence of statements in the program */
@@ -279,8 +283,8 @@ barestmt:   PLUGSTMT
                                                CvOUTSIDE(PL_compcv)
                                             ))[$2->op_targ]))
                              CvCLONE_on(PL_compcv);
-                         PL_parser->in_my = 0;
-                         PL_parser->in_my_stash = NULL;
+                         parser->in_my = 0;
+                         parser->in_my_stash = NULL;
                        }
                proto subattrlist optsubbody
                        {
@@ -291,6 +295,7 @@ barestmt:   PLUGSTMT
                          ;
                          $$ = (OP*)NULL;
                          intro_my();
+                         parser->parsed_sub = 1;
                        }
        |       PACKAGE WORD WORD ';'
                        {
@@ -305,19 +310,20 @@ barestmt: PLUGSTMT
                        {
                          SvREFCNT_inc_simple_void(PL_compcv);
                          utilize($1, $2, $4, $5, $6);
+                         parser->parsed_sub = 1;
                          $$ = (OP*)NULL;
                        }
        |       IF '(' remember mexpr ')' mblock else
                        {
                          $$ = block_end($3,
                              newCONDOP(0, $4, op_scope($6), $7));
-                         PL_parser->copline = (line_t)$1;
+                         parser->copline = (line_t)$1;
                        }
        |       UNLESS '(' remember miexpr ')' mblock else
                        {
                          $$ = block_end($3,
                              newCONDOP(0, $4, op_scope($6), $7));
-                         PL_parser->copline = (line_t)$1;
+                         parser->copline = (line_t)$1;
                        }
        |       GIVEN '(' remember mexpr ')' mblock
                        {
@@ -328,7 +334,7 @@ barestmt:   PLUGSTMT
                                    || PAD_COMPNAME_FLAGS_isOUR(offset)
                                      ? 0
                                      : offset));
-                         PL_parser->copline = (line_t)$1;
+                         parser->copline = (line_t)$1;
                        }
        |       WHEN '(' remember mexpr ')' mblock
                        { $$ = block_end($3, newWHENOP($4, op_scope($6))); }
@@ -339,14 +345,14 @@ barestmt: PLUGSTMT
                          $$ = block_end($3,
                                  newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
                                      $4, $7, $8, $6));
-                         PL_parser->copline = (line_t)$1;
+                         parser->copline = (line_t)$1;
                        }
        |       UNTIL '(' remember iexpr ')' mintro mblock cont
                        {
                          $$ = block_end($3,
                                  newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
                                      $4, $7, $8, $6));
-                         PL_parser->copline = (line_t)$1;
+                         parser->copline = (line_t)$1;
                        }
        |       FOR '(' remember mnexpr ';'
                        { parser->expect = XTERM; }
@@ -364,25 +370,49 @@ barestmt: PLUGSTMT
                                      newOP(OP_UNSTACK, OPf_SPECIAL),
                                      forop));
                          }
+                         PL_hints |= HINT_BLOCK_SCOPE;
                          $$ = block_end($3, forop);
-                         PL_parser->copline = (line_t)$1;
+                         parser->copline = (line_t)$1;
                        }
        |       FOR MY remember my_scalar '(' mexpr ')' mblock cont
                        {
                          $$ = block_end($3, newFOROP(0, $4, $6, $8, $9));
-                         PL_parser->copline = (line_t)$1;
+                         parser->copline = (line_t)$1;
                        }
        |       FOR scalar '(' remember mexpr ')' mblock cont
                        {
                          $$ = block_end($4, newFOROP(0,
                                      op_lvalue($2, OP_ENTERLOOP), $5, $7, $8));
-                         PL_parser->copline = (line_t)$1;
+                         parser->copline = (line_t)$1;
+                       }
+       |       FOR REFGEN MY remember my_var
+                       { parser->in_my = 0; $<opval>$ = my($5); }
+               '(' mexpr ')' mblock cont
+                       {
+                         $$ = block_end(
+                               $4,
+                               newFOROP(0,
+                                        op_lvalue(
+                                           newUNOP(OP_REFGEN, 0,
+                                                   $<opval>6),
+                                           OP_ENTERLOOP),
+                                        $8, $10, $11)
+                         );
+                         parser->copline = (line_t)$1;
+                       }
+       |       FOR REFGEN refgen_topic '(' remember mexpr ')' mblock cont
+                       {
+                         $$ = block_end($5, newFOROP(
+                               0, op_lvalue(newUNOP(OP_REFGEN, 0,
+                                                    $3),
+                                            OP_ENTERLOOP), $6, $8, $9));
+                         parser->copline = (line_t)$1;
                        }
        |       FOR '(' remember mexpr ')' mblock cont
                        {
                          $$ = block_end($3,
                                  newFOROP(0, (OP*)NULL, $4, $6, $7));
-                         PL_parser->copline = (line_t)$1;
+                         parser->copline = (line_t)$1;
                        }
        |       block cont
                        {
@@ -402,8 +432,8 @@ barestmt:   PLUGSTMT
                          /* a block is a loop that happens once */
                          $$ = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
                                  (OP*)NULL, block_end($5, $7), (OP*)NULL, 0);
-                         if (PL_parser->copline > (line_t)$4)
-                             PL_parser->copline = (line_t)$4;
+                         if (parser->copline > (line_t)$4)
+                             parser->copline = (line_t)$4;
                        }
        |       sideff ';'
                        {
@@ -412,7 +442,7 @@ barestmt:   PLUGSTMT
        |       ';'
                        {
                          $$ = (OP*)NULL;
-                         PL_parser->copline = NOLINE;
+                         parser->copline = NOLINE;
                        }
        ;
 
@@ -426,11 +456,11 @@ formline: THING formarg
                          else {
                              list = $1;
                          }
-                         if (PL_parser->copline == NOLINE)
-                              PL_parser->copline = CopLINE(PL_curcop)-1;
-                         else PL_parser->copline--;
+                         if (parser->copline == NOLINE)
+                              parser->copline = CopLINE(PL_curcop)-1;
+                         else parser->copline--;
                          $$ = newSTATEOP(0, NULL,
-                                         convert(OP_FORMLINE, 0, list));
+                                         op_convert_list(OP_FORMLINE, 0, list));
                        }
        ;
 
@@ -455,7 +485,7 @@ sideff      :       error
                        { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1); }
        |       expr FOR expr
                        { $$ = newFOROP(0, (OP*)NULL, $3, $1, (OP*)NULL);
-                         PL_parser->copline = (line_t)$2; }
+                         parser->copline = (line_t)$2; }
        |       expr WHEN expr
                        { $$ = newWHENOP($3, op_scope($1)); }
        ;
@@ -469,7 +499,7 @@ else        :       /* NULL */
                          $$ = op_scope($2);
                        }
        |       ELSIF '(' mexpr ')' mblock else
-                       { PL_parser->copline = (line_t)$1;
+                       { parser->copline = (line_t)$1;
                            $$ = newCONDOP(0,
                                newSTATEOP(OPf_SPECIAL,NULL,$3),
                                op_scope($5), $6);
@@ -585,15 +615,15 @@ subsignature:     /* NULL */ { $$ = (OP*)NULL; }
                        {
                          $$ = op_append_list(OP_LINESEQ, $<opval>2,
                                newSTATEOP(0, NULL, sawparens(newNULLLIST())));
-                         PL_parser->expect = XBLOCK;
+                         parser->expect = XBLOCK;
                        }
        ;
 
 /* Subroutine body - block with optional signature */
 realsubbody:   remember subsignature '{' stmtseq '}'
                        {
-                         if (PL_parser->copline > (line_t)$3)
-                             PL_parser->copline = (line_t)$3;
+                         if (parser->copline > (line_t)$3)
+                             parser->copline = (line_t)$3;
                          $$ = block_end($1,
                                op_append_list(OP_LINESEQ, $2, $4));
                        }
@@ -627,40 +657,40 @@ listexpr: listexpr ','
 
 /* List operators */
 listop :       LSTOP indirob listexpr /* map {...} @args or print $fh @args */
-                       { $$ = convert($1, OPf_STACKED,
+                       { $$ = op_convert_list($1, OPf_STACKED,
                                op_prepend_elem(OP_LIST, newGVREF($1,$2), $3) );
                        }
        |       FUNC '(' indirob expr ')'      /* print ($fh @args */
-                       { $$ = convert($1, OPf_STACKED,
+                       { $$ = op_convert_list($1, OPf_STACKED,
                                op_prepend_elem(OP_LIST, newGVREF($1,$3), $4) );
                        }
        |       term ARROW method '(' optexpr ')' /* $foo->bar(list) */
-                       { $$ = convert(OP_ENTERSUB, OPf_STACKED,
+                       { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST,
                                    op_prepend_elem(OP_LIST, scalar($1), $5),
-                                   newUNOP(OP_METHOD, 0, $3)));
+                                   newMETHOP(OP_METHOD, 0, $3)));
                        }
        |       term ARROW method                     /* $foo->bar */
-                       { $$ = convert(OP_ENTERSUB, OPf_STACKED,
+                       { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST, scalar($1),
-                                   newUNOP(OP_METHOD, 0, $3)));
+                                   newMETHOP(OP_METHOD, 0, $3)));
                        }
        |       METHOD indirob optlistexpr           /* new Class @args */
-                       { $$ = convert(OP_ENTERSUB, OPf_STACKED,
+                       { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST,
                                    op_prepend_elem(OP_LIST, $2, $3),
-                                   newUNOP(OP_METHOD, 0, $1)));
+                                   newMETHOP(OP_METHOD, 0, $1)));
                        }
        |       FUNCMETH indirob '(' optexpr ')'    /* method $object (@args) */
-                       { $$ = convert(OP_ENTERSUB, OPf_STACKED,
+                       { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST,
                                    op_prepend_elem(OP_LIST, $2, $4),
-                                   newUNOP(OP_METHOD, 0, $1)));
+                                   newMETHOP(OP_METHOD, 0, $1)));
                        }
        |       LSTOP optlistexpr                    /* print @args */
-                       { $$ = convert($1, 0, $2); }
+                       { $$ = op_convert_list($1, 0, $2); }
        |       FUNC '(' optexpr ')'                 /* print (@args) */
-                       { $$ = convert($1, 0, $3); }
+                       { $$ = op_convert_list($1, 0, $3); }
        |       LSTOPSUB startanonsub block /* sub f(&@);   f { foo } ... */
                        { SvREFCNT_inc_simple_void(PL_compcv);
                          $<opval>$ = newANONATTRSUB($2, 0, (OP*)NULL, $3); }
@@ -680,9 +710,7 @@ method      :       METHOD
 subscripted:    gelem '{' expr ';' '}'        /* *main::{something} */
                         /* In this and all the hash accessors, ';' is
                          * provided by the tokeniser */
-                       { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3));
-                           PL_parser->expect = XOPERATOR;
-                       }
+                       { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); }
        |       scalar '[' expr ']'          /* $array[$element] */
                        { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3));
                        }
@@ -698,20 +726,15 @@ subscripted:    gelem '{' expr ';' '}'        /* *main::{something} */
                        }
        |       scalar '{' expr ';' '}'    /* $foo{bar();} */
                        { $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
-                           PL_parser->expect = XOPERATOR;
                        }
        |       term ARROW '{' expr ';' '}' /* somehref->{bar();} */
                        { $$ = newBINOP(OP_HELEM, 0,
                                        ref(newHVREF($1),OP_RV2HV),
-                                       jmaybe($4));
-                           PL_parser->expect = XOPERATOR;
-                       }
+                                       jmaybe($4)); }
        |       subscripted '{' expr ';' '}' /* $foo->[bar]->{baz;} */
                        { $$ = newBINOP(OP_HELEM, 0,
                                        ref(newHVREF($1),OP_RV2HV),
-                                       jmaybe($3));
-                           PL_parser->expect = XOPERATOR;
-                       }
+                                       jmaybe($3)); }
        |       term ARROW '(' ')'          /* $subref->() */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                   newCVREF(0, scalar($1))); }
@@ -786,7 +809,7 @@ termunop : '-' term %prec UMINUS                       /* -$x */
                        { $$ = newUNOP(OP_POSTDEC, 0,
                                        op_lvalue(scalar($1), OP_POSTDEC));}
        |       term POSTJOIN    /* implicit join after interpolated ->@ */
-                       { $$ = convert(OP_JOIN, 0,
+                       { $$ = op_convert_list(OP_JOIN, 0,
                                       op_append_elem(
                                        OP_LIST,
                                        newSVREF(scalar(
@@ -886,7 +909,6 @@ term        :       termbinop
                          if ($$ && $1)
                              $$->op_private |=
                                  $1->op_private & OPpSLICEWARNING;
-                           PL_parser->expect = XOPERATOR;
                        }
        |       kvslice '{' expr ';' '}'                 /* %hash{@keys} */
                        { $$ = op_prepend_elem(OP_KVHSLICE,
@@ -897,7 +919,6 @@ term        :       termbinop
                          if ($$ && $1)
                              $$->op_private |=
                                  $1->op_private & OPpSLICEWARNING;
-                           PL_parser->expect = XOPERATOR;
                        }
        |       THING   %prec '('
                        { $$ = $1; }
@@ -1024,7 +1045,16 @@ optexpr: /* NULL */
 /* A little bit of trickery to make "for my $foo (@bar)" actually be
    lexical */
 my_scalar:     scalar
-                       { PL_parser->in_my = 0; $$ = my($1); }
+                       { parser->in_my = 0; $$ = my($1); }
+       ;
+
+my_var :       scalar
+       |       ary
+       |       hsh
+       ;
+
+refgen_topic:  my_var
+       |       amper
        ;
 
 amper  :       '&' indirob