1 /* perly.y 2 * 3 * Copyright (c) 1991-2002, 2003, 2004, 2005, 2006 Larry Wall 4 * Copyright (c) 2007, 2008, 2009, 2010, 2011 by Larry Wall and others 5 * 6 * You may distribute under the terms of either the GNU General Public 7 * License or the Artistic License, as specified in the README file. 8 * 9 */ 10 11 /* 12 * 'I see,' laughed Strider. 'I look foul and feel fair. Is that it? 13 * All that is gold does not glitter, not all those who wander are lost.' 14 * 15 * [p.171 of _The Lord of the Rings_, I/x: "Strider"] 16 */ 17 18 /* 19 * This file holds the grammar for the Perl language. If edited, you need 20 * to run regen_perly.pl, which re-creates the files perly.h, perly.tab 21 * and perly.act which are derived from this. 22 * 23 * The main job of this grammar is to call the various newFOO() 24 * functions in op.c to build a syntax tree of OP structs. 25 * It relies on the lexer in toke.c to do the tokenizing. 26 * 27 * Note: due to the way that the cleanup code works WRT to freeing ops on 28 * the parse stack, it is dangerous to assign to the $n variables within 29 * an action. 30 */ 31 32 /* Make the parser re-entrant. */ 33 34 %define api.pure 35 36 %start grammar 37 38 %union { 39 I32 ival; /* __DEFAULT__ (marker for regen_perly.pl; 40 must always be 1st union member) */ 41 char *pval; 42 OP *opval; 43 GV *gvval; 44 } 45 46 %token <ival> GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE 47 48 %token <ival> PERLY_AMPERSAND 49 %token <ival> PERLY_BRACE_OPEN 50 %token <ival> PERLY_BRACE_CLOSE 51 %token <ival> PERLY_BRACKET_OPEN 52 %token <ival> PERLY_BRACKET_CLOSE 53 %token <ival> PERLY_COMMA 54 %token <ival> PERLY_DOLLAR 55 %token <ival> PERLY_DOT 56 %token <ival> PERLY_EQUAL_SIGN 57 %token <ival> PERLY_MINUS 58 %token <ival> PERLY_PERCENT_SIGN 59 %token <ival> PERLY_PLUS 60 %token <ival> PERLY_SEMICOLON 61 %token <ival> PERLY_SLASH 62 %token <ival> PERLY_SNAIL 63 %token <ival> PERLY_STAR 64 65 %token <opval> BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST 66 %token <opval> FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB 67 %token <opval> PLUGEXPR PLUGSTMT 68 %token <opval> LABEL 69 %token <ival> FORMAT SUB SIGSUB ANONSUB ANON_SIGSUB PACKAGE USE 70 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR 71 %token <ival> GIVEN WHEN DEFAULT 72 %token <ival> TRY CATCH FINALLY 73 %token <ival> LOOPEX DOTDOT YADAYADA 74 %token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP 75 %token <ival> MULOP ADDOP 76 %token <ival> DOLSHARP DO HASHBRACK NOAMP 77 %token <ival> LOCAL MY REQUIRE 78 %token <ival> COLONATTR FORMLBRACK FORMRBRACK 79 %token <ival> SUBLEXSTART SUBLEXEND 80 %token <ival> DEFER 81 82 %type <ival> grammar remember mremember 83 %type <ival> startsub startanonsub startformsub 84 85 %type <ival> mintro 86 87 %type <opval> stmtseq fullstmt labfullstmt barestmt block mblock else finally 88 %type <opval> expr term subscripted scalar ary hsh arylen star amper sideff 89 %type <opval> condition 90 %type <opval> empty 91 %type <opval> sliceme kvslice gelem 92 %type <opval> listexpr nexpr texpr iexpr mexpr mnexpr 93 %type <opval> optlistexpr optexpr optrepl indirob listop method 94 %type <opval> formname subname proto cont my_scalar my_var 95 %type <opval> list_of_scalars my_list_of_scalars refgen_topic formblock 96 %type <opval> subattrlist myattrlist myattrterm myterm 97 %type <opval> termbinop termunop anonymous termdo 98 %type <opval> termrelop relopchain termeqop eqopchain 99 %type <ival> sigslurpsigil 100 %type <opval> sigvarname sigdefault sigscalarelem sigslurpelem 101 %type <opval> sigelem siglist optsiglist subsigguts subsignature optsubsignature 102 %type <opval> subbody optsubbody sigsubbody optsigsubbody 103 %type <opval> formstmtseq formline formarg 104 105 %nonassoc <ival> PREC_LOW 106 %nonassoc LOOPEX 107 108 %left <ival> OROP 109 %left <ival> ANDOP 110 %right <ival> NOTOP 111 %nonassoc LSTOP LSTOPSUB 112 %left PERLY_COMMA 113 %right <ival> ASSIGNOP 114 %right <ival> PERLY_QUESTION_MARK PERLY_COLON 115 %nonassoc DOTDOT 116 %left <ival> OROR DORDOR 117 %left <ival> ANDAND 118 %left <ival> BITOROP 119 %left <ival> BITANDOP 120 %left <ival> CHEQOP NCEQOP 121 %left <ival> CHRELOP NCRELOP 122 %nonassoc UNIOP UNIOPSUB 123 %nonassoc REQUIRE 124 %left <ival> SHIFTOP 125 %left ADDOP 126 %left MULOP 127 %left <ival> MATCHOP 128 %right <ival> PERLY_EXCLAMATION_MARK PERLY_TILDE UMINUS REFGEN 129 %right <ival> POWOP 130 %nonassoc <ival> PREINC PREDEC POSTINC POSTDEC POSTJOIN 131 %left <ival> ARROW 132 %nonassoc <ival> PERLY_PAREN_CLOSE 133 %left <ival> PERLY_PAREN_OPEN 134 %left PERLY_BRACKET_OPEN PERLY_BRACE_OPEN 135 136 %% /* RULES */ 137 138 /* Top-level choice of what kind of thing yyparse was called to parse */ 139 grammar : GRAMPROG 140 { 141 parser->expect = XSTATE; 142 $<ival>$ = 0; 143 } 144 remember stmtseq 145 { 146 newPROG(block_end($remember,$stmtseq)); 147 PL_compiling.cop_seq = 0; 148 $$ = 0; 149 } 150 | GRAMEXPR 151 { 152 parser->expect = XTERM; 153 $<ival>$ = 0; 154 } 155 optexpr 156 { 157 PL_eval_root = $optexpr; 158 $$ = 0; 159 } 160 | GRAMBLOCK 161 { 162 parser->expect = XBLOCK; 163 $<ival>$ = 0; 164 } 165 block 166 { 167 PL_pad_reset_pending = TRUE; 168 PL_eval_root = $block; 169 $$ = 0; 170 yyunlex(); 171 parser->yychar = yytoken = YYEOF; 172 } 173 | GRAMBARESTMT 174 { 175 parser->expect = XSTATE; 176 $<ival>$ = 0; 177 } 178 barestmt 179 { 180 PL_pad_reset_pending = TRUE; 181 PL_eval_root = $barestmt; 182 $$ = 0; 183 yyunlex(); 184 parser->yychar = yytoken = YYEOF; 185 } 186 | GRAMFULLSTMT 187 { 188 parser->expect = XSTATE; 189 $<ival>$ = 0; 190 } 191 fullstmt 192 { 193 PL_pad_reset_pending = TRUE; 194 PL_eval_root = $fullstmt; 195 $$ = 0; 196 yyunlex(); 197 parser->yychar = yytoken = YYEOF; 198 } 199 | GRAMSTMTSEQ 200 { 201 parser->expect = XSTATE; 202 $<ival>$ = 0; 203 } 204 stmtseq 205 { 206 PL_eval_root = $stmtseq; 207 $$ = 0; 208 } 209 | GRAMSUBSIGNATURE 210 { 211 parser->expect = XSTATE; 212 $<ival>$ = 0; 213 } 214 subsigguts 215 { 216 PL_eval_root = $subsigguts; 217 $$ = 0; 218 } 219 ; 220 221 /* An ordinary block */ 222 block : PERLY_BRACE_OPEN remember stmtseq PERLY_BRACE_CLOSE 223 { if (parser->copline > (line_t)$PERLY_BRACE_OPEN) 224 parser->copline = (line_t)$PERLY_BRACE_OPEN; 225 $$ = block_end($remember, $stmtseq); 226 } 227 ; 228 229 empty 230 : %empty { $$ = NULL; } 231 ; 232 233 /* format body */ 234 formblock: PERLY_EQUAL_SIGN remember PERLY_SEMICOLON FORMRBRACK formstmtseq PERLY_SEMICOLON PERLY_DOT 235 { if (parser->copline > (line_t)$PERLY_EQUAL_SIGN) 236 parser->copline = (line_t)$PERLY_EQUAL_SIGN; 237 $$ = block_end($remember, $formstmtseq); 238 } 239 ; 240 241 remember: %empty /* start a full lexical scope */ 242 { $$ = block_start(TRUE); 243 parser->parsed_sub = 0; } 244 ; 245 246 mblock : PERLY_BRACE_OPEN mremember stmtseq PERLY_BRACE_CLOSE 247 { if (parser->copline > (line_t)$PERLY_BRACE_OPEN) 248 parser->copline = (line_t)$PERLY_BRACE_OPEN; 249 $$ = block_end($mremember, $stmtseq); 250 } 251 ; 252 253 mremember: %empty /* start a partial lexical scope */ 254 { $$ = block_start(FALSE); 255 parser->parsed_sub = 0; } 256 ; 257 258 /* A sequence of statements in the program */ 259 stmtseq 260 : empty 261 | stmtseq[list] fullstmt 262 { $$ = op_append_list(OP_LINESEQ, $list, $fullstmt); 263 PL_pad_reset_pending = TRUE; 264 if ($list && $fullstmt) 265 PL_hints |= HINT_BLOCK_SCOPE; 266 } 267 ; 268 269 /* A sequence of format lines */ 270 formstmtseq 271 : empty 272 | formstmtseq[list] formline 273 { $$ = op_append_list(OP_LINESEQ, $list, $formline); 274 PL_pad_reset_pending = TRUE; 275 if ($list && $formline) 276 PL_hints |= HINT_BLOCK_SCOPE; 277 } 278 ; 279 280 /* A statement in the program, including optional labels */ 281 fullstmt: barestmt 282 { 283 $$ = $barestmt ? newSTATEOP(0, NULL, $barestmt) : NULL; 284 } 285 | labfullstmt 286 { $$ = $labfullstmt; } 287 ; 288 289 labfullstmt: LABEL barestmt 290 { 291 SV *label = cSVOPx_sv($LABEL); 292 $$ = newSTATEOP(SvFLAGS(label) & SVf_UTF8, 293 savepv(SvPVX_const(label)), $barestmt); 294 op_free($LABEL); 295 } 296 | LABEL labfullstmt[list] 297 { 298 SV *label = cSVOPx_sv($LABEL); 299 $$ = newSTATEOP(SvFLAGS(label) & SVf_UTF8, 300 savepv(SvPVX_const(label)), $list); 301 op_free($LABEL); 302 } 303 ; 304 305 /* A bare statement, lacking label and other aspects of state op */ 306 barestmt: PLUGSTMT 307 { $$ = $PLUGSTMT; } 308 | FORMAT startformsub formname formblock 309 { 310 CV *fmtcv = PL_compcv; 311 newFORM($startformsub, $formname, $formblock); 312 $$ = NULL; 313 if (CvOUTSIDE(fmtcv) && !CvEVAL(CvOUTSIDE(fmtcv))) { 314 pad_add_weakref(fmtcv); 315 } 316 parser->parsed_sub = 1; 317 } 318 | SUB subname startsub 319 /* sub declaration or definition not within scope 320 of 'use feature "signatures"'*/ 321 { 322 init_named_cv(PL_compcv, $subname); 323 parser->in_my = 0; 324 parser->in_my_stash = NULL; 325 } 326 proto subattrlist optsubbody 327 { 328 SvREFCNT_inc_simple_void(PL_compcv); 329 $subname->op_type == OP_CONST 330 ? newATTRSUB($startsub, $subname, $proto, $subattrlist, $optsubbody) 331 : newMYSUB($startsub, $subname, $proto, $subattrlist, $optsubbody) 332 ; 333 $$ = NULL; 334 intro_my(); 335 parser->parsed_sub = 1; 336 } 337 | SIGSUB subname startsub 338 /* sub declaration or definition under 'use feature 339 * "signatures"'. (Note that a signature isn't 340 * allowed in a declaration) 341 */ 342 { 343 init_named_cv(PL_compcv, $subname); 344 parser->in_my = 0; 345 parser->in_my_stash = NULL; 346 } 347 subattrlist optsigsubbody 348 { 349 SvREFCNT_inc_simple_void(PL_compcv); 350 $subname->op_type == OP_CONST 351 ? newATTRSUB($startsub, $subname, NULL, $subattrlist, $optsigsubbody) 352 : newMYSUB( $startsub, $subname, NULL, $subattrlist, $optsigsubbody) 353 ; 354 $$ = NULL; 355 intro_my(); 356 parser->parsed_sub = 1; 357 } 358 | PACKAGE BAREWORD[version] BAREWORD[package] PERLY_SEMICOLON 359 { 360 package($package); 361 if ($version) 362 package_version($version); 363 $$ = NULL; 364 } 365 | USE startsub 366 { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } 367 BAREWORD[version] BAREWORD[module] optlistexpr PERLY_SEMICOLON 368 { 369 SvREFCNT_inc_simple_void(PL_compcv); 370 utilize($USE, $startsub, $version, $module, $optlistexpr); 371 parser->parsed_sub = 1; 372 $$ = NULL; 373 } 374 | IF PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock else 375 { 376 $$ = block_end($remember, 377 newCONDOP(0, $mexpr, op_scope($mblock), $else)); 378 parser->copline = (line_t)$IF; 379 } 380 | UNLESS PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock else 381 { 382 $$ = block_end($remember, 383 newCONDOP(0, $mexpr, $else, op_scope($mblock))); 384 parser->copline = (line_t)$UNLESS; 385 } 386 | GIVEN PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock 387 { 388 $$ = block_end($remember, newGIVENOP($mexpr, op_scope($mblock), 0)); 389 parser->copline = (line_t)$GIVEN; 390 } 391 | WHEN PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock 392 { $$ = block_end($remember, newWHENOP($mexpr, op_scope($mblock))); } 393 | DEFAULT block 394 { $$ = newWHENOP(0, op_scope($block)); } 395 | WHILE PERLY_PAREN_OPEN remember texpr PERLY_PAREN_CLOSE mintro mblock cont 396 { 397 $$ = block_end($remember, 398 newWHILEOP(0, 1, NULL, 399 $texpr, $mblock, $cont, $mintro)); 400 parser->copline = (line_t)$WHILE; 401 } 402 | UNTIL PERLY_PAREN_OPEN remember iexpr PERLY_PAREN_CLOSE mintro mblock cont 403 { 404 $$ = block_end($remember, 405 newWHILEOP(0, 1, NULL, 406 $iexpr, $mblock, $cont, $mintro)); 407 parser->copline = (line_t)$UNTIL; 408 } 409 | FOR PERLY_PAREN_OPEN remember mnexpr[init_mnexpr] PERLY_SEMICOLON 410 { parser->expect = XTERM; } 411 texpr PERLY_SEMICOLON 412 { parser->expect = XTERM; } 413 mintro mnexpr[iterate_mnexpr] PERLY_PAREN_CLOSE 414 mblock 415 { 416 OP *initop = $init_mnexpr; 417 OP *forop = newWHILEOP(0, 1, NULL, 418 scalar($texpr), $mblock, $iterate_mnexpr, $mintro); 419 if (initop) { 420 forop = op_prepend_elem(OP_LINESEQ, initop, 421 op_append_elem(OP_LINESEQ, 422 newOP(OP_UNSTACK, OPf_SPECIAL), 423 forop)); 424 } 425 PL_hints |= HINT_BLOCK_SCOPE; 426 $$ = block_end($remember, forop); 427 parser->copline = (line_t)$FOR; 428 } 429 | FOR MY remember my_scalar PERLY_PAREN_OPEN mexpr PERLY_PAREN_CLOSE mblock cont 430 { 431 $$ = block_end($remember, newFOROP(0, $my_scalar, $mexpr, $mblock, $cont)); 432 parser->copline = (line_t)$FOR; 433 } 434 | FOR MY remember PERLY_PAREN_OPEN my_list_of_scalars PERLY_PAREN_CLOSE PERLY_PAREN_OPEN mexpr PERLY_PAREN_CLOSE mblock cont 435 { 436 if ($my_list_of_scalars->op_type == OP_PADSV) 437 /* degenerate case of 1 var: for my ($x) .... 438 Flag it so it can be special-cased in newFOROP */ 439 $my_list_of_scalars->op_flags |= OPf_PARENS; 440 $$ = block_end($remember, newFOROP(0, $my_list_of_scalars, $mexpr, $mblock, $cont)); 441 parser->copline = (line_t)$FOR; 442 } 443 | FOR scalar PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock cont 444 { 445 $$ = block_end($remember, newFOROP(0, 446 op_lvalue($scalar, OP_ENTERLOOP), $mexpr, $mblock, $cont)); 447 parser->copline = (line_t)$FOR; 448 } 449 | FOR my_refgen remember my_var 450 { parser->in_my = 0; $<opval>$ = my($my_var); }[variable] 451 PERLY_PAREN_OPEN mexpr PERLY_PAREN_CLOSE mblock cont 452 { 453 $$ = block_end( 454 $remember, 455 newFOROP(0, 456 op_lvalue( 457 newUNOP(OP_REFGEN, 0, 458 $<opval>variable), 459 OP_ENTERLOOP), 460 $mexpr, $mblock, $cont) 461 ); 462 parser->copline = (line_t)$FOR; 463 } 464 | FOR REFGEN refgen_topic PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock cont 465 { 466 $$ = block_end($remember, newFOROP( 467 0, op_lvalue(newUNOP(OP_REFGEN, 0, 468 $refgen_topic), 469 OP_ENTERLOOP), $mexpr, $mblock, $cont)); 470 parser->copline = (line_t)$FOR; 471 } 472 | FOR PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock cont 473 { 474 $$ = block_end($remember, 475 newFOROP(0, NULL, $mexpr, $mblock, $cont)); 476 parser->copline = (line_t)$FOR; 477 } 478 | TRY mblock[try] CATCH PERLY_PAREN_OPEN 479 { parser->in_my = 1; } 480 remember scalar 481 { parser->in_my = 0; intro_my(); } 482 PERLY_PAREN_CLOSE mblock[catch] finally 483 { 484 $$ = newTRYCATCHOP(0, 485 $try, $scalar, block_end($remember, op_scope($catch))); 486 if($finally) 487 $$ = op_wrap_finally($$, $finally); 488 parser->copline = (line_t)$TRY; 489 } 490 | block cont 491 { 492 /* a block is a loop that happens once */ 493 $$ = newWHILEOP(0, 1, NULL, 494 NULL, $block, $cont, 0); 495 } 496 | PACKAGE BAREWORD[version] BAREWORD[package] PERLY_BRACE_OPEN remember 497 { 498 package($package); 499 if ($version) { 500 package_version($version); 501 } 502 } 503 stmtseq PERLY_BRACE_CLOSE 504 { 505 /* a block is a loop that happens once */ 506 $$ = newWHILEOP(0, 1, NULL, 507 NULL, block_end($remember, $stmtseq), NULL, 0); 508 if (parser->copline > (line_t)$PERLY_BRACE_OPEN) 509 parser->copline = (line_t)$PERLY_BRACE_OPEN; 510 } 511 | sideff PERLY_SEMICOLON 512 { 513 $$ = $sideff; 514 } 515 | DEFER mblock 516 { 517 $$ = newDEFEROP(0, op_scope($2)); 518 } 519 | YADAYADA PERLY_SEMICOLON 520 { 521 $$ = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), 522 newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); 523 } 524 | PERLY_SEMICOLON 525 { 526 $$ = NULL; 527 parser->copline = NOLINE; 528 } 529 ; 530 531 /* Format line */ 532 formline: THING formarg 533 { OP *list; 534 if ($formarg) { 535 OP *term = $formarg; 536 list = op_append_elem(OP_LIST, $THING, term); 537 } 538 else { 539 list = $THING; 540 } 541 if (parser->copline == NOLINE) 542 parser->copline = CopLINE(PL_curcop)-1; 543 else parser->copline--; 544 $$ = newSTATEOP(0, NULL, 545 op_convert_list(OP_FORMLINE, 0, list)); 546 } 547 ; 548 549 formarg 550 : empty 551 | FORMLBRACK stmtseq FORMRBRACK 552 { $$ = op_unscope($stmtseq); } 553 ; 554 555 condition: expr 556 ; 557 558 /* An expression which may have a side-effect */ 559 sideff : error 560 { $$ = NULL; } 561 | expr[body] 562 { $$ = $body; } 563 | expr[body] IF condition 564 { $$ = newLOGOP(OP_AND, 0, $condition, $body); } 565 | expr[body] UNLESS condition 566 { $$ = newLOGOP(OP_OR, 0, $condition, $body); } 567 | expr[body] WHILE condition 568 { $$ = newLOOPOP(OPf_PARENS, 1, scalar($condition), $body); } 569 | expr[body] UNTIL iexpr 570 { $$ = newLOOPOP(OPf_PARENS, 1, $iexpr, $body); } 571 | expr[body] FOR condition 572 { $$ = newFOROP(0, NULL, $condition, $body, NULL); 573 parser->copline = (line_t)$FOR; } 574 | expr[body] WHEN condition 575 { $$ = newWHENOP($condition, op_scope($body)); } 576 ; 577 578 /* else and elsif blocks */ 579 else 580 : empty 581 | ELSE mblock 582 { 583 ($mblock)->op_flags |= OPf_PARENS; 584 $$ = op_scope($mblock); 585 } 586 | ELSIF PERLY_PAREN_OPEN mexpr PERLY_PAREN_CLOSE mblock else[else.recurse] 587 { parser->copline = (line_t)$ELSIF; 588 $$ = newCONDOP(0, 589 newSTATEOP(OPf_SPECIAL,NULL,$mexpr), 590 op_scope($mblock), $[else.recurse]); 591 PL_hints |= HINT_BLOCK_SCOPE; 592 } 593 ; 594 595 /* Continue blocks */ 596 cont 597 : empty 598 | CONTINUE block 599 { $$ = op_scope($block); } 600 ; 601 602 /* Finally blocks */ 603 finally : %empty 604 { $$ = NULL; } 605 | FINALLY block 606 { $$ = op_scope($block); } 607 ; 608 609 /* determine whether there are any new my declarations */ 610 mintro : %empty 611 { $$ = (PL_min_intro_pending && 612 PL_max_intro_pending >= PL_min_intro_pending); 613 intro_my(); } 614 615 /* Normal expression */ 616 nexpr 617 : empty 618 | sideff 619 ; 620 621 /* Boolean expression */ 622 texpr : %empty /* NULL means true */ 623 { YYSTYPE tmplval; 624 (void)scan_num("1", &tmplval); 625 $$ = tmplval.opval; } 626 | expr 627 ; 628 629 /* Inverted boolean expression */ 630 iexpr : expr 631 { $$ = invert(scalar($expr)); } 632 ; 633 634 /* Expression with its own lexical scope */ 635 mexpr : expr 636 { $$ = $expr; intro_my(); } 637 ; 638 639 mnexpr : nexpr 640 { $$ = $nexpr; intro_my(); } 641 ; 642 643 formname: BAREWORD { $$ = $BAREWORD; } 644 | empty 645 ; 646 647 startsub: %empty /* start a regular subroutine scope */ 648 { $$ = start_subparse(FALSE, 0); 649 SAVEFREESV(PL_compcv); } 650 651 ; 652 653 startanonsub: %empty /* start an anonymous subroutine scope */ 654 { $$ = start_subparse(FALSE, CVf_ANON); 655 SAVEFREESV(PL_compcv); } 656 ; 657 658 startformsub: %empty /* start a format subroutine scope */ 659 { $$ = start_subparse(TRUE, 0); 660 SAVEFREESV(PL_compcv); } 661 ; 662 663 /* Name of a subroutine - must be a bareword, could be special */ 664 subname : BAREWORD 665 | PRIVATEREF 666 ; 667 668 /* Subroutine prototype */ 669 proto 670 : empty 671 | THING 672 ; 673 674 /* Optional list of subroutine attributes */ 675 subattrlist 676 : empty 677 | COLONATTR THING 678 { $$ = $THING; } 679 | COLONATTR 680 { $$ = NULL; } 681 ; 682 683 /* List of attributes for a "my" variable declaration */ 684 myattrlist: COLONATTR THING 685 { $$ = $THING; } 686 | COLONATTR 687 { $$ = NULL; } 688 ; 689 690 691 692 /* -------------------------------------- 693 * subroutine signature parsing 694 */ 695 696 /* the '' or 'foo' part of a '$' or '@foo' etc signature variable */ 697 sigvarname: %empty 698 { parser->in_my = 0; $$ = NULL; } 699 | PRIVATEREF 700 { parser->in_my = 0; $$ = $PRIVATEREF; } 701 ; 702 703 sigslurpsigil: 704 PERLY_SNAIL 705 { $$ = '@'; } 706 | PERLY_PERCENT_SIGN 707 { $$ = '%'; } 708 709 /* @, %, @foo, %foo */ 710 sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */ 711 { 712 I32 sigil = $sigslurpsigil; 713 OP *var = $sigvarname; 714 OP *defexpr = $sigdefault; 715 716 if (parser->sig_slurpy) 717 yyerror("Multiple slurpy parameters not allowed"); 718 parser->sig_slurpy = (char)sigil; 719 720 if (defexpr) 721 yyerror("A slurpy parameter may not have " 722 "a default value"); 723 724 $$ = var ? newSTATEOP(0, NULL, var) : NULL; 725 } 726 ; 727 728 /* default part of sub signature scalar element: i.e. '= default_expr' */ 729 sigdefault 730 : empty 731 | ASSIGNOP 732 { $$ = newOP(OP_NULL, 0); } 733 | ASSIGNOP term 734 { $$ = $term; } 735 736 737 /* subroutine signature scalar element: e.g. '$x', '$=', '$x = $default' */ 738 sigscalarelem: 739 PERLY_DOLLAR sigvarname sigdefault 740 { 741 OP *var = $sigvarname; 742 OP *defexpr = $sigdefault; 743 744 if (parser->sig_slurpy) 745 yyerror("Slurpy parameter not last"); 746 747 parser->sig_elems++; 748 749 if (defexpr) { 750 parser->sig_optelems++; 751 752 if ( defexpr->op_type == OP_NULL 753 && !(defexpr->op_flags & OPf_KIDS)) 754 { 755 /* handle '$=' special case */ 756 if (var) 757 yyerror("Optional parameter " 758 "lacks default expression"); 759 op_free(defexpr); 760 } 761 else { 762 /* a normal '=default' expression */ 763 OP *defop = (OP*)alloc_LOGOP(OP_ARGDEFELEM, 764 defexpr, 765 LINKLIST(defexpr)); 766 /* re-purpose op_targ to hold @_ index */ 767 defop->op_targ = 768 (PADOFFSET)(parser->sig_elems - 1); 769 770 if (var) { 771 var->op_flags |= OPf_STACKED; 772 (void)op_sibling_splice(var, 773 NULL, 0, defop); 774 scalar(defop); 775 } 776 else 777 var = newUNOP(OP_NULL, 0, defop); 778 779 LINKLIST(var); 780 /* NB: normally the first child of a 781 * logop is executed before the logop, 782 * and it pushes a boolean result 783 * ready for the logop. For ARGDEFELEM, 784 * the op itself does the boolean 785 * calculation, so set the first op to 786 * it instead. 787 */ 788 var->op_next = defop; 789 defexpr->op_next = var; 790 } 791 } 792 else { 793 if (parser->sig_optelems) 794 yyerror("Mandatory parameter " 795 "follows optional parameter"); 796 } 797 798 $$ = var ? newSTATEOP(0, NULL, var) : NULL; 799 } 800 ; 801 802 803 /* subroutine signature element: e.g. '$x = $default' or '%h' */ 804 sigelem: sigscalarelem 805 { parser->in_my = KEY_sigvar; $$ = $sigscalarelem; } 806 | sigslurpelem 807 { parser->in_my = KEY_sigvar; $$ = $sigslurpelem; } 808 ; 809 810 /* list of subroutine signature elements */ 811 siglist: 812 siglist[list] PERLY_COMMA 813 { $$ = $list; } 814 | siglist[list] PERLY_COMMA sigelem[element] 815 { 816 $$ = op_append_list(OP_LINESEQ, $list, $element); 817 } 818 | sigelem[element] %prec PREC_LOW 819 { $$ = $element; } 820 ; 821 822 /* () or (....) */ 823 optsiglist 824 : empty 825 | siglist 826 ; 827 828 /* optional subroutine signature */ 829 optsubsignature 830 : empty 831 | subsignature 832 ; 833 834 /* Subroutine signature */ 835 subsignature: PERLY_PAREN_OPEN subsigguts PERLY_PAREN_CLOSE 836 { $$ = $subsigguts; } 837 838 subsigguts: 839 { 840 ENTER; 841 SAVEIV(parser->sig_elems); 842 SAVEIV(parser->sig_optelems); 843 SAVEI8(parser->sig_slurpy); 844 parser->sig_elems = 0; 845 parser->sig_optelems = 0; 846 parser->sig_slurpy = 0; 847 parser->in_my = KEY_sigvar; 848 } 849 optsiglist 850 { 851 OP *sigops = $optsiglist; 852 struct op_argcheck_aux *aux; 853 OP *check; 854 855 if (!FEATURE_SIGNATURES_IS_ENABLED) 856 Perl_croak(aTHX_ "Experimental " 857 "subroutine signatures not enabled"); 858 859 /* We shouldn't get here otherwise */ 860 aux = (struct op_argcheck_aux*) 861 PerlMemShared_malloc( 862 sizeof(struct op_argcheck_aux)); 863 aux->params = parser->sig_elems; 864 aux->opt_params = parser->sig_optelems; 865 aux->slurpy = parser->sig_slurpy; 866 check = newUNOP_AUX(OP_ARGCHECK, 0, NULL, 867 (UNOP_AUX_item *)aux); 868 sigops = op_prepend_elem(OP_LINESEQ, check, sigops); 869 sigops = op_prepend_elem(OP_LINESEQ, 870 newSTATEOP(0, NULL, NULL), 871 sigops); 872 /* a nextstate at the end handles context 873 * correctly for an empty sub body */ 874 sigops = op_append_elem(OP_LINESEQ, 875 sigops, 876 newSTATEOP(0, NULL, NULL)); 877 /* wrap the list of arg ops in a NULL aux op. 878 This serves two purposes. First, it makes 879 the arg list a separate subtree from the 880 body of the sub, and secondly the null op 881 may in future be upgraded to an OP_SIGNATURE 882 when implemented. For now leave it as 883 ex-argcheck */ 884 $$ = newUNOP_AUX(OP_ARGCHECK, 0, sigops, NULL); 885 op_null($$); 886 887 CvSIGNATURE_on(PL_compcv); 888 889 parser->in_my = 0; 890 /* tell the toker that attrributes can follow 891 * this sig, but only so that the toker 892 * can skip through any (illegal) trailing 893 * attribute text then give a useful error 894 * message about "attributes before sig", 895 * rather than falling over ina mess at 896 * unrecognised syntax. 897 */ 898 parser->expect = XATTRBLOCK; 899 parser->sig_seen = TRUE; 900 LEAVE; 901 } 902 ; 903 904 /* Optional subroutine body (for named subroutine declaration) */ 905 optsubbody 906 : subbody 907 | PERLY_SEMICOLON { $$ = NULL; } 908 ; 909 910 911 /* Subroutine body (without signature) */ 912 subbody: remember PERLY_BRACE_OPEN stmtseq PERLY_BRACE_CLOSE 913 { 914 if (parser->copline > (line_t)$PERLY_BRACE_OPEN) 915 parser->copline = (line_t)$PERLY_BRACE_OPEN; 916 $$ = block_end($remember, $stmtseq); 917 } 918 ; 919 920 921 /* optional [ Subroutine body with optional signature ] (for named 922 * subroutine declaration) */ 923 optsigsubbody 924 : sigsubbody 925 | PERLY_SEMICOLON { $$ = NULL; } 926 ; 927 928 /* Subroutine body with optional signature */ 929 sigsubbody: remember optsubsignature PERLY_BRACE_OPEN stmtseq PERLY_BRACE_CLOSE 930 { 931 if (parser->copline > (line_t)$PERLY_BRACE_OPEN) 932 parser->copline = (line_t)$PERLY_BRACE_OPEN; 933 $$ = block_end($remember, 934 op_append_list(OP_LINESEQ, $optsubsignature, $stmtseq)); 935 } 936 ; 937 938 939 /* Ordinary expressions; logical combinations */ 940 expr : expr[lhs] ANDOP expr[rhs] 941 { $$ = newLOGOP(OP_AND, 0, $lhs, $rhs); } 942 | expr[lhs] OROP[operator] expr[rhs] 943 { $$ = newLOGOP($operator, 0, $lhs, $rhs); } 944 | listexpr %prec PREC_LOW 945 ; 946 947 /* Expressions are a list of terms joined by commas */ 948 listexpr: listexpr[list] PERLY_COMMA 949 { $$ = $list; } 950 | listexpr[list] PERLY_COMMA term 951 { 952 OP* term = $term; 953 $$ = op_append_elem(OP_LIST, $list, term); 954 } 955 | term %prec PREC_LOW 956 ; 957 958 /* List operators */ 959 listop : LSTOP indirob listexpr /* map {...} @args or print $fh @args */ 960 { $$ = op_convert_list($LSTOP, OPf_STACKED, 961 op_prepend_elem(OP_LIST, newGVREF($LSTOP,$indirob), $listexpr) ); 962 } 963 | FUNC PERLY_PAREN_OPEN indirob expr PERLY_PAREN_CLOSE /* print ($fh @args */ 964 { $$ = op_convert_list($FUNC, OPf_STACKED, 965 op_prepend_elem(OP_LIST, newGVREF($FUNC,$indirob), $expr) ); 966 } 967 | term ARROW method PERLY_PAREN_OPEN optexpr PERLY_PAREN_CLOSE /* $foo->bar(list) */ 968 { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, 969 op_append_elem(OP_LIST, 970 op_prepend_elem(OP_LIST, scalar($term), $optexpr), 971 newMETHOP(OP_METHOD, 0, $method))); 972 } 973 | term ARROW method /* $foo->bar */ 974 { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, 975 op_append_elem(OP_LIST, scalar($term), 976 newMETHOP(OP_METHOD, 0, $method))); 977 } 978 | METHOD indirob optlistexpr /* new Class @args */ 979 { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, 980 op_append_elem(OP_LIST, 981 op_prepend_elem(OP_LIST, $indirob, $optlistexpr), 982 newMETHOP(OP_METHOD, 0, $METHOD))); 983 } 984 | FUNCMETH indirob PERLY_PAREN_OPEN optexpr PERLY_PAREN_CLOSE /* method $object (@args) */ 985 { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, 986 op_append_elem(OP_LIST, 987 op_prepend_elem(OP_LIST, $indirob, $optexpr), 988 newMETHOP(OP_METHOD, 0, $FUNCMETH))); 989 } 990 | LSTOP optlistexpr /* print @args */ 991 { $$ = op_convert_list($LSTOP, 0, $optlistexpr); } 992 | FUNC PERLY_PAREN_OPEN optexpr PERLY_PAREN_CLOSE /* print (@args) */ 993 { $$ = op_convert_list($FUNC, 0, $optexpr); } 994 | FUNC SUBLEXSTART optexpr SUBLEXEND /* uc($arg) from "\U..." */ 995 { $$ = op_convert_list($FUNC, 0, $optexpr); } 996 | LSTOPSUB startanonsub block /* sub f(&@); f { foo } ... */ 997 { SvREFCNT_inc_simple_void(PL_compcv); 998 $<opval>$ = newANONATTRSUB($startanonsub, 0, NULL, $block); }[anonattrsub] 999 optlistexpr %prec LSTOP /* ... @bar */ 1000 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1001 op_append_elem(OP_LIST, 1002 op_prepend_elem(OP_LIST, $<opval>anonattrsub, $optlistexpr), $LSTOPSUB)); 1003 } 1004 ; 1005 1006 /* Names of methods. May use $object->$methodname */ 1007 method : METHOD 1008 | scalar 1009 ; 1010 1011 /* Some kind of subscripted expression */ 1012 subscripted: gelem PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* *main::{something} */ 1013 /* In this and all the hash accessors, PERLY_SEMICOLON is 1014 * provided by the tokeniser */ 1015 { $$ = newBINOP(OP_GELEM, 0, $gelem, scalar($expr)); } 1016 | scalar[array] PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* $array[$element] */ 1017 { $$ = newBINOP(OP_AELEM, 0, oopsAV($array), scalar($expr)); 1018 } 1019 | term[array_reference] ARROW PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* somearef->[$element] */ 1020 { $$ = newBINOP(OP_AELEM, 0, 1021 ref(newAVREF($array_reference),OP_RV2AV), 1022 scalar($expr)); 1023 } 1024 | subscripted[array_reference] PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* $foo->[$bar]->[$baz] */ 1025 { $$ = newBINOP(OP_AELEM, 0, 1026 ref(newAVREF($array_reference),OP_RV2AV), 1027 scalar($expr)); 1028 } 1029 | scalar[hash] PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* $foo{bar();} */ 1030 { $$ = newBINOP(OP_HELEM, 0, oopsHV($hash), jmaybe($expr)); 1031 } 1032 | term[hash_reference] ARROW PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* somehref->{bar();} */ 1033 { $$ = newBINOP(OP_HELEM, 0, 1034 ref(newHVREF($hash_reference),OP_RV2HV), 1035 jmaybe($expr)); } 1036 | subscripted[hash_reference] PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* $foo->[bar]->{baz;} */ 1037 { $$ = newBINOP(OP_HELEM, 0, 1038 ref(newHVREF($hash_reference),OP_RV2HV), 1039 jmaybe($expr)); } 1040 | term[code_reference] ARROW PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* $subref->() */ 1041 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1042 newCVREF(0, scalar($code_reference))); 1043 if (parser->expect == XBLOCK) 1044 parser->expect = XOPERATOR; 1045 } 1046 | term[code_reference] ARROW PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* $subref->(@args) */ 1047 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1048 op_append_elem(OP_LIST, $expr, 1049 newCVREF(0, scalar($code_reference)))); 1050 if (parser->expect == XBLOCK) 1051 parser->expect = XOPERATOR; 1052 } 1053 1054 | subscripted[code_reference] PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* $foo->{bar}->(@args) */ 1055 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1056 op_append_elem(OP_LIST, $expr, 1057 newCVREF(0, scalar($code_reference)))); 1058 if (parser->expect == XBLOCK) 1059 parser->expect = XOPERATOR; 1060 } 1061 | subscripted[code_reference] PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* $foo->{bar}->() */ 1062 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1063 newCVREF(0, scalar($code_reference))); 1064 if (parser->expect == XBLOCK) 1065 parser->expect = XOPERATOR; 1066 } 1067 | PERLY_PAREN_OPEN expr[list] PERLY_PAREN_CLOSE PERLY_BRACKET_OPEN expr[slice] PERLY_BRACKET_CLOSE /* list slice */ 1068 { $$ = newSLICEOP(0, $slice, $list); } 1069 | QWLIST PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* list literal slice */ 1070 { $$ = newSLICEOP(0, $expr, $QWLIST); } 1071 | PERLY_PAREN_OPEN PERLY_PAREN_CLOSE PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* empty list slice! */ 1072 { $$ = newSLICEOP(0, $expr, NULL); } 1073 ; 1074 1075 /* Binary operators between terms */ 1076 termbinop: term[lhs] ASSIGNOP term[rhs] /* $x = $y, $x += $y */ 1077 { $$ = newASSIGNOP(OPf_STACKED, $lhs, $ASSIGNOP, $rhs); } 1078 | term[lhs] POWOP term[rhs] /* $x ** $y */ 1079 { $$ = newBINOP($POWOP, 0, scalar($lhs), scalar($rhs)); } 1080 | term[lhs] MULOP term[rhs] /* $x * $y, $x x $y */ 1081 { if ($MULOP != OP_REPEAT) 1082 scalar($lhs); 1083 $$ = newBINOP($MULOP, 0, $lhs, scalar($rhs)); 1084 } 1085 | term[lhs] ADDOP term[rhs] /* $x + $y */ 1086 { $$ = newBINOP($ADDOP, 0, scalar($lhs), scalar($rhs)); } 1087 | term[lhs] SHIFTOP term[rhs] /* $x >> $y, $x << $y */ 1088 { $$ = newBINOP($SHIFTOP, 0, scalar($lhs), scalar($rhs)); } 1089 | termrelop %prec PREC_LOW /* $x > $y, etc. */ 1090 { $$ = $termrelop; } 1091 | termeqop %prec PREC_LOW /* $x == $y, $x cmp $y */ 1092 { $$ = $termeqop; } 1093 | term[lhs] BITANDOP term[rhs] /* $x & $y */ 1094 { $$ = newBINOP($BITANDOP, 0, scalar($lhs), scalar($rhs)); } 1095 | term[lhs] BITOROP term[rhs] /* $x | $y */ 1096 { $$ = newBINOP($BITOROP, 0, scalar($lhs), scalar($rhs)); } 1097 | term[lhs] DOTDOT term[rhs] /* $x..$y, $x...$y */ 1098 { $$ = newRANGE($DOTDOT, scalar($lhs), scalar($rhs)); } 1099 | term[lhs] ANDAND term[rhs] /* $x && $y */ 1100 { $$ = newLOGOP(OP_AND, 0, $lhs, $rhs); } 1101 | term[lhs] OROR term[rhs] /* $x || $y */ 1102 { $$ = newLOGOP(OP_OR, 0, $lhs, $rhs); } 1103 | term[lhs] DORDOR term[rhs] /* $x // $y */ 1104 { $$ = newLOGOP(OP_DOR, 0, $lhs, $rhs); } 1105 | term[lhs] MATCHOP term[rhs] /* $x =~ /$y/ */ 1106 { $$ = bind_match($MATCHOP, $lhs, $rhs); } 1107 ; 1108 1109 termrelop: relopchain %prec PREC_LOW 1110 { $$ = cmpchain_finish($relopchain); } 1111 | term[lhs] NCRELOP term[rhs] 1112 { $$ = newBINOP($NCRELOP, 0, scalar($lhs), scalar($rhs)); } 1113 | termrelop NCRELOP 1114 { yyerror("syntax error"); YYERROR; } 1115 | termrelop CHRELOP 1116 { yyerror("syntax error"); YYERROR; } 1117 ; 1118 1119 relopchain: term[lhs] CHRELOP term[rhs] 1120 { $$ = cmpchain_start($CHRELOP, $lhs, $rhs); } 1121 | relopchain[lhs] CHRELOP term[rhs] 1122 { $$ = cmpchain_extend($CHRELOP, $lhs, $rhs); } 1123 ; 1124 1125 termeqop: eqopchain %prec PREC_LOW 1126 { $$ = cmpchain_finish($eqopchain); } 1127 | term[lhs] NCEQOP term[rhs] 1128 { $$ = newBINOP($NCEQOP, 0, scalar($lhs), scalar($rhs)); } 1129 | termeqop NCEQOP 1130 { yyerror("syntax error"); YYERROR; } 1131 | termeqop CHEQOP 1132 { yyerror("syntax error"); YYERROR; } 1133 ; 1134 1135 eqopchain: term[lhs] CHEQOP term[rhs] 1136 { $$ = cmpchain_start($CHEQOP, $lhs, $rhs); } 1137 | eqopchain[lhs] CHEQOP term[rhs] 1138 { $$ = cmpchain_extend($CHEQOP, $lhs, $rhs); } 1139 ; 1140 1141 /* Unary operators and terms */ 1142 termunop : PERLY_MINUS term %prec UMINUS /* -$x */ 1143 { $$ = newUNOP(OP_NEGATE, 0, scalar($term)); } 1144 | PERLY_PLUS term %prec UMINUS /* +$x */ 1145 { $$ = $term; } 1146 1147 | PERLY_EXCLAMATION_MARK term /* !$x */ 1148 { $$ = newUNOP(OP_NOT, 0, scalar($term)); } 1149 | PERLY_TILDE term /* ~$x */ 1150 { $$ = newUNOP($PERLY_TILDE, 0, scalar($term)); } 1151 | term POSTINC /* $x++ */ 1152 { $$ = newUNOP(OP_POSTINC, 0, 1153 op_lvalue(scalar($term), OP_POSTINC)); } 1154 | term POSTDEC /* $x-- */ 1155 { $$ = newUNOP(OP_POSTDEC, 0, 1156 op_lvalue(scalar($term), OP_POSTDEC));} 1157 | term POSTJOIN /* implicit join after interpolated ->@ */ 1158 { $$ = op_convert_list(OP_JOIN, 0, 1159 op_append_elem( 1160 OP_LIST, 1161 newSVREF(scalar( 1162 newSVOP(OP_CONST,0, 1163 newSVpvs("\"")) 1164 )), 1165 $term 1166 )); 1167 } 1168 | PREINC term /* ++$x */ 1169 { $$ = newUNOP(OP_PREINC, 0, 1170 op_lvalue(scalar($term), OP_PREINC)); } 1171 | PREDEC term /* --$x */ 1172 { $$ = newUNOP(OP_PREDEC, 0, 1173 op_lvalue(scalar($term), OP_PREDEC)); } 1174 1175 ; 1176 1177 /* Constructors for anonymous data */ 1178 anonymous 1179 : PERLY_BRACKET_OPEN optexpr PERLY_BRACKET_CLOSE 1180 { $$ = newANONLIST($optexpr); } 1181 | HASHBRACK optexpr PERLY_SEMICOLON PERLY_BRACE_CLOSE %prec PERLY_PAREN_OPEN /* { foo => "Bar" } */ 1182 { $$ = newANONHASH($optexpr); } 1183 | ANONSUB startanonsub proto subattrlist subbody %prec PERLY_PAREN_OPEN 1184 { SvREFCNT_inc_simple_void(PL_compcv); 1185 $$ = newANONATTRSUB($startanonsub, $proto, $subattrlist, $subbody); } 1186 | ANON_SIGSUB startanonsub subattrlist sigsubbody %prec PERLY_PAREN_OPEN 1187 { SvREFCNT_inc_simple_void(PL_compcv); 1188 $$ = newANONATTRSUB($startanonsub, NULL, $subattrlist, $sigsubbody); } 1189 ; 1190 1191 /* Things called with "do" */ 1192 termdo : DO term %prec UNIOP /* do $filename */ 1193 { $$ = dofile($term, $DO);} 1194 | DO block %prec PERLY_PAREN_OPEN /* do { code */ 1195 { $$ = newUNOP(OP_NULL, OPf_SPECIAL, op_scope($block));} 1196 ; 1197 1198 term[product] : termbinop 1199 | termunop 1200 | anonymous 1201 | termdo 1202 | term[condition] PERLY_QUESTION_MARK term[then] PERLY_COLON term[else] 1203 { $$ = newCONDOP(0, $condition, $then, $else); } 1204 | REFGEN term[operand] /* \$x, \@y, \%z */ 1205 { $$ = newUNOP(OP_REFGEN, 0, $operand); } 1206 | myattrterm %prec UNIOP 1207 { $$ = $myattrterm; } 1208 | LOCAL term[operand] %prec UNIOP 1209 { $$ = localize($operand,0); } 1210 | PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE 1211 { $$ = sawparens($expr); } 1212 | QWLIST 1213 { $$ = $QWLIST; } 1214 | PERLY_PAREN_OPEN PERLY_PAREN_CLOSE 1215 { $$ = sawparens(newNULLLIST()); } 1216 | scalar %prec PERLY_PAREN_OPEN 1217 { $$ = $scalar; } 1218 | star %prec PERLY_PAREN_OPEN 1219 { $$ = $star; } 1220 | hsh %prec PERLY_PAREN_OPEN 1221 { $$ = $hsh; } 1222 | ary %prec PERLY_PAREN_OPEN 1223 { $$ = $ary; } 1224 | arylen %prec PERLY_PAREN_OPEN /* $#x, $#{ something } */ 1225 { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($arylen, OP_AV2ARYLEN));} 1226 | subscripted 1227 { $$ = $subscripted; } 1228 | sliceme PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* array slice */ 1229 { $$ = op_prepend_elem(OP_ASLICE, 1230 newOP(OP_PUSHMARK, 0), 1231 newLISTOP(OP_ASLICE, 0, 1232 list($expr), 1233 ref($sliceme, OP_ASLICE))); 1234 if ($$ && $sliceme) 1235 $$->op_private |= 1236 $sliceme->op_private & OPpSLICEWARNING; 1237 } 1238 | kvslice PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* array key/value slice */ 1239 { $$ = op_prepend_elem(OP_KVASLICE, 1240 newOP(OP_PUSHMARK, 0), 1241 newLISTOP(OP_KVASLICE, 0, 1242 list($expr), 1243 ref(oopsAV($kvslice), OP_KVASLICE))); 1244 if ($$ && $kvslice) 1245 $$->op_private |= 1246 $kvslice->op_private & OPpSLICEWARNING; 1247 } 1248 | sliceme PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* @hash{@keys} */ 1249 { $$ = op_prepend_elem(OP_HSLICE, 1250 newOP(OP_PUSHMARK, 0), 1251 newLISTOP(OP_HSLICE, 0, 1252 list($expr), 1253 ref(oopsHV($sliceme), OP_HSLICE))); 1254 if ($$ && $sliceme) 1255 $$->op_private |= 1256 $sliceme->op_private & OPpSLICEWARNING; 1257 } 1258 | kvslice PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* %hash{@keys} */ 1259 { $$ = op_prepend_elem(OP_KVHSLICE, 1260 newOP(OP_PUSHMARK, 0), 1261 newLISTOP(OP_KVHSLICE, 0, 1262 list($expr), 1263 ref($kvslice, OP_KVHSLICE))); 1264 if ($$ && $kvslice) 1265 $$->op_private |= 1266 $kvslice->op_private & OPpSLICEWARNING; 1267 } 1268 | THING %prec PERLY_PAREN_OPEN 1269 { $$ = $THING; } 1270 | amper /* &foo; */ 1271 { $$ = newUNOP(OP_ENTERSUB, 0, scalar($amper)); } 1272 | amper PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* &foo() or foo() */ 1273 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($amper)); 1274 } 1275 | amper PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* &foo(@args) or foo(@args) */ 1276 { 1277 $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1278 op_append_elem(OP_LIST, $expr, scalar($amper))); 1279 } 1280 | NOAMP subname optlistexpr /* foo @args (no parens) */ 1281 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1282 op_append_elem(OP_LIST, $optlistexpr, scalar($subname))); 1283 } 1284 | term[operand] ARROW PERLY_DOLLAR PERLY_STAR 1285 { $$ = newSVREF($operand); } 1286 | term[operand] ARROW PERLY_SNAIL PERLY_STAR 1287 { $$ = newAVREF($operand); } 1288 | term[operand] ARROW PERLY_PERCENT_SIGN PERLY_STAR 1289 { $$ = newHVREF($operand); } 1290 | term[operand] ARROW PERLY_AMPERSAND PERLY_STAR 1291 { $$ = newUNOP(OP_ENTERSUB, 0, 1292 scalar(newCVREF($PERLY_AMPERSAND,$operand))); } 1293 | term[operand] ARROW PERLY_STAR PERLY_STAR %prec PERLY_PAREN_OPEN 1294 { $$ = newGVREF(0,$operand); } 1295 | LOOPEX /* loop exiting command (goto, last, dump, etc) */ 1296 { $$ = newOP($LOOPEX, OPf_SPECIAL); 1297 PL_hints |= HINT_BLOCK_SCOPE; } 1298 | LOOPEX term[operand] 1299 { $$ = newLOOPEX($LOOPEX,$operand); } 1300 | NOTOP listexpr /* not $foo */ 1301 { $$ = newUNOP(OP_NOT, 0, scalar($listexpr)); } 1302 | UNIOP /* Unary op, $_ implied */ 1303 { $$ = newOP($UNIOP, 0); } 1304 | UNIOP block /* eval { foo }* */ 1305 { $$ = newUNOP($UNIOP, 0, $block); } 1306 | UNIOP term[operand] /* Unary op */ 1307 { $$ = newUNOP($UNIOP, 0, $operand); } 1308 | REQUIRE /* require, $_ implied */ 1309 { $$ = newOP(OP_REQUIRE, $REQUIRE ? OPf_SPECIAL : 0); } 1310 | REQUIRE term[operand] /* require Foo */ 1311 { $$ = newUNOP(OP_REQUIRE, $REQUIRE ? OPf_SPECIAL : 0, $operand); } 1312 | UNIOPSUB 1313 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($UNIOPSUB)); } 1314 | UNIOPSUB term[operand] /* Sub treated as unop */ 1315 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1316 op_append_elem(OP_LIST, $operand, scalar($UNIOPSUB))); } 1317 | FUNC0 /* Nullary operator */ 1318 { $$ = newOP($FUNC0, 0); } 1319 | FUNC0 PERLY_PAREN_OPEN PERLY_PAREN_CLOSE 1320 { $$ = newOP($FUNC0, 0);} 1321 | FUNC0OP /* Same as above, but op created in toke.c */ 1322 { $$ = $FUNC0OP; } 1323 | FUNC0OP PERLY_PAREN_OPEN PERLY_PAREN_CLOSE 1324 { $$ = $FUNC0OP; } 1325 | FUNC0SUB /* Sub treated as nullop */ 1326 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($FUNC0SUB)); } 1327 | FUNC1 PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* not () */ 1328 { $$ = ($FUNC1 == OP_NOT) 1329 ? newUNOP($FUNC1, 0, newSVOP(OP_CONST, 0, newSViv(0))) 1330 : newOP($FUNC1, OPf_SPECIAL); } 1331 | FUNC1 PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* not($foo) */ 1332 { $$ = newUNOP($FUNC1, 0, $expr); } 1333 | PMFUNC /* m//, s///, qr//, tr/// */ 1334 { 1335 if ( $PMFUNC->op_type != OP_TRANS 1336 && $PMFUNC->op_type != OP_TRANSR 1337 && (((PMOP*)$PMFUNC)->op_pmflags & PMf_HAS_CV)) 1338 { 1339 $<ival>$ = start_subparse(FALSE, CVf_ANON); 1340 SAVEFREESV(PL_compcv); 1341 } else 1342 $<ival>$ = 0; 1343 } 1344 SUBLEXSTART listexpr optrepl SUBLEXEND 1345 { $$ = pmruntime($PMFUNC, $listexpr, $optrepl, 1, $<ival>2); } 1346 | BAREWORD 1347 | listop 1348 | PLUGEXPR 1349 ; 1350 1351 /* "my" declarations, with optional attributes */ 1352 myattrterm 1353 : MY myterm myattrlist 1354 { $$ = my_attrs($myterm,$myattrlist); } 1355 | MY myterm 1356 { $$ = localize($myterm,1); } 1357 | MY REFGEN myterm myattrlist 1358 { $$ = newUNOP(OP_REFGEN, 0, my_attrs($myterm,$myattrlist)); } 1359 | MY REFGEN term[operand] 1360 { $$ = newUNOP(OP_REFGEN, 0, localize($operand,1)); } 1361 ; 1362 1363 /* Things that can be "my"'d */ 1364 myterm : PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE 1365 { $$ = sawparens($expr); } 1366 | PERLY_PAREN_OPEN PERLY_PAREN_CLOSE 1367 { $$ = sawparens(newNULLLIST()); } 1368 1369 | scalar %prec PERLY_PAREN_OPEN 1370 { $$ = $scalar; } 1371 | hsh %prec PERLY_PAREN_OPEN 1372 { $$ = $hsh; } 1373 | ary %prec PERLY_PAREN_OPEN 1374 { $$ = $ary; } 1375 ; 1376 1377 /* Basic list expressions */ 1378 optlistexpr 1379 : empty %prec PREC_LOW 1380 | listexpr %prec PREC_LOW 1381 ; 1382 1383 optexpr 1384 : empty 1385 | expr 1386 ; 1387 1388 optrepl 1389 : empty 1390 | PERLY_SLASH expr { $$ = $expr; } 1391 ; 1392 1393 /* A little bit of trickery to make "for my $foo (@bar)" actually be 1394 lexical */ 1395 my_scalar: scalar 1396 { parser->in_my = 0; $$ = my($scalar); } 1397 ; 1398 1399 /* A list of scalars for "for my ($foo, $bar) (@baz)" */ 1400 list_of_scalars: list_of_scalars[list] PERLY_COMMA 1401 { $$ = $list; } 1402 | list_of_scalars[list] PERLY_COMMA scalar 1403 { 1404 $$ = op_append_elem(OP_LIST, $list, $scalar); 1405 } 1406 | scalar %prec PREC_LOW 1407 ; 1408 1409 my_list_of_scalars: list_of_scalars 1410 { parser->in_my = 0; $$ = $list_of_scalars; } 1411 ; 1412 1413 my_var : scalar 1414 | ary 1415 | hsh 1416 ; 1417 1418 refgen_topic: my_var 1419 | amper 1420 ; 1421 1422 my_refgen: MY REFGEN 1423 | REFGEN MY 1424 ; 1425 1426 amper : PERLY_AMPERSAND indirob 1427 { $$ = newCVREF($PERLY_AMPERSAND,$indirob); } 1428 ; 1429 1430 scalar : PERLY_DOLLAR indirob 1431 { $$ = newSVREF($indirob); } 1432 ; 1433 1434 ary : PERLY_SNAIL indirob 1435 { $$ = newAVREF($indirob); 1436 if ($$) $$->op_private |= $PERLY_SNAIL; 1437 } 1438 ; 1439 1440 hsh : PERLY_PERCENT_SIGN indirob 1441 { $$ = newHVREF($indirob); 1442 if ($$) $$->op_private |= $PERLY_PERCENT_SIGN; 1443 } 1444 ; 1445 1446 arylen : DOLSHARP indirob 1447 { $$ = newAVREF($indirob); } 1448 | term ARROW DOLSHARP PERLY_STAR 1449 { $$ = newAVREF($term); } 1450 ; 1451 1452 star : PERLY_STAR indirob 1453 { $$ = newGVREF(0,$indirob); } 1454 ; 1455 1456 sliceme : ary 1457 | term ARROW PERLY_SNAIL 1458 { $$ = newAVREF($term); } 1459 ; 1460 1461 kvslice : hsh 1462 | term ARROW PERLY_PERCENT_SIGN 1463 { $$ = newHVREF($term); } 1464 ; 1465 1466 gelem : star 1467 | term ARROW PERLY_STAR 1468 { $$ = newGVREF(0,$term); } 1469 ; 1470 1471 /* Indirect objects */ 1472 indirob : BAREWORD 1473 { $$ = scalar($BAREWORD); } 1474 | scalar %prec PREC_LOW 1475 { $$ = scalar($scalar); } 1476 | block 1477 { $$ = op_scope($block); } 1478 1479 | PRIVATEREF 1480 { $$ = $PRIVATEREF; } 1481 ; 1482