[dummy merge]

[perl5.git] / perly.y

diff --git a/perly.y b/perly.y
index 5ee78f8..5de74ff 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -46,12 +46,13 @@ dep()
 %token <ival> DOLSHARP DO HASHBRACK NOAMP
 %token LOCAL MY
 
-%type <ival> prog decl local format startsub remember mremember '&'
+%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 mnexpr mtexpr miexpr
-%type <opval> listexpr listexprcom indirob
-%type <opval> listop method proto cont my_scalar
+%type <opval> listexpr listexprcom indirob listop method
+%type <opval> formname subname proto subbody cont my_scalar
 %type <pval> label
 
 %left <ival> OROP
@@ -173,15 +174,6 @@ cond       :       IF '(' remember mexpr ')' mblock else
                        { copline = $1;
                            $$ = block_end($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); }
        ;
 
 cont   :       /* NULL */
@@ -202,19 +194,6 @@ loop       :       label WHILE '(' remember mtexpr ')' mblock cont
                                   newSTATEOP(0, $1,
                                     newWHILEOP(0, 1, (LOOP*)Nullop,
                                                $5, $7, $8))); }
-       |       label WHILE block block cont
-                       { copline = $2;
-                           deprecate("while BLOCK BLOCK");
-                           $$ = newSTATEOP(0, $1,
-                                  newWHILEOP(0, 1, (LOOP*)Nullop,
-                                             scope($3), $4, $5)); }
-       |       label UNTIL block block cont
-                       { copline = $2;
-                           deprecate("until BLOCK BLOCK");
-                           $$ = newSTATEOP(0, $1,
-                                  newWHILEOP(0, 1, (LOOP*)Nullop,
-                                             invert(scalar(scope($3))),
-                                             $4, $5)); }
        |       label FOR MY remember my_scalar '(' mexpr ')' mblock cont
                        { $$ = block_end($4,
                                 newFOROP(0, $1, $2, $5, $7, $9, $10)); }
@@ -285,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 ';'
@@ -312,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
@@ -355,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
@@ -433,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; }
@@ -550,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); }