X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=308176f88b12c9c4cadc381930c5ea17ff291986;hb=42a116590b56a49035a440a6b0f3a679f91e9375;hp=5d1b19fd77b5696e8f5fc23a2899addb56ae8c37;hpb=166f8a29442475f7fe0e9216f957512a793bc4ed;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perly.y b/perly.y
index 5d1b19f..308176f 100644
--- a/perly.y
+++ b/perly.y
@@ -18,7 +18,7 @@
  *
  * The main job of of this grammar is to call the various newFOO()
  * functions in op.c to build a syntax tree of OP structs.
- * It relies in the lexer in toke.c to do the tokenizing.
+ * It relies on the lexer in toke.c to do the tokenizing.
  */
 
 /*  Make the parser re-entrant. */
@@ -48,11 +48,11 @@
 %token <ival> LOCAL MY MYSUB
 %token COLONATTR
 
-%type <ival> prog decl format startsub startanonsub startformsub
+%type <ival> prog decl format startsub startanonsub startformsub mintro
 %type <ival> progstart remember mremember '&' savescope
 %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
+%type <opval> argexpr nexpr texpr iexpr mexpr mnexpr miexpr
 %type <opval> listexpr listexprcom indirob listop method
 %type <opval> formname subname proto subbody cont my_scalar
 %type <opval> subattrlist myattrlist mysubrout myattrterm myterm
@@ -207,18 +207,18 @@ cont	:	/* NULL */
 	;
 
 /* Loops: while, until, for, and a bare block */
-loop	:	label WHILE '(' remember mtexpr ')' mblock cont
+loop	:	label WHILE '(' remember texpr ')' mintro mblock cont
 			{ 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
+						$2, $5, $8, $9, $7))); }
+	|	label UNTIL '(' remember iexpr ')' mintro mblock cont
 			{ PL_copline = (line_t)$2;
 			    $$ = block_end($4,
 				   newSTATEOP(0, $1,
 				     newWHILEOP(0, 1, (LOOP*)Nullop,
-						$2, $5, $7, $8))); }
+						$2, $5, $8, $9, $7))); }
 	|	label FOR MY remember my_scalar '(' mexpr ')' mblock cont
 			{ $$ = block_end($4,
 				 newFOROP(0, $1, (line_t)$2, $5, $7, $9, $10)); }
@@ -229,14 +229,15 @@ loop	:	label WHILE '(' remember mtexpr ')' mblock cont
 	|	label FOR '(' remember mexpr ')' mblock cont
 			{ $$ = block_end($4,
 				 newFOROP(0, $1, (line_t)$2, Nullop, $5, $7, $8)); }
-	|	label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock
+	|	label FOR '(' remember mnexpr ';' texpr ';' mintro mnexpr ')'
+	    	    mblock
 			/* basically fake up an initialize-while lineseq */
 			{ OP *forop;
 			  PL_copline = (line_t)$2;
 			  forop = newSTATEOP(0, $1,
 					    newWHILEOP(0, 1, (LOOP*)Nullop,
 						$2, scalar($7),
-						$11, $9));
+						$12, $10, $9));
 			  if ($5) {
 				forop = append_elem(OP_LINESEQ,
                                         newSTATEOP(0, ($1?savepv($1):Nullch),
@@ -248,9 +249,15 @@ loop	:	label WHILE '(' remember mtexpr ')' mblock cont
 	|	label block cont  /* a block is a loop that happens once */
 			{ $$ = newSTATEOP(0, $1,
 				 newWHILEOP(0, 1, (LOOP*)Nullop,
-					    NOLINE, Nullop, $2, $3)); }
+					    NOLINE, Nullop, $2, $3, 0)); }
 	;
 
+/* determine whether there are any new my declarations */
+mintro	:	/* NULL */
+			{ $$ = (PL_min_intro_pending &&
+			    PL_max_intro_pending >=  PL_min_intro_pending);
+			  intro_my(); }
+
 /* Normal expression */
 nexpr	:	/* NULL */
 			{ $$ = Nullop; }
@@ -277,10 +284,6 @@ mnexpr	:	nexpr
 			{ $$ = $1; intro_my(); }
 	;
 
-mtexpr	:	texpr
-			{ $$ = $1; intro_my(); }
-	;
-
 miexpr	:	iexpr
 			{ $$ = $1; intro_my(); }
 	;
@@ -398,7 +401,7 @@ argexpr	:	argexpr ','
 	;
 
 /* List operators */
-listop	:	LSTOP indirob argexpr          /* print $fh @args */
+listop	:	LSTOP indirob argexpr /* map {...} @args or print $fh @args */
 			{ $$ = convert($1, OPf_STACKED,
 				prepend_elem(OP_LIST, newGVREF($1,$2), $3) ); }
 	|	FUNC '(' indirob expr ')'      /* print ($fh @args */
@@ -427,7 +430,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 /* sub f(&@);   f { foo } ... */
 			{ $3 = newANONATTRSUB($2, 0, Nullop, $3); }
 		    listexpr		%prec LSTOP  /* ... @bar */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
@@ -672,13 +675,12 @@ term	:	termbinop
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				scalar($1)); }
 	|	FUNC1 '(' ')'                        /* not () */
-			{ $$ = newOP($1, OPf_SPECIAL); }
+			{ $$ = $1 == OP_NOT ? newUNOP($1, 0, newSVOP(OP_CONST, 0, newSViv(0)))
+					    : newOP($1, OPf_SPECIAL); }
 	|	FUNC1 '(' expr ')'                   /* not($foo) */
 			{ $$ = newUNOP($1, 0, $3); }
-	|	PMFUNC '(' term ')'                  /* /foo/ */
-			{ $$ = pmruntime($1, $3, Nullop); }
-	|	PMFUNC '(' term ',' term ')'         /* s/foo/bar/ (or tr) */
-			{ $$ = pmruntime($1, $3, $5); }
+	|	PMFUNC '(' argexpr ')'           /* m//, s///, tr/// */
+			{ $$ = pmruntime($1, $3, 1); }
 	|	WORD
 	|	listop
 	;