X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/8635e3c238f87f82dab918053e6f0b6a1a2525e6..a4f8ff4607cb674cb0c6feeb56b8eb80bbe28259:/perly.y?ds=sidebyside diff --git a/perly.y b/perly.y index 839575d..4b73977 100644 --- a/perly.y +++ b/perly.y @@ -45,7 +45,7 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ -%token '{' '}' '[' ']' '-' '+' '$' '@' '%' '*' '&' ';' '=' '.' +%token '{' '}' '[' ']' '-' '+' '@' '%' '&' '=' '.' %token WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST %token FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB @@ -70,11 +70,11 @@ %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 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 @@ -194,7 +194,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 '}' @@ -205,7 +206,8 @@ 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 */ @@ -258,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 { @@ -293,6 +295,46 @@ 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 ';' { @@ -307,6 +349,7 @@ barestmt: PLUGSTMT { SvREFCNT_inc_simple_void(PL_compcv); utilize($1, $2, $4, $5, $6); + parser->parsed_sub = 1; $$ = (OP*)NULL; } | IF '(' remember mexpr ')' mblock else @@ -366,6 +409,7 @@ barestmt: PLUGSTMT newOP(OP_UNSTACK, OPf_SPECIAL), forop)); } + PL_hints |= HINT_BLOCK_SCOPE; $$ = block_end($3, forop); parser->copline = (line_t)$1; } @@ -594,13 +638,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"); @@ -610,22 +653,12 @@ subsignature: /* NULL */ { $$ = (OP*)NULL; } { $$ = op_append_list(OP_LINESEQ, $2, newSTATEOP(0, NULL, sawparens(newNULLLIST()))); - parser->expect = XBLOCK; - } - ; - -/* Subroutine body - block with optional signature */ -realsubbody: remember subsignature '{' stmtseq '}' - { - if (parser->copline > (line_t)$3) - 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; } ; @@ -643,7 +676,7 @@ expr : expr ANDOP expr listexpr: listexpr ',' { $$ = $1; } | listexpr ',' term - { + { OP* term = $3; $$ = op_append_elem(OP_LIST, $1, term); } @@ -796,7 +829,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)); } @@ -832,9 +865,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); + } ; @@ -852,7 +895,7 @@ 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); } | myattrterm %prec UNIOP { $$ = $1; } | LOCAL term %prec UNIOP @@ -991,8 +1034,8 @@ term : termbinop } else $$ = 0; } - '(' listexpr ')' - { $$ = pmruntime($1, $4, 1, $2); } + '(' listexpr optrepl ')' + { $$ = pmruntime($1, $4, $5, 1, $2); } | WORD | listop | YADAYADA @@ -1037,6 +1080,12 @@ 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