X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=7d392421602fdd2217cd854cc99125c4782bf9e4;hb=bed601927f5ca7f54b544d9e5ce1f77461311b68;hp=0fd8f9c70f9b082d64028a5800460e277cadd01f;hpb=891be0197d5104b86b76c5aeca98d9d8b12deafc;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perly.y b/perly.y
index 0fd8f9c..7d39242 100644
--- a/perly.y
+++ b/perly.y
@@ -1,6 +1,6 @@
 /*    perly.y
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, 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.
@@ -41,7 +41,7 @@ struct ysv {
     YYSTYPE oldyylval;
 };
 
-static void yydestruct(pTHXo_ void *ptr);
+static void yydestruct(pTHX_ void *ptr);
 
 %}
 
@@ -83,7 +83,7 @@ static void yydestruct(pTHXo_ void *ptr);
 %token COLONATTR
 
 %type <ival> prog decl format startsub startanonsub startformsub
-%type <ival> remember mremember '&'
+%type <ival> progstart remember mremember '&'
 %type <opval> block mblock lineseq line loop cond else
 %type <opval> expr term subscripted scalar ary hsh arylen star amper sideff
 %type <opval> argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr
@@ -96,7 +96,7 @@ static void yydestruct(pTHXo_ void *ptr);
 %nonassoc PREC_LOW
 %nonassoc LOOPEX
 
-%left <ival> OROP
+%left <ival> OROP DOROP
 %left ANDOP
 %right NOTOP
 %nonassoc LSTOP LSTOPSUB
@@ -104,7 +104,7 @@ static void yydestruct(pTHXo_ void *ptr);
 %right <ival> ASSIGNOP
 %right '?' ':'
 %nonassoc DOTDOT
-%left OROR
+%left OROR DORDOR
 %left ANDAND
 %left <ival> BITOROP
 %left <ival> BITANDOP
@@ -126,21 +126,15 @@ static void yydestruct(pTHXo_ void *ptr);
 %% /* RULES */
 
 /* The whole program */
-prog	:	/* NULL */
-		{
-#if defined(YYDEBUG) && defined(DEBUGGING)
-		    yydebug = (DEBUG_p_TEST);
-#endif
-		    PL_expect = XSTATE; $$ = block_start(TRUE);
-		}
+prog	:	progstart
 	/*CONTINUED*/	lineseq
-			{ newPROG(block_end($1,$2)); }
+			{ $$ = $1; newPROG(block_end($1,$2)); }
 	;
 
 /* An ordinary block */
 block	:	'{' remember lineseq '}'
 			{ if (PL_copline > (line_t)$1)
-			      PL_copline = $1;
+			      PL_copline = (line_t)$1;
 			  $$ = block_end($2, $3); }
 	;
 
@@ -148,9 +142,19 @@ remember:	/* NULL */	/* start a full lexical scope */
 			{ $$ = block_start(TRUE); }
 	;
 
+progstart:
+		{
+#if defined(YYDEBUG) && defined(DEBUGGING)
+		    yydebug = (DEBUG_p_TEST);
+#endif
+		    PL_expect = XSTATE; $$ = block_start(TRUE);
+		}
+	;
+
+
 mblock	:	'{' mremember lineseq '}'
 			{ if (PL_copline > (line_t)$1)
-			      PL_copline = $1;
+			      PL_copline = (line_t)$1;
 			  $$ = block_end($2, $3); }
 	;
 
@@ -202,7 +206,7 @@ sideff	:	error
 	|	expr UNTIL iexpr
 			{ $$ = newLOOPOP(OPf_PARENS, 1, $3, $1);}
 	|	expr FOR expr
-			{ $$ = newFOROP(0, Nullch, $2,
+			{ $$ = newFOROP(0, Nullch, (line_t)$2,
 					Nullop, $3, $1, Nullop); }
 	;
 
@@ -212,18 +216,18 @@ else	:	/* NULL */
 	|	ELSE mblock
 			{ ($2)->op_flags |= OPf_PARENS; $$ = scope($2); }
 	|	ELSIF '(' mexpr ')' mblock else
-			{ PL_copline = $1;
+			{ PL_copline = (line_t)$1;
 			    $$ = newCONDOP(0, $3, scope($5), $6);
 			    PL_hints |= HINT_BLOCK_SCOPE; }
 	;
 
 /* Real conditional expressions */
 cond	:	IF '(' remember mexpr ')' mblock else
-			{ PL_copline = $1;
+			{ PL_copline = (line_t)$1;
 			    $$ = block_end($3,
 				   newCONDOP(0, $4, scope($6), $7)); }
 	|	UNLESS '(' remember miexpr ')' mblock else
-			{ PL_copline = $1;
+			{ PL_copline = (line_t)$1;
 			    $$ = block_end($3,
 				   newCONDOP(0, $4, scope($6), $7)); }
 	;
@@ -237,31 +241,31 @@ cont	:	/* NULL */
 
 /* Loops: while, until, for, and a bare block */
 loop	:	label WHILE '(' remember mtexpr ')' mblock cont
-			{ PL_copline = $2;
+			{ PL_copline = (line_t)$2;
 			    $$ = block_end($4,
 				   newSTATEOP(0, $1,
 				     newWHILEOP(0, 1, (LOOP*)Nullop,
 						$2, $5, $7, $8))); }
 	|	label UNTIL '(' remember miexpr ')' mblock cont
-			{ PL_copline = $2;
+			{ PL_copline = (line_t)$2;
 			    $$ = block_end($4,
 				   newSTATEOP(0, $1,
 				     newWHILEOP(0, 1, (LOOP*)Nullop,
 						$2, $5, $7, $8))); }
 	|	label FOR MY remember my_scalar '(' mexpr ')' mblock cont
 			{ $$ = block_end($4,
-				 newFOROP(0, $1, $2, $5, $7, $9, $10)); }
+				 newFOROP(0, $1, (line_t)$2, $5, $7, $9, $10)); }
 	|	label FOR scalar '(' remember mexpr ')' mblock cont
 			{ $$ = block_end($5,
-				 newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
+				 newFOROP(0, $1, (line_t)$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)); }
+				 newFOROP(0, $1, (line_t)$2, Nullop, $5, $7, $8)); }
 	|	label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock
 			/* basically fake up an initialize-while lineseq */
 			{ OP *forop;
-			  PL_copline = $2;
+			  PL_copline = (line_t)$2;
 			  forop = newSTATEOP(0, $1,
 					    newWHILEOP(0, 1, (LOOP*)Nullop,
 						$2, scalar($7),
@@ -400,8 +404,6 @@ subbody	:	block	{ $$ = $1; }
 
 package :	PACKAGE WORD ';'
 			{ package($2); }
-	|	PACKAGE ';'
-			{ package(Nullop); }
 	;
 
 use	:	USE startsub
@@ -415,6 +417,8 @@ expr	:	expr ANDOP expr
 			{ $$ = newLOGOP(OP_AND, 0, $1, $3); }
 	|	expr OROP expr
 			{ $$ = newLOGOP($2, 0, $1, $3); }
+	|	expr DOROP expr
+			{ $$ = newLOGOP(OP_DOR, 0, $1, $3); }
 	|	argexpr %prec PREC_LOW
 	;
 
@@ -456,7 +460,7 @@ listop	:	LSTOP indirob argexpr          /* print $fh @args */
 			{ $$ = convert($1, 0, $2); }
 	|	FUNC '(' listexprcom ')'             /* print (@args) */
 			{ $$ = convert($1, 0, $3); }
-	|	LSTOPSUB startanonsub block          /* map { foo } ... */ 
+	|	LSTOPSUB startanonsub block          /* map { foo } ... */
 			{ $3 = newANONATTRSUB($2, 0, Nullop, $3); }
 		    listexpr		%prec LSTOP  /* ... @bar */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
@@ -541,6 +545,8 @@ termbinop	:	term ASSIGNOP term             /* $x = $y */
 			{ $$ = newLOGOP(OP_AND, 0, $1, $3); }
 	|	term OROR term                         /* $x || $y */
 			{ $$ = newLOGOP(OP_OR, 0, $1, $3); }
+	|	term DORDOR term                       /* $x // $y */
+			{ $$ = newLOGOP(OP_DOR, 0, $1, $3); }
 	|	term MATCHOP term                      /* $x =~ /$y/ */
 			{ $$ = bind_match($2, $1, $3); }
     ;
@@ -575,7 +581,7 @@ anonymous:	'[' expr ']'
 	|	'[' ']'
 			{ $$ = newANONLIST(Nullop); }
 	|	HASHBRACK expr ';' '}'	%prec '(' /* { foo => "Bar" } */
-			{ $$ = newANONHASH($2); } 
+			{ $$ = newANONHASH($2); }
 	|	HASHBRACK ';' '}'	%prec '(' /* { } (';' by tokener) */
 			{ $$ = newANONHASH(Nullop); }
 	|	ANONSUB startanonsub proto subattrlist block	%prec '('
@@ -666,7 +672,7 @@ term	:	termbinop
 			{ $$ = $1; }
 	|	amper                                /* &foo; */
 			{ $$ = newUNOP(OP_ENTERSUB, 0, scalar($1)); }
-	|	amper '(' ')'                        /* &foo() */ 
+	|	amper '(' ')'                        /* &foo() */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); }
 	|	amper '(' expr ')'                   /* &foo(@args) */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,