X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/71be2cbc73608e37e1a2ab7e459a02111137d1b0..eedd3c3615d88ae5f720d5296d9bd81945898b9f:/perly.y

diff --git a/perly.y b/perly.y
index a281dff..a1a1f0d 100644
--- 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.'
  */
 
 %{
@@ -17,7 +17,7 @@
 #include "perl.h"
 
 static void
-dep()
+dep(void)
 {
     deprecate("\"do\" to call subroutines");
 }
@@ -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
@@ -152,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 */
@@ -186,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)); }
@@ -205,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 */
@@ -263,25 +267,44 @@ 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 = SvPV(((SVOP*)$1)->op_sv, na);
+			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
+			      || strEQ(name, "INIT"))
+			      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 ';'
@@ -290,8 +313,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
@@ -333,11 +358,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
@@ -411,12 +437,12 @@ 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; }
 	|	star '{' expr ';' '}'
-			{ $$ = newBINOP(OP_GELEM, 0, newGVREF(0,$1), $3); }
+			{ $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); }
 	|	star	%prec '('
 			{ $$ = $1; }
 	|	scalar '[' expr ']'	%prec '('
@@ -507,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; }
@@ -528,7 +561,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); }