X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=922453797904a0862f6ef1540b58a5182b940b0d;hb=ce335f3791058b599c665db1b9a094f3a312805a;hp=f87f5815646edf4cc291f1e8f59848d38113e676;hpb=eb160463266f58ba83ae9bb9ae8bbdc8f0c3027b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perly.y b/perly.y
index f87f581..9224537 100644
--- a/perly.y
+++ b/perly.y
@@ -1,6 +1,6 @@
 /*    perly.y
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (c) 1991-2002, 2003, 2004 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.
@@ -12,44 +12,11 @@
  * All that is gold does not glitter, not all those who wander are lost.'
  */
 
-%{
-#include "EXTERN.h"
-#define PERL_IN_PERLY_C
-#include "perl.h"
-#ifdef EBCDIC
-#undef YYDEBUG
-#endif
-#define dep() deprecate("\"do\" to call subroutines")
-
-/* stuff included here to make perly_c.diff apply better */
-
-#define yydebug	    PL_yydebug
-#define yynerrs	    PL_yynerrs
-#define yyerrflag   PL_yyerrflag
-#define yychar	    PL_yychar
-#define yyval	    PL_yyval
-#define yylval	    PL_yylval
-
-struct ysv {
-    short* yyss;
-    YYSTYPE* yyvs;
-    int oldyydebug;
-    int oldyynerrs;
-    int oldyyerrflag;
-    int oldyychar;
-    YYSTYPE oldyyval;
-    YYSTYPE oldyylval;
-};
-
-static void yydestruct(pTHX_ void *ptr);
-
-%}
+/*  Make the parser re-entrant. */
 
-%start prog
+%pure_parser
 
-%{
-#if 0 /* get this from perly.h instead */
-%}
+%start prog
 
 %union {
     I32	ival;
@@ -58,16 +25,6 @@ static void yydestruct(pTHX_ void *ptr);
     GV *gvval;
 }
 
-%{
-#endif /* 0 */
-
-#ifdef USE_PURE_BISON
-#define YYLEX_PARAM (&yychar)
-#define yylex yylex_r
-#endif
-
-%}
-
 %token <ival> '{'
 
 %token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF
@@ -83,7 +40,7 @@ static void yydestruct(pTHX_ void *ptr);
 %token COLONATTR
 
 %type <ival> prog decl format startsub startanonsub startformsub
-%type <ival> progstart remember mremember '&'
+%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
@@ -96,7 +53,7 @@ static void yydestruct(pTHX_ void *ptr);
 %nonassoc PREC_LOW
 %nonassoc LOOPEX
 
-%left <ival> OROP
+%left <ival> OROP DOROP
 %left ANDOP
 %right NOTOP
 %nonassoc LSTOP LSTOPSUB
@@ -104,7 +61,7 @@ static void yydestruct(pTHX_ void *ptr);
 %right <ival> ASSIGNOP
 %right '?' ':'
 %nonassoc DOTDOT
-%left OROR
+%left OROR DORDOR
 %left ANDAND
 %left <ival> BITOROP
 %left <ival> BITANDOP
@@ -144,9 +101,6 @@ remember:	/* NULL */	/* start a full lexical scope */
 
 progstart:
 		{
-#if defined(YYDEBUG) && defined(DEBUGGING)
-		    yydebug = (DEBUG_p_TEST);
-#endif
 		    PL_expect = XSTATE; $$ = block_start(TRUE);
 		}
 	;
@@ -162,16 +116,20 @@ mremember:	/* NULL */	/* start a partial lexical scope */
 			{ $$ = block_start(FALSE); }
 	;
 
+savescope:	/* NULL */	/* remember stack pos in case of error */
+		{ $$ = PL_savestack_ix; }
+
 /* A collection of "lines" in the program */
 lineseq	:	/* NULL */
 			{ $$ = Nullop; }
 	|	lineseq decl
 			{ $$ = $1; }
-	|	lineseq line
-			{   $$ = append_list(OP_LINESEQ,
-				(LISTOP*)$1, (LISTOP*)$2);
+	|	lineseq savescope line
+			{   LEAVE_SCOPE($2);
+			    $$ = append_list(OP_LINESEQ,
+				(LISTOP*)$1, (LISTOP*)$3);
 			    PL_pad_reset_pending = TRUE;
-			    if ($1 && $2) PL_hints |= HINT_BLOCK_SCOPE; }
+			    if ($1 && $3) PL_hints |= HINT_BLOCK_SCOPE; }
 	;
 
 /* A "line" in the program */
@@ -404,8 +362,6 @@ subbody	:	block	{ $$ = $1; }
 
 package :	PACKAGE WORD ';'
 			{ package($2); }
-	|	PACKAGE ';'
-			{ package(Nullop); }
 	;
 
 use	:	USE startsub
@@ -419,6 +375,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
 	;
 
@@ -477,7 +435,8 @@ method	:	METHOD
 subscripted:    star '{' expr ';' '}'        /* *main::{something} */
                         /* In this and all the hash accessors, ';' is
                          * provided by the tokeniser */
-			{ $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); }
+			{ $$ = newBINOP(OP_GELEM, 0, $1, scalar($3));
+			    PL_expect = XOPERATOR; }
 	|	scalar '[' expr ']'          /* $array[$element] */
 			{ $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); }
 	|	term ARROW '[' expr ']'      /* somearef->[$element] */
@@ -545,6 +504,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); }
     ;
@@ -687,7 +648,7 @@ term	:	termbinop
 			{ $$ = newUNOP(OP_NOT, 0, scalar($2)); }
 	|	UNIOP                                /* Unary op, $_ implied */
 			{ $$ = newOP($1, 0); }
-	|	UNIOP block                          /* eval { foo }, I *think* */
+	|	UNIOP block                          /* eval { foo } */
 			{ $$ = newUNOP($1, 0, $2); }
 	|	UNIOP term                           /* Unary op */
 			{ $$ = newUNOP($1, 0, $2); }
@@ -705,9 +666,9 @@ term	:	termbinop
 			{ $$ = newOP($1, OPf_SPECIAL); }
 	|	FUNC1 '(' expr ')'                   /* not($foo) */
 			{ $$ = newUNOP($1, 0, $3); }
-	|	PMFUNC '(' term ')'                  /* split (/foo/) */
+	|	PMFUNC '(' term ')'                  /* /foo/ */
 			{ $$ = pmruntime($1, $3, Nullop); }
-	|	PMFUNC '(' term ',' term ')'         /* split (/foo/,$bar) */
+	|	PMFUNC '(' term ',' term ')'         /* s/foo/bar/ (or tr) */
 			{ $$ = pmruntime($1, $3, $5); }
 	|	WORD
 	|	listop
@@ -789,13 +750,3 @@ indirob	:	WORD
 	|	PRIVATEREF
 			{ $$ = $1; }
 	;
-
-%% /* PROGRAM */
-
-/* more stuff added to make perly_c.diff easier to apply */
-
-#ifdef yyparse
-#undef yyparse
-#endif
-#define yyparse() Perl_yyparse(pTHX)
-