This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #96228] perlop misdocuments ${ qr/x/ } as undef
[perl5.git] / perly.y
diff --git a/perly.y b/perly.y
index 29fb93a..9c308a3 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -69,7 +69,7 @@
 #endif
 }
 
-%token <ival> GRAMPROG GRAMBLOCK GRAMFULLSTMT GRAMSTMTSEQ
+%token <ival> GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ
 
 %token <i_tkval> '{' '}' '[' ']' '-' '+' '$' '@' '%' '*' '&' ';'
 
 
 %type <i_tkval> lpar_or_qw
 
-%type <ival> grammar prog progstart remember mremember
+%type <ival> grammar remember mremember
 %type <ival>  startsub startanonsub startformsub
 /* FIXME for MAD - are these two ival? */
 %type <ival> mydefsv mintro
 
-%type <opval> stmtseq fullstmt barestmt block mblock else
+%type <opval> stmtseq fullstmt labfullstmt barestmt block mblock else
 %type <opval> expr term subscripted scalar ary hsh arylen star amper sideff
-%type <opval> argexpr nexpr texpr iexpr mexpr mnexpr miexpr
-%type <opval> listexpr listexprcom indirob listop method
+%type <opval> listexpr nexpr texpr iexpr mexpr mnexpr miexpr
+%type <opval> optlistexpr optexpr indirob listop method
 %type <opval> formname subname proto subbody cont my_scalar
 %type <opval> subattrlist myattrlist myattrterm myterm
 %type <opval> termbinop termunop anonymous termdo
-%type <p_tkval> label
 
 %nonassoc <i_tkval> PREC_LOW
 %nonassoc LOOPEX
 %% /* RULES */
 
 /* Top-level choice of what kind of thing yyparse was called to parse */
-grammar        :       GRAMPROG prog
-                       { $$ = $2; }
+grammar        :       GRAMPROG
+                       {
+                         PL_parser->expect = XSTATE;
+                       }
+               remember stmtseq
+                       {
+                         newPROG(block_end($3,$4));
+                         $$ = 0;
+                       }
+       |       GRAMEXPR
+                       {
+                         parser->expect = XTERM;
+                       }
+               optexpr
+                       {
+                         PL_eval_root = $3;
+                         $$ = 0;
+                       }
        |       GRAMBLOCK
                        {
                          parser->expect = XBLOCK;
@@ -153,6 +168,18 @@ grammar    :       GRAMPROG prog
                          yyunlex();
                          parser->yychar = YYEOF;
                        }
+       |       GRAMBARESTMT
+                       {
+                         parser->expect = XSTATE;
+                       }
+               barestmt
+                       {
+                         PL_pad_reset_pending = TRUE;
+                         PL_eval_root = $3;
+                         $$ = 0;
+                         yyunlex();
+                         parser->yychar = YYEOF;
+                       }
        |       GRAMFULLSTMT
                        {
                          parser->expect = XSTATE;
@@ -176,12 +203,6 @@ grammar    :       GRAMPROG prog
                        }
        ;
 
-/* The whole program */
-prog   :       progstart
-       /*CONTINUED*/   stmtseq
-                       { $$ = $1; newPROG(block_end($1,$2)); }
-       ;
-
 /* An ordinary block */
 block  :       '{' remember stmtseq '}'
                        { if (PL_parser->copline > (line_t)IVAL($1))
@@ -200,13 +221,6 @@ mydefsv:   /* NULL */      /* lexicalize $_ */
                        { $$ = (I32) Perl_allocmy(aTHX_ STR_WITH_LEN("$_"), 0); }
        ;
 
-progstart:
-               {
-                   PL_parser->expect = XSTATE; $$ = block_start(TRUE);
-               }
-       ;
-
-
 mblock :       '{' mremember stmtseq '}'
                        { if (PL_parser->copline > (line_t)IVAL($1))
                              PL_parser->copline = (line_t)IVAL($1);
@@ -231,17 +245,30 @@ stmtseq   :       /* NULL */
                        }
        ;
 
-/* A statement in the program, including optional label */
-fullstmt:      label barestmt
+/* A statement in the program, including optional labels */
+fullstmt:      barestmt
                        {
-                         if (PVAL($1) || $2) {
-                             $$ = newSTATEOP(0, PVAL($1), $2);
-                             TOKEN_GETMAD($1,
-                                 $2 ? cLISTOPx($$)->op_first : $$, 'L');
+                         if($1) {
+                             $$ = newSTATEOP(0, NULL, $1);
                          } else {
-                             $$ = IF_MAD(newOP(OP_NULL, 0), $2);
+                             $$ = IF_MAD(newOP(OP_NULL, 0), NULL);
                          }
                        }
+       |       labfullstmt
+                       { $$ = $1; }
+       ;
+
+labfullstmt:   LABEL barestmt
+                       {
+                         $$ = newSTATEOP(0, PVAL($1), $2);
+                         TOKEN_GETMAD($1,
+                             $2 ? cLISTOPx($$)->op_first : $$, 'L');
+                       }
+       |       LABEL labfullstmt
+                       {
+                         $$ = newSTATEOP(0, PVAL($1), $2);
+                         TOKEN_GETMAD($1, cLISTOPx($$)->op_first, 'L');
+                       }
        ;
 
 /* A bare statement, lacking label and other aspects of state op */
@@ -267,7 +294,7 @@ barestmt:   PLUGSTMT
 #endif
                          if (CvOUTSIDE(fmtcv) && !CvUNIQUE(CvOUTSIDE(fmtcv))) {
                              SvREFCNT_inc_simple_void(fmtcv);
-                             pad_add_anon((SV*)fmtcv, OP_NULL);
+                             pad_add_anon(fmtcv, OP_NULL);
                          }
                        }
        |       SUB startsub subname proto subattrlist subbody
@@ -320,7 +347,7 @@ barestmt:   PLUGSTMT
                        }
        |       USE startsub
                        { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
-               WORD WORD listexpr ';'
+               WORD WORD optlistexpr ';'
                        {
                          SvREFCNT_inc_simple_void(PL_compcv);
 #ifdef MAD
@@ -337,7 +364,8 @@ barestmt:   PLUGSTMT
                        }
        |       IF lpar_or_qw remember mexpr ')' mblock else
                        {
-                         $$ = block_end($3, newCONDOP(0, $4, scope($6), $7));
+                         $$ = block_end($3,
+                             newCONDOP(0, $4, op_scope($6), $7));
                          TOKEN_GETMAD($1,$$,'I');
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($5,$$,')');
@@ -345,7 +373,8 @@ barestmt:   PLUGSTMT
                        }
        |       UNLESS lpar_or_qw remember miexpr ')' mblock else
                        {
-                         $$ = block_end($3, newCONDOP(0, $4, scope($6), $7));
+                         $$ = block_end($3,
+                             newCONDOP(0, $4, op_scope($6), $7));
                          TOKEN_GETMAD($1,$$,'I');
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($5,$$,')');
@@ -354,18 +383,18 @@ barestmt: PLUGSTMT
        |       GIVEN lpar_or_qw remember mydefsv mexpr ')' mblock
                        {
                          $$ = block_end($3,
-                                 newGIVENOP($5, scope($7), (PADOFFSET)$4));
+                                 newGIVENOP($5, op_scope($7), (PADOFFSET)$4));
                          PL_parser->copline = (line_t)IVAL($1);
                        }
        |       WHEN lpar_or_qw remember mexpr ')' mblock
-                       { $$ = block_end($3, newWHENOP($4, scope($6))); }
+                       { $$ = block_end($3, newWHENOP($4, op_scope($6))); }
        |       DEFAULT block
-                       { $$ = newWHENOP(0, scope($2)); }
+                       { $$ = newWHENOP(0, op_scope($2)); }
        |       WHILE lpar_or_qw remember texpr ')' mintro mblock cont
                        {
                          $$ = block_end($3,
                                  newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
-                                     IVAL($1), $4, $7, $8, $6));
+                                     $4, $7, $8, $6));
                          TOKEN_GETMAD($1,$$,'W');
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($5,$$,')');
@@ -374,8 +403,8 @@ barestmt:   PLUGSTMT
        |       UNTIL lpar_or_qw remember iexpr ')' mintro mblock cont
                        {
                          $$ = block_end($3,
-                                 newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
-                                     IVAL($1), $4, $7, $8, $6));
+                                 newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
+                                     $4, $7, $8, $6));
                          TOKEN_GETMAD($1,$$,'W');
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($5,$$,')');
@@ -386,7 +415,7 @@ barestmt:   PLUGSTMT
                        {
                          OP *initop = IF_MAD($4 ? $4 : newOP(OP_NULL, 0), $4);
                          OP *forop = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
-                                     IVAL($1), scalar($6), $11, $9, $8);
+                                     scalar($6), $11, $9, $8);
                          if (initop) {
                              forop = op_prepend_elem(OP_LINESEQ, initop,
                                  op_append_elem(OP_LINESEQ,
@@ -404,9 +433,7 @@ barestmt:   PLUGSTMT
                        }
        |       FOR MY remember my_scalar lpar_or_qw mexpr ')' mblock cont
                        {
-                         $$ = block_end($3,
-                                 newFOROP(0, (line_t)IVAL($1),
-                                     $4, $6, $8, $9));
+                         $$ = block_end($3, newFOROP(0, $4, $6, $8, $9));
                          TOKEN_GETMAD($1,$$,'W');
                          TOKEN_GETMAD($2,$$,'d');
                          TOKEN_GETMAD($5,$$,'(');
@@ -415,9 +442,8 @@ barestmt:   PLUGSTMT
                        }
        |       FOR scalar lpar_or_qw remember mexpr ')' mblock cont
                        {
-                         $$ = block_end($4,
-                                 newFOROP(0, (line_t)IVAL($1),
-                                     mod($2, OP_ENTERLOOP), $5, $7, $8));
+                         $$ = block_end($4, newFOROP(0,
+                                     op_lvalue($2, OP_ENTERLOOP), $5, $7, $8));
                          TOKEN_GETMAD($1,$$,'W');
                          TOKEN_GETMAD($3,$$,'(');
                          TOKEN_GETMAD($6,$$,')');
@@ -426,8 +452,7 @@ barestmt:   PLUGSTMT
        |       FOR lpar_or_qw remember mexpr ')' mblock cont
                        {
                          $$ = block_end($3,
-                                 newFOROP(0, (line_t)IVAL($1),
-                                     (OP*)NULL, $4, $6, $7));
+                                 newFOROP(0, (OP*)NULL, $4, $6, $7));
                          TOKEN_GETMAD($1,$$,'W');
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($5,$$,')');
@@ -437,7 +462,7 @@ barestmt:   PLUGSTMT
                        {
                          /* a block is a loop that happens once */
                          $$ = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
-                                 NOLINE, (OP*)NULL, $1, $2, 0);
+                                 (OP*)NULL, $1, $2, 0);
                        }
        |       PACKAGE WORD WORD '{' remember
                        {
@@ -455,7 +480,7 @@ barestmt:   PLUGSTMT
                stmtseq '}'
                        {
                          /* a block is a loop that happens once */
-                         $$ = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, NOLINE,
+                         $$ = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
                                  (OP*)NULL, block_end($5, $7), (OP*)NULL, 0);
                          op_free($3);
                          if ($2)
@@ -502,25 +527,29 @@ sideff    :       error
                          TOKEN_GETMAD($2,$$,'w');
                        }
        |       expr FOR expr
-                       { $$ = newFOROP(0, (line_t)IVAL($2),
-                                       (OP*)NULL, $3, $1, (OP*)NULL);
+                       { $$ = newFOROP(0, (OP*)NULL, $3, $1, (OP*)NULL);
                          TOKEN_GETMAD($2,$$,'w');
+                         PL_parser->copline = (line_t)IVAL($2);
                        }
        |       expr WHEN expr
-                       { $$ = newWHENOP($3, scope($1)); }
+                       { $$ = newWHENOP($3, op_scope($1)); }
        ;
 
 /* else and elsif blocks */
 else   :       /* NULL */
                        { $$ = (OP*)NULL; }
        |       ELSE mblock
-                       { ($2)->op_flags |= OPf_PARENS; $$ = scope($2);
+                       {
+                         ($2)->op_flags |= OPf_PARENS;
+                         $$ = op_scope($2);
                          TOKEN_GETMAD($1,$$,'o');
                        }
        |       ELSIF lpar_or_qw mexpr ')' mblock else
                        { PL_parser->copline = (line_t)IVAL($1);
-                           $$ = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,$3), scope($5), $6);
-                           PL_hints |= HINT_BLOCK_SCOPE;
+                           $$ = newCONDOP(0,
+                               newSTATEOP(OPf_SPECIAL,NULL,$3),
+                               op_scope($5), $6);
+                         PL_hints |= HINT_BLOCK_SCOPE;
                          TOKEN_GETMAD($1,$$,'I');
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($4,$$,')');
@@ -531,7 +560,8 @@ else        :       /* NULL */
 cont   :       /* NULL */
                        { $$ = (OP*)NULL; }
        |       CONTINUE block
-                       { $$ = scope($2);
+                       {
+                         $$ = op_scope($2);
                          TOKEN_GETMAD($1,$$,'o');
                        }
        ;
@@ -574,20 +604,6 @@ miexpr     :       iexpr
                        { $$ = $1; intro_my(); }
        ;
 
-/* Optional "MAIN:"-style loop labels */
-label  :       /* empty */
-                       {
-#ifdef MAD
-                         YYSTYPE tmplval;
-                         tmplval.pval = NULL;
-                         $$ = newTOKEN(OP_NULL, tmplval, 0);
-#else
-                         $$ = NULL;
-#endif
-                       }
-       |       LABEL
-       ;
-
 formname:      WORD            { $$ = $1; }
        |       /* NULL */      { $$ = (OP*)NULL; }
        ;
@@ -677,11 +693,11 @@ expr      :       expr ANDOP expr
                        { $$ = newLOGOP(OP_DOR, 0, $1, $3);
                          TOKEN_GETMAD($2,$$,'o');
                        }
-       |       argexpr %prec PREC_LOW
+       |       listexpr %prec PREC_LOW
        ;
 
 /* Expressions are a list of terms joined by commas */
-argexpr        :       argexpr ','
+listexpr:      listexpr ','
                        {
 #ifdef MAD
                          OP* op = newNULLLIST();
@@ -691,7 +707,7 @@ argexpr     :       argexpr ','
                          $$ = $1;
 #endif
                        }
-       |       argexpr ',' term
+       |       listexpr ',' term
                        { 
                          OP* term = $3;
                          DO_MAD(
@@ -704,7 +720,7 @@ argexpr     :       argexpr ','
        ;
 
 /* List operators */
-listop :       LSTOP indirob argexpr /* map {...} @args or print $fh @args */
+listop :       LSTOP indirob listexpr /* map {...} @args or print $fh @args */
                        { $$ = convert(IVAL($1), OPf_STACKED,
                                op_prepend_elem(OP_LIST, newGVREF(IVAL($1),$2), $3) );
                          TOKEN_GETMAD($1,$$,'o');
@@ -716,7 +732,7 @@ listop      :       LSTOP indirob argexpr /* map {...} @args or print $fh @args */
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($5,$$,')');
                        }
-       |       term ARROW method lpar_or_qw listexprcom ')' /* $foo->bar(list) */
+       |       term ARROW method lpar_or_qw optexpr ')' /* $foo->bar(list) */
                        { $$ = convert(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST,
                                    op_prepend_elem(OP_LIST, scalar($1), $5),
@@ -731,13 +747,13 @@ listop    :       LSTOP indirob argexpr /* map {...} @args or print $fh @args */
                                    newUNOP(OP_METHOD, 0, $3)));
                          TOKEN_GETMAD($2,$$,'A');
                        }
-       |       METHOD indirob listexpr              /* new Class @args */
+       |       METHOD indirob optlistexpr           /* new Class @args */
                        { $$ = convert(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST,
                                    op_prepend_elem(OP_LIST, $2, $3),
                                    newUNOP(OP_METHOD, 0, $1)));
                        }
-       |       FUNCMETH indirob '(' listexprcom ')' /* method $object (@args) */
+       |       FUNCMETH indirob '(' optexpr ')'    /* method $object (@args) */
                        { $$ = convert(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST,
                                    op_prepend_elem(OP_LIST, $2, $4),
@@ -745,11 +761,11 @@ listop    :       LSTOP indirob argexpr /* map {...} @args or print $fh @args */
                          TOKEN_GETMAD($3,$$,'(');
                          TOKEN_GETMAD($5,$$,')');
                        }
-       |       LSTOP listexpr                       /* print @args */
+       |       LSTOP optlistexpr                    /* print @args */
                        { $$ = convert(IVAL($1), 0, $2);
                          TOKEN_GETMAD($1,$$,'o');
                        }
-       |       FUNC '(' listexprcom ')'             /* print (@args) */
+       |       FUNC '(' optexpr ')'                 /* print (@args) */
                        { $$ = convert(IVAL($1), 0, $3);
                          TOKEN_GETMAD($1,$$,'o');
                          TOKEN_GETMAD($2,$$,'(');
@@ -758,7 +774,7 @@ listop      :       LSTOP indirob argexpr /* map {...} @args or print $fh @args */
        |       LSTOPSUB startanonsub block /* sub f(&@);   f { foo } ... */
                        { SvREFCNT_inc_simple_void(PL_compcv);
                          $<opval>$ = newANONATTRSUB($2, 0, (OP*)NULL, $3); }
-                   listexpr            %prec LSTOP  /* ... @bar */
+                   optlistexpr         %prec LSTOP  /* ... @bar */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                 op_append_elem(OP_LIST,
                                   op_prepend_elem(OP_LIST, $<opval>4, $5), $1));
@@ -800,7 +816,7 @@ subscripted:    star '{' expr ';' '}'        /* *main::{something} */
                          TOKEN_GETMAD($2,$$,'[');
                          TOKEN_GETMAD($4,$$,']');
                        }
-       |       scalar '{' expr ';' '}'    /* $foo->{bar();} */
+       |       scalar '{' expr ';' '}'    /* $foo{bar();} */
                        { $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
                            PL_parser->expect = XOPERATOR;
                          TOKEN_GETMAD($2,$$,'{');
@@ -970,22 +986,22 @@ termunop : '-' term %prec UMINUS                       /* -$x */
                        }
        |       term POSTINC                           /* $x++ */
                        { $$ = newUNOP(OP_POSTINC, 0,
-                                       mod(scalar($1), OP_POSTINC));
+                                       op_lvalue(scalar($1), OP_POSTINC));
                          TOKEN_GETMAD($2,$$,'o');
                        }
        |       term POSTDEC                           /* $x-- */
                        { $$ = newUNOP(OP_POSTDEC, 0,
-                                       mod(scalar($1), OP_POSTDEC));
+                                       op_lvalue(scalar($1), OP_POSTDEC));
                          TOKEN_GETMAD($2,$$,'o');
                        }
        |       PREINC term                            /* ++$x */
                        { $$ = newUNOP(OP_PREINC, 0,
-                                       mod(scalar($2), OP_PREINC));
+                                       op_lvalue(scalar($2), OP_PREINC));
                          TOKEN_GETMAD($1,$$,'o');
                        }
        |       PREDEC term                            /* --$x */
                        { $$ = newUNOP(OP_PREDEC, 0,
-                                       mod(scalar($2), OP_PREDEC));
+                                       op_lvalue(scalar($2), OP_PREDEC));
                          TOKEN_GETMAD($1,$$,'o');
                        }
 
@@ -1030,7 +1046,7 @@ termdo    :       DO term %prec UNIOP                     /* do $filename */
                          TOKEN_GETMAD($1,$$,'o');
                        }
        |       DO block        %prec '('               /* do { code */
-                       { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2));
+                       { $$ = newUNOP(OP_NULL, OPf_SPECIAL, op_scope($2));
                          TOKEN_GETMAD($1,$$,'D');
                        }
        |       DO WORD lpar_or_qw ')'                  /* do somesub() */
@@ -1088,7 +1104,7 @@ term      :       termbinop
                          TOKEN_GETMAD($4,$$,':');
                        }
        |       REFGEN term                          /* \$x, \@y, \%z */
-                       { $$ = newUNOP(OP_REFGEN, 0, mod($2,OP_REFGEN));
+                       { $$ = newUNOP(OP_REFGEN, 0, op_lvalue($2,OP_REFGEN));
                          TOKEN_GETMAD($1,$$,'o');
                        }
        |       myattrterm      %prec UNIOP
@@ -1163,7 +1179,7 @@ term      :       termbinop
                              token_getmad($4,op,')');
                          })
                        }
-       |       NOAMP WORD listexpr                  /* foo(@args) */
+       |       NOAMP WORD optlistexpr               /* foo(@args) */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            op_append_elem(OP_LIST, $3, scalar($2)));
                          TOKEN_GETMAD($1,$$,'o');
@@ -1177,7 +1193,7 @@ term      :       termbinop
                        { $$ = newLOOPEX(IVAL($1),$2);
                          TOKEN_GETMAD($1,$$,'o');
                        }
-       |       NOTOP argexpr                        /* not $foo */
+       |       NOTOP listexpr                       /* not $foo */
                        { $$ = newUNOP(OP_NOT, 0, scalar($2));
                          TOKEN_GETMAD($1,$$,'o');
                        }
@@ -1234,7 +1250,7 @@ term      :       termbinop
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($4,$$,')');
                        }
-       |       PMFUNC '(' argexpr ')'          /* m//, s///, tr/// */
+       |       PMFUNC '(' listexpr ')'         /* m//, s///, tr/// */
                        { $$ = pmruntime($1, $3, 1);
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($4,$$,')');
@@ -1285,13 +1301,13 @@ myterm  :       '(' expr ')'
        ;
 
 /* Basic list expressions */
-listexpr:      /* NULL */ %prec PREC_LOW
+optlistexpr:   /* NULL */ %prec PREC_LOW
                        { $$ = (OP*)NULL; }
-       |       argexpr    %prec PREC_LOW
+       |       listexpr    %prec PREC_LOW
                        { $$ = $1; }
        ;
 
-listexprcom:   /* NULL */
+optexpr:       /* NULL */
                        { $$ = (OP*)NULL; }
        |       expr
                        { $$ = $1; }
@@ -1353,7 +1369,7 @@ indirob   :       WORD
        |       scalar %prec PREC_LOW
                        { $$ = scalar($1); }
        |       block
-                       { $$ = scope($1); }
+                       { $$ = op_scope($1); }
 
        |       PRIVATEREF
                        { $$ = $1; }