X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/53a7735b62aee14640bc8ca619b4267f07d686b9..2098fd41655bd1ab9694501f15e9e5b0465d3bef:/perly.y diff --git a/perly.y b/perly.y index 0a857c7..5ec5845 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. @@ -72,14 +77,14 @@ %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 %token LOCAL MY MYSUB REQUIRE %token COLONATTR -%type prog progstart remember mremember savescope +%type prog progstart remember mremember %type startsub startanonsub startformsub /* FIXME for MAD - are these two ival? */ %type mydefsv mintro @@ -106,7 +111,7 @@ %left ',' %right ASSIGNOP %right '?' ':' -%nonassoc DOTDOT +%nonassoc DOTDOT YADAYADA %left OROR DORDOR %left ANDAND %left BITOROP @@ -175,12 +180,9 @@ 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; } + { $$ = (OP*)NULL; } | lineseq decl { $$ = IF_MAD( @@ -188,12 +190,13 @@ lineseq : /* NULL */ (LISTOP*)$1, (LISTOP*)$2), $1); } - | lineseq savescope line - { LEAVE_SCOPE($2); - $$ = append_list(OP_LINESEQ, - (LISTOP*)$1, (LISTOP*)$3); + | lineseq line + { $$ = append_list(OP_LINESEQ, + (LISTOP*)$1, (LISTOP*)$2); PL_pad_reset_pending = TRUE; - if ($1 && $3) PL_hints |= HINT_BLOCK_SCOPE; } + if ($1 && $2) + PL_hints |= HINT_BLOCK_SCOPE; + } ; /* A "line" in the program */ @@ -215,7 +218,7 @@ line : label cond else { $$ = IF_MAD( newOP(OP_NULL, 0), - Nullop); + (OP*)NULL); PL_parser->copline = NOLINE; TOKEN_FREE($1); TOKEN_GETMAD($2,$$,';'); @@ -226,7 +229,7 @@ line : label cond { $$ = newSTATEOP(0, PVAL($1), $2); PL_parser->expect = XSTATE; - DO_MAD( + DO_MAD({ /* sideff might already have a nexstate */ OP* op = ((LISTOP*)$$)->op_first; if (op) { @@ -236,13 +239,13 @@ line : label cond token_getmad($1,op,'L'); token_getmad($3,op,';'); } - ) + }) } ; /* An expression which may have a side-effect */ sideff : error - { $$ = Nullop; } + { $$ = (OP*)NULL; } | expr { $$ = $1; } | expr IF expr @@ -262,22 +265,24 @@ sideff : error TOKEN_GETMAD($2,$$,'w'); } | expr FOR expr - { $$ = newFOROP(0, Nullch, (line_t)IVAL($2), - Nullop, $3, $1, Nullop); + { $$ = newFOROP(0, NULL, (line_t)IVAL($2), + (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 */ else : /* NULL */ - { $$ = Nullop; } + { $$ = (OP*)NULL; } | ELSE mblock { ($2)->op_flags |= OPf_PARENS; $$ = scope($2); TOKEN_GETMAD($1,$$,'o'); } | 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,$$,'('); @@ -314,7 +319,7 @@ case : WHEN '(' remember mexpr ')' mblock /* Continue blocks */ cont : /* NULL */ - { $$ = Nullop; } + { $$ = (OP*)NULL; } | CONTINUE block { $$ = scope($2); TOKEN_GETMAD($1,$$,'o'); @@ -327,7 +332,7 @@ loop : label WHILE '(' remember texpr ')' mintro mblock cont PL_parser->copline = (line_t)$2; $$ = block_end($4, newSTATEOP(0, PVAL($1), - innerop = newWHILEOP(0, 1, (LOOP*)Nullop, + innerop = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, IVAL($2), $5, $8, $9, $7))); TOKEN_GETMAD($1,innerop,'L'); TOKEN_GETMAD($2,innerop,'W'); @@ -340,7 +345,7 @@ loop : label WHILE '(' remember texpr ')' mintro mblock cont PL_parser->copline = (line_t)$2; $$ = block_end($4, newSTATEOP(0, PVAL($1), - innerop = newWHILEOP(0, 1, (LOOP*)Nullop, + innerop = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, IVAL($2), $5, $8, $9, $7))); TOKEN_GETMAD($1,innerop,'L'); TOKEN_GETMAD($2,innerop,'W'); @@ -372,7 +377,7 @@ loop : label WHILE '(' remember texpr ')' mintro mblock cont { OP *innerop; $$ = block_end($4, innerop = newFOROP(0, PVAL($1), (line_t)IVAL($2), - Nullop, $5, $7, $8)); + (OP*)NULL, $5, $7, $8)); TOKEN_GETMAD($1,((LISTOP*)innerop)->op_first,'L'); TOKEN_GETMAD($2,((LISTOP*)innerop)->op_first->op_sibling,'W'); TOKEN_GETMAD($3,((LISTOP*)innerop)->op_first->op_sibling,'('); @@ -384,7 +389,7 @@ loop : label WHILE '(' remember texpr ')' mintro mblock cont { OP *forop; PL_parser->copline = (line_t)IVAL($2); forop = newSTATEOP(0, PVAL($1), - newWHILEOP(0, 1, (LOOP*)Nullop, + newWHILEOP(0, 1, (LOOP*)(OP*)NULL, IVAL($2), scalar($7), $12, $10, $9)); #ifdef MAD @@ -412,8 +417,8 @@ loop : label WHILE '(' remember texpr ')' mintro mblock cont $$ = block_end($4, forop); } | label block cont /* a block is a loop that happens once */ { $$ = newSTATEOP(0, PVAL($1), - newWHILEOP(0, 1, (LOOP*)Nullop, - NOLINE, Nullop, $2, $3, 0)); + newWHILEOP(0, 1, (LOOP*)(OP*)NULL, + NOLINE, (OP*)NULL, $2, $3, 0)); TOKEN_GETMAD($1,((LISTOP*)$$)->op_first,'L'); } ; @@ -434,7 +439,7 @@ mintro : /* NULL */ /* Normal expression */ nexpr : /* NULL */ - { $$ = Nullop; } + { $$ = (OP*)NULL; } | sideff ; @@ -469,10 +474,10 @@ label : /* empty */ { #ifdef MAD YYSTYPE tmplval; - tmplval.pval = Nullch; + tmplval.pval = NULL; $$ = newTOKEN(OP_NULL, tmplval, 0); #else - $$ = Nullch; + $$ = NULL; #endif } | LABEL @@ -511,13 +516,13 @@ format : FORMAT startformsub formname block token_free($1); #else newFORM($2, $3, $4); - $$ = Nullop; + $$ = (OP*)NULL; #endif } ; formname: WORD { $$ = $1; } - | /* NULL */ { $$ = Nullop; } + | /* NULL */ { $$ = (OP*)NULL; } ; /* Unimplemented "my sub foo { }" */ @@ -528,7 +533,7 @@ mysubrout: MYSUB startsub subname proto subattrlist subbody token_getmad($1,$$,'d'); #else newMYSUB($2, $3, $4, $5, $6); - $$ = Nullop; + $$ = (OP*)NULL; #endif } ; @@ -537,19 +542,21 @@ mysubrout: MYSUB startsub subname proto subattrlist subbody subrout : SUB startsub subname proto subattrlist subbody { SvREFCNT_inc_simple_void(PL_compcv); #ifdef MAD - OP* o = newSVOP(OP_ANONCODE, 0, - (SV*)newATTRSUB($2, $3, $4, $5, $6)); - $$ = newOP(OP_NULL,0); - op_getmad(o,$$,'&'); - op_getmad($3,$$,'n'); - op_getmad($4,$$,'s'); - op_getmad($5,$$,'a'); - token_getmad($1,$$,'d'); - append_madprops($6->op_madprop, $$, 0); - $6->op_madprop = 0; + { + OP* o = newSVOP(OP_ANONCODE, 0, + (SV*)newATTRSUB($2, $3, $4, $5, $6)); + $$ = newOP(OP_NULL,0); + op_getmad(o,$$,'&'); + op_getmad($3,$$,'n'); + op_getmad($4,$$,'s'); + op_getmad($5,$$,'a'); + token_getmad($1,$$,'d'); + append_madprops($6->op_madprop, $$, 0); + $6->op_madprop = 0; + } #else newATTRSUB($2, $3, $4, $5, $6); - $$ = Nullop; + $$ = (OP*)NULL; #endif } ; @@ -581,13 +588,13 @@ subname : WORD { const char *const name = SvPV_nolen_const(((SVOP*)$1)->op_sv); /* Subroutine prototype */ proto : /* NULL */ - { $$ = Nullop; } + { $$ = (OP*)NULL; } | THING ; /* Optional list of subroutine attributes */ subattrlist: /* NULL */ - { $$ = Nullop; } + { $$ = (OP*)NULL; } | COLONATTR THING { $$ = $2; TOKEN_GETMAD($1,$$,':'); @@ -595,7 +602,7 @@ subattrlist: /* NULL */ | COLONATTR { $$ = IF_MAD( newOP(OP_NULL, 0), - Nullop + (OP*)NULL ); TOKEN_GETMAD($1,$$,':'); } @@ -609,7 +616,7 @@ myattrlist: COLONATTR THING | COLONATTR { $$ = IF_MAD( newOP(OP_NULL, 0), - Nullop + (OP*)NULL ); TOKEN_GETMAD($1,$$,':'); } @@ -619,22 +626,26 @@ myattrlist: COLONATTR THING subbody : block { $$ = $1; } | ';' { $$ = IF_MAD( newOP(OP_NULL,0), - Nullop + (OP*)NULL ); PL_parser->expect = XSTATE; TOKEN_GETMAD($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); - $$ = Nullop; + package($3); + if ($2) + package_version($2); + $$ = (OP*)NULL; #endif } ; @@ -647,11 +658,12 @@ use : USE startsub $$ = utilize(IVAL($1), $2, $4, $5, $6); token_getmad($1,$$,'o'); token_getmad($7,$$,';'); - if (PL_rsfp_filters && AvFILLp(PL_rsfp_filters) >= 0) - append_madprops(newMADPROP('!', MAD_PV, "", 0), $$, 0); + if (PL_parser->rsfp_filters && + AvFILLp(PL_parser->rsfp_filters) >= 0) + append_madprops(newMADPROP('!', MAD_NULL, NULL, 0), $$, 0); #else utilize(IVAL($1), $2, $4, $5, $6); - $$ = Nullop; + $$ = (OP*)NULL; #endif } ; @@ -749,7 +761,7 @@ listop : LSTOP indirob argexpr /* map {...} @args or print $fh @args */ } | LSTOPSUB startanonsub block /* sub f(&@); f { foo } ... */ { SvREFCNT_inc_simple_void(PL_compcv); - $$ = newANONATTRSUB($2, 0, Nullop, $3); } + $$ = newANONATTRSUB($2, 0, (OP*)NULL, $3); } listexpr %prec LSTOP /* ... @bar */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, @@ -855,7 +867,7 @@ subscripted: star '{' expr ';' '}' /* *main::{something} */ TOKEN_GETMAD($6,$$,']'); } | '(' ')' '[' expr ']' /* empty list slice! */ - { $$ = newSLICEOP(0, $4, Nullop); + { $$ = newSLICEOP(0, $4, (OP*)NULL); TOKEN_GETMAD($1,$$,'('); TOKEN_GETMAD($2,$$,')'); TOKEN_GETMAD($3,$$,'['); @@ -905,14 +917,14 @@ termbinop: term ASSIGNOP term /* $x = $y */ | term DOTDOT term /* $x..$y, $x...$y */ { $$ = newRANGE(IVAL($2), scalar($1), scalar($3)); - DO_MAD( + DO_MAD({ UNOP *op; op = (UNOP*)$$; op = (UNOP*)op->op_first; /* get to flop */ op = (UNOP*)op->op_first; /* get to flip */ op = (UNOP*)op->op_first; /* get to range */ token_getmad($2,(OP*)op,'o'); - ) + }) } | term ANDAND term /* $x && $y */ { $$ = newLOGOP(OP_AND, 0, $1, $3); @@ -985,7 +997,7 @@ anonymous: '[' expr ']' TOKEN_GETMAD($3,$$,']'); } | '[' ']' - { $$ = newANONLIST(Nullop); + { $$ = newANONLIST((OP*)NULL); TOKEN_GETMAD($1,$$,'['); TOKEN_GETMAD($2,$$,']'); } @@ -996,7 +1008,7 @@ anonymous: '[' expr ']' TOKEN_GETMAD($4,$$,'}'); } | HASHBRACK ';' '}' %prec '(' /* { } (';' by tokener) */ - { $$ = newANONHASH(Nullop); + { $$ = newANONHASH((OP*)NULL); TOKEN_GETMAD($1,$$,'{'); TOKEN_GETMAD($2,$$,';'); TOKEN_GETMAD($3,$$,'}'); @@ -1027,7 +1039,7 @@ termdo : DO term %prec UNIOP /* do $filename */ scalar(newCVREF( (OPpENTERSUB_AMPER<<8), scalar($2) - )),Nullop)); dep(); + )),(OP*)NULL)); dep(); TOKEN_GETMAD($1,$$,'o'); TOKEN_GETMAD($3,$$,'('); TOKEN_GETMAD($4,$$,')'); @@ -1048,7 +1060,7 @@ termdo : DO term %prec UNIOP /* do $filename */ | DO scalar '(' ')' /* do $subref () */ { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, - scalar(newCVREF(0,scalar($2))), Nullop)); dep(); + scalar(newCVREF(0,scalar($2))), (OP*)NULL)); dep(); TOKEN_GETMAD($1,$$,'o'); TOKEN_GETMAD($3,$$,'('); TOKEN_GETMAD($4,$$,')'); @@ -1082,7 +1094,7 @@ term : termbinop { $$ = $1; } | LOCAL term %prec UNIOP { $$ = localize($2,IVAL($1)); - TOKEN_GETMAD($1,$$,'d'); + TOKEN_GETMAD($1,$$,'k'); } | '(' expr ')' { $$ = sawparens(IF_MAD(newUNOP(OP_NULL,0,$2), $2)); @@ -1139,14 +1151,14 @@ term : termbinop { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, $3, scalar($1))); - DO_MAD( + DO_MAD({ OP* op = $$; if (op->op_type == OP_CONST) { /* defeat const fold */ op = (OP*)op->op_madprop->mad_val; } token_getmad($2,op,'('); token_getmad($4,op,')'); - ) + }) } | NOAMP WORD listexpr /* foo(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, @@ -1226,6 +1238,12 @@ term : termbinop } | WORD | listop + | YADAYADA + { + $$ = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), + newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); + TOKEN_GETMAD($1,$$,'X'); + } ; /* "my" declarations, with optional attributes */ @@ -1264,13 +1282,13 @@ myterm : '(' expr ')' /* Basic list expressions */ listexpr: /* NULL */ %prec PREC_LOW - { $$ = Nullop; } + { $$ = (OP*)NULL; } | argexpr %prec PREC_LOW { $$ = $1; } ; listexprcom: /* NULL */ - { $$ = Nullop; } + { $$ = (OP*)NULL; } | expr { $$ = $1; } | expr ',' @@ -1289,7 +1307,7 @@ listexprcom: /* NULL */ /* A little bit of trickery to make "for my $foo (@bar)" actually be lexical */ my_scalar: scalar - { PL_in_my = 0; $$ = my($1); } + { PL_parser->in_my = 0; $$ = my($1); } ; amper : '&' indirob