X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=565439bcdf54abe075b47b40c56091393d054f67;hb=dd99ebda2fe680296a282a6804ed647eefc7f935;hp=4feb549be53935d58b49814f6e3c4beed026f40a;hpb=55497cffdd24c959994f9a8ddd56db8ce85e1c5b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perly.y b/perly.y index 4feb549..565439b 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.' */ %{ @@ -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 '{' ')' %token WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF @@ -41,23 +54,24 @@ dep() %token FORMAT SUB ANONSUB PACKAGE USE %token WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR %token LOOPEX DOTDOT -%token FUNC0 FUNC1 FUNC +%token FUNC0 FUNC1 FUNC UNIOP LSTOP %token RELOP EQOP MULOP ADDOP %token DOLSHARP DO HASHBRACK NOAMP %token LOCAL MY -%type prog decl local format startsub remember mremember '&' -%type block mblock mintro lineseq line loop cond else +%type prog decl local format startsub startanonsub startformsub +%type remember mremember '&' +%type block mblock lineseq line loop cond else %type expr term scalar ary hsh arylen star amper sideff -%type argexpr nexpr texpr iexpr mexpr mtexpr miexpr -%type listexpr listexprcom indirob -%type listop method proto cont my_scalar +%type argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr +%type listexpr listexprcom indirob listop method +%type formname subname proto subbody cont my_scalar %type label %left OROP %left ANDOP %right NOTOP -%nonassoc LSTOP +%nonassoc LSTOP LSTOPSUB %left ',' %right ASSIGNOP %right '?' ':' @@ -68,7 +82,7 @@ dep() %left BITANDOP %nonassoc EQOP %nonassoc RELOP -%nonassoc UNIOP +%nonassoc UNIOP UNIOPSUB %left SHIFTOP %left ADDOP %left MULOP @@ -84,33 +98,28 @@ 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 '}' - { $$ = block_end($1,$2,$3); } + { if (PL_copline > (line_t)$1) + PL_copline = $1; + $$ = block_end($2, $3); } ; remember: /* NULL */ /* start a full lexical scope */ { $$ = block_start(TRUE); } ; -mblock : '{' mintro mremember lineseq '}' - { if ($2) - $4 = $4 ? append_list(OP_LINESEQ, - (LISTOP*)$2, (LISTOP*)$4) : $2; - $$ = block_end($1, $3, $4); } - ; - -mintro : /* NULL */ /* introduce pending lexicals */ - { $$ = min_intro_pending - ? newSTATEOP(0, Nullch, newOP(OP_NULL, 0)) - : NULL; } +mblock : '{' mremember lineseq '}' + { if (PL_copline > (line_t)$1) + PL_copline = $1; + $$ = block_end($2, $3); } ; mremember: /* NULL */ /* start a partial lexical scope */ @@ -124,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 @@ -137,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 @@ -157,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 */ @@ -164,28 +176,20 @@ else : /* NULL */ | ELSE mblock { $$ = scope($2); } | ELSIF '(' mexpr ')' mblock else - { copline = $1; - $$ = newCONDOP(0, $3, scope($5), $6); - hints |= HINT_BLOCK_SCOPE; } + { PL_copline = $1; + $$ = newSTATEOP(0, Nullch, + newCONDOP(0, $3, scope($5), $6)); + PL_hints |= HINT_BLOCK_SCOPE; } ; cond : IF '(' remember mexpr ')' mblock else - { copline = $1; - $$ = block_end($1, $3, - newCONDOP(0, $4, scope($6), $7)); } + { PL_copline = $1; + $$ = block_end($3, + newCONDOP(0, $4, scope($6), $7)); } | UNLESS '(' remember miexpr ')' mblock else - { copline = $1; - $$ = block_end($1, $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); } + { PL_copline = $1; + $$ = block_end($3, + newCONDOP(0, $4, scope($6), $7)); } ; cont : /* NULL */ @@ -195,57 +199,40 @@ cont : /* NULL */ ; loop : label WHILE '(' remember mtexpr ')' mblock cont - { copline = $2; - $$ = block_end($2, $4, + { PL_copline = $2; + $$ = block_end($4, newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - $5, $7, $8) )); } + newWHILEOP(0, 1, (LOOP*)Nullop, + $2, $5, $7, $8))); } | label UNTIL '(' remember miexpr ')' mblock cont - { copline = $2; - $$ = block_end($2, $4, + { PL_copline = $2; + $$ = block_end($4, newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - $5, $7, $8) )); } - | label WHILE block block cont - { copline = $2; - $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - scope($3), $4, $5) ); } - | label UNTIL block block cont - { copline = $2; - $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - invert(scalar(scope($3))), $4, $5)); } - | label FOR MY remember my_scalar '(' expr ')' mblock cont - { $$ = block_end($2, $4, - newFOROP(0, $1, $2, $5, $7, $9, $10)); } - | label FOR scalar '(' expr ')' block cont - { $$ = newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP), - $5, $7, $8); } - | label FOR '(' remember expr ')' mblock cont - { $$ = block_end($2, $4, + 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)); } + | label FOR scalar '(' remember mexpr ')' mblock cont + { $$ = block_end($5, + newFOROP(0, $1, $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)); } - | label FOR '(' remember nexpr ';' - { if ($5) { - $5 = scalar($5); - if (min_intro_pending) - $5 = newSTATEOP(0, Nullch, $5); } } - texpr ';' - { $8 = scalar($8); - if (min_intro_pending) - $8 = newSTATEOP(0, Nullch, $8); } - nexpr ')' mblock + | label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock /* basically fake up an initialize-while lineseq */ - { copline = $2; - $$ = block_end($2, $4, - append_elem(OP_LINESEQ, $5, - newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - $8, $13, scalar($11))))); } + { 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 */ @@ -263,18 +250,19 @@ iexpr : expr ; mexpr : expr - { $$ = min_intro_pending - ? newSTATEOP(0, Nullch, $1) : $1; } + { $$ = $1; intro_my(); } + ; + +mnexpr : nexpr + { $$ = $1; intro_my(); } ; mtexpr : texpr - { $$ = min_intro_pending - ? newSTATEOP(0, Nullch, $1) : $1; } + { $$ = $1; intro_my(); } ; miexpr : iexpr - { $$ = min_intro_pending - ? newSTATEOP(0, Nullch, $1) : $1; } + { $$ = $1; intro_my(); } ; label : /* empty */ @@ -292,25 +280,44 @@ 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 { 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; } ; proto : /* NULL */ { $$ = Nullop; } | THING ; - -startsub: /* NULL */ /* start a subroutine scope */ - { $$ = start_subparse(); } + +subbody : block { $$ = $1; } + | ';' { $$ = Nullop; PL_expect = XSTATE; } ; package : PACKAGE WORD ';' @@ -319,8 +326,10 @@ package : PACKAGE WORD ';' { package(Nullop); } ; -use : USE startsub WORD WORD listexpr ';' - { utilize($1, $2, $3, $4, $5); } +use : USE startsub + { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } + WORD WORD listexpr ';' + { utilize($1, $2, $4, $5, $6); } ; expr : expr ANDOP expr @@ -348,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, @@ -362,11 +375,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 @@ -440,12 +454,12 @@ 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; } | star '{' expr ';' '}' - { $$ = newBINOP(OP_GELEM, 0, newGVREF(0,$1), $3); } + { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); } | star %prec '(' { $$ = $1; } | scalar '[' expr ']' %prec '(' @@ -466,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 '(' @@ -493,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 @@ -507,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 '(' ')' @@ -536,9 +550,16 @@ term : term ASSIGNOP term prepend_elem(OP_LIST, $4, scalar(newCVREF(0,scalar($2))))); dep();} + | term ARROW '(' ')' %prec '(' + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, + newCVREF(0, scalar($1))); } + | term ARROW '(' expr ')' %prec '(' + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, $4, + 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 @@ -557,7 +578,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); } @@ -590,7 +611,7 @@ local : LOCAL { $$ = 0; } ; my_scalar: scalar - { in_my = 0; $$ = my($1); } + { PL_in_my = 0; $$ = my($1); } ; amper : '&' indirob