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