X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/bcabcc50f85300b3fbf720ece84c2fd14bd909ed..04dbb930790f65897bff3bb82bb961f95014aa10:/perly.y?ds=sidebyside diff --git a/perly.y b/perly.y index ad7b552..edbcb19 100644 --- a/perly.y +++ b/perly.y @@ -1,6 +1,7 @@ /* perly.y * * Copyright (c) 1991-2002, 2003, 2004, 2005, 2006 Larry Wall + * Copyright (c) 2007, 2008 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -9,8 +10,12 @@ /* * 'I see,' laughed Strider. 'I look foul and feel fair. Is that it? - * All that is gold does not glitter, not all those who wander are lost.' + * All that is gold does not glitter, not all those who wander are lost.' * + * [p.171 of _The Lord of the Rings_, I/x: "Strider"] + */ + +/* * This file holds the grammar for the Perl language. If edited, you need * to run regen_perly.pl, which re-creates the files perly.h, perly.tab * and perly.act which are derived from this. @@ -68,11 +73,12 @@ %token WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF %token FUNC0SUB UNIOPSUB LSTOPSUB +%token PLUGEXPR PLUGSTMT %token LABEL %token FORMAT SUB ANONSUB PACKAGE USE %token WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR %token GIVEN WHEN DEFAULT -%token LOOPEX DOTDOT +%token LOOPEX DOTDOT YADAYADA %token FUNC0 FUNC1 FUNC UNIOP LSTOP %token RELOP EQOP MULOP ADDOP %token DOLSHARP DO HASHBRACK NOAMP @@ -86,7 +92,7 @@ %type decl format subrout mysubrout package use peg -%type block mblock lineseq line loop cond else +%type block package_block mblock lineseq line loop cond else %type expr term subscripted scalar ary hsh arylen star amper sideff %type argexpr nexpr texpr iexpr mexpr mnexpr miexpr %type listexpr listexprcom indirob listop method @@ -106,7 +112,7 @@ %left ',' %right ASSIGNOP %right '?' ':' -%nonassoc DOTDOT +%nonassoc DOTDOT YADAYADA %left OROR DORDOR %left ANDAND %left BITOROP @@ -152,7 +158,7 @@ remember: /* NULL */ /* start a full lexical scope */ ; mydefsv: /* NULL */ /* lexicalize $_ */ - { $$ = (I32) allocmy("$_"); } + { $$ = (I32) Perl_allocmy(aTHX_ STR_WITH_LEN("$_"), 0); } ; progstart: @@ -236,6 +242,13 @@ line : label cond } }) } + | package_block + { $$ = newSTATEOP(0, NULL, + newWHILEOP(0, 1, (LOOP*)(OP*)NULL, + NOLINE, (OP*)NULL, $1, + (OP*)NULL, 0)); } + | label PLUGSTMT + { $$ = newSTATEOP(0, PVAL($1), $2); } ; /* An expression which may have a side-effect */ @@ -264,6 +277,8 @@ sideff : error (OP*)NULL, $3, $1, (OP*)NULL); TOKEN_GETMAD($2,((LISTOP*)$$)->op_first->op_sibling,'w'); } + | expr WHEN expr + { $$ = newWHENOP($3, scope($1)); } ; /* else and elsif blocks */ @@ -275,7 +290,7 @@ else : /* NULL */ } | ELSIF '(' mexpr ')' mblock else { PL_parser->copline = (line_t)IVAL($1); - $$ = newCONDOP(0, $3, scope($5), $6); + $$ = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,$3), scope($5), $6); PL_hints |= HINT_BLOCK_SCOPE; TOKEN_GETMAD($1,$$,'I'); TOKEN_GETMAD($2,$$,'('); @@ -322,7 +337,7 @@ cont : /* NULL */ /* Loops: while, until, for, and a bare block */ loop : label WHILE '(' remember texpr ')' mintro mblock cont { OP *innerop; - PL_parser->copline = (line_t)$2; + PL_parser->copline = (line_t)IVAL($2); $$ = block_end($4, newSTATEOP(0, PVAL($1), innerop = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, @@ -335,7 +350,7 @@ loop : label WHILE '(' remember texpr ')' mintro mblock cont | label UNTIL '(' remember iexpr ')' mintro mblock cont { OP *innerop; - PL_parser->copline = (line_t)$2; + PL_parser->copline = (line_t)IVAL($2); $$ = block_end($4, newSTATEOP(0, PVAL($1), innerop = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, @@ -417,7 +432,7 @@ loop : label WHILE '(' remember texpr ')' mintro mblock cont /* Switch blocks */ switch : label GIVEN '(' remember mydefsv mexpr ')' mblock - { PL_parser->copline = (line_t) $2; + { PL_parser->copline = (line_t) IVAL($2); $$ = block_end($4, newSTATEOP(0, PVAL($1), newGIVENOP($6, scope($8), @@ -501,7 +516,9 @@ peg : PEG ; format : FORMAT startformsub formname block - { SvREFCNT_inc_simple_void(PL_compcv); + { + CV *fmtcv = PL_compcv; + SvREFCNT_inc_simple_void(PL_compcv); #ifdef MAD $$ = newFORM($2, $3, $4); prepend_madprops($1->tk_mad, $$, 'F'); @@ -511,6 +528,10 @@ format : FORMAT startformsub formname block newFORM($2, $3, $4); $$ = (OP*)NULL; #endif + if (CvOUTSIDE(fmtcv) && !CvUNIQUE(CvOUTSIDE(fmtcv))) { + SvREFCNT_inc_simple_void(fmtcv); + pad_add_anon((SV*)fmtcv, OP_NULL); + } } ; @@ -626,19 +647,48 @@ subbody : block { $$ = $1; } } ; -package : PACKAGE WORD ';' +package : PACKAGE WORD WORD ';' { #ifdef MAD - $$ = package($2); + $$ = package($3); token_getmad($1,$$,'o'); - token_getmad($3,$$,';'); + if ($2) + package_version($2); + token_getmad($4,$$,';'); #else - package($2); + package($3); + if ($2) + package_version($2); $$ = (OP*)NULL; #endif } ; +package_block: PACKAGE WORD WORD '{' remember + { + int save_3_latefree = $3->op_latefree; + $3->op_latefree = 1; + package($3); + $3->op_latefree = save_3_latefree; + if ($2) { + int save_2_latefree = $2->op_latefree; + $2->op_latefree = 1; + package_version($2); + $2->op_latefree = save_2_latefree; + } + } + lineseq '}' + { if (PL_parser->copline > (line_t)IVAL($4)) + PL_parser->copline = (line_t)IVAL($4); + $$ = block_end($5, $7); + TOKEN_GETMAD($4,$$,'{'); + TOKEN_GETMAD($8,$$,'}'); + op_free($3); + if ($2) + op_free($2); + } + ; + use : USE startsub { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } WORD WORD listexpr ';' @@ -649,7 +699,7 @@ use : USE startsub token_getmad($7,$$,';'); if (PL_parser->rsfp_filters && AvFILLp(PL_parser->rsfp_filters) >= 0) - append_madprops(newMADPROP('!', MAD_PV, "", 0), $$, 0); + append_madprops(newMADPROP('!', MAD_NULL, NULL, 0), $$, 0); #else utilize(IVAL($1), $2, $4, $5, $6); $$ = (OP*)NULL; @@ -1227,6 +1277,13 @@ term : termbinop } | WORD | listop + | YADAYADA + { + $$ = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), + newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); + TOKEN_GETMAD($1,$$,'X'); + } + | PLUGEXPR ; /* "my" declarations, with optional attributes */