X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d39c26a657753cddffc8cb3dbd2aaa929b2c78fe..a705fd33893d18a8306026f955019f8440681b9a:/perly.y diff --git a/perly.y b/perly.y index a909436..7d57dea 100644 --- a/perly.y +++ b/perly.y @@ -31,7 +31,7 @@ /* Make the parser re-entrant. */ -%pure_parser +%pure-parser %start grammar @@ -45,9 +45,9 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ -%token '{' '}' '[' ']' '-' '+' '$' '@' '%' '*' '&' ';' '=' '.' +%token '{' '}' '[' ']' '-' '+' '@' '%' '&' '=' '.' -%token WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST +%token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST %token FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB %token PLUGEXPR PLUGSTMT %token LABEL @@ -69,12 +69,15 @@ %type stmtseq fullstmt labfullstmt barestmt block mblock else %type expr term subscripted scalar ary hsh arylen star amper sideff %type sliceme kvslice gelem -%type listexpr nexpr texpr iexpr mexpr mnexpr miexpr -%type optlistexpr optexpr indirob listop method +%type listexpr nexpr texpr iexpr mexpr mnexpr +%type optlistexpr optexpr optrepl indirob listop method %type formname subname proto optsubbody cont my_scalar my_var %type refgen_topic formblock %type subattrlist myattrlist myattrterm myterm -%type realsubbody subsignature termbinop termunop anonymous termdo +%type termbinop termunop anonymous termdo +%type sigslurpsigil +%type sigvarname sigdefault sigscalarelem sigslurpelem +%type sigelem siglist siglistornull subsignature %type formstmtseq formline formarg %nonassoc PREC_LOW @@ -118,6 +121,7 @@ grammar : GRAMPROG remember stmtseq { newPROG(block_end($3,$4)); + PL_compiling.cop_seq = 0; $$ = 0; } | GRAMEXPR @@ -139,7 +143,7 @@ grammar : GRAMPROG PL_eval_root = $3; $$ = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } | GRAMBARESTMT { @@ -151,7 +155,7 @@ grammar : GRAMPROG PL_eval_root = $3; $$ = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } | GRAMFULLSTMT { @@ -163,7 +167,7 @@ grammar : GRAMPROG PL_eval_root = $3; $$ = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } | GRAMSTMTSEQ { @@ -193,7 +197,8 @@ formblock: '=' remember ';' FORMRBRACK formstmtseq ';' '.' ; remember: /* NULL */ /* start a full lexical scope */ - { $$ = block_start(TRUE); } + { $$ = block_start(TRUE); + parser->parsed_sub = 0; } ; mblock : '{' mremember stmtseq '}' @@ -204,12 +209,13 @@ mblock : '{' mremember stmtseq '}' ; mremember: /* NULL */ /* start a partial lexical scope */ - { $$ = block_start(FALSE); } + { $$ = block_start(FALSE); + parser->parsed_sub = 0; } ; /* A sequence of statements in the program */ stmtseq : /* NULL */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | stmtseq fullstmt { $$ = op_append_list(OP_LINESEQ, $1, $2); PL_pad_reset_pending = TRUE; @@ -220,7 +226,7 @@ stmtseq : /* NULL */ /* A sequence of format lines */ formstmtseq: /* NULL */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | formstmtseq formline { $$ = op_append_list(OP_LINESEQ, $1, $2); PL_pad_reset_pending = TRUE; @@ -255,11 +261,11 @@ barestmt: PLUGSTMT { CV *fmtcv = PL_compcv; newFORM($2, $3, $4); - $$ = (OP*)NULL; + $$ = NULL; if (CvOUTSIDE(fmtcv) && !CvEVAL(CvOUTSIDE(fmtcv))) { - SvREFCNT_inc_simple_void(fmtcv); - pad_add_anon(fmtcv, OP_NULL); + pad_add_weakref(fmtcv); } + parser->parsed_sub = 1; } | SUB subname startsub { @@ -290,23 +296,64 @@ barestmt: PLUGSTMT ? newATTRSUB($3, $2, $5, $6, $7) : newMYSUB($3, $2, $5, $6, $7) ; - $$ = (OP*)NULL; + $$ = NULL; + intro_my(); + parser->parsed_sub = 1; + } + | SUB subname startsub + { + if ($2->op_type == OP_CONST) { + const char *const name = + SvPV_nolen_const(((SVOP*)$2)->op_sv); + if (strEQ(name, "BEGIN") || strEQ(name, "END") + || strEQ(name, "INIT") || strEQ(name, "CHECK") + || strEQ(name, "UNITCHECK")) + CvSPECIAL_on(PL_compcv); + } + else + /* State subs inside anonymous subs need to be + clonable themselves. */ + if (CvANON(CvOUTSIDE(PL_compcv)) + || CvCLONE(CvOUTSIDE(PL_compcv)) + || !PadnameIsSTATE(PadlistNAMESARRAY(CvPADLIST( + CvOUTSIDE(PL_compcv) + ))[$2->op_targ])) + CvCLONE_on(PL_compcv); + parser->in_my = 0; + parser->in_my_stash = NULL; + } + remember subsignature subattrlist '{' stmtseq '}' + { + OP *body; + if (parser->copline > (line_t)$8) + parser->copline = (line_t)$8; + body = block_end($5, + op_append_list(OP_LINESEQ, $6, $9)); + + SvREFCNT_inc_simple_void(PL_compcv); + $2->op_type == OP_CONST + ? newATTRSUB($3, $2, NULL, $7, body) + : newMYSUB($3, $2, NULL, $7, body) + ; + $$ = NULL; intro_my(); + parser->parsed_sub = 1; } - | PACKAGE WORD WORD ';' + | PACKAGE BAREWORD BAREWORD ';' { package($3); if ($2) package_version($2); - $$ = (OP*)NULL; + $$ = NULL; } | USE startsub { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } - WORD WORD optlistexpr ';' + BAREWORD BAREWORD optlistexpr ';' { SvREFCNT_inc_simple_void(PL_compcv); utilize($1, $2, $4, $5, $6); - $$ = (OP*)NULL; + parser->parsed_sub = 1; + $$ = NULL; } | IF '(' remember mexpr ')' mblock else { @@ -314,21 +361,15 @@ barestmt: PLUGSTMT newCONDOP(0, $4, op_scope($6), $7)); parser->copline = (line_t)$1; } - | UNLESS '(' remember miexpr ')' mblock else + | UNLESS '(' remember mexpr ')' mblock else { $$ = block_end($3, - newCONDOP(0, $4, op_scope($6), $7)); + newCONDOP(0, $4, $7, op_scope($6))); parser->copline = (line_t)$1; } | GIVEN '(' remember mexpr ')' mblock { - const PADOFFSET offset = pad_findmy_pvs("$_", 0); - $$ = block_end($3, - newGIVENOP($4, op_scope($6), - offset == NOT_IN_PAD - || PAD_COMPNAME_FLAGS_isOUR(offset) - ? 0 - : offset)); + $$ = block_end($3, newGIVENOP($4, op_scope($6), 0)); parser->copline = (line_t)$1; } | WHEN '(' remember mexpr ')' mblock @@ -338,14 +379,14 @@ barestmt: PLUGSTMT | WHILE '(' remember texpr ')' mintro mblock cont { $$ = block_end($3, - newWHILEOP(0, 1, (LOOP*)(OP*)NULL, + newWHILEOP(0, 1, NULL, $4, $7, $8, $6)); parser->copline = (line_t)$1; } | UNTIL '(' remember iexpr ')' mintro mblock cont { $$ = block_end($3, - newWHILEOP(0, 1, (LOOP*)(OP*)NULL, + newWHILEOP(0, 1, NULL, $4, $7, $8, $6)); parser->copline = (line_t)$1; } @@ -357,7 +398,7 @@ barestmt: PLUGSTMT mblock { OP *initop = $4; - OP *forop = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, + OP *forop = newWHILEOP(0, 1, NULL, scalar($7), $13, $11, $10); if (initop) { forop = op_prepend_elem(OP_LINESEQ, initop, @@ -365,6 +406,7 @@ barestmt: PLUGSTMT newOP(OP_UNSTACK, OPf_SPECIAL), forop)); } + PL_hints |= HINT_BLOCK_SCOPE; $$ = block_end($3, forop); parser->copline = (line_t)$1; } @@ -379,19 +421,18 @@ barestmt: PLUGSTMT op_lvalue($2, OP_ENTERLOOP), $5, $7, $8)); parser->copline = (line_t)$1; } - | FOR REFGEN MY remember my_var - { parser->in_my = 0; $$ = my($5); } + | FOR my_refgen remember my_var + { parser->in_my = 0; $$ = my($4); } '(' mexpr ')' mblock cont { $$ = block_end( - $4, + $3, newFOROP(0, op_lvalue( newUNOP(OP_REFGEN, 0, - op_lvalue($6, - OP_REFGEN)), + $5), OP_ENTERLOOP), - $8, $10, $11) + $7, $9, $10) ); parser->copline = (line_t)$1; } @@ -399,24 +440,23 @@ barestmt: PLUGSTMT { $$ = block_end($5, newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, - op_lvalue($3, - OP_REFGEN)), + $3), OP_ENTERLOOP), $6, $8, $9)); parser->copline = (line_t)$1; } | FOR '(' remember mexpr ')' mblock cont { $$ = block_end($3, - newFOROP(0, (OP*)NULL, $4, $6, $7)); + newFOROP(0, NULL, $4, $6, $7)); parser->copline = (line_t)$1; } | block cont { /* a block is a loop that happens once */ - $$ = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, - (OP*)NULL, $1, $2, 0); + $$ = newWHILEOP(0, 1, NULL, + NULL, $1, $2, 0); } - | PACKAGE WORD WORD '{' remember + | PACKAGE BAREWORD BAREWORD '{' remember { package($3); if ($2) { @@ -426,8 +466,8 @@ barestmt: PLUGSTMT stmtseq '}' { /* a block is a loop that happens once */ - $$ = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, - (OP*)NULL, block_end($5, $7), (OP*)NULL, 0); + $$ = newWHILEOP(0, 1, NULL, + NULL, block_end($5, $7), NULL, 0); if (parser->copline > (line_t)$4) parser->copline = (line_t)$4; } @@ -437,7 +477,7 @@ barestmt: PLUGSTMT } | ';' { - $$ = (OP*)NULL; + $$ = NULL; parser->copline = NOLINE; } ; @@ -456,7 +496,7 @@ formline: THING formarg parser->copline = CopLINE(PL_curcop)-1; else parser->copline--; $$ = newSTATEOP(0, NULL, - convert(OP_FORMLINE, 0, list)); + op_convert_list(OP_FORMLINE, 0, list)); } ; @@ -468,7 +508,7 @@ formarg : /* NULL */ /* An expression which may have a side-effect */ sideff : error - { $$ = (OP*)NULL; } + { $$ = NULL; } | expr { $$ = $1; } | expr IF expr @@ -480,7 +520,7 @@ sideff : error | expr UNTIL iexpr { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1); } | expr FOR expr - { $$ = newFOROP(0, (OP*)NULL, $3, $1, (OP*)NULL); + { $$ = newFOROP(0, NULL, $3, $1, NULL); parser->copline = (line_t)$2; } | expr WHEN expr { $$ = newWHENOP($3, op_scope($1)); } @@ -488,7 +528,7 @@ sideff : error /* else and elsif blocks */ else : /* NULL */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | ELSE mblock { ($2)->op_flags |= OPf_PARENS; @@ -505,7 +545,7 @@ else : /* NULL */ /* Continue blocks */ cont : /* NULL */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | CONTINUE block { $$ = op_scope($2); } ; @@ -518,7 +558,7 @@ mintro : /* NULL */ /* Normal expression */ nexpr : /* NULL */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | sideff ; @@ -544,12 +584,8 @@ mnexpr : nexpr { $$ = $1; intro_my(); } ; -miexpr : iexpr - { $$ = $1; intro_my(); } - ; - -formname: WORD { $$ = $1; } - | /* NULL */ { $$ = (OP*)NULL; } +formname: BAREWORD { $$ = $1; } + | /* NULL */ { $$ = NULL; } ; startsub: /* NULL */ /* start a regular subroutine scope */ @@ -569,65 +605,225 @@ startformsub: /* NULL */ /* start a format subroutine scope */ ; /* Name of a subroutine - must be a bareword, could be special */ -subname : WORD +subname : BAREWORD | PRIVATEREF ; /* Subroutine prototype */ proto : /* NULL */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | THING ; /* Optional list of subroutine attributes */ subattrlist: /* NULL */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | COLONATTR THING { $$ = $2; } | COLONATTR - { $$ = (OP*)NULL; } + { $$ = NULL; } ; /* List of attributes for a "my" variable declaration */ myattrlist: COLONATTR THING { $$ = $2; } | COLONATTR - { $$ = (OP*)NULL; } + { $$ = NULL; } ; -/* Optional subroutine signature */ -subsignature: /* NULL */ { $$ = (OP*)NULL; } - | '(' - { - if (!FEATURE_SIGNATURES_IS_ENABLED) - Perl_croak(aTHX_ "Experimental " - "subroutine signatures not enabled"); - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__SIGNATURES), - "The signatures feature is experimental"); - $$ = parse_subsignature(); - } - ')' + + +/* -------------------------------------- + * subroutine signature parsing + */ + +/* the '' or 'foo' part of a '$' or '@foo' etc signature variable */ +sigvarname: /* NULL */ + { parser->in_my = 0; $$ = NULL; } + | PRIVATEREF + { parser->in_my = 0; $$ = $1; } + ; + +sigslurpsigil: + '@' + { $$ = '@'; } + | '%' + { $$ = '%'; } + +/* @, %, @foo, %foo */ +sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */ + { + I32 sigil = $1; + OP *var = $2; + OP *defexpr = $3; + + if (parser->sig_slurpy) + yyerror("Multiple slurpy parameters not allowed"); + parser->sig_slurpy = (char)sigil; + + if (defexpr) + yyerror("A slurpy parameter may not have " + "a default value"); + + $$ = var ? newSTATEOP(0, NULL, var) : NULL; + } + ; + +/* default part of sub signature scalar element: i.e. '= default_expr' */ +sigdefault: /* NULL */ + { $$ = NULL; } + | ASSIGNOP + { $$ = newOP(OP_NULL, 0); } + | ASSIGNOP term + { $$ = $2; } + + +/* subroutine signature scalar element: e.g. '$x', '$=', '$x = $default' */ +sigscalarelem: + '$' sigvarname sigdefault + { + OP *var = $2; + OP *defexpr = $3; + + if (parser->sig_slurpy) + yyerror("Slurpy parameter not last"); + + parser->sig_elems++; + + if (defexpr) { + parser->sig_optelems++; + + if ( defexpr->op_type == OP_NULL + && !(defexpr->op_flags & OPf_KIDS)) + { + /* handle '$=' special case */ + if (var) + yyerror("Optional parameter " + "lacks default expression"); + op_free(defexpr); + } + else { + /* a normal '=default' expression */ + OP *defop = (OP*)alloc_LOGOP(OP_ARGDEFELEM, + defexpr, + LINKLIST(defexpr)); + /* re-purpose op_targ to hold @_ index */ + defop->op_targ = + (PADOFFSET)(parser->sig_elems - 1); + + if (var) { + var->op_flags |= OPf_STACKED; + (void)op_sibling_splice(var, + NULL, 0, defop); + scalar(defop); + } + else + var = newUNOP(OP_NULL, 0, defop); + + LINKLIST(var); + /* NB: normally the first child of a + * logop is executed before the logop, + * and it pushes a boolean result + * ready for the logop. For ARGDEFELEM, + * the op itself does the boolean + * calculation, so set the first op to + * it instead. + */ + var->op_next = defop; + defexpr->op_next = var; + } + } + else { + if (parser->sig_optelems) + yyerror("Mandatory parameter " + "follows optional parameter"); + } + + $$ = var ? newSTATEOP(0, NULL, var) : NULL; + } + ; + + +/* subroutine signature element: e.g. '$x = $default' or '%h' */ +sigelem: sigscalarelem + { parser->in_my = KEY_sigvar; $$ = $1; } + | sigslurpelem + { parser->in_my = KEY_sigvar; $$ = $1; } + ; + +/* list of subroutine signature elements */ +siglist: + siglist ',' + { $$ = $1; } + | siglist ',' sigelem { - $$ = op_append_list(OP_LINESEQ, $2, - newSTATEOP(0, NULL, sawparens(newNULLLIST()))); - parser->expect = XBLOCK; + $$ = op_append_list(OP_LINESEQ, $1, $3); } + | sigelem %prec PREC_LOW + { $$ = $1; } ; -/* Subroutine body - block with optional signature */ -realsubbody: remember subsignature '{' stmtseq '}' +/* () or (....) */ +siglistornull: /* NULL */ + { $$ = NULL; } + | siglist + { $$ = $1; } + +/* Subroutine signature */ +subsignature: '(' + { + ENTER; + SAVEIV(parser->sig_elems); + SAVEIV(parser->sig_optelems); + SAVEI8(parser->sig_slurpy); + parser->sig_elems = 0; + parser->sig_optelems = 0; + parser->sig_slurpy = 0; + parser->in_my = KEY_sigvar; + } + siglistornull + ')' { - if (parser->copline > (line_t)$3) - parser->copline = (line_t)$3; - $$ = block_end($1, - op_append_list(OP_LINESEQ, $2, $4)); + OP *sigops = $3; + UNOP_AUX_item *aux; + OP *check; + + if (!parser->error_count) { + assert(FEATURE_SIGNATURES_IS_ENABLED); + } + + /* We shouldn't get here otherwise */ + Perl_ck_warner_d(aTHX_ + packWARN(WARN_EXPERIMENTAL__SIGNATURES), + "The signatures feature is experimental"); + + aux = (UNOP_AUX_item*)PerlMemShared_malloc( + sizeof(UNOP_AUX_item) * 3); + aux[0].iv = parser->sig_elems; + aux[1].iv = parser->sig_optelems; + aux[2].iv = parser->sig_slurpy; + check = newUNOP_AUX(OP_ARGCHECK, 0, NULL, aux); + sigops = op_prepend_elem(OP_LINESEQ, check, sigops); + sigops = op_prepend_elem(OP_LINESEQ, + newSTATEOP(0, NULL, NULL), + sigops); + /* a nextstate at the end handles context + * correctly for an empty sub body */ + $$ = op_append_elem(OP_LINESEQ, + sigops, + newSTATEOP(0, NULL, NULL)); + + parser->in_my = 0; + parser->expect = XATTRBLOCK; + LEAVE; } ; + + /* Optional subroutine body, for named subroutine declaration */ -optsubbody: realsubbody { $$ = $1; } - | ';' { $$ = (OP*)NULL; } +optsubbody: block + | ';' { $$ = NULL; } ; /* Ordinary expressions; logical combinations */ @@ -644,7 +840,7 @@ expr : expr ANDOP expr listexpr: listexpr ',' { $$ = $1; } | listexpr ',' term - { + { OP* term = $3; $$ = op_append_elem(OP_LIST, $1, term); } @@ -653,43 +849,43 @@ listexpr: listexpr ',' /* List operators */ listop : LSTOP indirob listexpr /* map {...} @args or print $fh @args */ - { $$ = convert($1, OPf_STACKED, + { $$ = op_convert_list($1, OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF($1,$2), $3) ); } | FUNC '(' indirob expr ')' /* print ($fh @args */ - { $$ = convert($1, OPf_STACKED, + { $$ = op_convert_list($1, OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF($1,$3), $4) ); } | term ARROW method '(' optexpr ')' /* $foo->bar(list) */ - { $$ = convert(OP_ENTERSUB, OPf_STACKED, + { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar($1), $5), newMETHOP(OP_METHOD, 0, $3))); } | term ARROW method /* $foo->bar */ - { $$ = convert(OP_ENTERSUB, OPf_STACKED, + { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar($1), newMETHOP(OP_METHOD, 0, $3))); } | METHOD indirob optlistexpr /* new Class @args */ - { $$ = convert(OP_ENTERSUB, OPf_STACKED, + { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, $2, $3), newMETHOP(OP_METHOD, 0, $1))); } | FUNCMETH indirob '(' optexpr ')' /* method $object (@args) */ - { $$ = convert(OP_ENTERSUB, OPf_STACKED, + { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, $2, $4), newMETHOP(OP_METHOD, 0, $1))); } | LSTOP optlistexpr /* print @args */ - { $$ = convert($1, 0, $2); } + { $$ = op_convert_list($1, 0, $2); } | FUNC '(' optexpr ')' /* print (@args) */ - { $$ = convert($1, 0, $3); } + { $$ = op_convert_list($1, 0, $3); } | LSTOPSUB startanonsub block /* sub f(&@); f { foo } ... */ { SvREFCNT_inc_simple_void(PL_compcv); - $$ = newANONATTRSUB($2, 0, (OP*)NULL, $3); } + $$ = newANONATTRSUB($2, 0, NULL, $3); } optlistexpr %prec LSTOP /* ... @bar */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, @@ -751,7 +947,7 @@ subscripted: gelem '{' expr ';' '}' /* *main::{something} */ | QWLIST '[' expr ']' /* list literal slice */ { $$ = newSLICEOP(0, $3, $1); } | '(' ')' '[' expr ']' /* empty list slice! */ - { $$ = newSLICEOP(0, $4, (OP*)NULL); } + { $$ = newSLICEOP(0, $4, NULL); } ; /* Binary operators between terms */ @@ -797,7 +993,7 @@ termunop : '-' term %prec UMINUS /* -$x */ | '!' term /* !$x */ { $$ = newUNOP(OP_NOT, 0, scalar($2)); } | '~' term /* ~$x */ - { $$ = newUNOP(OP_COMPLEMENT, 0, scalar($2)); } + { $$ = newUNOP($1, 0, scalar($2)); } | term POSTINC /* $x++ */ { $$ = newUNOP(OP_POSTINC, 0, op_lvalue(scalar($1), OP_POSTINC)); } @@ -805,7 +1001,7 @@ termunop : '-' term %prec UMINUS /* -$x */ { $$ = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar($1), OP_POSTDEC));} | term POSTJOIN /* implicit join after interpolated ->@ */ - { $$ = convert(OP_JOIN, 0, + { $$ = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, newSVREF(scalar( @@ -828,14 +1024,24 @@ termunop : '-' term %prec UMINUS /* -$x */ anonymous: '[' expr ']' { $$ = newANONLIST($2); } | '[' ']' - { $$ = newANONLIST((OP*)NULL);} + { $$ = newANONLIST(NULL);} | HASHBRACK expr ';' '}' %prec '(' /* { foo => "Bar" } */ { $$ = newANONHASH($2); } | HASHBRACK ';' '}' %prec '(' /* { } (';' by tokener) */ - { $$ = newANONHASH((OP*)NULL); } - | ANONSUB startanonsub proto subattrlist realsubbody %prec '(' + { $$ = newANONHASH(NULL); } + | ANONSUB startanonsub proto subattrlist block %prec '(' { SvREFCNT_inc_simple_void(PL_compcv); $$ = newANONATTRSUB($2, $3, $4, $5); } + | ANONSUB startanonsub remember subsignature subattrlist '{' stmtseq '}' %prec '(' + { + OP *body; + if (parser->copline > (line_t)$6) + parser->copline = (line_t)$6; + body = block_end($3, + op_append_list(OP_LINESEQ, $4, $7)); + SvREFCNT_inc_simple_void(PL_compcv); + $$ = newANONATTRSUB($2, NULL, $5, body); + } ; @@ -853,11 +1059,13 @@ term : termbinop | term '?' term ':' term { $$ = newCONDOP(0, $1, $3, $5); } | REFGEN term /* \$x, \@y, \%z */ - { $$ = newUNOP(OP_REFGEN, 0, op_lvalue($2,OP_REFGEN)); } + { $$ = newUNOP(OP_REFGEN, 0, $2); } + | MY REFGEN term + { $$ = newUNOP(OP_REFGEN, 0, localize($3,1)); } | myattrterm %prec UNIOP { $$ = $1; } | LOCAL term %prec UNIOP - { $$ = localize($2,$1); } + { $$ = localize($2,0); } | '(' expr ')' { $$ = sawparens($2); } | QWLIST @@ -992,9 +1200,9 @@ term : termbinop } else $$ = 0; } - '(' listexpr ')' - { $$ = pmruntime($1, $4, 1, $2); } - | WORD + '(' listexpr optrepl ')' + { $$ = pmruntime($1, $4, $5, 1, $2); } + | BAREWORD | listop | YADAYADA { @@ -1008,7 +1216,9 @@ term : termbinop myattrterm: MY myterm myattrlist { $$ = my_attrs($2,$3); } | MY myterm - { $$ = localize($2,$1); } + { $$ = localize($2,1); } + | MY REFGEN myterm myattrlist + { $$ = newUNOP(OP_REFGEN, 0, my_attrs($3,$4)); } ; /* Things that can be "my"'d */ @@ -1027,17 +1237,23 @@ myterm : '(' expr ')' /* Basic list expressions */ optlistexpr: /* NULL */ %prec PREC_LOW - { $$ = (OP*)NULL; } + { $$ = NULL; } | listexpr %prec PREC_LOW { $$ = $1; } ; optexpr: /* NULL */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | expr { $$ = $1; } ; +optrepl: /* NULL */ + { $$ = NULL; } + | '/' expr + { $$ = $2; } + ; + /* A little bit of trickery to make "for my $foo (@bar)" actually be lexical */ my_scalar: scalar @@ -1053,6 +1269,10 @@ refgen_topic: my_var | amper ; +my_refgen: MY REFGEN + | REFGEN MY + ; + amper : '&' indirob { $$ = newCVREF($1,$2); } ; @@ -1099,7 +1319,7 @@ gelem : star ; /* Indirect objects */ -indirob : WORD +indirob : BAREWORD { $$ = scalar($1); } | scalar %prec PREC_LOW { $$ = scalar($1); }