X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/28383d1aefa4f4c119153a5ed41ebf82ecd7a062..d33c0cb5873af9140aa5c05ab0a6daabd94c6a07:/perly.y diff --git a/perly.y b/perly.y index e7cea35..0325d66 100644 --- a/perly.y +++ b/perly.y @@ -43,15 +43,15 @@ GV *gvval; } -%token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ +%token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE %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 -%token FORMAT SUB ANONSUB PACKAGE USE +%token LABEL +%token FORMAT SUB SIGSUB ANONSUB ANON_SIGSUB PACKAGE USE %token WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR %token GIVEN WHEN DEFAULT %token LOOPEX DOTDOT YADAYADA @@ -60,6 +60,7 @@ %token DOLSHARP DO HASHBRACK NOAMP %token LOCAL MY REQUIRE %token COLONATTR FORMLBRACK FORMRBRACK +%token SUBLEXSTART SUBLEXEND %type grammar remember mremember %type startsub startanonsub startformsub @@ -71,10 +72,14 @@ %type sliceme kvslice gelem %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 formname subname proto cont my_scalar my_var %type refgen_topic formblock %type subattrlist myattrlist myattrterm myterm -%type subsignature termbinop termunop anonymous termdo +%type termbinop termunop anonymous termdo +%type sigslurpsigil +%type sigvarname sigdefault sigscalarelem sigslurpelem +%type sigelem siglist siglistornull subsigguts subsignature optsubsignature +%type subbody optsubbody sigsubbody optsigsubbody %type formstmtseq formline formarg %nonassoc PREC_LOW @@ -87,7 +92,7 @@ %left ',' %right ASSIGNOP %right '?' ':' -%nonassoc DOTDOT YADAYADA +%nonassoc DOTDOT %left OROR DORDOR %left ANDAND %left BITOROP @@ -114,6 +119,7 @@ grammar : GRAMPROG { parser->expect = XSTATE; + $$ = 0; } remember stmtseq { @@ -124,6 +130,7 @@ grammar : GRAMPROG | GRAMEXPR { parser->expect = XTERM; + $$ = 0; } optexpr { @@ -133,6 +140,7 @@ grammar : GRAMPROG | GRAMBLOCK { parser->expect = XBLOCK; + $$ = 0; } block { @@ -140,11 +148,12 @@ grammar : GRAMPROG PL_eval_root = $3; $$ = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } | GRAMBARESTMT { parser->expect = XSTATE; + $$ = 0; } barestmt { @@ -152,11 +161,12 @@ grammar : GRAMPROG PL_eval_root = $3; $$ = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } | GRAMFULLSTMT { parser->expect = XSTATE; + $$ = 0; } fullstmt { @@ -164,17 +174,28 @@ grammar : GRAMPROG PL_eval_root = $3; $$ = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } | GRAMSTMTSEQ { parser->expect = XSTATE; + $$ = 0; } stmtseq { PL_eval_root = $3; $$ = 0; } + | GRAMSUBSIGNATURE + { + parser->expect = XSTATE; + $$ = 0; + } + subsigguts + { + PL_eval_root = $3; + $$ = 0; + } ; /* An ordinary block */ @@ -212,7 +233,7 @@ mremember: /* NULL */ /* start a partial lexical scope */ /* 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; @@ -223,7 +244,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; @@ -243,11 +264,17 @@ fullstmt: barestmt labfullstmt: LABEL barestmt { - $$ = newSTATEOP(SVf_UTF8 * $1[strlen($1)+1], $1, $2); + SV *label = cSVOPx_sv($1); + $$ = newSTATEOP(SvFLAGS(label) & SVf_UTF8, + savepv(SvPVX_const(label)), $2); + op_free($1); } | LABEL labfullstmt { - $$ = newSTATEOP(SVf_UTF8 * $1[strlen($1)+1], $1, $2); + SV *label = cSVOPx_sv($1); + $$ = newSTATEOP(SvFLAGS(label) & SVf_UTF8, + savepv(SvPVX_const(label)), $2); + op_free($1); } ; @@ -258,99 +285,67 @@ barestmt: PLUGSTMT { CV *fmtcv = PL_compcv; newFORM($2, $3, $4); - $$ = (OP*)NULL; + $$ = NULL; if (CvOUTSIDE(fmtcv) && !CvEVAL(CvOUTSIDE(fmtcv))) { pad_add_weakref(fmtcv); } parser->parsed_sub = 1; } | SUB subname startsub + /* sub declaration or definition not within scope + of 'use feature "signatures"'*/ { - 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); + init_named_cv(PL_compcv, $2); parser->in_my = 0; parser->in_my_stash = NULL; } - proto subattrlist optsubbody + proto subattrlist optsubbody { SvREFCNT_inc_simple_void(PL_compcv); $2->op_type == OP_CONST ? newATTRSUB($3, $2, $5, $6, $7) : newMYSUB($3, $2, $5, $6, $7) ; - $$ = (OP*)NULL; + $$ = NULL; intro_my(); parser->parsed_sub = 1; } - | SUB subname startsub + | SIGSUB subname startsub + /* sub declaration or definition under 'use feature + * "signatures"'. (Note that a signature isn't + * allowed in a declaration) + */ { - 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); + init_named_cv(PL_compcv, $2); parser->in_my = 0; parser->in_my_stash = NULL; } - remember subsignature subattrlist '{' stmtseq '}' + subattrlist optsigsubbody { - 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) + ? newATTRSUB($3, $2, NULL, $5, $6) + : newMYSUB( $3, $2, NULL, $5, $6) ; - $$ = (OP*)NULL; + $$ = 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); parser->parsed_sub = 1; - $$ = (OP*)NULL; + $$ = NULL; } | IF '(' remember mexpr ')' mblock else { @@ -376,14 +371,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; } @@ -395,7 +390,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, @@ -418,18 +413,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, - $6), + $5), OP_ENTERLOOP), - $8, $10, $11) + $7, $9, $10) ); parser->copline = (line_t)$1; } @@ -444,16 +439,16 @@ barestmt: PLUGSTMT | 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) { @@ -463,8 +458,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; } @@ -472,9 +467,14 @@ barestmt: PLUGSTMT { $$ = $1; } + | YADAYADA ';' + { + $$ = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), + newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); + } | ';' { - $$ = (OP*)NULL; + $$ = NULL; parser->copline = NOLINE; } ; @@ -505,7 +505,7 @@ formarg : /* NULL */ /* An expression which may have a side-effect */ sideff : error - { $$ = (OP*)NULL; } + { $$ = NULL; } | expr { $$ = $1; } | expr IF expr @@ -517,7 +517,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)); } @@ -525,7 +525,7 @@ sideff : error /* else and elsif blocks */ else : /* NULL */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | ELSE mblock { ($2)->op_flags |= OPf_PARENS; @@ -542,7 +542,7 @@ else : /* NULL */ /* Continue blocks */ cont : /* NULL */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | CONTINUE block { $$ = op_scope($2); } ; @@ -555,7 +555,7 @@ mintro : /* NULL */ /* Normal expression */ nexpr : /* NULL */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | sideff ; @@ -581,8 +581,8 @@ mnexpr : nexpr { $$ = $1; intro_my(); } ; -formname: WORD { $$ = $1; } - | /* NULL */ { $$ = (OP*)NULL; } +formname: BAREWORD { $$ = $1; } + | /* NULL */ { $$ = NULL; } ; startsub: /* NULL */ /* start a regular subroutine scope */ @@ -602,56 +602,280 @@ 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; } ; -/* Subroutine signature */ -subsignature: '(' - { - /* We shouldn't get here otherwise */ - assert(FEATURE_SIGNATURES_IS_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, $1, $3); } - ')' + | sigelem %prec PREC_LOW + { $$ = $1; } + ; + +/* () or (....) */ +siglistornull: /* NULL */ + { $$ = NULL; } + | siglist + { $$ = $1; } + +/* optional subroutine signature */ +optsubsignature: /* NULL */ + { $$ = NULL; } + | subsignature + { $$ = $1; } + +/* Subroutine signature */ +subsignature: '(' subsigguts ')' + { $$ = $2; } + +subsigguts: + { + 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 { - $$ = op_append_list(OP_LINESEQ, $2, - newSTATEOP(0, NULL, sawparens(newNULLLIST()))); - parser->expect = XATTRBLOCK; + OP *sigops = $2; + struct op_argcheck_aux *aux; + OP *check; + + if (!FEATURE_SIGNATURES_IS_ENABLED) + Perl_croak(aTHX_ "Experimental " + "subroutine signatures not enabled"); + + /* We shouldn't get here otherwise */ + Perl_ck_warner_d(aTHX_ + packWARN(WARN_EXPERIMENTAL__SIGNATURES), + "The signatures feature is experimental"); + + aux = (struct op_argcheck_aux*) + PerlMemShared_malloc( + sizeof(struct op_argcheck_aux)); + aux->params = parser->sig_elems; + aux->opt_params = parser->sig_optelems; + aux->slurpy = parser->sig_slurpy; + check = newUNOP_AUX(OP_ARGCHECK, 0, NULL, + (UNOP_AUX_item *)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 */ + sigops = op_append_elem(OP_LINESEQ, + sigops, + newSTATEOP(0, NULL, NULL)); + /* wrap the list of arg ops in a NULL aux op. + This serves two purposes. First, it makes + the arg list a separate subtree from the + body of the sub, and secondly the null op + may in future be upgraded to an OP_SIGNATURE + when implemented. For now leave it as + ex-argcheck */ + $$ = newUNOP_AUX(OP_ARGCHECK, 0, sigops, NULL); + op_null($$); + + parser->in_my = 0; + /* tell the toker that attrributes can follow + * this sig, but only so that the toker + * can skip through any (illegal) trailing + * attribute text then give a useful error + * message about "attributes before sig", + * rather than falling over ina mess at + * unrecognised syntax. + */ + parser->expect = XATTRBLOCK; + parser->sig_seen = TRUE; + LEAVE; } ; -/* Optional subroutine body, for named subroutine declaration */ -optsubbody: block - | ';' { $$ = (OP*)NULL; } +/* Optional subroutine body (for named subroutine declaration) */ +optsubbody: subbody { $$ = $1; } + | ';' { $$ = NULL; } + ; + + +/* Subroutine body (without signature) */ +subbody: remember '{' stmtseq '}' + { + if (parser->copline > (line_t)$2) + parser->copline = (line_t)$2; + $$ = block_end($1, $3); + } ; + +/* optional [ Subroutine body with optional signature ] (for named + * subroutine declaration) */ +optsigsubbody: sigsubbody { $$ = $1; } + | ';' { $$ = NULL; } + +/* Subroutine body with optional signature */ +sigsubbody: remember optsubsignature '{' stmtseq '}' + { + if (parser->copline > (line_t)$3) + parser->copline = (line_t)$3; + $$ = block_end($1, + op_append_list(OP_LINESEQ, $2, $4)); + } + ; + + /* Ordinary expressions; logical combinations */ expr : expr ANDOP expr { $$ = newLOGOP(OP_AND, 0, $1, $3); } @@ -709,9 +933,11 @@ listop : LSTOP indirob listexpr /* map {...} @args or print $fh @args */ { $$ = op_convert_list($1, 0, $2); } | FUNC '(' optexpr ')' /* print (@args) */ { $$ = op_convert_list($1, 0, $3); } + | FUNC SUBLEXSTART optexpr SUBLEXEND /* uc($arg) from "\U..." */ + { $$ = 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, @@ -755,29 +981,41 @@ subscripted: gelem '{' expr ';' '}' /* *main::{something} */ jmaybe($3)); } | term ARROW '(' ')' /* $subref->() */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, - newCVREF(0, scalar($1))); } + newCVREF(0, scalar($1))); + if (parser->expect == XBLOCK) + parser->expect = XOPERATOR; + } | term ARROW '(' expr ')' /* $subref->(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, $4, - newCVREF(0, scalar($1)))); } + newCVREF(0, scalar($1)))); + if (parser->expect == XBLOCK) + parser->expect = XOPERATOR; + } | subscripted '(' expr ')' /* $foo->{bar}->(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, $3, - newCVREF(0, scalar($1)))); } + newCVREF(0, scalar($1)))); + if (parser->expect == XBLOCK) + parser->expect = XOPERATOR; + } | subscripted '(' ')' /* $foo->{bar}->() */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, - newCVREF(0, scalar($1))); } + newCVREF(0, scalar($1))); + if (parser->expect == XBLOCK) + parser->expect = XOPERATOR; + } | '(' expr ')' '[' expr ']' /* list slice */ { $$ = newSLICEOP(0, $5, $2); } | 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 */ -termbinop: term ASSIGNOP term /* $x = $y */ +termbinop: term ASSIGNOP term /* $x = $y, $x += $y */ { $$ = newASSIGNOP(OPf_STACKED, $1, $2, $3); } | term POWOP term /* $x ** $y */ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } @@ -850,25 +1088,17 @@ 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 block %prec '(' + { $$ = newANONHASH(NULL); } + | ANONSUB startanonsub proto subattrlist subbody %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); - } - + | ANON_SIGSUB startanonsub subattrlist sigsubbody %prec '(' + { SvREFCNT_inc_simple_void(PL_compcv); + $$ = newANONATTRSUB($2, NULL, $3, $4); } ; /* Things called with "do" */ @@ -886,6 +1116,8 @@ term : termbinop { $$ = newCONDOP(0, $1, $3, $5); } | REFGEN term /* \$x, \@y, \%z */ { $$ = newUNOP(OP_REFGEN, 0, $2); } + | MY REFGEN term + { $$ = newUNOP(OP_REFGEN, 0, localize($3,1)); } | myattrterm %prec UNIOP { $$ = $1; } | LOCAL term %prec UNIOP @@ -1024,15 +1256,10 @@ term : termbinop } else $$ = 0; } - '(' listexpr optrepl ')' + SUBLEXSTART listexpr optrepl SUBLEXEND { $$ = pmruntime($1, $4, $5, 1, $2); } - | WORD + | BAREWORD | listop - | YADAYADA - { - $$ = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), - newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); - } | PLUGEXPR ; @@ -1041,6 +1268,8 @@ myattrterm: MY myterm myattrlist { $$ = my_attrs($2,$3); } | MY myterm { $$ = localize($2,1); } + | MY REFGEN myterm myattrlist + { $$ = newUNOP(OP_REFGEN, 0, my_attrs($3,$4)); } ; /* Things that can be "my"'d */ @@ -1059,19 +1288,19 @@ 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 */ - { $$ = (OP*)NULL; } + { $$ = NULL; } | '/' expr { $$ = $2; } ; @@ -1091,6 +1320,10 @@ refgen_topic: my_var | amper ; +my_refgen: MY REFGEN + | REFGEN MY + ; + amper : '&' indirob { $$ = newCVREF($1,$2); } ; @@ -1137,7 +1370,7 @@ gelem : star ; /* Indirect objects */ -indirob : WORD +indirob : BAREWORD { $$ = scalar($1); } | scalar %prec PREC_LOW { $$ = scalar($1); }