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