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 1060 { PL_parser->sig_seen = FALSE; } 1061 stmtseq PERLY_BRACE_CLOSE 1062 { 1063 if (parser->copline > (line_t)$PERLY_BRACE_OPEN) 1064 parser->copline = (line_t)$PERLY_BRACE_OPEN; 1065 $$ = block_end($remember, 1066 op_append_list(OP_LINESEQ, $optsubsignature, $stmtseq)); 1067 } 1068 ; 1069 1070 1071 /* Ordinary expressions; logical combinations */ 1072 expr : expr[lhs] ANDOP expr[rhs] 1073 { $$ = newLOGOP(OP_AND, 0, $lhs, $rhs); } 1074 | expr[lhs] PLUGIN_LOGICAL_AND_LOW_OP[op] expr[rhs] 1075 { $$ = build_infix_plugin($lhs, $rhs, $op); } 1076 | expr[lhs] OROP[operator] expr[rhs] 1077 { $$ = newLOGOP($operator, 0, $lhs, $rhs); } 1078 | expr[lhs] PLUGIN_LOGICAL_OR_LOW_OP[op] expr[rhs] 1079 { $$ = build_infix_plugin($lhs, $rhs, $op); } 1080 | listexpr %prec PREC_LOW 1081 ; 1082 1083 /* Expressions are a list of terms joined by commas */ 1084 listexpr: listexpr[list] PERLY_COMMA 1085 { $$ = $list; } 1086 | listexpr[list] PERLY_COMMA term 1087 { 1088 OP* term = $term; 1089 $$ = op_append_elem(OP_LIST, $list, term); 1090 } 1091 | term %prec PREC_LOW 1092 ; 1093 1094 /* List operators */ 1095 listop : LSTOP indirob listexpr /* map {...} @args or print $fh @args */ 1096 { $$ = op_convert_list($LSTOP, OPf_STACKED, 1097 op_prepend_elem(OP_LIST, newGVREF($LSTOP,$indirob), $listexpr) ); 1098 } 1099 | FUNC PERLY_PAREN_OPEN indirob expr PERLY_PAREN_CLOSE /* print ($fh @args */ 1100 { $$ = op_convert_list($FUNC, OPf_STACKED, 1101 op_prepend_elem(OP_LIST, newGVREF($FUNC,$indirob), $expr) ); 1102 } 1103 | term ARROW methodname PERLY_PAREN_OPEN optexpr PERLY_PAREN_CLOSE /* $foo->bar(list) */ 1104 { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, 1105 op_append_elem(OP_LIST, 1106 op_prepend_elem(OP_LIST, scalar($term), $optexpr), 1107 newMETHOP(OP_METHOD, 0, $methodname))); 1108 } 1109 | term ARROW methodname /* $foo->bar */ 1110 { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, 1111 op_append_elem(OP_LIST, scalar($term), 1112 newMETHOP(OP_METHOD, 0, $methodname))); 1113 } 1114 | METHCALL0 indirob optlistexpr /* new Class @args */ 1115 { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, 1116 op_append_elem(OP_LIST, 1117 op_prepend_elem(OP_LIST, $indirob, $optlistexpr), 1118 newMETHOP(OP_METHOD, 0, $METHCALL0))); 1119 } 1120 | METHCALL indirob PERLY_PAREN_OPEN optexpr PERLY_PAREN_CLOSE /* method $object (@args) */ 1121 { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, 1122 op_append_elem(OP_LIST, 1123 op_prepend_elem(OP_LIST, $indirob, $optexpr), 1124 newMETHOP(OP_METHOD, 0, $METHCALL))); 1125 } 1126 | LSTOP optlistexpr /* print @args */ 1127 { $$ = op_convert_list($LSTOP, 0, $optlistexpr); } 1128 | FUNC PERLY_PAREN_OPEN optexpr PERLY_PAREN_CLOSE /* print (@args) */ 1129 { $$ = op_convert_list($FUNC, 0, $optexpr); } 1130 | FUNC SUBLEXSTART optexpr SUBLEXEND /* uc($arg) from "\U..." */ 1131 { $$ = op_convert_list($FUNC, 0, $optexpr); } 1132 | LSTOPSUB startanonsub block /* sub f(&@); f { foo } ... */ 1133 { SvREFCNT_inc_simple_void(PL_compcv); 1134 $<opval>$ = newANONATTRSUB($startanonsub, 0, NULL, $block); 1135 /* prevent double op_free() if the following fails to parse */ 1136 $block = NULL; 1137 }[anonattrsub] 1138 optlistexpr %prec LSTOP /* ... @bar */ 1139 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1140 op_append_elem(OP_LIST, 1141 op_prepend_elem(OP_LIST, $<opval>anonattrsub, $optlistexpr), $LSTOPSUB)); 1142 } 1143 ; 1144 1145 /* Names of methods. May use $object->$methodname */ 1146 methodname: METHCALL0 1147 | scalar 1148 ; 1149 1150 /* Some kind of subscripted expression */ 1151 subscripted: gelem PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* *main::{something} */ 1152 /* In this and all the hash accessors, PERLY_SEMICOLON is 1153 * provided by the tokeniser */ 1154 { $$ = newBINOP(OP_GELEM, 0, $gelem, scalar($expr)); } 1155 | scalar[array] PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* $array[$element] */ 1156 { $$ = newBINOP(OP_AELEM, 0, oopsAV($array), scalar($expr)); 1157 } 1158 | term[array_reference] ARROW PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* somearef->[$element] */ 1159 { $$ = newBINOP(OP_AELEM, 0, 1160 ref(newAVREF($array_reference),OP_RV2AV), 1161 scalar($expr)); 1162 } 1163 | subscripted[array_reference] PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* $foo->[$bar]->[$baz] */ 1164 { $$ = newBINOP(OP_AELEM, 0, 1165 ref(newAVREF($array_reference),OP_RV2AV), 1166 scalar($expr)); 1167 } 1168 | scalar[hash] PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* $foo{bar();} */ 1169 { $$ = newBINOP(OP_HELEM, 0, oopsHV($hash), jmaybe($expr)); 1170 } 1171 | term[hash_reference] ARROW PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* somehref->{bar();} */ 1172 { $$ = newBINOP(OP_HELEM, 0, 1173 ref(newHVREF($hash_reference),OP_RV2HV), 1174 jmaybe($expr)); } 1175 | subscripted[hash_reference] PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* $foo->[bar]->{baz;} */ 1176 { $$ = newBINOP(OP_HELEM, 0, 1177 ref(newHVREF($hash_reference),OP_RV2HV), 1178 jmaybe($expr)); } 1179 | term[code_reference] ARROW PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* $subref->() */ 1180 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1181 newCVREF(0, scalar($code_reference))); 1182 if (parser->expect == XBLOCK) 1183 parser->expect = XOPERATOR; 1184 } 1185 | term[code_reference] ARROW PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* $subref->(@args) */ 1186 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1187 op_append_elem(OP_LIST, $expr, 1188 newCVREF(0, scalar($code_reference)))); 1189 if (parser->expect == XBLOCK) 1190 parser->expect = XOPERATOR; 1191 } 1192 1193 | subscripted[code_reference] PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* $foo->{bar}->(@args) */ 1194 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1195 op_append_elem(OP_LIST, $expr, 1196 newCVREF(0, scalar($code_reference)))); 1197 if (parser->expect == XBLOCK) 1198 parser->expect = XOPERATOR; 1199 } 1200 | subscripted[code_reference] PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* $foo->{bar}->() */ 1201 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1202 newCVREF(0, scalar($code_reference))); 1203 if (parser->expect == XBLOCK) 1204 parser->expect = XOPERATOR; 1205 } 1206 | PERLY_PAREN_OPEN expr[list] PERLY_PAREN_CLOSE PERLY_BRACKET_OPEN expr[slice] PERLY_BRACKET_CLOSE /* list slice */ 1207 { $$ = newSLICEOP(0, $slice, $list); } 1208 | QWLIST PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* list literal slice */ 1209 { $$ = newSLICEOP(0, $expr, $QWLIST); } 1210 | PERLY_PAREN_OPEN PERLY_PAREN_CLOSE PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* empty list slice! */ 1211 { $$ = newSLICEOP(0, $expr, NULL); } 1212 ; 1213 1214 /* Binary operators between terms */ 1215 termbinop: term[lhs] PLUGIN_HIGH_OP[op] term[rhs] 1216 { $$ = build_infix_plugin($lhs, $rhs, $op); } 1217 | term[lhs] ASSIGNOP term[rhs] /* $x = $y, $x += $y */ 1218 { $$ = newASSIGNOP(OPf_STACKED, $lhs, $ASSIGNOP, $rhs); } 1219 | term[lhs] PLUGIN_ASSIGN_OP[op] term[rhs] 1220 { $$ = build_infix_plugin($lhs, $rhs, $op); } 1221 | term[lhs] POWOP term[rhs] /* $x ** $y */ 1222 { $$ = newBINOP($POWOP, 0, scalar($lhs), scalar($rhs)); } 1223 | term[lhs] PLUGIN_POW_OP[op] term[rhs] 1224 { $$ = build_infix_plugin($lhs, $rhs, $op); } 1225 | term[lhs] MULOP term[rhs] /* $x * $y, $x x $y */ 1226 { if ($MULOP != OP_REPEAT) 1227 scalar($lhs); 1228 $$ = newBINOP($MULOP, 0, $lhs, scalar($rhs)); 1229 } 1230 | term[lhs] PLUGIN_MUL_OP[op] term[rhs] 1231 { $$ = build_infix_plugin($lhs, $rhs, $op); } 1232 | term[lhs] ADDOP term[rhs] /* $x + $y */ 1233 { $$ = newBINOP($ADDOP, 0, scalar($lhs), scalar($rhs)); } 1234 | term[lhs] PLUGIN_ADD_OP[op] term[rhs] 1235 { $$ = build_infix_plugin($lhs, $rhs, $op); } 1236 | term[lhs] SHIFTOP term[rhs] /* $x >> $y, $x << $y */ 1237 { $$ = newBINOP($SHIFTOP, 0, scalar($lhs), scalar($rhs)); } 1238 | termrelop %prec PREC_LOW /* $x > $y, etc. */ 1239 { $$ = $termrelop; } 1240 | termeqop %prec PREC_LOW /* $x == $y, $x cmp $y */ 1241 { $$ = $termeqop; } 1242 | term[lhs] BITANDOP term[rhs] /* $x & $y */ 1243 { $$ = newBINOP($BITANDOP, 0, scalar($lhs), scalar($rhs)); } 1244 | term[lhs] BITOROP term[rhs] /* $x | $y */ 1245 { $$ = newBINOP($BITOROP, 0, scalar($lhs), scalar($rhs)); } 1246 | term[lhs] DOTDOT term[rhs] /* $x..$y, $x...$y */ 1247 { $$ = newRANGE($DOTDOT, scalar($lhs), scalar($rhs)); } 1248 | term[lhs] ANDAND term[rhs] /* $x && $y */ 1249 { $$ = newLOGOP(OP_AND, 0, $lhs, $rhs); } 1250 | term[lhs] PLUGIN_LOGICAL_AND_OP[op] term[rhs] 1251 { $$ = build_infix_plugin($lhs, $rhs, $op); } 1252 | term[lhs] OROR term[rhs] /* $x || $y */ 1253 { $$ = newLOGOP($OROR, 0, $lhs, $rhs); } 1254 | term[lhs] PLUGIN_LOGICAL_OR_OP[op] term[rhs] 1255 { $$ = build_infix_plugin($lhs, $rhs, $op); } 1256 | term[lhs] DORDOR term[rhs] /* $x // $y */ 1257 { $$ = newLOGOP(OP_DOR, 0, $lhs, $rhs); } 1258 | term[lhs] MATCHOP term[rhs] /* $x =~ /$y/ */ 1259 { $$ = bind_match($MATCHOP, $lhs, $rhs); } 1260 | term[lhs] PLUGIN_LOW_OP[op] term[rhs] 1261 { $$ = build_infix_plugin($lhs, $rhs, $op); } 1262 ; 1263 1264 termrelop: relopchain %prec PREC_LOW 1265 { $$ = cmpchain_finish($relopchain); } 1266 | term[lhs] NCRELOP term[rhs] 1267 { $$ = newBINOP($NCRELOP, 0, scalar($lhs), scalar($rhs)); } 1268 | termrelop NCRELOP 1269 { yyerror("syntax error"); YYERROR; } 1270 | termrelop CHRELOP 1271 { yyerror("syntax error"); YYERROR; } 1272 | term[lhs] PLUGIN_REL_OP[op] term[rhs] 1273 { $$ = build_infix_plugin($lhs, $rhs, $op); } 1274 ; 1275 1276 relopchain: term[lhs] CHRELOP term[rhs] 1277 { $$ = cmpchain_start($CHRELOP, $lhs, $rhs); } 1278 | relopchain[lhs] CHRELOP term[rhs] 1279 { $$ = cmpchain_extend($CHRELOP, $lhs, $rhs); } 1280 ; 1281 1282 termeqop: eqopchain %prec PREC_LOW 1283 { $$ = cmpchain_finish($eqopchain); } 1284 | term[lhs] NCEQOP term[rhs] 1285 { $$ = newBINOP($NCEQOP, 0, scalar($lhs), scalar($rhs)); } 1286 | termeqop NCEQOP 1287 { yyerror("syntax error"); YYERROR; } 1288 | termeqop CHEQOP 1289 { yyerror("syntax error"); YYERROR; } 1290 ; 1291 1292 eqopchain: term[lhs] CHEQOP term[rhs] 1293 { $$ = cmpchain_start($CHEQOP, $lhs, $rhs); } 1294 | eqopchain[lhs] CHEQOP term[rhs] 1295 { $$ = cmpchain_extend($CHEQOP, $lhs, $rhs); } 1296 ; 1297 1298 /* Unary operators and terms */ 1299 termunop : PERLY_MINUS term %prec UMINUS /* -$x */ 1300 { $$ = newUNOP(OP_NEGATE, 0, scalar($term)); } 1301 | PERLY_PLUS term %prec UMINUS /* +$x */ 1302 { $$ = $term; } 1303 1304 | PERLY_EXCLAMATION_MARK term /* !$x */ 1305 { $$ = newUNOP(OP_NOT, 0, scalar($term)); } 1306 | PERLY_TILDE term /* ~$x */ 1307 { $$ = newUNOP($PERLY_TILDE, 0, scalar($term)); } 1308 | term POSTINC /* $x++ */ 1309 { $$ = newUNOP(OP_POSTINC, 0, 1310 op_lvalue(scalar($term), OP_POSTINC)); } 1311 | term POSTDEC /* $x-- */ 1312 { $$ = newUNOP(OP_POSTDEC, 0, 1313 op_lvalue(scalar($term), OP_POSTDEC));} 1314 | term POSTJOIN /* implicit join after interpolated ->@ */ 1315 { $$ = op_convert_list(OP_JOIN, 0, 1316 op_append_elem( 1317 OP_LIST, 1318 newSVREF(scalar( 1319 newSVOP(OP_CONST,0, 1320 newSVpvs("\"")) 1321 )), 1322 $term 1323 )); 1324 } 1325 | PREINC term /* ++$x */ 1326 { $$ = newUNOP(OP_PREINC, 0, 1327 op_lvalue(scalar($term), OP_PREINC)); } 1328 | PREDEC term /* --$x */ 1329 { $$ = newUNOP(OP_PREDEC, 0, 1330 op_lvalue(scalar($term), OP_PREDEC)); } 1331 1332 ; 1333 1334 /* Constructors for anonymous data */ 1335 anonymous 1336 : PERLY_BRACKET_OPEN optexpr PERLY_BRACKET_CLOSE 1337 { $$ = newANONLIST($optexpr); } 1338 | HASHBRACK optexpr PERLY_SEMICOLON PERLY_BRACE_CLOSE %prec PERLY_PAREN_OPEN /* { foo => "Bar" } */ 1339 { $$ = newANONHASH($optexpr); } 1340 | KW_SUB_anon startanonsub proto subattrlist subbody %prec PERLY_PAREN_OPEN 1341 { SvREFCNT_inc_simple_void(PL_compcv); 1342 $$ = newANONATTRSUB($startanonsub, $proto, $subattrlist, $subbody); } 1343 | KW_SUB_anon_sig startanonsub subattrlist sigsubbody %prec PERLY_PAREN_OPEN 1344 { SvREFCNT_inc_simple_void(PL_compcv); 1345 $$ = newANONATTRSUB($startanonsub, NULL, $subattrlist, $sigsubbody); } 1346 | KW_METHOD_anon startanonmethod subattrlist sigsubbody %prec PERLY_PAREN_OPEN 1347 { 1348 SvREFCNT_inc_simple_void(PL_compcv); 1349 $$ = newANONATTRSUB($startanonmethod, NULL, $subattrlist, $sigsubbody); 1350 } 1351 ; 1352 1353 /* Things called with "do" */ 1354 termdo : KW_DO term %prec UNIOP /* do $filename */ 1355 { $$ = dofile($term, $KW_DO);} 1356 | KW_DO block %prec PERLY_PAREN_OPEN /* do { code */ 1357 { $$ = newUNOP(OP_NULL, OPf_SPECIAL, op_scope($block));} 1358 ; 1359 1360 term[product] : termbinop 1361 | termunop 1362 | anonymous 1363 | termdo 1364 | term[condition] PERLY_QUESTION_MARK term[then] PERLY_COLON term[else] 1365 { $$ = newCONDOP(0, $condition, $then, $else); } 1366 | REFGEN term[operand] /* \$x, \@y, \%z */ 1367 { $$ = newUNOP(OP_REFGEN, 0, $operand); } 1368 | myattrterm %prec UNIOP 1369 { $$ = $myattrterm; } 1370 | KW_LOCAL term[operand] %prec UNIOP 1371 { $$ = localize($operand,0); } 1372 | PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE 1373 { $$ = sawparens($expr); } 1374 | QWLIST 1375 { $$ = $QWLIST; } 1376 | PERLY_PAREN_OPEN PERLY_PAREN_CLOSE 1377 { $$ = sawparens(newNULLLIST()); } 1378 | scalar %prec PERLY_PAREN_OPEN 1379 { $$ = $scalar; } 1380 | star %prec PERLY_PAREN_OPEN 1381 { $$ = $star; } 1382 | hsh %prec PERLY_PAREN_OPEN 1383 { $$ = $hsh; } 1384 | ary %prec PERLY_PAREN_OPEN 1385 { $$ = $ary; } 1386 | arylen %prec PERLY_PAREN_OPEN /* $#x, $#{ something } */ 1387 { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($arylen, OP_AV2ARYLEN));} 1388 | subscripted 1389 { $$ = $subscripted; } 1390 | sliceme PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* array slice */ 1391 { $$ = op_prepend_elem(OP_ASLICE, 1392 newOP(OP_PUSHMARK, 0), 1393 newLISTOP(OP_ASLICE, 0, 1394 list($expr), 1395 ref($sliceme, OP_ASLICE))); 1396 if ($$ && $sliceme) 1397 $$->op_private |= 1398 $sliceme->op_private & OPpSLICEWARNING; 1399 } 1400 | kvslice PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* array key/value slice */ 1401 { $$ = op_prepend_elem(OP_KVASLICE, 1402 newOP(OP_PUSHMARK, 0), 1403 newLISTOP(OP_KVASLICE, 0, 1404 list($expr), 1405 ref(oopsAV($kvslice), OP_KVASLICE))); 1406 if ($$ && $kvslice) 1407 $$->op_private |= 1408 $kvslice->op_private & OPpSLICEWARNING; 1409 } 1410 | sliceme PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* @hash{@keys} */ 1411 { $$ = op_prepend_elem(OP_HSLICE, 1412 newOP(OP_PUSHMARK, 0), 1413 newLISTOP(OP_HSLICE, 0, 1414 list($expr), 1415 ref(oopsHV($sliceme), OP_HSLICE))); 1416 if ($$ && $sliceme) 1417 $$->op_private |= 1418 $sliceme->op_private & OPpSLICEWARNING; 1419 } 1420 | kvslice PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* %hash{@keys} */ 1421 { $$ = op_prepend_elem(OP_KVHSLICE, 1422 newOP(OP_PUSHMARK, 0), 1423 newLISTOP(OP_KVHSLICE, 0, 1424 list($expr), 1425 ref($kvslice, OP_KVHSLICE))); 1426 if ($$ && $kvslice) 1427 $$->op_private |= 1428 $kvslice->op_private & OPpSLICEWARNING; 1429 } 1430 | THING %prec PERLY_PAREN_OPEN 1431 { $$ = $THING; } 1432 | amper /* &foo; */ 1433 { $$ = newUNOP(OP_ENTERSUB, 0, scalar($amper)); } 1434 | amper PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* &foo() or foo() */ 1435 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($amper)); 1436 } 1437 | amper PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* &foo(@args) or foo(@args) */ 1438 { 1439 $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1440 op_append_elem(OP_LIST, $expr, scalar($amper))); 1441 } 1442 | NOAMP subname optlistexpr /* foo @args (no parens) */ 1443 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1444 op_append_elem(OP_LIST, $optlistexpr, scalar($subname))); 1445 } 1446 | term[operand] ARROW PERLY_DOLLAR PERLY_STAR 1447 { $$ = newSVREF($operand); } 1448 | term[operand] ARROW PERLY_SNAIL PERLY_STAR 1449 { $$ = newAVREF($operand); } 1450 | term[operand] ARROW PERLY_PERCENT_SIGN PERLY_STAR 1451 { $$ = newHVREF($operand); } 1452 | term[operand] ARROW PERLY_AMPERSAND PERLY_STAR 1453 { $$ = newUNOP(OP_ENTERSUB, 0, 1454 scalar(newCVREF($PERLY_AMPERSAND,$operand))); } 1455 | term[operand] ARROW PERLY_STAR PERLY_STAR %prec PERLY_PAREN_OPEN 1456 { $$ = newGVREF(0,$operand); } 1457 | LOOPEX /* loop exiting command (goto, last, dump, etc) */ 1458 { $$ = newOP($LOOPEX, OPf_SPECIAL); 1459 PL_hints |= HINT_BLOCK_SCOPE; } 1460 | LOOPEX term[operand] 1461 { $$ = newLOOPEX($LOOPEX,$operand); } 1462 | NOTOP listexpr /* not $foo */ 1463 { $$ = newUNOP(OP_NOT, 0, scalar($listexpr)); } 1464 | UNIOP /* Unary op, $_ implied */ 1465 { $$ = newOP($UNIOP, 0); } 1466 | UNIOP block /* eval { foo }* */ 1467 { $$ = newUNOP($UNIOP, 0, $block); } 1468 | UNIOP term[operand] /* Unary op */ 1469 { $$ = newUNOP($UNIOP, 0, $operand); } 1470 | KW_REQUIRE /* require, $_ implied */ 1471 { $$ = newOP(OP_REQUIRE, $KW_REQUIRE ? OPf_SPECIAL : 0); } 1472 | KW_REQUIRE term[operand] /* require Foo */ 1473 { $$ = newUNOP(OP_REQUIRE, $KW_REQUIRE ? OPf_SPECIAL : 0, $operand); } 1474 | UNIOPSUB 1475 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($UNIOPSUB)); } 1476 | UNIOPSUB term[operand] /* Sub treated as unop */ 1477 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, 1478 op_append_elem(OP_LIST, $operand, scalar($UNIOPSUB))); } 1479 | FUNC0 /* Nullary operator */ 1480 { $$ = newOP($FUNC0, 0); } 1481 | FUNC0 PERLY_PAREN_OPEN PERLY_PAREN_CLOSE 1482 { $$ = newOP($FUNC0, 0);} 1483 | FUNC0OP /* Same as above, but op created in toke.c */ 1484 { $$ = $FUNC0OP; } 1485 | FUNC0OP PERLY_PAREN_OPEN PERLY_PAREN_CLOSE 1486 { $$ = $FUNC0OP; } 1487 | FUNC0SUB /* Sub treated as nullop */ 1488 { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($FUNC0SUB)); } 1489 | FUNC1 PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* not () */ 1490 { $$ = ($FUNC1 == OP_NOT) 1491 ? newUNOP($FUNC1, 0, newSVOP(OP_CONST, 0, newSViv(0))) 1492 : newOP($FUNC1, OPf_SPECIAL); } 1493 | FUNC1 PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* not($foo) */ 1494 { $$ = newUNOP($FUNC1, 0, $expr); } 1495 | PMFUNC /* m//, s///, qr//, tr/// */ 1496 { 1497 if ( $PMFUNC->op_type != OP_TRANS 1498 && $PMFUNC->op_type != OP_TRANSR 1499 && (((PMOP*)$PMFUNC)->op_pmflags & PMf_HAS_CV)) 1500 { 1501 $<ival>$ = start_subparse(FALSE, CVf_ANON); 1502 SAVEFREESV(PL_compcv); 1503 } else 1504 $<ival>$ = 0; 1505 } 1506 SUBLEXSTART listexpr optrepl SUBLEXEND 1507 { $$ = pmruntime($PMFUNC, $listexpr, $optrepl, 1, $<ival>2); } 1508 | BAREWORD 1509 | listop 1510 | PLUGEXPR 1511 ; 1512 1513 /* "my" declarations, with optional attributes */ 1514 myattrterm 1515 : KW_MY myterm myattrlist 1516 { $$ = my_attrs($myterm,$myattrlist); } 1517 | KW_MY myterm 1518 { $$ = localize($myterm,1); } 1519 | KW_MY REFGEN myterm myattrlist 1520 { $$ = newUNOP(OP_REFGEN, 0, my_attrs($myterm,$myattrlist)); } 1521 | KW_MY REFGEN term[operand] 1522 { $$ = newUNOP(OP_REFGEN, 0, localize($operand,1)); } 1523 ; 1524 1525 /* Things that can be "my"'d */ 1526 myterm : PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE 1527 { $$ = sawparens($expr); } 1528 | PERLY_PAREN_OPEN PERLY_PAREN_CLOSE 1529 { $$ = sawparens(newNULLLIST()); } 1530 1531 | scalar %prec PERLY_PAREN_OPEN 1532 { $$ = $scalar; } 1533 | hsh %prec PERLY_PAREN_OPEN 1534 { $$ = $hsh; } 1535 | ary %prec PERLY_PAREN_OPEN 1536 { $$ = $ary; } 1537 ; 1538 1539 /* "field" declarations */ 1540 fieldvar: scalar %prec PERLY_PAREN_OPEN 1541 { 1542 $$ = PadnamelistARRAY(PL_comppad_name)[$scalar->op_targ]; 1543 op_free($scalar); 1544 } 1545 | hsh %prec PERLY_PAREN_OPEN 1546 { 1547 $$ = PadnamelistARRAY(PL_comppad_name)[$hsh->op_targ]; 1548 op_free($hsh); 1549 } 1550 | ary %prec PERLY_PAREN_OPEN 1551 { 1552 $$ = PadnamelistARRAY(PL_comppad_name)[$ary->op_targ]; 1553 op_free($ary); 1554 } 1555 ; 1556 1557 optfieldattrlist: 1558 COLONATTR THING 1559 { $$ = $THING; } 1560 | COLONATTR 1561 { $$ = NULL; } 1562 | empty 1563 ; 1564 1565 fielddecl 1566 : KW_FIELD fieldvar optfieldattrlist 1567 { 1568 parser->in_my = 0; 1569 if($optfieldattrlist) 1570 class_apply_field_attributes((PADNAME *)$fieldvar, $optfieldattrlist); 1571 $$ = newOP(OP_NULL, 0); 1572 } 1573 | KW_FIELD fieldvar optfieldattrlist ASSIGNOP 1574 { 1575 parser->in_my = 0; 1576 if($optfieldattrlist) 1577 class_apply_field_attributes((PADNAME *)$fieldvar, $optfieldattrlist); 1578 ENTER; 1579 class_prepare_initfield_parse(); 1580 } 1581 term 1582 { 1583 class_set_field_defop((PADNAME *)$fieldvar, $ASSIGNOP, $term); 1584 LEAVE; 1585 $$ = newOP(OP_NULL, 0); 1586 } 1587 ; 1588 1589 /* Basic list expressions */ 1590 optlistexpr 1591 : empty %prec PREC_LOW 1592 | listexpr %prec PREC_LOW 1593 ; 1594 1595 optexpr 1596 : empty 1597 | expr 1598 ; 1599 1600 optrepl 1601 : empty 1602 | PERLY_SLASH expr { $$ = $expr; } 1603 ; 1604 1605 /* A little bit of trickery to make "for my $foo (@bar)" actually be 1606 lexical */ 1607 my_scalar: scalar 1608 { parser->in_my = 0; $$ = my($scalar); } 1609 ; 1610 1611 /* A list of scalars for "for my ($foo, $bar) (@baz)" */ 1612 list_of_scalars: list_of_scalars[list] PERLY_COMMA 1613 { $$ = $list; } 1614 | list_of_scalars[list] PERLY_COMMA scalar 1615 { 1616 $$ = op_append_elem(OP_LIST, $list, $scalar); 1617 } 1618 | scalar %prec PREC_LOW 1619 ; 1620 1621 my_list_of_scalars: list_of_scalars 1622 { parser->in_my = 0; $$ = $list_of_scalars; } 1623 ; 1624 1625 my_var : scalar 1626 | ary 1627 | hsh 1628 ; 1629 1630 refgen_topic: my_var 1631 | amper 1632 ; 1633 1634 my_refgen: KW_MY REFGEN 1635 | REFGEN KW_MY 1636 ; 1637 1638 amper : PERLY_AMPERSAND indirob 1639 { $$ = newCVREF($PERLY_AMPERSAND,$indirob); } 1640 ; 1641 1642 scalar : PERLY_DOLLAR indirob 1643 { $$ = newSVREF($indirob); } 1644 ; 1645 1646 ary : PERLY_SNAIL indirob 1647 { $$ = newAVREF($indirob); 1648 if ($$) $$->op_private |= $PERLY_SNAIL; 1649 } 1650 ; 1651 1652 hsh : PERLY_PERCENT_SIGN indirob 1653 { $$ = newHVREF($indirob); 1654 if ($$) $$->op_private |= $PERLY_PERCENT_SIGN; 1655 } 1656 ; 1657 1658 arylen : DOLSHARP indirob 1659 { $$ = newAVREF($indirob); } 1660 | term ARROW DOLSHARP PERLY_STAR 1661 { $$ = newAVREF($term); } 1662 ; 1663 1664 star : PERLY_STAR indirob 1665 { $$ = newGVREF(0,$indirob); } 1666 ; 1667 1668 sliceme : ary 1669 | term ARROW PERLY_SNAIL 1670 { $$ = newAVREF($term); } 1671 ; 1672 1673 kvslice : hsh 1674 | term ARROW PERLY_PERCENT_SIGN 1675 { $$ = newHVREF($term); } 1676 ; 1677 1678 gelem : star 1679 | term ARROW PERLY_STAR 1680 { $$ = newGVREF(0,$term); } 1681 ; 1682 1683 /* Indirect objects */ 1684 indirob : BAREWORD 1685 { $$ = scalar($BAREWORD); } 1686 | scalar %prec PREC_LOW 1687 { $$ = scalar($scalar); } 1688 | block 1689 { $$ = op_scope($block); } 1690 1691 | PRIVATEREF 1692 { $$ = $PRIVATEREF; } 1693 ; 1694