X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=565439bcdf54abe075b47b40c56091393d054f67;hb=dd99ebda2fe680296a282a6804ed647eefc7f935;hp=be6fe98f2042d8986c2cc64fa9c7d5a7a1c42453;hpb=6da72b644b845971d5b417f3c6f5590e23084bcd;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perly.y b/perly.y
index be6fe98..565439b 100644
--- a/perly.y
+++ b/perly.y
@@ -17,7 +17,7 @@
 #include "perl.h"
 
 static void
-dep()
+dep(void)
 {
     deprecate("\"do\" to call subroutines");
 }
@@ -26,6 +26,11 @@ dep()
 
 %start prog
 
+%{
+/* I sense a Big Blue pattern here... */
+#if !defined(OEMVS) && !defined(__OPEN_VM) && !defined(POSIX_BC)
+%}
+
 %union {
     I32	ival;
     char *pval;
@@ -33,6 +38,14 @@ dep()
     GV *gvval;
 }
 
+%{
+#endif /* !OEMVS && !__OPEN_VM && !POSIX_BC */
+
+#ifdef USE_PURE_BISON
+#define YYLEX_PARAM (&yychar)
+#endif
+%}
+
 %token <ival> '{' ')'
 
 %token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF
@@ -85,17 +98,17 @@ dep()
 prog	:	/* NULL */
 		{
 #if defined(YYDEBUG) && defined(DEBUGGING)
-		    yydebug = (debug & 1);
+		    yydebug = (PL_debug & 1);
 #endif
-		    expect = XSTATE;
+		    PL_expect = XSTATE;
 		}
 	/*CONTINUED*/	lineseq
 			{ newPROG($2); }
 	;
 
 block	:	'{' remember lineseq '}'
-			{ if (copline > (line_t)$1)
-			      copline = $1;
+			{ if (PL_copline > (line_t)$1)
+			      PL_copline = $1;
 			  $$ = block_end($2, $3); }
 	;
 
@@ -104,8 +117,8 @@ remember:	/* NULL */	/* start a full lexical scope */
 	;
 
 mblock	:	'{' mremember lineseq '}'
-			{ if (copline > (line_t)$1)
-			      copline = $1;
+			{ if (PL_copline > (line_t)$1)
+			      PL_copline = $1;
 			  $$ = block_end($2, $3); }
 	;
 
@@ -120,8 +133,8 @@ lineseq	:	/* NULL */
 	|	lineseq line
 			{   $$ = append_list(OP_LINESEQ,
 				(LISTOP*)$1, (LISTOP*)$2);
-			    pad_reset_pending = TRUE;
-			    if ($1 && $2) hints |= HINT_BLOCK_SCOPE; }
+			    PL_pad_reset_pending = TRUE;
+			    if ($1 && $2) PL_hints |= HINT_BLOCK_SCOPE; }
 	;
 
 line	:	label cond
@@ -133,12 +146,12 @@ line	:	label cond
 			    }
 			    else {
 			      $$ = Nullop;
-			      copline = NOLINE;
+			      PL_copline = NOLINE;
 			    }
-			    expect = XSTATE; }
+			    PL_expect = XSTATE; }
 	|	label sideff ';'
 			{ $$ = newSTATEOP(0, $1, $2);
-			  expect = XSTATE; }
+			  PL_expect = XSTATE; }
 	;
 
 sideff	:	error
@@ -153,6 +166,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 */
@@ -160,18 +176,18 @@ else	:	/* NULL */
 	|	ELSE mblock
 			{ $$ = scope($2); }
 	|	ELSIF '(' mexpr ')' mblock else
-			{ copline = $1;
+			{ PL_copline = $1;
 			    $$ = newSTATEOP(0, Nullch,
 				   newCONDOP(0, $3, scope($5), $6));
-			    hints |= HINT_BLOCK_SCOPE; }
+			    PL_hints |= HINT_BLOCK_SCOPE; }
 	;
 
 cond	:	IF '(' remember mexpr ')' mblock else
-			{ copline = $1;
+			{ PL_copline = $1;
 			    $$ = block_end($3,
 				   newCONDOP(0, $4, scope($6), $7)); }
 	|	UNLESS '(' remember miexpr ')' mblock else
-			{ copline = $1;
+			{ PL_copline = $1;
 			    $$ = block_end($3,
 				   newCONDOP(0, $4, scope($6), $7)); }
 	;
@@ -183,17 +199,17 @@ cont	:	/* NULL */
 	;
 
 loop	:	label WHILE '(' remember mtexpr ')' mblock cont
-			{ copline = $2;
+			{ PL_copline = $2;
 			    $$ = 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;
+			{ PL_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 +222,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,
-				   newSTATEOP(0, $1,
-				     append_elem(OP_LINESEQ, scalar($5),
-				       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)));
+			  PL_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 */
@@ -288,9 +304,10 @@ 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);
+subname	:	WORD	{ STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a);
+			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
+			      || strEQ(name, "INIT"))
+			      CvSPECIAL_on(PL_compcv);
 			  $$ = $1; }
 	;
 
@@ -300,7 +317,7 @@ proto	:	/* NULL */
 	;
 
 subbody	:	block	{ $$ = $1; }
-	|	';'	{ $$ = Nullop; expect = XSTATE; }
+	|	';'	{ $$ = Nullop; PL_expect = XSTATE; }
 	;
 
 package :	PACKAGE WORD ';'
@@ -310,7 +327,7 @@ package :	PACKAGE WORD ';'
 	;
 
 use	:	USE startsub
-			{ CvUNIQUE_on(compcv); /* It's a BEGIN {} */ }
+			{ CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
 		    WORD WORD listexpr ';'
 			{ utilize($1, $2, $4, $5, $6); }
 	;
@@ -340,6 +357,10 @@ listop	:	LSTOP indirob argexpr
 				append_elem(OP_LIST,
 				    prepend_elem(OP_LIST, scalar($1), $5),
 				    newUNOP(OP_METHOD, 0, $3))); }
+	|	term ARROW method
+			{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST, scalar($1),
+				    newUNOP(OP_METHOD, 0, $3))); }
 	|	METHOD indirob listexpr
 			{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
 				append_elem(OP_LIST,
@@ -438,7 +459,7 @@ term	:	term ASSIGNOP term
 	|	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 '('
@@ -459,17 +480,17 @@ term	:	term ASSIGNOP term
 			{ $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));}
 	|	scalar '{' expr ';' '}'	%prec '('
 			{ $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
-			    expect = XOPERATOR; }
+			    PL_expect = XOPERATOR; }
 	|	term ARROW '{' expr ';' '}'	%prec '('
 			{ $$ = newBINOP(OP_HELEM, 0,
 					ref(newHVREF($1),OP_RV2HV),
 					jmaybe($4));
-			    expect = XOPERATOR; }
+			    PL_expect = XOPERATOR; }
 	|	term '{' expr ';' '}'	%prec '('
 			{ assertref($1); $$ = newBINOP(OP_HELEM, 0,
 					ref(newHVREF($1),OP_RV2HV),
 					jmaybe($3));
-			    expect = XOPERATOR; }
+			    PL_expect = XOPERATOR; }
 	|	'(' expr ')' '[' expr ']'	%prec '('
 			{ $$ = newSLICEOP(0, $5, $2); }
 	|	'(' ')' '[' expr ']'	%prec '('
@@ -486,7 +507,7 @@ term	:	term ASSIGNOP term
 				    newLISTOP(OP_HSLICE, 0,
 					list($3),
 					ref(oopsHV($1), OP_HSLICE)));
-			    expect = XOPERATOR; }
+			    PL_expect = XOPERATOR; }
 	|	THING	%prec '('
 			{ $$ = $1; }
 	|	amper
@@ -500,7 +521,7 @@ term	:	term ASSIGNOP term
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 			    append_elem(OP_LIST, $3, scalar($2))); }
 	|	DO term	%prec UNIOP
-			{ $$ = newUNOP(OP_DOFILE, 0, scalar($2)); }
+			{ $$ = dofile($2); }
 	|	DO block	%prec '('
 			{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
 	|	DO WORD '(' ')'
@@ -538,7 +559,7 @@ term	:	term ASSIGNOP term
 				       newCVREF(0, scalar($1)))); }
 	|	LOOPEX
 			{ $$ = newOP($1, OPf_SPECIAL);
-			    hints |= HINT_BLOCK_SCOPE; }
+			    PL_hints |= HINT_BLOCK_SCOPE; }
 	|	LOOPEX term
 			{ $$ = newLOOPEX($1,$2); }
 	|	NOTOP argexpr
@@ -590,7 +611,7 @@ local	:	LOCAL	{ $$ = 0; }
 	;
 
 my_scalar:	scalar
-			{ in_my = 0; $$ = my($1); }
+			{ PL_in_my = 0; $$ = my($1); }
 	;
 
 amper	:	'&' indirob