This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[dummy merge]
[perl5.git] / perly.y
diff --git a/perly.y b/perly.y
index 4feb549..5de74ff 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -41,23 +41,24 @@ dep()
 %token <ival> FORMAT SUB ANONSUB PACKAGE USE
 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR
 %token <ival> LOOPEX DOTDOT
-%token <ival> FUNC0 FUNC1 FUNC
+%token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP
 %token <ival> RELOP EQOP MULOP ADDOP
 %token <ival> DOLSHARP DO HASHBRACK NOAMP
 %token LOCAL MY
 
-%type <ival> prog decl local format startsub remember mremember '&'
-%type <opval> block mblock mintro lineseq line loop cond else
+%type <ival> prog decl local format startsub startanonsub startformsub
+%type <ival> remember mremember '&'
+%type <opval> block mblock lineseq line loop cond else
 %type <opval> expr term scalar ary hsh arylen star amper sideff
-%type <opval> argexpr nexpr texpr iexpr mexpr mtexpr miexpr
-%type <opval> listexpr listexprcom indirob
-%type <opval> listop method proto cont my_scalar
+%type <opval> argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr
+%type <opval> listexpr listexprcom indirob listop method
+%type <opval> formname subname proto subbody cont my_scalar
 %type <pval> label
 
 %left <ival> OROP
 %left ANDOP
 %right NOTOP
-%nonassoc <ival> LSTOP
+%nonassoc LSTOP LSTOPSUB
 %left ','
 %right <ival> ASSIGNOP
 %right '?' ':'
@@ -68,7 +69,7 @@ dep()
 %left <ival> BITANDOP
 %nonassoc EQOP
 %nonassoc RELOP
-%nonassoc <ival> UNIOP
+%nonassoc UNIOP UNIOPSUB
 %left <ival> SHIFTOP
 %left ADDOP
 %left MULOP
@@ -93,24 +94,19 @@ prog        :       /* NULL */
        ;
 
 block  :       '{' remember lineseq '}'
-                       { $$ = block_end($1,$2,$3); }
+                       { if (copline > (line_t)$1)
+                             copline = $1;
+                         $$ = block_end($2, $3); }
        ;
 
 remember:      /* NULL */      /* start a full lexical scope */
                        { $$ = block_start(TRUE); }
        ;
 
-mblock :       '{' mintro mremember lineseq '}'
-                       { if ($2)
-                           $4 = $4 ? append_list(OP_LINESEQ,
-                                         (LISTOP*)$2, (LISTOP*)$4) : $2;
-                         $$ = block_end($1, $3, $4); }
-       ;
-
-mintro :       /* NULL */      /* introduce pending lexicals */
-                       { $$ = min_intro_pending
-                             ? newSTATEOP(0, Nullch, newOP(OP_NULL, 0))
-                             : NULL; }
+mblock :       '{' mremember lineseq '}'
+                       { if (copline > (line_t)$1)
+                             copline = $1;
+                         $$ = block_end($2, $3); }
        ;
 
 mremember:     /* NULL */      /* start a partial lexical scope */
@@ -165,27 +161,19 @@ else      :       /* NULL */
                        { $$ = scope($2); }
        |       ELSIF '(' mexpr ')' mblock else
                        { copline = $1;
-                           $$ = newCONDOP(0, $3, scope($5), $6);
+                           $$ = newSTATEOP(0, Nullch,
+                                  newCONDOP(0, $3, scope($5), $6));
                            hints |= HINT_BLOCK_SCOPE; }
        ;
 
 cond   :       IF '(' remember mexpr ')' mblock else
                        { copline = $1;
-                           $$ = block_end($1, $3,
-                                   newCONDOP(0, $4, scope($6), $7)); }
+                           $$ = block_end($3,
+                                  newCONDOP(0, $4, scope($6), $7)); }
        |       UNLESS '(' remember miexpr ')' mblock else
                        { copline = $1;
-                           $$ = block_end($1, $3,
-                                   newCONDOP(0, $4, scope($6), $7)); }
-       |       IF block block else
-                       { copline = $1;
-                           deprecate("if BLOCK BLOCK");
-                           $$ = newCONDOP(0, scope($2), scope($3), $4); }
-       |       UNLESS block block else
-                       { copline = $1;
-                           deprecate("unless BLOCK BLOCK");
-                           $$ = newCONDOP(0, invert(scalar(scope($2))),
-                                               scope($3), $4); }
+                           $$ = block_end($3,
+                                  newCONDOP(0, $4, scope($6), $7)); }
        ;
 
 cont   :       /* NULL */
@@ -196,52 +184,35 @@ cont      :       /* NULL */
 
 loop   :       label WHILE '(' remember mtexpr ')' mblock cont
                        { copline = $2;
-                           $$ = block_end($2, $4,
+                           $$ = block_end($4,
                                   newSTATEOP(0, $1,
-                                     newWHILEOP(0, 1, (LOOP*)Nullop,
-                                                $5, $7, $8) )); }
+                                    newWHILEOP(0, 1, (LOOP*)Nullop,
+                                               $5, $7, $8))); }
        |       label UNTIL '(' remember miexpr ')' mblock cont
                        { copline = $2;
-                           $$ = block_end($2, $4,
+                           $$ = block_end($4,
                                   newSTATEOP(0, $1,
-                                     newWHILEOP(0, 1, (LOOP*)Nullop,
-                                                $5, $7, $8) )); }
-       |       label WHILE block block cont
-                       { copline = $2;
-                           $$ = newSTATEOP(0, $1,
-                                   newWHILEOP(0, 1, (LOOP*)Nullop,
-                                       scope($3), $4, $5) ); }
-       |       label UNTIL block block cont
-                       { copline = $2;
-                           $$ = newSTATEOP(0, $1,
-                                   newWHILEOP(0, 1, (LOOP*)Nullop,
-                                       invert(scalar(scope($3))), $4, $5)); }
-       |       label FOR MY remember my_scalar '(' expr ')' mblock cont
-                       { $$ = block_end($2, $4,
-                                 newFOROP(0, $1, $2, $5, $7, $9, $10)); }
-       |       label FOR scalar '(' expr ')' block cont
-                       { $$ = newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
-                               $5, $7, $8); }
-       |       label FOR '(' remember expr ')' mblock cont
-                       { $$ = block_end($2, $4,
+                                    newWHILEOP(0, 1, (LOOP*)Nullop,
+                                               $5, $7, $8))); }
+       |       label FOR MY remember my_scalar '(' mexpr ')' mblock cont
+                       { $$ = block_end($4,
+                                newFOROP(0, $1, $2, $5, $7, $9, $10)); }
+       |       label FOR scalar '(' remember mexpr ')' mblock cont
+                       { $$ = block_end($5,
+                                newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
+                                         $6, $8, $9)); }
+       |       label FOR '(' remember mexpr ')' mblock cont
+                       { $$ = block_end($4,
                                 newFOROP(0, $1, $2, Nullop, $5, $7, $8)); }
-       |       label FOR '(' remember nexpr ';'
-                               { if ($5) {
-                                   $5 = scalar($5);
-                                   if (min_intro_pending)
-                                     $5 = newSTATEOP(0, Nullch, $5); } }
-                             texpr ';'
-                               { $8 = scalar($8);
-                                 if (min_intro_pending)
-                                   $8 = newSTATEOP(0, Nullch, $8); }
-                             nexpr ')' mblock
+       |       label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock
                        /* basically fake up an initialize-while lineseq */
                        { copline = $2;
-                           $$ = block_end($2, $4,
-                                  append_elem(OP_LINESEQ, $5,
-                                     newSTATEOP(0, $1,
-                                        newWHILEOP(0, 1, (LOOP*)Nullop,
-                                                   $8, $13, scalar($11))))); }
+                           $$ = block_end($4,
+                                  append_elem(OP_LINESEQ, scalar($5),
+                                    newSTATEOP(0, $1,
+                                      newWHILEOP(0, 1, (LOOP*)Nullop,
+                                                 scalar($7),
+                                                 $11, scalar($9))))); }
        |       label block cont  /* a block is a loop that happens once */
                        { $$ = newSTATEOP(0,
                                $1, newWHILEOP(0, 1, (LOOP*)Nullop,
@@ -263,18 +234,19 @@ iexpr     :       expr
        ;
 
 mexpr  :       expr
-                       { $$ = min_intro_pending
-                               ? newSTATEOP(0, Nullch, $1) : $1; }
+                       { $$ = $1; intro_my(); }
+       ;
+
+mnexpr :       nexpr
+                       { $$ = $1; intro_my(); }
        ;
 
 mtexpr :       texpr
-                       { $$ = min_intro_pending
-                               ? newSTATEOP(0, Nullch, $1) : $1; }
+                       { $$ = $1; intro_my(); }
        ;
 
 miexpr :       iexpr
-                       { $$ = min_intro_pending
-                               ? newSTATEOP(0, Nullch, $1) : $1; }
+                       { $$ = $1; intro_my(); }
        ;
 
 label  :       /* empty */
@@ -292,25 +264,43 @@ decl      :       format
                        { $$ = 0; }
        ;
 
-format :       FORMAT startsub WORD block
+format :       FORMAT startformsub formname block
                        { newFORM($2, $3, $4); }
-       |       FORMAT startsub block
-                       { newFORM($2, Nullop, $3); }
        ;
 
-subrout        :       SUB startsub WORD proto block
+formname:      WORD            { $$ = $1; }
+       |       /* NULL */      { $$ = Nullop; }
+       ;
+
+subrout        :       SUB startsub subname proto subbody
                        { newSUB($2, $3, $4, $5); }
-       |       SUB startsub WORD proto ';'
-                       { newSUB($2, $3, $4, Nullop); expect = XSTATE; }
+       ;
+
+startsub:      /* NULL */      /* start a regular subroutine scope */
+                       { $$ = start_subparse(FALSE, 0); }
+       ;
+
+startanonsub:  /* NULL */      /* start an anonymous subroutine scope */
+                       { $$ = start_subparse(FALSE, CVf_ANON); }
+       ;
+
+startformsub:  /* NULL */      /* start a format subroutine scope */
+                       { $$ = start_subparse(TRUE, 0); }
+       ;
+
+subname        :       WORD    { char *name = SvPVx(((SVOP*)$1)->op_sv, na);
+                         if (strEQ(name, "BEGIN") || strEQ(name, "END"))
+                             CvUNIQUE_on(compcv);
+                         $$ = $1; }
        ;
 
 proto  :       /* NULL */
                        { $$ = Nullop; }
        |       THING
        ;
-               
-startsub:      /* NULL */      /* start a subroutine scope */
-                       { $$ = start_subparse(); }
+
+subbody        :       block   { $$ = $1; }
+       |       ';'     { $$ = Nullop; expect = XSTATE; }
        ;
 
 package :      PACKAGE WORD ';'
@@ -319,8 +309,10 @@ package :  PACKAGE WORD ';'
                        { package(Nullop); }
        ;
 
-use    :       USE startsub WORD WORD listexpr ';'
-                       { utilize($1, $2, $3, $4, $5); }
+use    :       USE startsub
+                       { CvUNIQUE_on(compcv); /* It's a BEGIN {} */ }
+                   WORD WORD listexpr ';'
+                       { utilize($1, $2, $4, $5, $6); }
        ;
 
 expr   :       expr ANDOP expr
@@ -362,11 +354,12 @@ listop    :       LSTOP indirob argexpr
                        { $$ = convert($1, 0, $2); }
        |       FUNC '(' listexprcom ')'
                        { $$ = convert($1, 0, $3); }
-       |       LSTOPSUB startsub block listexpr        %prec LSTOP
+       |       LSTOPSUB startanonsub block
+                       { $3 = newANONSUB($2, 0, $3); }
+                   listexpr            %prec LSTOP
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                           append_elem(OP_LIST,
-                             prepend_elem(OP_LIST, newANONSUB($2, 0, $3), $4),
-                             $1)); }
+                                append_elem(OP_LIST,
+                                  prepend_elem(OP_LIST, $3, $5), $1)); }
        ;
 
 method :       METHOD
@@ -440,7 +433,7 @@ term        :       term ASSIGNOP term
                        { $$ = newANONHASH($2); }
        |       HASHBRACK ';' '}'                               %prec '('
                        { $$ = newANONHASH(Nullop); }
-       |       ANONSUB startsub proto block                    %prec '('
+       |       ANONSUB startanonsub proto block                %prec '('
                        { $$ = newANONSUB($2, $3, $4); }
        |       scalar  %prec '('
                        { $$ = $1; }
@@ -557,7 +550,7 @@ term        :       term ASSIGNOP term
        |       FUNC0 '(' ')'
                        { $$ = newOP($1, 0); }
        |       FUNC0SUB
-                       { $$ = newUNOP(OP_ENTERSUB, 0,
+                       { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                scalar($1)); }
        |       FUNC1 '(' ')'
                        { $$ = newOP($1, OPf_SPECIAL); }