X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=b181d5fb39279a413138066fe0675bcd44642943;hb=daff0e373f3630eaa9dbded0adcc04185f454487;hp=6d3c75c20dcd85459114549d7a1f8c8d6454b878;hpb=bbce6d69784bf43b0e69e8d312042d65f258af23;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perly.y b/perly.y
index 6d3c75c..b181d5f 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.'
  */
 
 %{
@@ -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 <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
 %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,7 +94,9 @@ 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 */
@@ -101,7 +104,9 @@ remember:	/* NULL */	/* start a full lexical scope */
 	;
 
 mblock	:	'{' mremember lineseq '}'
-			{ $$ = block_end($1,$2,$3); }
+			{ if (copline > (line_t)$1)
+			      copline = $1;
+			  $$ = block_end($2, $3); }
 	;
 
 mremember:	/* NULL */	/* start a partial lexical scope */
@@ -163,21 +168,12 @@ else	:	/* NULL */
 
 cond	:	IF '(' remember mexpr ')' mblock else
 			{ copline = $1;
-			    $$ = block_end($1, $3,
+			    $$ = block_end($3,
 				   newCONDOP(0, $4, scope($6), $7)); }
 	|	UNLESS '(' remember miexpr ')' mblock else
 			{ copline = $1;
-			    $$ = block_end($1, $3,
+			    $$ = 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 */
@@ -188,39 +184,30 @@ 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))); }
 	|	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;
-			    $$ = newWHILEOP(0, 1, (LOOP*)Nullop,
-					    scope($3), $4, $5); }
-	|	label UNTIL block block cont
-			{ copline = $2;
-			    $$ = newWHILEOP(0, 1, (LOOP*)Nullop,
-					    invert(scalar(scope($3))),
-					    $4, $5); }
 	|	label FOR MY remember my_scalar '(' mexpr ')' mblock cont
-			{ $$ = block_end($2, $4,
+			{ $$ = block_end($4,
 				 newFOROP(0, $1, $2, $5, $7, $9, $10)); }
 	|	label FOR scalar '(' remember mexpr ')' mblock cont
-			{ $$ = block_end($2, $5,
+			{ $$ = block_end($5,
 				 newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
 					  $6, $8, $9)); }
 	|	label FOR '(' remember mexpr ')' mblock cont
-			{ $$ = block_end($2, $4,
+			{ $$ = 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;
-			    $$ = block_end($2, $4,
+			    $$ = block_end($4,
 				   append_elem(OP_LINESEQ, scalar($5),
 				     newSTATEOP(0, $1,
 				       newWHILEOP(0, 1, (LOOP*)Nullop,
@@ -277,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 ';'
@@ -304,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
@@ -347,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
@@ -425,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; }
@@ -542,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); }