X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/5c86b6dfc4a5c74dad9f83a08d08b4536632cda1..ef269bf5f55cf5087c6190ddbf34459c60a69622:/perly.y diff --git a/perly.y b/perly.y index e2f934f..6eb4b23 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,11 +69,12 @@ %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 formname subname proto optsubbody cont my_scalar formblock +%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 subsignature termbinop termunop anonymous termdo %type formstmtseq formline formarg %nonassoc PREC_LOW @@ -112,11 +113,12 @@ /* Top-level choice of what kind of thing yyparse was called to parse */ grammar : GRAMPROG { - PL_parser->expect = XSTATE; + parser->expect = XSTATE; } remember stmtseq { newPROG(block_end($3,$4)); + PL_compiling.cop_seq = 0; $$ = 0; } | GRAMEXPR @@ -177,33 +179,35 @@ grammar : GRAMPROG /* An ordinary block */ block : '{' remember stmtseq '}' - { if (PL_parser->copline > (line_t)$1) - PL_parser->copline = (line_t)$1; + { if (parser->copline > (line_t)$1) + parser->copline = (line_t)$1; $$ = block_end($2, $3); } ; /* format body */ formblock: '=' remember ';' FORMRBRACK formstmtseq ';' '.' - { if (PL_parser->copline > (line_t)$1) - PL_parser->copline = (line_t)$1; + { if (parser->copline > (line_t)$1) + parser->copline = (line_t)$1; $$ = block_end($2, $5); } ; remember: /* NULL */ /* start a full lexical scope */ - { $$ = block_start(TRUE); } + { $$ = block_start(TRUE); + parser->parsed_sub = 0; } ; mblock : '{' mremember stmtseq '}' - { if (PL_parser->copline > (line_t)$1) - PL_parser->copline = (line_t)$1; + { if (parser->copline > (line_t)$1) + parser->copline = (line_t)$1; $$ = block_end($2, $3); } ; mremember: /* NULL */ /* start a partial lexical scope */ - { $$ = block_start(FALSE); } + { $$ = block_start(FALSE); + parser->parsed_sub = 0; } ; /* A sequence of statements in the program */ @@ -256,9 +260,9 @@ barestmt: PLUGSTMT newFORM($2, $3, $4); $$ = (OP*)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 { @@ -279,8 +283,8 @@ barestmt: PLUGSTMT CvOUTSIDE(PL_compcv) ))[$2->op_targ])) CvCLONE_on(PL_compcv); - PL_parser->in_my = 0; - PL_parser->in_my_stash = NULL; + parser->in_my = 0; + parser->in_my_stash = NULL; } proto subattrlist optsubbody { @@ -291,8 +295,48 @@ barestmt: PLUGSTMT ; $$ = (OP*)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) + ; + $$ = (OP*)NULL; + intro_my(); + parser->parsed_sub = 1; } - | PACKAGE WORD WORD ';' + | PACKAGE BAREWORD BAREWORD ';' { package($3); if ($2) @@ -301,34 +345,29 @@ barestmt: PLUGSTMT } | 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; } | IF '(' remember mexpr ')' mblock else { $$ = block_end($3, newCONDOP(0, $4, op_scope($6), $7)); - PL_parser->copline = (line_t)$1; + 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)); - PL_parser->copline = (line_t)$1; + 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)); - PL_parser->copline = (line_t)$1; + $$ = block_end($3, newGIVENOP($4, op_scope($6), 0)); + parser->copline = (line_t)$1; } | WHEN '(' remember mexpr ')' mblock { $$ = block_end($3, newWHENOP($4, op_scope($6))); } @@ -339,14 +378,14 @@ barestmt: PLUGSTMT $$ = block_end($3, newWHILEOP(0, 1, (LOOP*)(OP*)NULL, $4, $7, $8, $6)); - PL_parser->copline = (line_t)$1; + parser->copline = (line_t)$1; } | UNTIL '(' remember iexpr ')' mintro mblock cont { $$ = block_end($3, newWHILEOP(0, 1, (LOOP*)(OP*)NULL, $4, $7, $8, $6)); - PL_parser->copline = (line_t)$1; + parser->copline = (line_t)$1; } | FOR '(' remember mnexpr ';' { parser->expect = XTERM; } @@ -364,25 +403,49 @@ barestmt: PLUGSTMT newOP(OP_UNSTACK, OPf_SPECIAL), forop)); } + PL_hints |= HINT_BLOCK_SCOPE; $$ = block_end($3, forop); - PL_parser->copline = (line_t)$1; + parser->copline = (line_t)$1; } | FOR MY remember my_scalar '(' mexpr ')' mblock cont { $$ = block_end($3, newFOROP(0, $4, $6, $8, $9)); - PL_parser->copline = (line_t)$1; + parser->copline = (line_t)$1; } | FOR scalar '(' remember mexpr ')' mblock cont { $$ = block_end($4, newFOROP(0, op_lvalue($2, OP_ENTERLOOP), $5, $7, $8)); - PL_parser->copline = (line_t)$1; + parser->copline = (line_t)$1; + } + | FOR my_refgen remember my_var + { parser->in_my = 0; $$ = my($4); } + '(' mexpr ')' mblock cont + { + $$ = block_end( + $3, + newFOROP(0, + op_lvalue( + newUNOP(OP_REFGEN, 0, + $5), + OP_ENTERLOOP), + $7, $9, $10) + ); + parser->copline = (line_t)$1; + } + | FOR REFGEN refgen_topic '(' remember mexpr ')' mblock cont + { + $$ = block_end($5, newFOROP( + 0, op_lvalue(newUNOP(OP_REFGEN, 0, + $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)); - PL_parser->copline = (line_t)$1; + parser->copline = (line_t)$1; } | block cont { @@ -390,7 +453,7 @@ barestmt: PLUGSTMT $$ = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, (OP*)NULL, $1, $2, 0); } - | PACKAGE WORD WORD '{' remember + | PACKAGE BAREWORD BAREWORD '{' remember { package($3); if ($2) { @@ -402,8 +465,8 @@ barestmt: PLUGSTMT /* a block is a loop that happens once */ $$ = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, (OP*)NULL, block_end($5, $7), (OP*)NULL, 0); - if (PL_parser->copline > (line_t)$4) - PL_parser->copline = (line_t)$4; + if (parser->copline > (line_t)$4) + parser->copline = (line_t)$4; } | sideff ';' { @@ -412,7 +475,7 @@ barestmt: PLUGSTMT | ';' { $$ = (OP*)NULL; - PL_parser->copline = NOLINE; + parser->copline = NOLINE; } ; @@ -426,11 +489,11 @@ formline: THING formarg else { list = $1; } - if (PL_parser->copline == NOLINE) - PL_parser->copline = CopLINE(PL_curcop)-1; - else PL_parser->copline--; + if (parser->copline == NOLINE) + parser->copline = CopLINE(PL_curcop)-1; + else parser->copline--; $$ = newSTATEOP(0, NULL, - convert(OP_FORMLINE, 0, list)); + op_convert_list(OP_FORMLINE, 0, list)); } ; @@ -455,7 +518,7 @@ sideff : error { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1); } | expr FOR expr { $$ = newFOROP(0, (OP*)NULL, $3, $1, (OP*)NULL); - PL_parser->copline = (line_t)$2; } + parser->copline = (line_t)$2; } | expr WHEN expr { $$ = newWHENOP($3, op_scope($1)); } ; @@ -469,7 +532,7 @@ else : /* NULL */ $$ = op_scope($2); } | ELSIF '(' mexpr ')' mblock else - { PL_parser->copline = (line_t)$1; + { parser->copline = (line_t)$1; $$ = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,$3), op_scope($5), $6); @@ -518,11 +581,7 @@ mnexpr : nexpr { $$ = $1; intro_my(); } ; -miexpr : iexpr - { $$ = $1; intro_my(); } - ; - -formname: WORD { $$ = $1; } +formname: BAREWORD { $$ = $1; } | /* NULL */ { $$ = (OP*)NULL; } ; @@ -543,7 +602,7 @@ startformsub: /* NULL */ /* start a format subroutine scope */ ; /* Name of a subroutine - must be a bareword, could be special */ -subname : WORD +subname : BAREWORD | PRIVATEREF ; @@ -569,13 +628,12 @@ myattrlist: COLONATTR THING { $$ = (OP*)NULL; } ; -/* Optional subroutine signature */ -subsignature: /* NULL */ { $$ = (OP*)NULL; } - | '(' +/* Subroutine signature */ +subsignature: '(' { - if (!FEATURE_SIGNATURES_IS_ENABLED) - Perl_croak(aTHX_ "Experimental " - "subroutine signatures not enabled"); + /* 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"); @@ -585,22 +643,12 @@ subsignature: /* NULL */ { $$ = (OP*)NULL; } { $$ = op_append_list(OP_LINESEQ, $2, newSTATEOP(0, NULL, sawparens(newNULLLIST()))); - PL_parser->expect = XBLOCK; - } - ; - -/* Subroutine body - block with optional signature */ -realsubbody: remember subsignature '{' stmtseq '}' - { - if (PL_parser->copline > (line_t)$3) - PL_parser->copline = (line_t)$3; - $$ = block_end($1, - op_append_list(OP_LINESEQ, $2, $4)); + parser->expect = XATTRBLOCK; } ; /* Optional subroutine body, for named subroutine declaration */ -optsubbody: realsubbody { $$ = $1; } +optsubbody: block | ';' { $$ = (OP*)NULL; } ; @@ -618,7 +666,7 @@ expr : expr ANDOP expr listexpr: listexpr ',' { $$ = $1; } | listexpr ',' term - { + { OP* term = $3; $$ = op_append_elem(OP_LIST, $1, term); } @@ -627,40 +675,40 @@ 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), - newUNOP(OP_METHOD, 0, $3))); + 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), - newUNOP(OP_METHOD, 0, $3))); + 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), - newUNOP(OP_METHOD, 0, $1))); + 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), - newUNOP(OP_METHOD, 0, $1))); + 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); } @@ -771,7 +819,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)); } @@ -779,7 +827,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( @@ -807,9 +855,19 @@ anonymous: '[' expr ']' { $$ = newANONHASH($2); } | HASHBRACK ';' '}' %prec '(' /* { } (';' by tokener) */ { $$ = newANONHASH((OP*)NULL); } - | ANONSUB startanonsub proto subattrlist realsubbody %prec '(' + | 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); + } ; @@ -827,11 +885,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 @@ -966,9 +1026,9 @@ term : termbinop } else $$ = 0; } - '(' listexpr ')' - { $$ = pmruntime($1, $4, 1, $2); } - | WORD + '(' listexpr optrepl ')' + { $$ = pmruntime($1, $4, $5, 1, $2); } + | BAREWORD | listop | YADAYADA { @@ -982,7 +1042,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 */ @@ -1012,10 +1074,29 @@ optexpr: /* NULL */ { $$ = $1; } ; +optrepl: /* NULL */ + { $$ = (OP*)NULL; } + | '/' expr + { $$ = $2; } + ; + /* A little bit of trickery to make "for my $foo (@bar)" actually be lexical */ my_scalar: scalar - { PL_parser->in_my = 0; $$ = my($1); } + { parser->in_my = 0; $$ = my($1); } + ; + +my_var : scalar + | ary + | hsh + ; + +refgen_topic: my_var + | amper + ; + +my_refgen: MY REFGEN + | REFGEN MY ; amper : '&' indirob @@ -1064,7 +1145,7 @@ gelem : star ; /* Indirect objects */ -indirob : WORD +indirob : BAREWORD { $$ = scalar($1); } | scalar %prec PREC_LOW { $$ = scalar($1); }