[inseparable changes from patch from perl5.003_12 to perl5.003_13]
[p5sagit/p5-mst-13.2.git] / perly.y
diff --git a/perly.y b/perly.y
index 78d975a..5ee78f8 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -41,22 +41,23 @@ 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 LOCAL HASHBRACK NOAMP
+%token <ival> DOLSHARP DO HASHBRACK NOAMP
+%token LOCAL MY
 
-%type <ival> prog decl format remember startsub
-%type <opval> block lineseq line loop cond nexpr else argexpr
+%type <ival> prog decl local format startsub 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> texpr listop method proto
+%type <opval> listop method proto cont my_scalar
 %type <pval> label
-%type <opval> cont
 
 %left <ival> OROP
 %left ANDOP
-%left NOTOP
-%nonassoc <ival> LSTOP
+%right NOTOP
+%nonassoc LSTOP LSTOPSUB
 %left ','
 %right <ival> ASSIGNOP
 %right '?' ':'
@@ -67,7 +68,7 @@ dep()
 %left <ival> BITANDOP
 %nonassoc EQOP
 %nonassoc RELOP
-%nonassoc <ival> UNIOP
+%nonassoc UNIOP UNIOPSUB
 %left <ival> SHIFTOP
 %left ADDOP
 %left MULOP
@@ -92,11 +93,23 @@ 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 lexical scope */
-                       { $$ = block_start(); }
+remember:      /* NULL */      /* start a full lexical scope */
+                       { $$ = block_start(TRUE); }
+       ;
+
+mblock :       '{' mremember lineseq '}'
+                       { if (copline > (line_t)$1)
+                             copline = $1;
+                         $$ = block_end($2, $3); }
+       ;
+
+mremember:     /* NULL */      /* start a partial lexical scope */
+                       { $$ = block_start(FALSE); }
        ;
 
 lineseq        :       /* NULL */
@@ -137,28 +150,29 @@ sideff    :       error
                        { $$ = newLOGOP(OP_OR, 0, $3, $1); }
        |       expr WHILE expr
                        { $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); }
-       |       expr UNTIL expr
-                       { $$ = newLOOPOP(OPf_PARENS, 1, invert(scalar($3)), $1);}
+       |       expr UNTIL iexpr
+                       { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1);}
        ;
 
 else   :       /* NULL */
                        { $$ = Nullop; }
-       |       ELSE block
+       |       ELSE mblock
                        { $$ = scope($2); }
-       |       ELSIF '(' expr ')' block else
+       |       ELSIF '(' mexpr ')' mblock else
                        { copline = $1;
-                           $$ = newSTATEOP(0, 0,
-                               newCONDOP(0, $3, scope($5), $6));
+                           $$ = newSTATEOP(0, Nullch,
+                                  newCONDOP(0, $3, scope($5), $6));
                            hints |= HINT_BLOCK_SCOPE; }
        ;
 
-cond   :       IF '(' expr ')' block else
+cond   :       IF '(' remember mexpr ')' mblock else
                        { copline = $1;
-                           $$ = newCONDOP(0, $3, scope($5), $6); }
-       |       UNLESS '(' expr ')' block else
+                           $$ = block_end($3,
+                                  newCONDOP(0, $4, scope($6), $7)); }
+       |       UNLESS '(' remember miexpr ')' mblock else
                        { copline = $1;
-                           $$ = newCONDOP(0,
-                               invert(scalar($3)), scope($5), $6); }
+                           $$ = block_end($3,
+                                  newCONDOP(0, $4, scope($6), $7)); }
        |       IF block block else
                        { copline = $1;
                            deprecate("if BLOCK BLOCK");
@@ -176,39 +190,50 @@ cont      :       /* NULL */
                        { $$ = scope($2); }
        ;
 
-loop   :       label WHILE '(' texpr ')' block cont
+loop   :       label WHILE '(' remember mtexpr ')' mblock cont
                        { copline = $2;
-                           $$ = newSTATEOP(0, $1,
-                                   newWHILEOP(0, 1, (LOOP*)Nullop,
-                                       $4, $6, $7) ); }
-       |       label UNTIL '(' expr ')' block cont
+                           $$ = block_end($4,
+                                  newSTATEOP(0, $1,
+                                    newWHILEOP(0, 1, (LOOP*)Nullop,
+                                               $5, $7, $8))); }
+       |       label UNTIL '(' remember miexpr ')' mblock cont
                        { copline = $2;
-                           $$ = newSTATEOP(0, $1,
-                                   newWHILEOP(0, 1, (LOOP*)Nullop,
-                                       invert(scalar($4)), $6, $7) ); }
+                           $$ = block_end($4,
+                                  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) ); }
+                                  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 scalar '(' expr ')' block cont
-                       { $$ = newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
-                               $5, $7, $8); }
-       |       label FOR '(' expr ')' block cont
-                       { $$ = newFOROP(0, $1, $2, Nullop, $4, $6, $7); }
-       |       label FOR '(' nexpr ';' texpr ';' nexpr ')' block
+                                  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)); }
+       |       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 mnexpr ';' mtexpr ';' mnexpr ')' mblock
                        /* basically fake up an initialize-while lineseq */
-                       {  copline = $2;
-                           $$ = append_elem(OP_LINESEQ,
-                                   newSTATEOP(0, $1, scalar($4)),
-                                   newSTATEOP(0, $1,
-                                       newWHILEOP(0, 1, (LOOP*)Nullop,
-                                           scalar($6), $10, scalar($8)) )); }
+                       { copline = $2;
+                           $$ = 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,
@@ -225,6 +250,26 @@ texpr      :       /* NULL means true */
        |       expr
        ;
 
+iexpr  :       expr
+                       { $$ = invert(scalar($1)); }
+       ;
+
+mexpr  :       expr
+                       { $$ = $1; intro_my(); }
+       ;
+
+mnexpr :       nexpr
+                       { $$ = $1; intro_my(); }
+       ;
+
+mtexpr :       texpr
+                       { $$ = $1; intro_my(); }
+       ;
+
+miexpr :       iexpr
+                       { $$ = $1; intro_my(); }
+       ;
+
 label  :       /* empty */
                        { $$ = Nullch; }
        |       LABEL
@@ -267,16 +312,14 @@ package : PACKAGE WORD ';'
                        { package(Nullop); }
        ;
 
-use    :       USE WORD listexpr ';'
-                       { utilize($1, $2, $3); }
+use    :       USE startsub WORD WORD listexpr ';'
+                       { utilize($1, $2, $3, $4, $5); }
        ;
 
 expr   :       expr ANDOP expr
                        { $$ = newLOGOP(OP_AND, 0, $1, $3); }
        |       expr OROP expr
                        { $$ = newLOGOP($2, 0, $1, $3); }
-       |       NOTOP expr
-                       { $$ = newUNOP(OP_NOT, 0, scalar($2)); }
        |       argexpr
        ;
 
@@ -296,7 +339,7 @@ listop      :       LSTOP indirob argexpr
        |       term ARROW method '(' listexprcom ')'
                        { $$ = convert(OP_ENTERSUB, OPf_STACKED,
                                append_elem(OP_LIST,
-                                   prepend_elem(OP_LIST, $1, $5),
+                                   prepend_elem(OP_LIST, scalar($1), $5),
                                    newUNOP(OP_METHOD, 0, $3))); }
        |       METHOD indirob listexpr
                        { $$ = convert(OP_ENTERSUB, OPf_STACKED,
@@ -376,7 +419,7 @@ term        :       term ASSIGNOP term
        |       PREDEC term
                        { $$ = newUNOP(OP_PREDEC, 0,
                                        mod(scalar($2), OP_PREDEC)); }
-       |       LOCAL term      %prec UNIOP
+       |       local term      %prec UNIOP
                        { $$ = localize($2,$1); }
        |       '(' expr ')'
                        { $$ = sawparens($2); }
@@ -394,6 +437,8 @@ term        :       term ASSIGNOP term
                        { $$ = newANONSUB($2, $3, $4); }
        |       scalar  %prec '('
                        { $$ = $1; }
+       |       star '{' expr ';' '}'
+                       { $$ = newBINOP(OP_GELEM, 0, newGVREF(0,$1), $3); }
        |       star    %prec '('
                        { $$ = $1; }
        |       scalar '[' expr ']'     %prec '('
@@ -445,8 +490,7 @@ term        :       term ASSIGNOP term
        |       THING   %prec '('
                        { $$ = $1; }
        |       amper
-                       { $$ = newUNOP(OP_ENTERSUB, 0,
-                               scalar($1)); }
+                       { $$ = newUNOP(OP_ENTERSUB, 0, scalar($1)); }
        |       amper '(' ')'
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); }
        |       amper '(' expr ')'
@@ -454,35 +498,44 @@ term      :       term ASSIGNOP term
                            append_elem(OP_LIST, $3, scalar($1))); }
        |       NOAMP WORD listexpr
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                           append_elem(OP_LIST,
-                               $3, newCVREF(scalar($2)))); }
+                           append_elem(OP_LIST, $3, scalar($2))); }
        |       DO term %prec UNIOP
                        { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); }
        |       DO block        %prec '('
                        { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
        |       DO WORD '(' ')'
-                       { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
+                       { $$ = newUNOP(OP_ENTERSUB,
+                           OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
-                               scalar(newCVREF(scalar($2))), Nullop)); dep();}
+                               scalar(newCVREF(
+                                   (OPpENTERSUB_AMPER<<8),
+                                   scalar($2)
+                               )),Nullop)); dep();}
        |       DO WORD '(' expr ')'
-                       { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
+                       { $$ = newUNOP(OP_ENTERSUB,
+                           OPf_SPECIAL|OPf_STACKED,
                            append_elem(OP_LIST,
                                $4,
-                               scalar(newCVREF(scalar($2))))); dep();}
+                               scalar(newCVREF(
+                                   (OPpENTERSUB_AMPER<<8),
+                                   scalar($2)
+                               )))); dep();}
        |       DO scalar '(' ')'
                        { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
-                               scalar(newCVREF(scalar($2))), Nullop)); dep();}
+                               scalar(newCVREF(0,scalar($2))), Nullop)); dep();}
        |       DO scalar '(' expr ')'
                        { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
                                $4,
-                               scalar(newCVREF(scalar($2))))); dep();}
+                               scalar(newCVREF(0,scalar($2))))); dep();}
        |       LOOPEX
                        { $$ = newOP($1, OPf_SPECIAL);
                            hints |= HINT_BLOCK_SCOPE; }
        |       LOOPEX term
                        { $$ = newLOOPEX($1,$2); }
+       |       NOTOP argexpr
+                       { $$ = newUNOP(OP_NOT, 0, scalar($2)); }
        |       UNIOP
                        { $$ = newOP($1, 0); }
        |       UNIOP block
@@ -525,8 +578,16 @@ listexprcom:       /* NULL */
                        { $$ = $1; }
        ;
 
+local  :       LOCAL   { $$ = 0; }
+       |       MY      { $$ = 1; }
+       ;
+
+my_scalar:     scalar
+                       { in_my = 0; $$ = my($1); }
+       ;
+
 amper  :       '&' indirob
-                       { $$ = newCVREF($2); }
+                       { $$ = newCVREF($1,$2); }
        ;
 
 scalar :       '$' indirob