This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
"more doc for perldoc", #F103
[perl5.git] / perly.y
diff --git a/perly.y b/perly.y
index 7da1be3..8187ab4 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -1,6 +1,6 @@
 /*    perly.y
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -9,7 +9,7 @@
 
 /*
  * 'I see,' laughed Strider.  'I look foul and feel fair.  Is that it?
- * All that is gold does not glitter, not all those that wander are lost.'
+ * All that is gold does not glitter, not all those who wander are lost.'
  */
 
 %{
@@ -153,6 +153,9 @@ sideff      :       error
                        { $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); }
        |       expr UNTIL iexpr
                        { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1);}
+       |       expr FOR expr
+                       { $$ = newFOROP(0, Nullch, $2,
+                                       Nullop, $3, $1, Nullop); }
        ;
 
 else   :       /* NULL */
@@ -187,13 +190,13 @@ loop      :       label WHILE '(' remember mtexpr ')' mblock cont
                            $$ = block_end($4,
                                   newSTATEOP(0, $1,
                                     newWHILEOP(0, 1, (LOOP*)Nullop,
-                                               $5, $7, $8))); }
+                                               $2, $5, $7, $8))); }
        |       label UNTIL '(' remember miexpr ')' mblock cont
                        { copline = $2;
                            $$ = block_end($4,
                                   newSTATEOP(0, $1,
                                     newWHILEOP(0, 1, (LOOP*)Nullop,
-                                               $5, $7, $8))); }
+                                               $2, $5, $7, $8))); }
        |       label FOR MY remember my_scalar '(' mexpr ')' mblock cont
                        { $$ = block_end($4,
                                 newFOROP(0, $1, $2, $5, $7, $9, $10)); }
@@ -206,17 +209,17 @@ loop      :       label WHILE '(' remember mtexpr ')' mblock cont
                                 newFOROP(0, $1, $2, Nullop, $5, $7, $8)); }
        |       label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock
                        /* basically fake up an initialize-while lineseq */
-                       { copline = $2;
-                           $$ = block_end($4,
-                                  append_elem(OP_LINESEQ, scalar($5),
-                                    newSTATEOP(0, $1,
-                                      newWHILEOP(0, 1, (LOOP*)Nullop,
-                                                 scalar($7),
-                                                 $11, scalar($9))))); }
+                       { OP *forop = append_elem(OP_LINESEQ,
+                                       scalar($5),
+                                       newWHILEOP(0, 1, (LOOP*)Nullop,
+                                                  $2, scalar($7),
+                                                  $11, scalar($9)));
+                         copline = $2;
+                         $$ = block_end($4, newSTATEOP(0, $1, forop)); }
        |       label block cont  /* a block is a loop that happens once */
-                       { $$ = newSTATEOP(0,
-                               $1, newWHILEOP(0, 1, (LOOP*)Nullop,
-                                       Nullop, $2, $3)); }
+                       { $$ = newSTATEOP(0, $1,
+                                newWHILEOP(0, 1, (LOOP*)Nullop,
+                                           NOLINE, Nullop, $2, $3)); }
        ;
 
 nexpr  :       /* NULL */
@@ -276,18 +279,16 @@ subrout   :       SUB startsub subname proto subbody
                        { newSUB($2, $3, $4, $5); }
        ;
 
-startsub:      /* NULL */      /* start a subroutine scope */
-                       { $$ = start_subparse(); }
+startsub:      /* NULL */      /* start a regular subroutine scope */
+                       { $$ = start_subparse(FALSE, 0); }
        ;
 
 startanonsub:  /* NULL */      /* start an anonymous subroutine scope */
-                       { $$ = start_subparse();
-                         CvANON_on(compcv); }
+                       { $$ = start_subparse(FALSE, CVf_ANON); }
        ;
 
 startformsub:  /* NULL */      /* start a format subroutine scope */
-                       { $$ = start_subparse();
-                         CvFORMAT_on(compcv); }
+                       { $$ = start_subparse(TRUE, 0); }
        ;
 
 subname        :       WORD    { char *name = SvPVx(((SVOP*)$1)->op_sv, na);
@@ -440,7 +441,8 @@ term        :       term ASSIGNOP term
        |       scalar  %prec '('
                        { $$ = $1; }
        |       star '{' expr ';' '}'
-                       { $$ = newBINOP(OP_GELEM, 0, newGVREF(0,$1), $3); }
+                       { $$ = newBINOP(OP_GELEM, 0, newGVREF(0,$1),
+                                       scalar($3)); }
        |       star    %prec '('
                        { $$ = $1; }
        |       scalar '[' expr ']'     %prec '('
@@ -531,6 +533,13 @@ term       :       term ASSIGNOP term
                            prepend_elem(OP_LIST,
                                $4,
                                scalar(newCVREF(0,scalar($2))))); dep();}
+       |       term ARROW '(' ')'      %prec '('
+                       { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+                                  newCVREF(0, scalar($1))); }
+       |       term ARROW '(' expr ')' %prec '('
+                       { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+                                  append_elem(OP_LIST, $4,
+                                      newCVREF(0, scalar($1)))); }
        |       LOOPEX
                        { $$ = newOP($1, OPf_SPECIAL);
                            hints |= HINT_BLOCK_SCOPE; }